master c565a6c62c2 1/2: Add user option remote-file-name-access-timeout

[Michael Albinus]

branch: master
commit c565a6c62c2fdf79976b002299dfc9346697cb3d
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Add user option remote-file-name-access-timeout
    
    * doc/lispref/files.texi (Testing Accessibility):
    Add user option remote-file-name-access-timeout.
    
    * doc/misc/tramp.texi (Frequently Asked Questions):
    Explain remote-file-name-access-timeout.
    
    * etc/NEWS: Mention 'remote-file-name-access-timeout'.
    
    * lisp/files.el (remote-file-name-access-timeout): New defcustom.
    (remote-file-name-inhibit-auto-save-visited)
    (remote-file-name-inhibit-locks, remote-file-name-inhibit-cache)
    (remote-file-name-inhibit-delete-by-moving-to-trash):
    * lisp/simple.el (remote-file-name-inhibit-auto-save): Add group `tramp'.
    
    * lisp/net/tramp.el (with-tramp-timeout, with-tramp-suspended-timers):
    New defmacros.
    (tramp-dont-suspend-timers): New defvar.
    (tramp-handle-access-file): Implement handling of
    `remote-file-name-access-timeout'.  (Bug#64401)
    (tramp-action-show-and-confirm-message, tramp-process-actions)
    (with-tramp-locked-connection, tramp-wait-for-regexp)
    (tramp-read-passwd, tramp-read-passwd-without-cache): Use the macros.
    
    * test/lisp/net/tramp-tests.el (remote-file-name-access-timeout):
    Declare.
    (tramp-test18-file-attributes): Extend test.
---
 doc/lispref/files.texi       |   6 ++
 doc/misc/tramp.texi          |  29 ++++++++
 etc/NEWS                     |   8 ++-
 lisp/files.el                |  21 ++++++
 lisp/net/tramp.el            | 164 +++++++++++++++++++++++--------------------
 lisp/simple.el               |   1 +
 test/lisp/net/tramp-tests.el |  13 ++++
 7 files changed, 165 insertions(+), 77 deletions(-)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 3982eb14f2b..8f1210ad486 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -969,9 +969,15 @@ guaranteed to be writable.
 @end defmac
 
 @defun access-file filename string
+@vindex remote-file-name-access-timeout
 If you can read @var{filename} this function returns @code{nil};
 otherwise it signals an error
 using @var{string} as the error message text.
+
+If the user option @code{remote-file-name-access-timeout} is a number,
+the function signals an error when it doesn't finish after that time
+(in seconds).  This applies only to remote files, and only when there
+is no additional time spent while reading passwords or alike.
 @end defun
 
 @defun file-ownership-preserved-p filename &optional group
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 27145c3cca1..a965dd89e71 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -5153,6 +5153,35 @@ In order to disable those optimizations, set user option
 @code{tramp-local-host-regexp} to @code{nil}.
 
 
+@item
+@value{tramp} blocks Emacs at startup
+
+@vindex remote-file-name-access-timeout
+Some packages, like @file{desktop.el} or @file{recentf.el}, access
+remote files when loaded.  If the respective file is not accessible,
+@value{tramp} could block.  In order to check whether this could
+happen, add a test via @code{access-file} with a proper timeout prior
+loading these packages:
+
+@lisp
+@group
+(let ((remote-file-name-access-timeout 10))
+  (access-file "@file{@trampfn{method,user@@host,/path/to/file}}" "error"))
+@result{} nil
+@end group
+@end lisp
+
+The result @code{nil} means success.  If the file is not accessible,
+or if the underlying operations last too long, @code{access-file}
+returns with an error.
+
+The value of the timeout (10 seconds in the example) depends on your
+preference and on the quality of the connection to the remote host.
+If the connection to the remote host isn't established yet, and if
+this requires an interactive password, the timeout check doesn't work
+properly.
+
+
 @item
 Does @value{tramp} support @acronym{SSH} security keys?
 
diff --git a/etc/NEWS b/etc/NEWS
index 2891d88e6cf..b97e79d3d0a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -66,6 +66,11 @@ trash when deleting.  Default is nil.
 If this user option is non-nil, 'auto-save-mode' will not auto-save
 remote buffers.  The default is nil.
 
++++
+** New user option 'remote-file-name-access-timeout'.
+When a natural number, this option limits the call of 'access-file'
+for remote files to this number of seconds.  Default is nil.
+
 +++
 ** New user option 'yes-or-no-prompt'.
 This allows the user to customize the prompt that is appended by
@@ -103,7 +108,7 @@ This works like 'kill-matching-buffers', but without asking 
for
 confirmation.
 
 ---
-** New user option 'duplicate-region-final-position'
+** New user option 'duplicate-region-final-position'.
 It controls the placement of point and the region after duplicating a
 region with 'duplicate-dwim'.
 
