(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'
(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)
"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)
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)))))
(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.
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
(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
(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)))
;; 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)
projects / emacs.git / commitdiff