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.

10 files changed, 67 insertions, 15 deletions

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)