From 4a3b6daf76c385fc58759d57aeb4d34e8acc31e5 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 16 Aug 2025 12:26:19 +0200 Subject: [PATCH] Sync with Tramp 2.7.4-pre * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Adapt Tramp versions. * lisp/net/tramp-cmds.el (tramp-cleanup-connection): Use read syntax #' for `tramp-timeout-session', * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): Set "connected" property in time. * lisp/net/tramp-sh.el (tramp-timeout-session): Add ;;;###tramp-autoload cookie. * 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'. (tramp-skeleton-file-name-all-completions): Filter out "" hits. (Bug#79173) * 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. --- doc/misc/trampver.texi | 2 +- lisp/net/tramp-cmds.el | 2 +- lisp/net/tramp-gvfs.el | 8 +- lisp/net/tramp-rclone.el | 8 +- lisp/net/tramp-sh.el | 2 + lisp/net/tramp.el | 179 +++++++++++++++++------------------ lisp/net/trampver.el | 6 +- test/lisp/net/tramp-tests.el | 59 ++++++++++-- 8 files changed, 155 insertions(+), 111 deletions(-) diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index aa76672ea59..8fe3b9bb0a8 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.7.3.30.2 +@set trampver 2.7.4-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 27.1 diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index f03fa5cf404..18f5d12277e 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -122,7 +122,7 @@ When called 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))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 9530aa3733a..efbf9935573 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -2345,11 +2345,11 @@ connection if a previous connection has died for some reason." ;; Save the password. (ignore-errors (and (functionp tramp-password-save-function) - (funcall tramp-password-save-function))) + (funcall tramp-password-save-function)))))) - ;; Mark it as connected. - (tramp-set-connection-property - (tramp-get-connection-process vec) "connected" t)))))) + ;; Mark it as connected. + (tramp-set-connection-property + (tramp-get-connection-process vec) "connected" t))) (defun tramp-gvfs-gio-tool-p (vec) "Check, whether the gio tool is available." diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 07dd80deb9a..17ae36f94e8 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -411,11 +411,11 @@ connection if a previous connection has died for some reason." (tramp-get-method-parameter vec 'tramp-mount-args)) (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc))) (tramp-cleanup-connection vec 'keep-debug 'keep-password)) + (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec))) - ;; Mark it as connected. - (add-to-list 'tramp-fuse-mount-points (tramp-file-name-unify vec)) - (tramp-set-connection-property - (tramp-get-connection-process vec) "connected" t)))) + ;; Mark it as connected. + (tramp-set-connection-property + (tramp-get-connection-process vec) "connected" t))) ;; In `tramp-check-cached-permissions', the connection properties ;; "{uid,gid}-{integer,string}" are used. We set them to proper values. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index cae6d52f14c..287b46fc72e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5128,6 +5128,7 @@ Goes through the list `tramp-inline-compress-commands'." (t "-3"))) +;;;###tramp-autoload (defun tramp-timeout-session (vec) "Close the connection VEC after a session timeout. If there is just some editing, retry it after 5 seconds." @@ -5147,6 +5148,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)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e0e080021c7..c72ccc1738f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2098,10 +2098,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 @@ -2542,7 +2543,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)) @@ -2759,13 +2760,15 @@ They are completed by `M-x TAB' only if the current buffer is remote." "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." @@ -2863,7 +2866,7 @@ not in completion mode." BODY is the backend specific code." (declare (indent 2) (debug t)) `(ignore-error file-missing - (delete-dups (delq nil + (delete-dups (delq nil (delete "" (let* ((case-fold-search read-file-name-completion-ignore-case) (result (progn ,@body))) ;; Some storage systems do not return "." and "..". @@ -2880,7 +2883,7 @@ BODY is the backend specific code." (dolist (elt completion-regexp-list x) (unless (string-match-p elt x) (throw 'match nil)))))) result) - result)))))) + result))))))) (defvar tramp--last-hop-directory nil "Tracks the directory from which to run login programs.") @@ -3434,79 +3437,69 @@ 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 - (tramp-barf-if-file-missing v ,directory - (when (file-directory-p ,directory) - (setf ,directory - (file-name-as-directory (expand-file-name ,directory))) - (let ((temp - (with-tramp-file-property v localname "directory-files" ,@body)) - result item) - (while temp - (setq item (directory-file-name (pop temp))) - (when (or (null ,match) (string-match-p ,match item)) - (push (if ,full (concat ,directory item) item) - result))) - (unless ,nosort - (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))) + `(with-parsed-tramp-file-name (expand-file-name ,directory) nil + (tramp-barf-if-file-missing v ,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 + (with-tramp-file-property v localname "directory-files" ,@body)) + result item) + (while temp + (setq item (directory-file-name (pop temp))) + (when (or (null ,match) (string-match-p ,match item)) + (push (if ,full (concat ,directory item) item) + result))) + (unless ,nosort + (setq result (sort result #'string<))) + (when (and (natnump ,count) (> ,count 0)) + (setq result (tramp-compat-ntake ,count result))) + 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 - (tramp-barf-if-file-missing v ,directory - (when (file-directory-p ,directory) - (let ((temp - (copy-tree - (mapcar - (lambda (x) - (cons - (car x) - (tramp-convert-file-attributes - v (expand-file-name (car x) localname) - ,id-format (cdr x)))) - (with-tramp-file-property - v localname "directory-files-and-attributes" - ,@body)))) - result item) + `(with-parsed-tramp-file-name (expand-file-name ,directory) nil + (tramp-barf-if-file-missing v ,directory + (if (not (file-directory-p ,directory)) + ;; Trigger the `file-missing' error. + (signal 'error nil) + (let ((temp + (copy-tree + (mapcar + (lambda (x) + (cons + (car x) + (tramp-convert-file-attributes + v (expand-file-name (car x) localname) + ,id-format (cdr x)))) + (with-tramp-file-property + v localname "directory-files-and-attributes" + ,@body)))) + result item) - (while temp - (setq item (pop temp)) - (when (or (null ,match) (string-match-p ,match (car item))) - (when ,full - (setcar item (expand-file-name (car item) ,directory))) - (push item result))) + (while temp + (setq item (pop temp)) + (when (or (null ,match) (string-match-p ,match (car item))) + (when ,full + (setcar item (expand-file-name (car item) ,directory))) + (push item result))) - (unless ,nosort - (setq result - (sort result (lambda (x y) (string< (car x) (car y)))))) + (unless ,nosort + (setq result + (sort result (lambda (x y) (string< (car x) (car y)))))) - (when (and (natnump ,count) (> ,count 0)) - (setq result (tramp-compat-ntake ,count result))) + (when (and (natnump ,count) (> ,count 0)) + (setq result (tramp-compat-ntake ,count result))) - (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))) + (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))))))) (defcustom tramp-use-file-attributes t "Whether to use \"file-attributes\" connection property for check. @@ -3810,20 +3803,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)) - (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") - (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))))))) + (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") + (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))))))))) (defmacro tramp-skeleton-write-region (start end filename append visit lockname mustbenew &rest body) @@ -4013,9 +4009,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 @@ -4901,6 +4895,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 (tramp-compat-make-lock-file-name file))) (delete-file lockname) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 2b2fdf94a49..af6d52c4ae6 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.7.3.30.2 +;; Version: 2.7.4-pre ;; Package-Requires: ((emacs "27.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.7.3.30.2" +(defconst tramp-version "2.7.4-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -76,7 +76,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "27.1")) "ok" - (format "Tramp 2.7.3.30.2 is not fit for %s" + (format "Tramp 2.7.4-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4fe3fca0df8..3013a63e041 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -54,6 +54,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") @@ -82,6 +83,7 @@ (defvar dired-copy-dereference) ;; Declared in Emacs 30. +(defvar project-mode-line) (defvar remote-file-name-access-timeout) (defvar remote-file-name-inhibit-delete-by-moving-to-trash) @@ -8349,8 +8351,53 @@ process sentinels. They shall not disturb each other." tramp-use-fingerprint) (should (file-exists-p ert-remote-temporary-file-directory))))) +;; 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) + #'tramp-compat-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. @@ -8375,7 +8422,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 @@ -8405,7 +8452,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)) @@ -8429,7 +8476,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 @@ -8454,7 +8501,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)) @@ -8469,7 +8516,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)