[Emacs-diffs] master 0a6c447: Implement access-file in Tramp

[Michael Albinus]

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)