@@ -445,7 +450,6 @@ searching.
 CPerl mode fontifies subroutine signatures like variable declarations
 which makes them visually distinct from subroutine prototypes.
 
-
 
 * New Modes and Packages in Emacs 30.1
 
diff --git a/lisp/files.el b/lisp/files.el
index 148f47cbc97..dae71a50df0 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -482,6 +482,7 @@ non-nil."
   "When nil, `auto-save-visited-mode' will auto-save remote files.
 Any other value means that it will not."
   :group 'auto-save
+  :group 'tramp
   :type 'boolean
   :version "29.1")
 
@@ -557,6 +558,7 @@ using a transform that puts the lock files on a local file 
system."
 (defcustom remote-file-name-inhibit-locks nil
   "Whether to create file locks for remote files."
   :group 'files
+  :group 'tramp
   :version "28.1"
   :type 'boolean)
 
@@ -1317,6 +1319,7 @@ consecutive checks.  For example:
            (< 0 (file-attribute-size
                  (file-attributes (file-chase-links file)))))))"
   :group 'files
+  :group 'tramp
   :version "24.1"
   :type '(choice
          (const   :tag "Do not inhibit file name cache" nil)
@@ -1325,6 +1328,22 @@ consecutive checks.  For example:
                   :format "Do not use file name cache older then %v seconds"
                   :value 10)))
 
+(defcustom remote-file-name-access-timeout nil
+  "Timeout (in seconds) for `access-file'.
+This timeout limits the time to check, whether a remote file is
+accessible.  `access-file' returns an error after that time.  If
+the value is nil, no timeout is used.
+
+This applies only when there isn't time spent for other actions,
+like reading passwords."
+  :group 'files
+  :group 'tramp
+  :version "30.1"
+  ;;:type '(choice :tag "Timeout (seconds)" natnum (const nil)))
+  :type '(choice
+         (natnum :tag "Timeout (seconds)")
+          (const  :tag "Do not use timeout" nil)))
+
 (defun file-local-name (file)
   "Return the local name component of FILE.
 This function removes from FILE the specification of the remote host
@@ -6386,6 +6405,8 @@ RECURSIVE if DIRECTORY is nonempty."
   "Whether remote files shall be moved to the Trash.
 This overrules any setting of `delete-by-moving-to-trash'."
   :version "30.1"
+  :group 'files
+  :group 'tramp
   :type 'boolean)
 
 (defun file-equal-p (file1 file2)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 4820feb276e..39e70e99fa7 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2432,6 +2432,33 @@ without a visible progress reporter."
          (if tm (cancel-timer tm))
          (tramp-message ,vec ,level "%s...%s" ,message cookie)))))
 
