From c565a6c62c2fdf79976b002299dfc9346697cb3d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 3 Jul 2023 18:24:11 +0200 Subject: [PATCH] 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 -- 2.39.5