[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master c565a6c62c2 1/2: Add user option remote-file-name-access-timeout
From: |
Michael Albinus |
Subject: |
master c565a6c62c2 1/2: Add user option remote-file-name-access-timeout |
Date: |
Mon, 3 Jul 2023 12:25:59 -0400 (EDT) |
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