1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-17 11:20:39 -08:00

Tramp: Do not raise an error when not connected (Bug#78572)

* lisp/net/tramp-cmds.el (tramp-cleanup-connection):
Use read syntax #' for `tramp-timeout-session',

* lisp/net/tramp.el (tramp-barf-if-file-missing): Do not raise an error
when not connected.  (Bug#78572)
(tramp-file-name-handler): Do not force the backtrace.
(tramp-connectable-p): Check also, whether initial handshake is finished.
(tramp-skeleton-directory-files)
(tramp-skeleton-directory-files-and-attributes)
(tramp-skeleton-set-file-modes-times-uid-gid): Rearrange sending
`file-missing' error.
(tramp-handle-access-file, tramp-handle-unlock-file):
Use `tramp-connectable-p'.

* test/lisp/net/tramp-tests.el (project-mode-line-format)
(project-mode-line): Declare.
(tramp-test48-session-timeout): New test.
(tramp-test49-auto-load, tramp-test49-delay-load)
(tramp-test49-recursive-load, tramp-test49-remote-load-path)
(tramp-test50-without-remote-files, tramp-test51-unload): Rename.
This commit is contained in:
Michael Albinus 2025-06-02 11:44:43 +02:00
parent 1b03a348f7
commit 55691c61d4
4 changed files with 139 additions and 97 deletions

View file

@ -177,7 +177,7 @@ interactively, a Tramp connection has to be selected."
;; Cancel timer. ;; Cancel timer.
(dolist (timer timer-list) (dolist (timer timer-list)
(when (and (eq (timer--function timer) 'tramp-timeout-session) (when (and (eq (timer--function timer) #'tramp-timeout-session)
(tramp-file-name-equal-p vec (car (timer--args timer)))) (tramp-file-name-equal-p vec (car (timer--args timer))))
(cancel-timer timer))) (cancel-timer timer)))

View file

@ -5162,6 +5162,7 @@ If there is just some editing, retry it after 5 seconds."
Does not do anything if a connection is already open, but re-opens the Does not do anything if a connection is already open, but re-opens the
connection if a previous connection has died for some reason." connection if a previous connection has died for some reason."
;; During completion, don't reopen a new connection. ;; During completion, don't reopen a new connection.
;; Same for slide-in timer or process-{filter,sentinel}.
(unless (tramp-connectable-p vec) (unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential)) (throw 'non-essential 'non-essential))

View file

