mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-17 03:10:58 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

2
lisp/net/tramp-cmds.el
View file

@ -177,7 +177,7 @@ interactively, a Tramp connection has to be selected."
;; Cancel timer.
(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))))
(cancel-timer timer)))

1
lisp/net/tramp-sh.el
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
connection if a previous connection has died for some reason."
;; During completion, don't reopen a new connection.
;; Same for slide-in timer or process-{filter,sentinel}.
(unless (tramp-connectable-p vec)
(throw 'non-essential 'non-essential))

69
lisp/net/tramp.el
View file

@ -2105,10 +2105,11 @@ does not exist, otherwise propagate the error."
(declare (indent 2) (debug (symbolp form body)))
(let ((err (make-symbol "err")))
`(condition-case ,err
(progn ,@body)
(let (signal-hook-function) ,@body)
(error
(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)))))))
;; 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
v 5 "Non-essential received in operation %s"
(cons operation args))
(let ((tramp-verbose 10)) (tramp-backtrace v))
(tramp-backtrace v)
(tramp-run-real-handler operation args))
((eq result 'suppress)
(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.
This is true, if either the remote host is already connected, or if we are
not in completion mode."
(let ((tramp-verbose 0)
(vec (tramp-ensure-dissected-file-name vec-or-filename)))
(or ;; We check this for the process related to
;; `tramp-buffer-name'; otherwise `make-process' wouldn't run
;; ever when `non-essential' is non-nil.
(process-live-p (tramp-get-process vec))
(not non-essential))))
(or (not non-essential)
;; We check this for the process related to `tramp-buffer-name';
;; otherwise `make-process' wouldn't run ever when
;; `non-essential' is non-nil.
(and-let* ((tramp-verbose 0)
(vec (tramp-ensure-dissected-file-name vec-or-filename))
(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)
"Like `expand-file-name' for partial Tramp files."
@ -3470,10 +3473,11 @@ BODY is the backend specific code."
"Skeleton for `tramp-*-handle-directory-files'.
BODY is the backend specific code."
(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
(when (file-directory-p ,directory)
(if (not (file-directory-p ,directory))
;; Trigger the `file-missing' error.
(signal 'error nil)
(setf ,directory
(file-name-as-directory (expand-file-name ,directory)))
(let ((temp
@ -3488,23 +3492,18 @@ BODY is the backend specific code."
(setq result (sort result #'string<)))
(when (and (natnump ,count) (> ,count 0))
(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)))
result)))))
(defmacro tramp-skeleton-directory-files-and-attributes
(directory &optional full match nosort id-format count &rest body)
"Skeleton for `tramp-*-handle-directory-files-and-attributes'.
BODY is the backend specific code."
(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
(when (file-directory-p ,directory)
(if (not (file-directory-p ,directory))
;; Trigger the `file-missing' error.
(signal 'error nil)
(let ((temp
(copy-tree
(mapcar
@ -3536,13 +3535,7 @@ BODY is the backend specific code."
(or result
;; The scripts could fail, for example with huge file size.
(tramp-handle-directory-files-and-attributes
,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)))
,directory ,full ,match ,nosort ,id-format ,count)))))))
(defcustom tramp-use-file-attributes t
"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."
(declare (indent 1) (debug t))
`(with-parsed-tramp-file-name (expand-file-name ,filename) nil
(when (not (file-exists-p ,filename))
(tramp-error v 'file-missing ,filename))
(tramp-barf-if-file-missing v ,filename
(if (not (file-exists-p ,filename))
;; Trigger the `file-missing' error.
(signal 'error nil)
(with-tramp-saved-file-properties
v localname
;; We cannot add "file-attributes", "file-executable-p",
;; "file-ownership-preserved-p", "file-readable-p",
;; "file-writable-p".
'("file-directory-p" "file-exists-p" "file-symlink-p" "file-truename")
'("file-directory-p" "file-exists-p"
"file-symlink-p" "file-truename")
(tramp-flush-file-properties v localname))
(condition-case 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)))))))
(signal (car err) (cdr err)))))))))
(defmacro tramp-skeleton-write-region
(start end filename append visit lockname mustbenew &rest body)
@ -4051,9 +4047,7 @@ Let-bind it when necessary.")
(tramp-dont-suspend-timers t))
(with-tramp-timeout
(timeout
(unless (and-let* ((p (tramp-get-connection-process v))
((process-live-p p))
((tramp-get-connection-property p "connected"))))
(unless (and (not non-essential) (tramp-connectable-p v))
(tramp-cleanup-connection v 'keep-debug 'keep-password))
(tramp-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
;; connection. See Bug#61663.
(if-let* ((v (tramp-dissect-file-name file))
((tramp-connectable-p v))
((process-live-p (tramp-get-process v)))
(lockname (make-lock-file-name file)))
(delete-file lockname)

58
test/lisp/net/tramp-tests.el
View file

@ -67,6 +67,7 @@
(require 'vc-git)
(require 'vc-hg)
(declare-function project-mode-line-format "project")
(declare-function tramp-check-remote-uname "tramp-sh")
(declare-function tramp-find-executable "tramp-sh")
(declare-function tramp-get-remote-chmod-h "tramp-sh")
@ -89,6 +90,7 @@
(defvar tramp-use-connection-share)
;; Declared in Emacs 30.1.
(defvar project-mode-line)
(defvar remote-file-name-access-timeout)
(defvar remote-file-name-inhibit-delete-by-moving-to-trash)
@ -8374,8 +8376,52 @@ process sentinels. They shall not disturb each other."
;; Cleanup.
(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.
(ert-deftest tramp-test48-auto-load ()
(ert-deftest tramp-test49-auto-load ()
"Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded
;; 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 ")
(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."
;; Tramp is neither loaded at Emacs startup, nor when completing a
;; 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 ")
(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."
(skip-unless (tramp--test-enabled))
@ -8454,7 +8500,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(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'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; 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 ")
(shell-quote-argument code)))))))
(ert-deftest tramp-test49-without-remote-files ()
(ert-deftest tramp-test50-without-remote-files ()
"Check that Tramp can be suppressed."
(skip-unless (tramp--test-enabled))
@ -8494,7 +8540,7 @@ process sentinels. They shall not disturb each other."
(setq tramp-mode t)
(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.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)