From: Michael Albinus Date: Tue, 19 Feb 2019 13:00:17 +0000 (+0100) Subject: Implement access-file in Tramp X-Git-Tag: emacs-27.0.90~3573 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0a6c4479cff17b487580abe3a7ee202e71be25d2;p=emacs.git 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. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4fba4e14f3a..f3ba7f2a1eb 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 f975ccfcfa8..db9aec05c20 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 bc45acd3ce6..ccbb522184d 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 3a0e002bc67..698296bf550 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 404fae9197e..49bc9bfcfc3 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 fb9073becd0..f57c76c260b 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 04b0bebabd4..60eb2125030 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 d000bbe3d65..efe75033f77 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 1d9de39ae96..9f06ab1000c 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 3eb424c62dc..3afe9ad557d 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)