+(defmacro with-tramp-timeout (list &rest body)
+  "Like `with-timeout', but allow SECONDS to be nil.
+
+(fn (SECONDS TIMEOUT-FORMS...) BODY)"
+  (declare (indent 1) (debug ((form body) body)))
+  (let ((seconds (car list))
+       (timeout-forms (cdr list)))
+    `(if-let (((natnump ,seconds)))
+         (with-timeout (,seconds ,@timeout-forms) ,@body)
+       ,@body)))
+
+(defvar tramp-dont-suspend-timers nil
+  "Don't suspend timers when checking reentrant calls.
+This shouldn't be changed globally, but let-bind where needed.")
+
+(defmacro with-tramp-suspended-timers (&rest body)
+  "Run BODY with suspended timers.
+Obey `tramp-dont-suspend-timers'."
+  (declare (indent 0) (debug ((form body) body)))
+  `(if tramp-dont-suspend-timers
+       (progn ,@body)
+     (let ((stimers (with-timeout-suspend))
+          timer-list timer-idle-list)
+       (unwind-protect
+          (progn ,@body)
+        (with-timeout-unsuspend stimers)))))
+
 (defun tramp-drop-volume-letter (name)
   "Cut off unnecessary drive letter from file NAME.
 The functions `tramp-*-handle-expand-file-name' call `expand-file-name'
@@ -3957,19 +3984,30 @@ Let-bind it when necessary.")
 
 (defun tramp-handle-access-file (filename string)
   "Like `access-file' for Tramp files."
-  (setq filename (file-truename filename))
-  (with-parsed-tramp-file-name filename v
-    (if (file-exists-p filename)
-       (unless
-           (funcall
-            (if (file-directory-p filename)
-                #'file-accessible-directory-p #'file-readable-p)
-            filename)
-         (tramp-compat-permission-denied
-          v (format "%s: Permission denied, %s" string filename)))
-      (tramp-error
-       v 'file-missing
-       (format "%s: No such file or directory, %s" string filename)))))
+  (let ((timeout
+        (with-connection-local-variables
+         ;; This variable exists since Emacs 30.1.
+         (bound-and-true-p remote-file-name-access-timeout)))
+       ;; We rely on timers, so don't suspend them.
+       (tramp-dont-suspend-timers t))
+    (with-parsed-tramp-file-name filename v
+      (with-tramp-timeout
+         (timeout
+          (tramp-error
+           v 'file-error
+           (format "%s: Timeout %s second(s) accessing %s" string timeout 
filename)))
+       (setq filename (file-truename filename))
+       (if (file-exists-p filename)
+           (unless
+               (funcall
+                (if (file-directory-p filename)
+                    #'file-accessible-directory-p #'file-readable-p)
+                filename)
+             (tramp-compat-permission-denied
+              v (format "%s: Permission denied, %s" string filename)))
+         (tramp-error
+          v 'file-missing
+          (format "%s: No such file or directory, %s" string filename)))))))
 
 (defun tramp-handle-add-name-to-file
   (filename newname &optional ok-if-already-exists)
@@ -5679,26 +5717,24 @@ The terminal type can be configured with 
`tramp-terminal-type'."
   "Show the user a message for confirmation.
 Wait, until the connection buffer changes."
   (with-current-buffer (process-buffer proc)
-    (let ((stimers (with-timeout-suspend))
-         (cursor-in-echo-area t)
-         set-message-function clear-message-function)
-      ;; Silence byte compiler.
-      (ignore set-message-function clear-message-function)
-      (tramp-message vec 6 "\n%s" (buffer-string))
-      (tramp-check-for-regexp proc tramp-process-action-regexp)
-      (with-temp-message
-         (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0))
-       ;; Hide message in buffer.
-       (narrow-to-region (point-max) (point-max))
-       ;; Wait for new output.
-       (while (not (ignore-error file-error
-                     (tramp-wait-for-regexp
-                      proc 0.1 tramp-security-key-confirmed-regexp)))
-         (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp)
-           (throw 'tramp-action 'timeout))
-         (redisplay 'force)))
-      ;; Reenable the timers.
-      (with-timeout-unsuspend stimers)))
+    (let ((cursor-in-echo-area t)
+         set-message-function clear-message-function tramp-dont-suspend-timers)
+      (with-tramp-suspended-timers
+       ;; Silence byte compiler.
+       (ignore set-message-function clear-message-function)
+       (tramp-message vec 6 "\n%s" (buffer-string))
+       (tramp-check-for-regexp proc tramp-process-action-regexp)
+       (with-temp-message
+           (replace-regexp-in-string (rx (any "\r\n")) "" (match-string 0))
+         ;; Hide message in buffer.
+         (narrow-to-region (point-max) (point-max))
+         ;; Wait for new output.
+         (while (not (ignore-error file-error
+                       (tramp-wait-for-regexp
+                        proc 0.1 tramp-security-key-confirmed-regexp)))
+           (when (tramp-check-for-regexp proc 
tramp-security-key-timeout-regexp)
+             (throw 'tramp-action 'timeout))
+           (redisplay 'force))))))
   t)
 
 (defun tramp-action-process-alive (proc _vec)
@@ -5797,12 +5833,7 @@ performed successfully.  Any other value means an error."
        proc 3 "Waiting for prompts from remote shell"
       (let ((enable-recursive-minibuffers t)
            exit)
-       (if timeout
-           (with-timeout (timeout (setq exit 'timeout))
-             (while (not exit)
-               (setq exit
-                     (catch 'tramp-action
-                       (tramp-process-one-action proc vec actions)))))
+       (with-tramp-timeout (timeout (setq exit 'timeout))
          (while (not exit)
            (setq exit (catch 'tramp-action
                         (tramp-process-one-action proc vec actions)))))
@@ -5858,14 +5889,12 @@ Mostly useful to protect BODY from being interrupted by 
timers."
           (throw 'non-essential 'non-essential)
         (tramp-error
          ,proc 'remote-file-error "Forbidden reentrant call of Tramp"))
-     (let ((stimers (with-timeout-suspend))
-          timer-list timer-idle-list)
+     (with-tramp-suspended-timers
        (unwind-protect
           (progn
             (tramp-set-connection-property ,proc "locked" t)
             ,@body)
-        (tramp-flush-connection-property ,proc "locked")
-        (with-timeout-unsuspend stimers)))))
+        (tramp-flush-connection-property ,proc "locked")))))
 
 (defun tramp-accept-process-output (proc &optional _timeout)
   "Like `accept-process-output' for Tramp processes.
@@ -5958,21 +5987,13 @@ Expects the output of PROC to be sent to the current 
buffer.  Returns
 the string that matched, or nil.  Waits indefinitely if TIMEOUT is
 nil."
   (let ((found (tramp-check-for-regexp proc regexp)))
-    (cond (timeout
-          (with-timeout (timeout)
-            (while (not found)
-              (tramp-accept-process-output proc)
-              (unless (process-live-p proc)
-                (tramp-error-with-buffer
-                 nil proc 'file-error "Process has died"))
-              (setq found (tramp-check-for-regexp proc regexp)))))
-         (t
-          (while (not found)
-            (tramp-accept-process-output proc)
-            (unless (process-live-p proc)
-              (tramp-error-with-buffer
-               nil proc 'file-error "Process has died"))
-            (setq found (tramp-check-for-regexp proc regexp)))))
+    (with-tramp-timeout (timeout)
+      (while (not found)
+       (tramp-accept-process-output proc)
+       (unless (process-live-p proc)
+         (tramp-error-with-buffer
+          nil proc 'file-error "Process has died"))
+       (setq found (tramp-check-for-regexp proc regexp))))
     ;; The process could have timed out, for example due to session
     ;; timeout of sudo.  The process buffer does not exist any longer then.
     (ignore-errors
@@ -6754,9 +6775,7 @@ Consults the auth-source package."
         (auth-source-creation-prompts `((secret . ,pw-prompt)))
         ;; Use connection-local value.
         (auth-sources (buffer-local-value 'auth-sources (process-buffer proc)))
-        ;; We suspend the timers while reading the password.
-         (stimers (with-timeout-suspend))
-        auth-info auth-passwd)
+        auth-info auth-passwd tramp-dont-suspend-timers)
 
     (unwind-protect
        ;; We cannot use `with-parsed-tramp-file-name', because it
@@ -6781,7 +6800,7 @@ Consults the auth-source package."
                      (tramp-compat-auth-info-password auth-info))))
 
         ;; Try the password cache.
-        (progn
+        (with-tramp-suspended-timers
           (setq auth-passwd (password-read pw-prompt key)
                 tramp-password-save-function
                 (lambda () (password-cache-add key auth-passwd)))
@@ -6791,25 +6810,20 @@ Consults the auth-source package."
       ;; passwords.  See discussion in Bug#50399.
       (when (tramp-string-empty-or-nil-p auth-passwd)
        (setq tramp-password-save-function nil))
-      (tramp-set-connection-property vec "first-password-request" nil)
-
-      ;; Reenable the timers.
-      (with-timeout-unsuspend stimers))))
+      (tramp-set-connection-property vec "first-password-request" nil))))
 
 (put #'tramp-read-passwd 'tramp-suppress-trace t)
 
 (defun tramp-read-passwd-without-cache (proc &optional prompt)
   "Read a password from user (compat function)."
   ;; We suspend the timers while reading the password.
-  (let ((stimers (with-timeout-suspend)))
-    (unwind-protect
-       (password-read
-        (or prompt
-            (with-current-buffer (process-buffer proc)
-              (tramp-check-for-regexp proc tramp-password-prompt-regexp)
-              (match-string 0))))
-      ;; Reenable the timers.
-      (with-timeout-unsuspend stimers))))
+  (let (tramp-dont-suspend-timers)
+    (with-tramp-suspended-timers
+      (password-read
+       (or prompt
+          (with-current-buffer (process-buffer proc)
+            (tramp-check-for-regexp proc tramp-password-prompt-regexp)
+            (match-string 0)))))))
 
 (put #'tramp-read-passwd-without-cache 'tramp-suppress-trace t)
 
diff --git a/lisp/simple.el b/lisp/simple.el
index 646da8aafaa..321734a5026 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -9155,6 +9155,7 @@ presented."
   "When nil, `auto-save-mode' will auto-save remote files.
 Any other value means that it will not."
   :group 'auto-save
+  :group 'tramp
   :type 'boolean
   :version "30.1")
 
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 45bcf23f790..869bc63a544 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -81,6 +81,7 @@
 (defvar dired-copy-dereference)
 
 ;; Declared in Emacs 30.
+(defvar remote-file-name-access-timeout)
 (defvar remote-file-name-inhibit-delete-by-moving-to-trash)
 
 ;; `ert-resource-file' was introduced in Emacs 28.1.
@@ -3654,6 +3655,18 @@ This tests also `access-file', `file-readable-p',
           attr)
       (unwind-protect
          (progn
+           (write-region "foo" nil tmp-name1)
+           ;; `access-file' returns nil in case of success.
+           (should-not (access-file tmp-name1 "error"))
+           ;; `access-file' could use a timeout.
+           (let ((remote-file-name-access-timeout 1))
+             (cl-letf (((symbol-function #'file-exists-p)
+                        (lambda (_filename) (sleep-for 5))))
+               (should-error
+                (access-file tmp-name1 "error")
+                :type 'file-error)))
+           (delete-file tmp-name1)
+
            ;; A sticky bit could damage the `file-ownership-preserved-p' test.
            (when
                (and test-file-ownership-preserved-p