[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 0a6c447: Implement access-file in Tramp
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] master 0a6c447: Implement access-file in Tramp |
Date: |
Tue, 19 Feb 2019 08:00:28 -0500 (EST) |
branch: master
commit 0a6c4479cff17b487580abe3a7ee202e71be25d2
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Implement access-file in Tramp
* lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
* lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist):
* lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
* lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist):
* lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist)
* lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist):
Add `access-file'.
* lisp/net/tramp-archive.el (tramp-archive-handle-access-file):
* lisp/net/tramp.el (tramp-handle-access-file): New defun.
(tramp-condition-case-unless-debug): Add declaration.
(tramp-handle-insert-directory):
* lisp/net/tramp-sh.el (tramp-sh-handle-insert-directory):
* lisp/net/tramp-smb.el (tramp-smb-handle-insert-directory):
Check, whether directory is accessible.
* test/lisp/net/tramp-archive-tests.el
(tramp-archive-test17-insert-directory)
(tramp-archive-test18-file-attributes):
* test/lisp/net/tramp-tests.el (tramp-test17-insert-directory)
(tramp-test18-file-attributes): Test error cases.
---
lisp/net/tramp-adb.el | 2 +-
lisp/net/tramp-archive.el | 6 +++++-
lisp/net/tramp-gvfs.el | 2 +-
lisp/net/tramp-rclone.el | 2 +-
lisp/net/tramp-sh.el | 5 ++++-
lisp/net/tramp-smb.el | 5 ++++-
lisp/net/tramp-sudoedit.el | 2 +-
lisp/net/tramp.el | 11 +++++++++++
test/lisp/net/tramp-archive-tests.el | 21 ++++++++++++++++++---
test/lisp/net/tramp-tests.el | 26 +++++++++++++++++++++-----
10 files changed, 67 insertions(+), 15 deletions(-)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 4fba4e1..f3ba7f2 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -88,7 +88,7 @@ It is used for TCP/IP devices."
;;;###tramp-autoload
(defconst tramp-adb-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index f975ccf..db9aec0 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -209,7 +209,7 @@ It must be supported by libarchive(3).")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-archive-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-archive-handle-access-file)
(add-name-to-file . tramp-archive-handle-not-implemented)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
@@ -531,6 +531,10 @@ offered."
;; File name primitives.
+(defun tramp-archive-handle-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (access-file (tramp-archive-gvfs-file-name filename) string))
+
(defun tramp-archive-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index bc45acd..ccbb522 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -523,7 +523,7 @@ It has been changed in GVFS 1.14.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-gvfs-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 3a0e002..698296b 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -66,7 +66,7 @@
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-rclone-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 404fae9..49bc9bf 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -940,7 +940,7 @@ of command line.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-sh-file-name-handler-alist
- '(;; `access-file' performed by default handler.
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sh-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-sh-handle-copy-directory)
@@ -2574,6 +2574,9 @@ The method used must be an out-of-band method."
"Like `insert-directory' for Tramp files."
(setq filename (expand-file-name filename))
(unless switches (setq switches ""))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
(with-parsed-tramp-file-name filename nil
(if (and (featurep 'ls-lisp)
(not (symbol-value 'ls-lisp-use-insert-directory-program)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index fb9073b..f57c76c 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -214,7 +214,7 @@ See `tramp-actions-before-shell' for more info.")
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-smb-file-name-handler-alist
- '(;; `access-file' performed by default handler.
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-smb-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
(copy-directory . tramp-smb-handle-copy-directory)
@@ -994,6 +994,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Called from `dired-add-entry'.
(setq filename (file-name-as-directory filename))
(setq filename (directory-file-name filename)))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
(with-parsed-tramp-file-name filename nil
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(save-match-data
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 04b0beb..60eb212 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -63,7 +63,7 @@ See `tramp-actions-before-shell' for more info.")
;;;###tramp-autoload
(defconst tramp-sudoedit-file-name-handler-alist
- '((access-file . ignore)
+ '((access-file . tramp-handle-access-file)
(add-name-to-file . tramp-sudoedit-handle-add-name-to-file)
(byte-compiler-base-file-name . ignore)
;; `copy-directory' performed by default handler.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d000bbe..efe7503 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2310,6 +2310,7 @@ ARGS are the arguments OPERATION has been called with."
(defmacro tramp-condition-case-unless-debug
(var bodyform &rest handlers)
"Like `condition-case-unless-debug' but `tramp-debug-on-error'."
+ (declare (debug condition-case) (indent 2))
`(let ((debug-on-error tramp-debug-on-error))
(condition-case-unless-debug ,var ,bodyform ,@handlers)))
@@ -3060,6 +3061,13 @@ User is always nil."
(defvar tramp-handle-write-region-hook nil
"Normal hook to be run at the end of `tramp-*-handle-write-region'.")
+(defun tramp-handle-access-file (filename string)
+ "Like `access-file' for Tramp files."
+ (unless (file-readable-p filename)
+ (tramp-error
+ (tramp-dissect-file-name filename) tramp-file-missing
+ "%s: No such file or directory %s" string filename)))
+
(defun tramp-handle-add-name-to-file
(filename newname &optional ok-if-already-exists)
"Like `add-name-to-file' for Tramp files."
@@ -3439,6 +3447,9 @@ User is always nil."
(when (and (zerop (length (file-name-nondirectory filename)))
(not full-directory-p))
(setq switches (concat switches "F")))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
(require 'ls-lisp)
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index 1d9de39..9f06ab1 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -570,26 +570,35 @@ This checks also `file-name-as-directory',
`file-name-directory',
(format
"\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
(regexp-opt (directory-files tramp-archive-test-archive))
- (length (directory-files tramp-archive-test-archive))))))))
+ (length (directory-files tramp-archive-test-archive)))))))
+
+ ;; Check error case.
+ (with-temp-buffer
+ (should-error
+ (insert-directory
+ (expand-file-name "baz" tramp-archive-test-archive) nil)
+ :type tramp-file-missing)))
;; Cleanup.
(tramp-archive-cleanup-hash))))
(ert-deftest tramp-archive-test18-file-attributes ()
"Check `file-attributes'.
-This tests also `file-readable-p' and `file-regular-p'."
+This tests also `access-file', `file-readable-p' and `file-regular-p'."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
(let ((tmp-name1 (expand-file-name "foo.txt" tramp-archive-test-archive))
(tmp-name2 (expand-file-name "foo.lnk" tramp-archive-test-archive))
(tmp-name3 (expand-file-name "bar" tramp-archive-test-archive))
+ (tmp-name4 (expand-file-name "baz" tramp-archive-test-archive))
attr)
(unwind-protect
(progn
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
+ (should-not (access-file tmp-name1 "error"))
;; We do not test inodes and device numbers.
(setq attr (file-attributes tmp-name1))
@@ -622,7 +631,13 @@ This tests also `file-readable-p' and `file-regular-p'."
(should (file-readable-p tmp-name3))
(should-not (file-regular-p tmp-name3))
(setq attr (file-attributes tmp-name3))
- (should (eq (car attr) t)))
+ (should (eq (car attr) t))
+ (should-not (access-file tmp-name3 "error"))
+
+ ;; Check error case.
+ (should-error
+ (access-file tmp-name4 "error")
+ :type tramp-file-missing))
;; Cleanup.
(tramp-archive-cleanup-hash))))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 3eb424c..3afe9ad 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2730,7 +2730,14 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(format
"\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
(regexp-opt (directory-files tmp-name1))
- (length (directory-files tmp-name1))))))))
+ (length (directory-files tmp-name1)))))))
+
+ ;; Check error case. We do not check for the error type,
+ ;; because ls-lisp returns `file-error', and native Tramp
+ ;; returns `file-missing'.
+ (delete-directory tmp-name1 'recursive)
+ (with-temp-buffer
+ (should-error (insert-directory tmp-name1 nil))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -2856,8 +2863,8 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
-This tests also `file-readable-p', `file-regular-p' and
-`file-ownership-preserved-p'."
+This tests also `access-file', `file-readable-p',
+`file-regular-p' and `file-ownership-preserved-p'."
(skip-unless (tramp--test-enabled))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@@ -2878,6 +2885,9 @@ This tests also `file-readable-p', `file-regular-p' and
attr)
(unwind-protect
(progn
+ (should-error
+ (access-file tmp-name1 "error")
+ :type tramp-file-missing)
;; `file-ownership-preserved-p' should return t for
;; non-existing files. It is implemented only in tramp-sh.el.
(when (tramp--test-sh-p)
@@ -2886,6 +2896,7 @@ This tests also `file-readable-p', `file-regular-p' and
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
+ (should-not (access-file tmp-name1 "error"))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
@@ -2910,11 +2921,15 @@ This tests also `file-readable-p', `file-regular-p' and
(should (stringp (nth 3 attr))) ;; Gid.
(tramp--test-ignore-make-symbolic-link-error
+ (should-error
+ (access-file tmp-name2 "error")
+ :type tramp-file-missing)
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
+ (should-not (access-file tmp-name2 "error"))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
@@ -2953,6 +2968,7 @@ This tests also `file-readable-p', `file-regular-p' and
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
+ (should-not (access-file tmp-name1 ""))
(when (tramp--test-sh-p)
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
@@ -5590,8 +5606,8 @@ Since it unloads Tramp, it shall be the last test to run."
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
;; do not work properly for `nextcloud'.
-;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?).
-;; * Fix `tramp-test31-interrupt-process', timeout doesn't work reliably.
+;; * Fix `tramp-test29-start-file-process' and
+;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'.
(provide 'tramp-tests)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 0a6c447: Implement access-file in Tramp,
Michael Albinus <=