@ -2105,10 +2105,11 @@ does not exist, otherwise propagate the error."
(declare (indent 2) (debug (symbolp form body))) (declare (indent 2) (debug (symbolp form body)))
(let ((err (make-symbol "err"))) (let ((err (make-symbol "err")))
`(condition-case ,err `(condition-case ,err
(progn ,@body) (let (signal-hook-function) ,@body)
(error (error
(if (not (or (file-exists-p ,filename) (file-symlink-p ,filename))) (if (not (or (file-exists-p ,filename) (file-symlink-p ,filename)))
(tramp-error ,vec 'file-missing ,filename) (when (tramp-connectable-p ,vec)
(tramp-error ,vec 'file-missing ,filename))
(signal (car ,err) (cdr ,err))))))) (signal (car ,err) (cdr ,err)))))))
;; This function provides traces in case of errors not triggered by ;; This function provides traces in case of errors not triggered by
@ -2561,7 +2562,7 @@ Fall back to normal file name handler if no Tramp file name handler exists."
(tramp-message (tramp-message
v 5 "Non-essential received in operation %s" v 5 "Non-essential received in operation %s"
(cons operation args)) (cons operation args))
(let ((tramp-verbose 10)) (tramp-backtrace v)) (tramp-backtrace v)
(tramp-run-real-handler operation args)) (tramp-run-real-handler operation args))
((eq result 'suppress) ((eq result 'suppress)
(let ((inhibit-message t)) (let ((inhibit-message t))
@ -2793,13 +2794,15 @@ They are completed by `M-x TAB' only if there's an active connection or buffer."
"Check if it is possible to connect the remote host without side-effects. "Check if it is possible to connect the remote host without side-effects.
This is true, if either the remote host is already connected, or if we are This is true, if either the remote host is already connected, or if we are
not in completion mode." not in completion mode."
(let ((tramp-verbose 0) (or (not non-essential)
(vec (tramp-ensure-dissected-file-name vec-or-filename))) ;; We check this for the process related to `tramp-buffer-name';
(or ;; We check this for the process related to ;; otherwise `make-process' wouldn't run ever when
;; `tramp-buffer-name'; otherwise `make-process' wouldn't run ;; `non-essential' is non-nil.
;; ever when `non-essential' is non-nil. (and-let* ((tramp-verbose 0)
(process-live-p (tramp-get-process vec)) (vec (tramp-ensure-dissected-file-name vec-or-filename))
(not non-essential)))) (p (tramp-get-process vec))
((process-live-p p))
((tramp-get-connection-property p "connected"))))))
(defun tramp-completion-handle-expand-file-name (filename &optional directory) (defun tramp-completion-handle-expand-file-name (filename &optional directory)
"Like `expand-file-name' for partial Tramp files." "Like `expand-file-name' for partial Tramp files."
@ -3470,79 +3473,69 @@ BODY is the backend specific code."
"Skeleton for `tramp-*-handle-directory-files'. "Skeleton for `tramp-*-handle-directory-files'.
BODY is the backend specific code." BODY is the backend specific code."
(declare (indent 5) (debug t)) (declare (indent 5) (debug t))
`(or `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
(with-parsed-tramp-file-name (expand-file-name ,directory) nil (tramp-barf-if-file-missing v ,directory
(tramp-barf-if-file-missing v ,directory (if (not (file-directory-p ,directory))
(when (file-directory-p ,directory) ;; Trigger the `file-missing' error.
(setf ,directory (signal 'error nil)
(file-name-as-directory (expand-file-name ,directory))) (setf ,directory
(let ((temp (file-name-as-directory (expand-file-name ,directory)))
(with-tramp-file-property v localname "directory-files" ,@body)) (let ((temp
result item) (with-tramp-file-property v localname "directory-files" ,@body))
(while temp result item)
(setq item (directory-file-name (pop temp))) (while temp
(when (or (null ,match) (string-match-p ,match item)) (setq item (directory-file-name (pop temp)))
(push (if ,full (concat ,directory item) item) (when (or (null ,match) (string-match-p ,match item))
result))) (push (if ,full (concat ,directory item) item)
(unless ,nosort result)))
(setq result (sort result #'string<))) (unless ,nosort
(when (and (natnump ,count) (> ,count 0)) (setq result (sort result #'string<)))
(setq result (tramp-compat-ntake ,count result))) (when (and (natnump ,count) (> ,count 0))
result)))) (setq result (tramp-compat-ntake ,count result)))
result)))))
;; Error handling.
(if (not (file-exists-p ,directory))
(tramp-error
(tramp-dissect-file-name ,directory) 'file-missing ,directory)
nil)))
(defmacro tramp-skeleton-directory-files-and-attributes (defmacro tramp-skeleton-directory-files-and-attributes
(directory &optional full match nosort id-format count &rest body) (directory &optional full match nosort id-format count &rest body)
"Skeleton for `tramp-*-handle-directory-files-and-attributes'. "Skeleton for `tramp-*-handle-directory-files-and-attributes'.
BODY is the backend specific code." BODY is the backend specific code."
(declare (indent 6) (debug t)) (declare (indent 6) (debug t))
`(or `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
(with-parsed-tramp-file-name (expand-file-name ,directory) nil (tramp-barf-if-file-missing v ,directory
(tramp-barf-if-file-missing v ,directory (if (not (file-directory-p ,directory))
(when (file-directory-p ,directory) ;; Trigger the `file-missing' error.
(let ((temp (signal 'error nil)
(copy-tree (let ((temp
(mapcar (copy-tree
(lambda (x) (mapcar
(cons (lambda (x)
(car x) (cons
(tramp-convert-file-attributes (car x)
v (expand-file-name (car x) localname) (tramp-convert-file-attributes
,id-format (cdr x)))) v (expand-file-name (car x) localname)
(with-tramp-file-property ,id-format (cdr x))))
v localname "directory-files-and-attributes" (with-tramp-file-property
,@body)))) v localname "directory-files-and-attributes"
result item) ,@body))))
result item)
(while temp (while temp
(setq item (pop temp)) (setq item (pop temp))
(when (or (null ,match) (string-match-p ,match (car item))) (when (or (null ,match) (string-match-p ,match (car item)))
(when ,full (when ,full
(setcar item (expand-file-name (car item) ,directory))) (setcar item (expand-file-name (car item) ,directory)))
(push item result))) (push item result)))
(unless ,nosort (unless ,nosort
(setq result (setq result
(sort result (lambda (x y) (string< (car x) (car y)))))) (sort result (lambda (x y) (string< (car x) (car y))))))
(when (and (natnump ,count) (> ,count 0)) (when (and (natnump ,count) (> ,count 0))
(setq result (tramp-compat-ntake ,count result))) (setq result (tramp-compat-ntake ,count result)))
(or result (or result
;; The scripts could fail, for example with huge file size. ;; The scripts could fail, for example with huge file size.
(tramp-handle-directory-files-and-attributes (tramp-handle-directory-files-and-attributes
,directory ,full ,match ,nosort ,id-format ,count)))))) ,directory ,full ,match ,nosort ,id-format ,count)))))))
;; Error handling.
(if (not (file-exists-p ,directory))
(tramp-error
(tramp-dissect-file-name ,directory) 'file-missing ,directory)
nil)))
(defcustom tramp-use-file-attributes t (defcustom tramp-use-file-attributes t
"Whether to use \"file-attributes\" connection property for check. "Whether to use \"file-attributes\" connection property for check.
@ -3850,20 +3843,23 @@ BODY is the backend specific code."
BODY is the backend specific code." BODY is the backend specific code."
(declare (indent 1) (debug t)) (declare (indent 1) (debug t))
`(with-parsed-tramp-file-name (expand-file-name ,filename) nil `(with-parsed-tramp-file-name (expand-file-name ,filename) nil
(when (not (file-exists-p ,filename)) (tramp-barf-if-file-missing v ,filename
(tramp-error v 'file-missing ,filename)) (if (not (file-exists-p ,filename))
(with-tramp-saved-file-properties ;; Trigger the `file-missing' error.
v localname (signal 'error nil)
;; We cannot add "file-attributes", "file-executable-p", (with-tramp-saved-file-properties
;; "file-ownership-preserved-p", "file-readable-p", v localname
;; "file-writable-p". ;; We cannot add "file-attributes", "file-executable-p",
'("file-directory-p" "file-exists-p" "file-symlink-p" "file-truename") ;; "file-ownership-preserved-p", "file-readable-p",
(tramp-flush-file-properties v localname)) ;; "file-writable-p".
(condition-case err '("file-directory-p" "file-exists-p"
(progn ,@body) "file-symlink-p" "file-truename")
(error (if tramp-inhibit-errors-if-setting-file-attributes-fail (tramp-flush-file-properties v localname))
(display-warning 'tramp (error-message-string err)) (condition-case err
(signal (car err) (cdr err))))))) (progn ,@body)
(error (if tramp-inhibit-errors-if-setting-file-attributes-fail
(display-warning 'tramp (error-message-string err))
(signal (car err) (cdr err)))))))))
(defmacro tramp-skeleton-write-region (defmacro tramp-skeleton-write-region
(start end filename append visit lockname mustbenew &rest body) (start end filename append visit lockname mustbenew &rest body)
@ -4051,9 +4047,7 @@ Let-bind it when necessary.")
(tramp-dont-suspend-timers t)) (tramp-dont-suspend-timers t))
(with-tramp-timeout (with-tramp-timeout
(timeout (timeout
(unless (and-let* ((p (tramp-get-connection-process v)) (unless (and (not non-essential) (tramp-connectable-p v))
((process-live-p p))
((tramp-get-connection-property p "connected"))))
(tramp-cleanup-connection v 'keep-debug 'keep-password)) (tramp-cleanup-connection v 'keep-debug 'keep-password))
(tramp-error (tramp-error
v 'file-error v 'file-error
@ -4939,6 +4933,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.")
;; functions like `kill-buffer' would try to reestablish the ;; functions like `kill-buffer' would try to reestablish the
;; connection. See Bug#61663. ;; connection. See Bug#61663.
(if-let* ((v (tramp-dissect-file-name file)) (if-let* ((v (tramp-dissect-file-name file))
((tramp-connectable-p v))
((process-live-p (tramp-get-process v))) ((process-live-p (tramp-get-process v)))
(lockname (make-lock-file-name file))) (lockname (make-lock-file-name file)))
(delete-file lockname) (delete-file lockname)

View file

@ -67,6 +67,7 @@
(require 'vc-git) (require 'vc-git)
(require 'vc-hg) (require 'vc-hg)
(declare-function project-mode-line-format "project")
(declare-function tramp-check-remote-uname "tramp-sh") (declare-function tramp-check-remote-uname "tramp-sh")
(declare-function tramp-find-executable "tramp-sh") (declare-function tramp-find-executable "tramp-sh")
(declare-function tramp-get-remote-chmod-h "tramp-sh") (declare-function tramp-get-remote-chmod-h "tramp-sh")
@ -89,6 +90,7 @@
(defvar tramp-use-connection-share) (defvar tramp-use-connection-share)
;; Declared in Emacs 30.1. ;; Declared in Emacs 30.1.
(defvar project-mode-line)
(defvar remote-file-name-access-timeout) (defvar remote-file-name-access-timeout)
(defvar remote-file-name-inhibit-delete-by-moving-to-trash) (defvar remote-file-name-inhibit-delete-by-moving-to-trash)
@ -8374,8 +8376,52 @@ process sentinels. They shall not disturb each other."
;; Cleanup. ;; Cleanup.
(tramp-cleanup-connection tramp-test-vec 'keep-debug)) (tramp-cleanup-connection tramp-test-vec 'keep-debug))
;; This test is inspired by Bug#78572.
(ert-deftest tramp-test48-session-timeout ()
"Check that Tramp handles a session timeout properly."
(skip-unless (tramp--test-enabled))
(skip-unless
(tramp-get-method-parameter tramp-test-vec 'tramp-session-timeout))
;; We want to see the timeout message.
(tramp--test-instrument-test-case 3
(let ((remote-file-name-inhibit-cache t)
(tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(should-not (file-exists-p tmp-name))
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(tramp-timeout-session tramp-test-vec)
(should (file-exists-p tmp-name))
(should (directory-files (file-name-directory tmp-name)))
;; `project-mode-line' was introduced in Emacs 30.1.
(when (boundp 'project-mode-line)
(require 'project)
(ert-with-message-capture captured-messages
(let ((project-mode-line t))
(with-temp-buffer
(set-visited-file-name tmp-name)
(insert "foo")
(should (buffer-modified-p))
(tramp-timeout-session tramp-test-vec)
;; This calls `file-directory-p' and
;; `directory-files'. Shouldn't raise an error when
;; not connected.
(project-mode-line-format)
;; Steal the file lock.
(cl-letf (((symbol-function #'ask-user-about-lock) #'always))
(save-buffer)))
(should-not
(string-match-p "File is missing:" captured-messages))))))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
;; This test is inspired by Bug#29163. ;; This test is inspired by Bug#29163.
(ert-deftest tramp-test48-auto-load () (ert-deftest tramp-test49-auto-load ()
"Check that Tramp autoloads properly." "Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded ;; If we use another syntax but `default', Tramp is already loaded
;; due to the `tramp-change-syntax' call. ;; due to the `tramp-change-syntax' call.
@ -8400,7 +8446,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ") (mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))) (shell-quote-argument code)))))))
(ert-deftest tramp-test48-delay-load () (ert-deftest tramp-test49-delay-load ()
"Check that Tramp is loaded lazily, only when needed." "Check that Tramp is loaded lazily, only when needed."
;; Tramp is neither loaded at Emacs startup, nor when completing a ;; Tramp is neither loaded at Emacs startup, nor when completing a
;; non-Tramp file name like "/foo". Completing a Tramp-alike file ;; non-Tramp file name like "/foo". Completing a Tramp-alike file
@ -8430,7 +8476,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ") (mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm))))))))) (shell-quote-argument (format code tm)))))))))
(ert-deftest tramp-test48-recursive-load () (ert-deftest tramp-test49-recursive-load ()
"Check that Tramp does not fail due to recursive load." "Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -8454,7 +8500,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ") (mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))) (shell-quote-argument code))))))))
(ert-deftest tramp-test48-remote-load-path () (ert-deftest tramp-test49-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'." "Check that Tramp autoloads its packages with remote `load-path'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the ;; It shall still work, when a remote file name is in the
@ -8479,7 +8525,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ") (mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))) (shell-quote-argument code)))))))
(ert-deftest tramp-test49-without-remote-files () (ert-deftest tramp-test50-without-remote-files ()
"Check that Tramp can be suppressed." "Check that Tramp can be suppressed."
(skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-enabled))
@ -8494,7 +8540,7 @@ process sentinels. They shall not disturb each other."
(setq tramp-mode t) (setq tramp-mode t)
(should (file-remote-p ert-remote-temporary-file-directory))) (should (file-remote-p ert-remote-temporary-file-directory)))
(ert-deftest tramp-test50-unload () (ert-deftest tramp-test51-unload ()
"Check that Tramp and its subpackages unload completely. "Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run." Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test) :tags '(:expensive-test)