branch: externals/tramp
commit 01599cd23fff35b4f90f9125a02bb281fb141958
Author: Michael Albinus <michael.albi...@gmx.de>
Commit: Michael Albinus <michael.albi...@gmx.de>
Tramp ELPA version 2.8.0.2 released
---
README | 6 +-
test/tramp-archive-tests.el | 6 +-
test/tramp-tests.el | 333 +++++++++++++++++++++++++++++---------
texi/tramp.texi | 128 ++++++++++++++-
texi/trampver.texi | 2 +-
tramp-adb.el | 4 +-
tramp-cache.el | 23 +--
tramp-compat.el | 4 +-
tramp-gvfs.el | 2 +-
tramp-message.el | 18 ++-
tramp-sh.el | 74 ++++++---
tramp-smb.el | 11 +-
tramp.el | 380 +++++++++++++++++++++++++++++++-------------
trampver.el | 6 +-
14 files changed, 760 insertions(+), 237 deletions(-)
diff --git a/README b/README
index 25aca1bb1b..e51a5c9d70 100644
--- a/README
+++ b/README
@@ -32,11 +32,11 @@ Emacs 28 or older
• Remove all byte-compiled Tramp files
- $ rm -f ~/.emacs.d/elpa/tramp-2.8.0.1/tramp*.elc
+ $ rm -f ~/.emacs.d/elpa/tramp-2.8.0.2/tramp*.elc
• Start Emacs with Tramp's source files
- $ emacs -L ~/.emacs.d/elpa/tramp-2.8.0.1 -l tramp
+ $ emacs -L ~/.emacs.d/elpa/tramp-2.8.0.2 -l tramp
This should not give you the error.
@@ -50,7 +50,7 @@ Mitigation of a bug in Emacs 29.1
---------------------------------
Due to a bug in Emacs 29.1, you must apply the following change prior
-installation or upgrading Tramp 2.8.0.1 from GNU ELPA:
+installation or upgrading Tramp 2.8.0.2 from GNU ELPA:
(when (string-equal emacs-version "29.1")
(with-current-buffer
diff --git a/test/tramp-archive-tests.el b/test/tramp-archive-tests.el
index 5846dafa7d..0ff0f3ddd4 100644
--- a/test/tramp-archive-tests.el
+++ b/test/tramp-archive-tests.el
@@ -856,7 +856,7 @@ This tests also `file-executable-p', `file-writable-p' and
`set-file-modes'."
(should (equal uid (with-no-warnings (file-user-uid))))
(should (equal gid (with-no-warnings (file-group-gid)))))))
-(ert-deftest tramp-archive-test48-auto-load ()
+(ert-deftest tramp-archive-test50-auto-load ()
"Check that `tramp-archive' autoloads properly."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
@@ -898,7 +898,7 @@ This tests also `file-executable-p', `file-writable-p' and
`set-file-modes'."
(format "(setq tramp-archive-enabled %s)" enabled))
(shell-quote-argument (format code file)))))))))))
-(ert-deftest tramp-archive-test48-delay-load ()
+(ert-deftest tramp-archive-test50-delay-load ()
"Check that `tramp-archive' is loaded lazily, only when needed."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
@@ -937,7 +937,7 @@ This tests also `file-executable-p', `file-writable-p' and
`set-file-modes'."
code tae tramp-archive-test-file-archive
(concat tramp-archive-test-archive "foo"))))))))))
-(ert-deftest tramp-archive-test49-without-remote-files ()
+(ert-deftest tramp-archive-test51-without-remote-files ()
"Check that Tramp can be suppressed."
(skip-unless tramp-archive-enabled)
diff --git a/test/tramp-tests.el b/test/tramp-tests.el
index d0ce17d249..892e4ef519 100644
--- a/test/tramp-tests.el
+++ b/test/tramp-tests.el
@@ -68,6 +68,7 @@
(require 'vc-git)
(require 'vc-hg)
+(declare-function edebug-mode "edebug")
(declare-function project-mode-line-format "project")
(declare-function tramp-check-remote-uname "tramp-sh")
(declare-function tramp-find-executable "tramp-sh")
@@ -215,7 +216,10 @@ is greater than 10.
(kill-buffer buf))))))
(defsubst tramp--test-message (fmt-string &rest arguments)
- "Emit a message into ERT *Messages*."
+ "Emit a message into \"ERT *Messages*\" and the trace buffer."
+ (declare (tramp-suppress-trace t))
+ (when (get-buffer trace-buffer)
+ (trace-values (apply #'format fmt-string arguments)))
(tramp--test-instrument-test-case 0
(apply #'tramp-message tramp-test-vec 0 fmt-string arguments)))
@@ -4552,7 +4556,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(skip-unless (tramp--test-enabled))
(skip-unless
(or (tramp--test-adb-p) (tramp--test-gvfs-p)
- (tramp--test-sh-p) (tramp--test-sudoedit-p)))
+ (tramp--test-sh-p) (tramp--test-smb-p)
+ (tramp--test-sudoedit-p)))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -4565,9 +4570,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(should (consp (file-attribute-modification-time
(file-attributes tmp-name1))))
;; Skip the test, if the remote handler is not able to set
- ;; the correct time.
- ;; Some remote machines cannot resolve seconds. So we use a minute.
- (skip-unless (set-file-times tmp-name1 (seconds-to-time 60)))
+ ;; the correct time. Some remote machines cannot resolve
+ ;; seconds. tramp-adb.el needs at least a day.
+ (skip-unless
+ (set-file-times tmp-name1 (seconds-to-time (* 24 60 60))))
;; Dumb remote shells without perl(1) or stat(1) are not
;; able to return the date correctly. They say "don't know".
(unless (time-equal-p
@@ -4577,7 +4583,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(should
(time-equal-p
(file-attribute-modification-time (file-attributes tmp-name1))
- (seconds-to-time 60)))
+ (seconds-to-time (* 24 60 60))))
;; Setting the time for not existing files shall fail.
(should-error
(set-file-times tmp-name2)
@@ -4855,6 +4861,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(host (file-remote-p ert-remote-temporary-file-directory 'host))
(orig-syntax tramp-syntax)
(minibuffer-completing-file-name t))
+ ;; `file-remote-p' returns as host the string "host#port", which
+ ;; isn't useful.
(when (and (stringp host)
(string-match
(rx (regexp tramp-prefix-port-regexp) (regexp
tramp-port-regexp))
@@ -4866,7 +4874,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(tramp-syntax-values) `(,orig-syntax)))
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
- ;; for completion. We must refill the cache.
+ ;; for completion. We must refill the cache in order to get
+ ;; at least one completion candidate.
(tramp-set-connection-property tramp-test-vec "completion-use-cache"
t)
(let (;; This is needed for the `separate' syntax.
@@ -4881,6 +4890,14 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Complete method name.
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp))
+ ;; `read-directory-name' uses `file-directory-p'.
+ ;; `file-directory-p' works since Emacs 31.
+ ;; (Bug#79236)
+ (when (tramp--test-emacs31-p)
+ (should
+ (file-name-completion
+ (concat prefix-format (substring method 0 1))
+ "/" #'file-directory-p)))
(should
(member
(concat prefix-format method tramp-postfix-method-format)
@@ -4890,6 +4907,14 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(unless (or (tramp-string-empty-or-nil-p method)
(string-empty-p tramp-method-regexp)
(tramp-string-empty-or-nil-p host))
+ ;; `read-directory-name' uses `file-directory-p'.
+ ;; `file-directory-p' works since Emacs 31.
+ ;; (Bug#79236)
+ (when (tramp--test-emacs31-p)
+ (should
+ (file-name-completion
+ (concat prefix-format method tramp-postfix-method-format)
+ "/" #'file-directory-p)))
(should
(member
(concat
@@ -4981,6 +5006,17 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; and Bug#60505.
(ert-deftest tramp-test26-interactive-file-name-completion ()
"Check interactive completion with different `completion-styles'."
+ (skip-unless (tramp--test-enabled))
+
+ ;; (when (get-buffer trace-buffer) (kill-buffer trace-buffer))
+ ;; (dolist (elt (append
+ ;; (mapcar
+ ;; #'intern (all-completions "tramp-" obarray #'functionp))
+ ;; tramp-trace-functions))
+ ;; (unless (get elt 'tramp-suppress-trace)
+ ;; (trace-function-background elt)))
+ ;; (trace-function-background #'completion-file-name-table)
+ ;; (trace-function-background #'read-file-name)
;; Method, user and host name in completion mode.
(let ((method (file-remote-p ert-remote-temporary-file-directory 'method))
@@ -4989,39 +5025,54 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(hop (file-remote-p ert-remote-temporary-file-directory 'hop))
(orig-syntax tramp-syntax)
(non-essential t)
- (inhibit-message t))
+ (inhibit-message (not (ignore-errors (edebug-mode)))))
+ ;; `file-remote-p' returns as host the string "host#port", which
+ ;; isn't useful.
(when (and (stringp host)
(string-match
(rx (regexp tramp-prefix-port-regexp) (regexp
tramp-port-regexp))
host))
(setq host (replace-match "" nil nil host)))
- ;; (trace-function #'tramp-completion-file-name-handler)
- ;; (trace-function #'completion-file-name-table)
(unwind-protect
(dolist (syntax (if (tramp--test-expensive-test-p)
(tramp-syntax-values) `(,orig-syntax)))
(tramp-change-syntax syntax)
;; This has cleaned up all connection data, which are used
- ;; for completion. We must refill the cache.
+ ;; for completion. We must refill the cache in order to get
+ ;; at least one completion candidate.
(tramp-set-connection-property tramp-test-vec "completion-use-cache"
t)
(dolist
(style
(if (tramp--test-expensive-test-p)
- ;; It doesn't work for `initials' and `shorthand'
- ;; completion styles. Should it?
+ ;; FIXME: It doesn't work for `initials' and
+ ;; `shorthand' completion styles. Should it?
;; `orderless' passes the tests, but it is an ELPA package.
- '(emacs21 emacs22 basic partial-completion substring flex)
+ ;; What about `company' backends, `consult', `cider', `helm'?
+ `(emacs21 emacs22 basic partial-completion substring
+ ;; FIXME: `flex' is not compatible with IPv6 hosts.
+ ,@(unless (string-match-p tramp-ipv6-regexp host) '(flex)))
'(basic)))
(when (assoc style completion-styles-alist)
(let* (;; Force the real minibuffer in batch mode.
(executing-kbd-macro noninteractive)
+ ;; FIXME: Is this TRT for test?
+ (minibuffer-completing-file-name t)
+ (confirm-nonexistent-file-or-buffer nil)
(completion-styles `(,style))
completion-category-defaults
completion-category-overrides
- ;; This is needed for the `simplified' syntax,
+ ;; FIXME: Is this TRT for test?
+ (completion-pcm--delim-wild-regex
+ ;; "::1" is a complete word. ":" isn't a
+ ;; delimiter, therefore.
+ (rx-to-string
+ `(any
+ ,(string-replace
+ ":" "" completion-pcm-word-delimiters))))
+ ;; This is needed for the `simplified' syntax.
(tramp-default-method method)
(method-string
(unless (string-empty-p tramp-method-regexp)
@@ -5099,60 +5150,78 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
user-string host-string)
,host-string)))))
- (ignore-errors (kill-buffer "*Completions*"))
- ;; (and (bufferp trace-buffer) (kill-buffer trace-buffer))
- (discard-input)
- (setq test (car test-and-result)
- unread-command-events
- (mapcar #'identity (concat test "\t\t\n"))
- completions nil
- result (read-file-name "Prompt: "))
-
- (if (or (not (get-buffer "*Completions*"))
- (string-match-p
- (if (string-empty-p tramp-method-regexp)
+ (dolist
+ (predicate
+ (if (and (tramp--test-expensive-test-p)
+ (tramp--test-emacs31-p))
+ ;; `nil' will be expanded to `file-exists-p'.
+ ;; `read-directory-name' uses `file-directory-p'.
+ ;; `file-directory-p' works since Emacs 31.
+ ;; (Bug#79236)
+ '(file-exists-p file-directory-p) '(nil)))
+
+ (ignore-errors (kill-buffer "*Completions*"))
+ ;; (when (get-buffer trace-buffer)
+ ;; (kill-buffer trace-buffer))
+ (discard-input)
+ (setq test (car test-and-result)
+ unread-command-events
+ (append test '(tab tab return return))
+ completions nil
+ result
+ (read-file-name
+ "Prompt: " nil nil 'confirm nil predicate))
+
+ (if (or (not (get-buffer "*Completions*"))
+ (string-match-p
+ (if (string-empty-p tramp-method-regexp)
+ (rx
+ (| (regexp tramp-postfix-user-regexp)
+ (regexp tramp-postfix-host-regexp))
+ eos)
(rx
- (| (regexp tramp-postfix-user-regexp)
+ (| (regexp tramp-postfix-method-regexp)
+ (regexp tramp-postfix-user-regexp)
(regexp tramp-postfix-host-regexp))
- eos)
- (rx
- (| (regexp tramp-postfix-method-regexp)
- (regexp tramp-postfix-user-regexp)
- (regexp tramp-postfix-host-regexp))
- eos))
- result))
- (progn
- ;; (tramp--test-message
- ;; "syntax: %s style: %s test: %s result: %s"
- ;; syntax style test result)
- (should (string-prefix-p (cadr test-and-result)
result)))
-
- (with-current-buffer "*Completions*"
- ;; We must remove leading `default-directory'.
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (while (search-forward-regexp "//" nil 'noerror)
- (delete-region (line-beginning-position) (point))))
- (goto-char (point-min))
- (search-forward-regexp
- (rx bol (0+ nonl)
- (any "Pp") "ossible completions"
- (0+ nonl) eol))
- (forward-line 1)
- (setq completions
- (split-string
- (buffer-substring-no-properties (point)
(point-max))
- (rx (any "\r\n\t ")) 'omit)))
-
- ;; (tramp--test-message
- ;; "syntax: %s style: %s test: %s result: %s completions:
%S"
- ;; syntax style test result completions)
- (should (member (caddr test-and-result) completions))))))))
+ eos))
+ result))
+ (progn
+ ;; (tramp--test-message
+ ;; (concat
+ ;; "syntax: %s style: %s predicate: %s "
+ ;; "test: %s result: %s")
+ ;; syntax style predicate test result)
+ (should
+ (string-prefix-p (cadr test-and-result) result)))
+
+ (with-current-buffer "*Completions*"
+ ;; We must remove leading `default-directory'.
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ (while (search-forward-regexp "//" nil 'noerror)
+ (delete-region (line-beginning-position) (point))))
+ (goto-char (point-min))
+ (search-forward-regexp
+ (rx bol (0+ nonl)
+ (any "Pp") "ossible completions"
+ (0+ nonl) eol))
+ (forward-line 1)
+ (setq completions
+ (split-string
+ (buffer-substring-no-properties
+ (point) (point-max))
+ (rx (any "\r\n\t ")) 'omit)))
+
+ ;; (tramp--test-message
+ ;; (concat
+ ;; "syntax: %s style: %s predicate: %s test: %s "
+ ;; "result: %s completions: %S")
+ ;; syntax style predicate test result completions)
+ (should
+ (member (caddr test-and-result) completions)))))))))
;; Cleanup.
- ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer))
- ;; (untrace-function #'tramp-completion-file-name-handler)
- ;; (untrace-function #'completion-file-name-table)
+ ;; (untrace-all)
(tramp-change-syntax orig-syntax)
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))))
@@ -8469,13 +8538,127 @@ process sentinels. They shall not disturb each other."
(cl-letf (((symbol-function #'ask-user-about-lock)
#'always))
(save-buffer)))
(should-not
- (string-match-p "File is missing:" captured-messages))))))
+ (string-match-p "File is missing:" captured-messages)))))
+
+ ;; A modified buffer suppresses session timeout.
+ (with-temp-buffer
+ (set-visited-file-name tmp-name)
+ (insert "foo")
+ (should (buffer-modified-p))
+ (tramp-timeout-session tramp-test-vec)
+ (should
+ (process-live-p (tramp-get-connection-process tramp-test-vec)))
+ ;; Steal the file lock.
+ (cl-letf (((symbol-function #'ask-user-about-lock) #'always))
+ (save-buffer))
+ (tramp-timeout-session tramp-test-vec)
+ (should-not
+ (process-live-p (tramp-get-connection-process tramp-test-vec))))
+
+ ;; An auto-reverted buffer suppresses session timeout.
+ (with-temp-buffer
+ (set-visited-file-name tmp-name)
+ (auto-revert-mode 1)
+ ;; Steal the file lock.
+ (cl-letf (((symbol-function #'ask-user-about-lock) #'always))
+ (save-buffer))
+ (tramp-timeout-session tramp-test-vec)
+ (should
+ (process-live-p (tramp-get-connection-process tramp-test-vec)))
+ (auto-revert-mode -1)
+ (tramp-timeout-session tramp-test-vec)
+ (should-not
+ (process-live-p (tramp-get-connection-process tramp-test-vec)))))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
+(defun tramp--test-operation (&optional _file)
+ "Test operation."
+ "Test operation")
+
+(defun tramp--handler-for-test-operation (&optional _file)
+ "Test operation handler."
+ "Test operation handler")
+
+(ert-deftest tramp-test49-external-backend-function ()
+ "Check that Tramp handles external functions for a given backend."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+
+ (let* ((file-name-handler
+ (tramp-find-foreign-file-name-handler tramp-test-vec))
+ (backend
+ (intern
+ (string-remove-suffix
+ "-file-name-handler" (symbol-name file-name-handler)))))
+
+ ;; There is no backend specific code.
+ (should-not
+ (string-equal (tramp--test-operation ert-remote-temporary-file-directory)
+ (tramp--handler-for-test-operation
+ ert-remote-temporary-file-directory)))
+ (should-not
+ (string-equal (tramp--test-operation temporary-file-directory)
+ (tramp--handler-for-test-operation
+ temporary-file-directory)))
+ (let ((default-directory ert-remote-temporary-file-directory))
+ (should-not
+ (string-equal (tramp--test-operation)
+ (tramp--handler-for-test-operation))))
+ (let ((default-directory temporary-file-directory))
+ (should-not
+ (string-equal (tramp--test-operation)
+ (tramp--handler-for-test-operation))))
+
+ (should-error
+ (tramp-add-external-operation
+ #'tramp--test-operation
+ #'tramp--handler-for-test-operation 'foo)
+ :type 'file-missing)
+ (tramp-add-external-operation
+ #'tramp--test-operation
+ #'tramp--handler-for-test-operation backend)
+ ;; The backend specific function is called.
+ (should
+ (string-equal (tramp--test-operation ert-remote-temporary-file-directory)
+ (tramp--handler-for-test-operation
+ ert-remote-temporary-file-directory)))
+ (should-not
+ (string-equal (tramp--test-operation temporary-file-directory)
+ (tramp--handler-for-test-operation
+ temporary-file-directory)))
+ (let ((default-directory ert-remote-temporary-file-directory))
+ (should
+ (string-equal (tramp--test-operation)
+ (tramp--handler-for-test-operation))))
+ (let ((default-directory temporary-file-directory))
+ (should-not
+ (string-equal (tramp--test-operation)
+ (tramp--handler-for-test-operation))))
+
+ (tramp-remove-external-operation
+ #'tramp--test-operation backend)
+ ;; There is no backend specific code.
+ (should-not
+ (string-equal (tramp--test-operation ert-remote-temporary-file-directory)
+ (tramp--handler-for-test-operation
+ ert-remote-temporary-file-directory)))
+ (should-not
+ (string-equal (tramp--test-operation temporary-file-directory)
+ (tramp--handler-for-test-operation
+ temporary-file-directory)))
+ (let ((default-directory ert-remote-temporary-file-directory))
+ (should-not
+ (string-equal (tramp--test-operation)
+ (tramp--handler-for-test-operation))))
+ (let ((default-directory temporary-file-directory))
+ (should-not
+ (string-equal (tramp--test-operation)
+ (tramp--handler-for-test-operation))))))
+
;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test49-auto-load ()
+(ert-deftest tramp-test50-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.
@@ -8500,7 +8683,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test49-delay-load ()
+(ert-deftest tramp-test50-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
@@ -8530,7 +8713,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-test49-recursive-load ()
+(ert-deftest tramp-test50-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@@ -8554,7 +8737,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
-(ert-deftest tramp-test49-remote-load-path ()
+(ert-deftest tramp-test50-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
@@ -8579,7 +8762,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test50-without-remote-files ()
+(ert-deftest tramp-test51-without-remote-files ()
"Check that Tramp can be suppressed."
(skip-unless (tramp--test-enabled))
@@ -8594,7 +8777,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-test51-unload ()
+(ert-deftest tramp-test52-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
@@ -8699,6 +8882,12 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
;; * Use `skip-when' starting with Emacs 30.1.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for "ftp".
+;; * In `tramp-test26-file-name-completion', check also user, domain,
+;; port and hop.
+;; * In `tramp-test26-interactive-file-name-completion', check `flex',
+;; `initials' and `shorthand' completion styles. Should
+;; `minibuffer-completing-file-name' and `completion-pcm--delim-wild-regex'
+;; be bound? Check also domain, port and hop.
;; * Check, why a process filter t doesn't work in
;; `tramp-test29-start-file-process' and
;; `tramp-test30-make-process'.
diff --git a/texi/tramp.texi b/texi/tramp.texi
index 4170a35ad4..23e2311659 100644
--- a/texi/tramp.texi
+++ b/texi/tramp.texi
@@ -169,6 +169,7 @@ How file names, directories and localnames are mangled and
managed
* Localname deconstruction:: Breaking a localname into its components.
* External packages:: Integration with external Lisp packages.
* Extension packages:: Adding new methods to @value{tramp}.
+* New operations:: Handling further operations in @value{tramp}.
@end detailmenu
@end menu
@@ -2375,9 +2376,11 @@ value is @t{"-l"}, but some shells, like @command{ksh},
prefer
All @file{tramp-sh.el} based methods accept the property
@t{"session-timeout"}. This is the time (in seconds) after a
connection is disabled for security reasons, and must be
-reestablished. A value of @code{nil} disables this feature. Most of
-the methods do not set this property except the @option{sudo},
-@option{doas} and @option{run0} methods, which use predefined values.
+reestablished@footnote{If there is a modified buffer, or a buffer
+under @code{auto-revert}, this is suppressed.}. A value of @code{nil}
+disables this feature. Most of the methods do not set this property
+except the @option{sudo}, @option{doas} and @option{run0} methods,
+which use predefined values.
@item @t{"~"}@*
@t{"~user"}
@@ -3658,6 +3661,8 @@ behavior: @file{@trampfn{method,user@@host,path/to/file}}.
For specifying port numbers, affix @file{#<port>} to the host
name. For example: @file{@trampfn{ssh,daniel@@melancholia#42,.emacs}}.
+If the host is an IPv6 address, the port is appended like this:
+@file{@trampfn{ssh,@value{ipv6prefix}::1@value{ipv6postfix}#42,.emacs}}.
All method, user name, host name, port number and local name parts are
optional, @xref{Default Method}, @xref{Default User}, @xref{Default Host}.
@@ -5472,6 +5477,13 @@ Suppress reading the remote history file in
@code{shell}. Set
Disable excessive traces. Set @code{tramp-verbose} to 3 or lower,
default being 3. Increase trace levels temporarily when hunting for
bugs.
+
+@c @item
+@c Use a package with @value{tramp} specific implementation of high-level
+@c operations. For example, the GNU ELPA package @file{tramp-hlo}
+@c implements specialized versions of @code{dir-locals--all-files},
+@c @code{locate-dominating-file} and @code{dir-locals-find-file} for
+@c @value{tramp}'s @code{tramp-sh} backend (@pxref{New operations}).
@end itemize
@@ -6457,6 +6469,7 @@ programs.
* Localname deconstruction:: Splitting a localname into its component parts.
* External packages:: Integrating with external Lisp packages.
* Extension packages:: Adding new methods to @value{tramp}.
+* New operations:: Handling further operations in @value{tramp}.
@end menu
@@ -6721,15 +6734,112 @@ The trick is to wrap the function definition of
@code{;;;###autoload} cookie.
+@node New operations
+@section Handling further operations in @value{tramp}
+
+By default, @value{tramp} handles the basic operations listed in
+@ref{Magic File Names, , Magic File Name Operations, elisp}.
+Sometimes, it is desired to support more complex operations directly,
+mainly for performance reasons.
+
+An external package package could add an own implementation of an
+operation to @value{tramp}, which avoids the performance overhead
+caused by using the basic operations which are aware of remote files.
+For example, it could implement this by using an own shell script
+which collects the information on the remote host for this very
+special purpose with one round-trip per-call.
+
+@defun tramp-add-external-operation operation function backend
+This adds an implementation of @var{operation} to @value{tramp}'s
+backend @var{backend}. @var{function} is the new implementation.
+
+Both @var{operation} and @var{function} shall be function symbols.
+They must have the same argument list. The first argument is used to
+determine, whether @value{tramp} is invoked (check for remote file
+name syntax). It must be a string or nil, in the latter case
+@code{default-directory} is used for the check.
+
+@var{backend}, also a symbol, is the feature name of a @value{tramp}
+backend (except @code{tramp-ftp}). The new implementation will be
+applied only for this backend. Example:
+
+@lisp
+@group
+(defun test-operation (file)
+ (message "Original implementation for %s" file))
+@end group
+
+@group
+(defun handle-test-operation (file)
+ (message "Handler implementation for %s" file))
+@end group
+
+@group
+(tramp-add-external-operation
+ #'test-operation #'handle-test-operation 'tramp-sh)
+@end group
+@end lisp
+
+Then we have the different use cases:
+
+@lisp
+@group
+;; Local file name.
+(test-operation "/a/b")
+@result{} "Original implementation for /a/b"
+@end group
+
+@group
+;; Remote file name, handled by `tramp-sh'.
+(test-operation "/ssh::/a/b")
+@result{} "Handler implementation for /ssh::/a/b"
+@end group
+
+@group
+;; Remote file name, handled by `tramp-gvfs'.
+(test-operation "/sftp::/a/b")
+@result{} "Original implementation for /sftp::/a/b"
+@end group
+@end lisp
+
+@var{function} is implemented like an ordinary @value{tramp} backend
+handler, see the examples in @code{tramp-<backend>-handle-*} and
+@code{tramp-handle-*}. It can expect, that the first argument (or
+@code{default-directory}, if that is @code{nil}) has remote file name
+syntax. It shall use @value{tramp} internal macros and functions like
+@code{with-parsed-tramp-file-name} and the different cache functions.
+
+If the same @var{function} shall be used for different @value{tramp}
+backends, @code{tramp-add-external-operation} must be called for every
+backend, respectively.
+@end defun
+
+@defun tramp-remove-external-operation operation backend
+The handler for @var{operation}, added by
+@code{tramp-add-external-operation}, is removed from @var{backend}.
+If there are handlers of @var{operation} for other @var{backend}s,
+they are kept. Example:
+
+@lisp
+@group
+(tramp-remove-external-operation
+ #'test-operation 'tramp-sh)
+@end group
+@end lisp
+@end defun
+
+
@node Traces and Profiles
@chapter How to Customize Traces
@vindex tramp-verbose
@vindex tramp-debug-to-file
@vindex tramp-debug-command-messages
+@vindex tramp-debug-buffer-limit
@value{tramp} messages are raised with verbosity levels ranging from 0
to 10. @value{tramp} does not display all messages; only those with a
-verbosity level less than or equal to @code{tramp-verbose}.
+verbosity level less than or equal to 3, when @code{tramp-verbose}
+permits.
@noindent
The verbosity levels are
@@ -6814,6 +6924,12 @@ strings), and the entry and exit messages for the
function
@code{tramp-file-name-handler}. This is intended for @value{tramp}
maintainers, analyzing the remote commands for performance analysis.
+The debug buffer can be very large, if @code{tramp-verbose} is high,
+and @value{tramp} runs for a long time. If the buffer size exceeds
+@code{tramp-debug-buffer-limit} (100MB by default), a warning will be
+raised. This user option can be adapted to your needs; a value of 0
+means that there is no limit (no warning).
+
@node GNU Free Documentation License
@appendix GNU Free Documentation License
@@ -6841,7 +6957,7 @@ maintainers, analyzing the remote commands for
performance analysis.
@bye
-@c TODO
+@c TODO:
@c
@c * Say something about the .login and .profile files of the remote
@c shells.
@@ -6850,3 +6966,5 @@ maintainers, analyzing the remote commands for
performance analysis.
@c host and then send commands to it.
@c
@c * Consistent small or capitalized words especially in menus.
+@c
+@c * Starting with Emacs 29, use 'setopt' in the examples.
diff --git a/texi/trampver.texi b/texi/trampver.texi
index 5f2b2fad36..fedbca9a5b 100644
--- a/texi/trampver.texi
+++ b/texi/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.8.0.1
+@set trampver 2.8.0.2
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 28.1
diff --git a/tramp-adb.el b/tramp-adb.el
index 2d240e8756..5d6c053868 100644
--- a/tramp-adb.el
+++ b/tramp-adb.el
@@ -573,9 +573,9 @@ Emacs dired can't find files."
"touch -t %s %s %s")
(format-time-string "%Y-%m-%dT%H:%M:%S.%NZ" time t)
nofollow quoted-name (tramp-get-remote-null-device v)
- (format-time-string "%Y-%m-%dT%H:%M:%S" time t)
+ (format-time-string "%Y-%m-%dT%H:%M:%S" time)
nofollow quoted-name (tramp-get-remote-null-device v)
- (format-time-string "%Y%m%d%H%M.%S" time t)
+ (format-time-string "%Y%m%d%H%M.%S" time)
nofollow quoted-name)))))
(defun tramp-adb-handle-copy-file
diff --git a/tramp-cache.el b/tramp-cache.el
index 721b7be123..4ecc804bf2 100644
--- a/tramp-cache.el
+++ b/tramp-cache.el
@@ -647,17 +647,18 @@ your laptop to different networks frequently."
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
- (mapcar
- (lambda (key)
- (let ((tramp-verbose 0))
- (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key))
- (tramp-get-method-parameter
- key 'tramp-completion-use-cache tramp-completion-use-cache)
- (list (tramp-file-name-user key)
- (tramp-file-name-host key)))))
- (hash-table-keys tramp-cache-data)))
+ (delete-dups
+ (tramp-compat-seq-keep
+ (lambda (key)
+ (let ((tramp-verbose 0))
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (tramp-get-method-parameter
+ key 'tramp-completion-use-cache tramp-completion-use-cache)
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key)))))
+ (hash-table-keys tramp-cache-data))))
;; When "emacs -Q" has been called, both variables are nil. We do not
;; load the persistency file then, in order to have a clean test environment.
diff --git a/tramp-compat.el b/tramp-compat.el
index 9787e3a655..feda8943be 100644
--- a/tramp-compat.el
+++ b/tramp-compat.el
@@ -29,7 +29,7 @@
;;; Code:
-(require 'tramp-loaddefs)
+(require 'tramp-loaddefs nil t) ; guard against load during autoload gen
(require 'ansi-color)
(require 'auth-source)
(require 'format-spec)
@@ -251,7 +251,7 @@ value is the default binding of the variable."
;;
;; * Use `ensure-list'.
;;
-;; * Starting with Emacs 29.1, use `buffer-match-p'.
+;; * Starting with Emacs 29.1, use `buffer-match-p' and `match-buffers'.
;;
;; * Starting with Emacs 29.1, use `string-split'.
;;
diff --git a/tramp-gvfs.el b/tramp-gvfs.el
index b5f1135a60..7f3ac945bb 100644
--- a/tramp-gvfs.el
+++ b/tramp-gvfs.el
@@ -2557,7 +2557,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled
in Avahi."
(shell-command-to-string (format "avahi-browse -trkp %s" service))
(rx (+ (any "\r\n"))) 'omit (rx bol "+;" (* nonl) eol)))))
(delete-dups
- (mapcar
+ (tramp-compat-seq-keep
(lambda (x)
(ignore-errors
(let* ((list (split-string x ";"))
diff --git a/tramp-message.el b/tramp-message.el
index 5131e5fced..a328183e18 100644
--- a/tramp-message.el
+++ b/tramp-message.el
@@ -94,6 +94,15 @@ This increases `tramp-verbose' to 6 if necessary."
:type 'boolean
:link '(info-link :tag "Tramp manual" "(tramp) Traces and Profiles"))
+(defcustom tramp-debug-buffer-limit (* 100 1024 1024) ;100MB
+ "The upper limit of a Tramp debug buffer.
+If the size of a debug buffer exceeds this limit, a warning is raised.
+Set it to 0 if there is no limit."
+ :group 'tramp
+ :version "31.1"
+ :type 'natnum
+ :link '(info-link :tag "Tramp manual" "(tramp) Traces and Profiles"))
+
(defconst tramp-debug-outline-regexp
(rx ;; Timestamp.
(+ digit) ":" (+ digit) ":" (+ digit) "." (+ digit) blank
@@ -281,7 +290,14 @@ ARGUMENTS to actually emit the message (if applicable)."
(when tramp-debug-to-file
(ignore-errors
(write-region
- point (point-max) (tramp-get-debug-file-name vec) 'append))))))))
+ point (point-max) (tramp-get-debug-file-name vec) 'append))))
+ (when (and (natnump tramp-debug-buffer-limit)
+ (not (zerop tramp-debug-buffer-limit))
+ (> (point-max) tramp-debug-buffer-limit))
+ (setq-local tramp-debug-buffer-limit nil)
+ (lwarn
+ 'tramp :warning
+ "Tramp debug buffer %S exceeds the limit" (current-buffer)))))))
;;;###tramp-autoload
(defun tramp-message (vec-or-proc level fmt-string &rest arguments)
diff --git a/tramp-sh.el b/tramp-sh.el
index 576f09b764..9d13cdc3a2 100644
--- a/tramp-sh.el
+++ b/tramp-sh.el
@@ -1633,7 +1633,10 @@ of."
"-t %s"
(format-time-string "%Y%m%d%H%M.%S" (tramp-defined-time time) t))
"")
- (if (eq flag 'nofollow) "-h" "")
+ (if (and (eq flag 'nofollow)
+ (tramp-get-connection-property v "touch-h"))
+ "-h"
+ "")
(tramp-shell-quote-argument localname))))))
(defun tramp-sh-handle-get-home-directory (vec &optional user)
@@ -3669,6 +3672,8 @@ are \"file-exists-p\", \"file-readable-p\",
\"file-directory-p\" and
(defun tramp-sh-handle-vc-registered (file)
"Like `vc-registered' for Tramp files."
(when vc-handled-backends
+ ;; Starting with Emacs 31, use `revert-buffer-in-progress'.
+ (with-suppressed-warnings ((obsolete revert-buffer-in-progress-p))
(let ((inhibit-message (or revert-buffer-in-progress-p inhibit-message))
(temp-message (unless revert-buffer-in-progress-p "")))
(with-temp-message temp-message
@@ -3728,7 +3733,7 @@ are \"file-exists-p\", \"file-readable-p\",
\"file-directory-p\" and
;; Run.
(tramp-with-demoted-errors
v "Error in 2nd pass of `vc-registered': %s"
- (tramp-run-real-handler #'vc-registered (list file))))))))))
+ (tramp-run-real-handler #'vc-registered (list file)))))))))))
;;;###tramp-autoload
(defun tramp-sh-file-name-handler (operation &rest args)
@@ -5149,17 +5154,41 @@ Goes through the list `tramp-inline-compress-commands'."
;;;###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."
- (if (and (tramp-get-connection-property
- (tramp-get-connection-process vec) "locked")
- (tramp-file-name-equal-p vec (car tramp-current-connection)))
- (progn
- (tramp-message
- vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
- (run-at-time 5 nil #'tramp-timeout-session vec))
+If there is just some editing, retry it after 5 seconds.
+If there is a modified buffer, retry it after 60 seconds."
+ (cond
+ ;; Tramp is locked. Try it, again.
+ ((and (tramp-get-connection-property
+ (tramp-get-connection-process vec) "locked")
+ (tramp-file-name-equal-p vec (car tramp-current-connection)))
+ (tramp-message
+ vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
+ (run-at-time 5 nil #'tramp-timeout-session vec))
+ ;; There's a modified buffer. Try it, again.
+ ((seq-some
+ (lambda (buf)
+ (and-let* (((or (buffer-modified-p buf)
+ (with-current-buffer buf
+ ;; We don't know whether autorevert.el has
+ ;; been loaded alreaddy.
+ (tramp-compat-funcall 'auto-revert-active-p))))
+ (bfn (buffer-file-name buf))
+ (v (tramp-ensure-dissected-file-name bfn))
+ ((tramp-file-name-equal-p vec v)))))
+ (tramp-list-remote-buffers))
(tramp-message
- vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
- (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
+ vec 5
+ (concat
+ "Cannot timeout session (modified buffer), "
+ "trying it again in %s seconds.")
+ (tramp-get-method-parameter vec 'tramp-session-timeout))
+ (run-at-time
+ (tramp-get-method-parameter vec 'tramp-session-timeout) nil
+ #'tramp-timeout-session vec))
+ ;; Do it.
+ (t (tramp-message
+ vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
+ (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes))))
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -5887,12 +5916,12 @@ Nonexistent directories are removed from spec."
"Determine remote `touch' command."
(with-tramp-connection-property vec "touch"
(tramp-message vec 5 "Finding a suitable `touch' command")
- (let ((result (tramp-find-executable
- vec "touch" (tramp-get-remote-path vec)))
- (tmpfile (tramp-make-tramp-temp-name vec)))
- ;; Busyboxes do support the "-t" option only when they have been
- ;; built with the DESKTOP config option. Let's check it.
- (when result
+ (when-let* ((result (tramp-find-executable
+ vec "touch" (tramp-get-remote-path vec)))
+ (tmpfile (tramp-make-tramp-temp-name vec)))
+ (prog1 result
+ ;; Busyboxes do support the "-t" option only when they have
+ ;; been built with the DESKTOP config option. Let's check it.
(tramp-set-connection-property
vec "touch-t"
(tramp-send-command-and-check
@@ -5902,8 +5931,13 @@ Nonexistent directories are removed from spec."
result
(format-time-string "%Y%m%d%H%M.%S")
(tramp-file-local-name tmpfile))))
- (delete-file tmpfile))
- result)))
+ ;; The touch command included in busybox (version 1.30.1-6) on
+ ;; OpenWrt does not have the option "-h".
+ (tramp-set-connection-property
+ vec "touch-h"
+ (tramp-send-command-and-check
+ vec (format "%s -h %s" result (tramp-file-local-name tmpfile))))
+ (delete-file tmpfile)))))
(defun tramp-get-remote-df (vec)
"Determine remote `df' command."
diff --git a/tramp-smb.el b/tramp-smb.el
index 28364de83f..fdda945f12 100644
--- a/tramp-smb.el
+++ b/tramp-smb.el
@@ -295,7 +295,7 @@ See `tramp-actions-before-shell' for more info.")
(set-file-acl . tramp-smb-handle-set-file-acl)
(set-file-modes . tramp-smb-handle-set-file-modes)
(set-file-selinux-context . ignore)
- (set-file-times . ignore)
+ (set-file-times . tramp-smb-handle-set-file-times)
(set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-smb-handle-start-file-process)
@@ -1534,6 +1534,15 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(tramp-error
v 'file-error "Error while changing file's mode %s" filename))))))
+(defun tramp-smb-handle-set-file-times (filename &optional time _flag)
+ "Like `set-file-times' for Tramp files."
+ (tramp-skeleton-set-file-modes-times-uid-gid filename
+ (tramp-smb-send-command
+ v (format
+ "utimes %s -1 -1 %s -1"
+ (tramp-smb-shell-quote-localname v)
+ (format-time-string "%Y:%m:%d-%H:%M:%S" (tramp-defined-time time))))))
+
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
diff --git a/tramp.el b/tramp.el
index b58acea229..b63c5d97a0 100644
--- a/tramp.el
+++ b/tramp.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albi...@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.8.0.1
+;; Version: 2.8.0.2
;; Package-Requires: ((emacs "28.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@@ -103,8 +103,15 @@
(put 'tramp--startup-hook 'tramp-suppress-trace t)
+ ;; TODO: Once (autoload-macro expand) is available in all supported
+ ;; Emacs versions (Emacs 31.1+), this can be eliminated:
+ ;; Backward compatibility for autoload-macro declare form.
+ (unless (assq 'autoload-macro macro-declarations-alist)
+ (push '(autoload-macro ignore) macro-declarations-alist))
+
(defmacro tramp--with-startup (&rest body)
"Schedule BODY to be executed at the end of tramp.el."
+ (declare (autoload-macro expand))
`(add-hook 'tramp--startup-hook (lambda () ,@body)))
(eval-and-compile
@@ -1040,7 +1047,7 @@ Used in `tramp-make-tramp-file-name'.")
"Regexp matching delimiter between method and user or host names.
Derived from `tramp-postfix-method-format'.")
-(defconst tramp-user-regexp (rx (+ (not (any "/:|" blank))))
+(defconst tramp-user-regexp (rx (+ (not (any "/:|[]" blank))))
"Regexp matching user names.")
(defconst tramp-prefix-domain-format "%"
@@ -1994,10 +2001,21 @@ necessary only. This function will be used in file
name completion."
(concat user tramp-postfix-user-format))
(unless (tramp-string-empty-or-nil-p host)
(concat
- (if (string-match-p tramp-ipv6-regexp host)
- (concat
- tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
- host)
+ (cond
+ (;; ipv6#port -> [ipv6]#port
+ (string-match
+ (rx (group (regexp tramp-ipv6-regexp))
+ (group (regexp tramp-prefix-port-regexp)
+ (regexp tramp-port-regexp)))
+ host)
+ (concat
+ tramp-prefix-ipv6-format (match-string 1 host)
+ tramp-postfix-ipv6-format (match-string 2 host)))
+ (;; ipv6 -> [ipv6]
+ (string-match-p tramp-ipv6-regexp host)
+ (concat
+ tramp-prefix-ipv6-format host tramp-postfix-ipv6-format))
+ (t host))
tramp-postfix-host-format))
localname))
@@ -2380,6 +2398,9 @@ arguments to pass to the OPERATION."
signal-hook-function)
(apply operation args)))
+(defvar tramp-file-name-for-operation-external nil
+ "List of operations added by external packages.")
+
;; We handle here all file primitives. Most of them have the file
;; name as first parameter; nevertheless we check for them explicitly
;; in order to be signaled if a new primitive appears. This
@@ -2387,6 +2408,10 @@ arguments to pass to the OPERATION."
;; syntactical means whether a foreign method must be called. It would
;; ease the life if `file-name-handler-alist' would support a decision
;; function as well but regexp only.
+;; Operations added by external packages are kept in
+;; `tramp-file-name-for-operation-external'. They expect the file
+;; name to be checked as first argument or, if there isn't any
+;; argument, `default-directory'.
(defun tramp-file-name-for-operation (operation &rest args)
"Return file name related to OPERATION file primitive.
ARGS are the arguments OPERATION has been called with.
@@ -2396,40 +2421,40 @@ first argument of `expand-file-name' is absolute and
not remote.
Must be handled by the callers."
(cond
;; FILE resp DIRECTORY.
- ((member operation
- '(access-file byte-compiler-base-file-name delete-directory
- delete-file diff-latest-backup-file directory-file-name
- directory-files directory-files-and-attributes dired-compress-file
- dired-uncache file-acl file-accessible-directory-p file-attributes
- file-directory-p file-executable-p file-exists-p file-local-copy
- file-locked-p file-modes file-name-as-directory
- file-name-case-insensitive-p file-name-directory
- file-name-nondirectory file-name-sans-versions
- file-notify-add-watch file-ownership-preserved-p file-readable-p
- file-regular-p file-remote-p file-selinux-context file-symlink-p
- file-system-info file-truename file-writable-p
- find-backup-file-name get-file-buffer
- insert-directory insert-file-contents load lock-file
make-directory
- make-lock-file-name set-file-acl set-file-modes
- set-file-selinux-context set-file-times substitute-in-file-name
- unhandled-file-name-directory unlock-file vc-registered
- ;; Emacs 28- only.
- make-directory-internal
- ;; Emacs 29+ only.
- abbreviate-file-name
- ;; Tramp internal magic file name function.
- tramp-set-file-uid-gid))
+ ((memq operation
+ '(access-file byte-compiler-base-file-name delete-directory
+ delete-file diff-latest-backup-file directory-file-name
+ directory-files directory-files-and-attributes dired-compress-file
+ dired-uncache file-acl file-accessible-directory-p file-attributes
+ file-directory-p file-executable-p file-exists-p file-local-copy
+ file-locked-p file-modes file-name-as-directory
+ file-name-case-insensitive-p file-name-directory
+ file-name-nondirectory file-name-sans-versions
+ file-notify-add-watch file-ownership-preserved-p file-readable-p
+ file-regular-p file-remote-p file-selinux-context file-symlink-p
+ file-system-info file-truename file-writable-p
+ find-backup-file-name get-file-buffer
+ insert-directory insert-file-contents load lock-file make-directory
+ make-lock-file-name set-file-acl set-file-modes
+ set-file-selinux-context set-file-times substitute-in-file-name
+ unhandled-file-name-directory unlock-file vc-registered
+ ;; Emacs 28- only.
+ make-directory-internal
+ ;; Emacs 29+ only.
+ abbreviate-file-name
+ ;; Tramp internal magic file name function.
+ tramp-set-file-uid-gid))
(if (file-name-absolute-p (nth 0 args))
(nth 0 args)
default-directory))
;; STRING FILE.
((eq operation 'make-symbolic-link) (nth 1 args))
;; FILE DIRECTORY resp FILE1 FILE2.
- ((member operation
- '(add-name-to-file copy-directory copy-file
- file-equal-p file-in-directory-p
- file-name-all-completions file-name-completion
- file-newer-than-file-p rename-file))
+ ((memq operation
+ '(add-name-to-file copy-directory copy-file
+ file-equal-p file-in-directory-p
+ file-name-all-completions file-name-completion
+ file-newer-than-file-p rename-file))
(cond
((tramp-tramp-file-p (nth 0 args)) (nth 0 args))
((file-name-absolute-p (nth 1 args)) (nth 1 args))
@@ -2446,31 +2471,39 @@ Must be handled by the callers."
(nth 2 args)
default-directory))
;; BUFFER.
- ((member operation
- '(make-auto-save-file-name
- set-visited-file-modtime verify-visited-file-modtime))
+ ((memq operation
+ '(make-auto-save-file-name
+ set-visited-file-modtime verify-visited-file-modtime))
(buffer-file-name
(if (bufferp (nth 0 args)) (nth 0 args) (current-buffer))))
;; COMMAND.
- ((member operation
- '(exec-path make-nearby-temp-file make-process process-file
- shell-command start-file-process temporary-file-directory
- ;; Emacs 29+ only.
- list-system-processes memory-info process-attributes
- ;; Emacs 30+ only.
- file-group-gid file-user-uid))
+ ((memq operation
+ '(exec-path make-nearby-temp-file make-process process-file
+ shell-command start-file-process temporary-file-directory
+ ;; Emacs 29+ only.
+ list-system-processes memory-info process-attributes
+ ;; Emacs 30+ only.
+ file-group-gid file-user-uid))
default-directory)
;; PROC.
- ((member operation '(file-notify-rm-watch file-notify-valid-p))
+ ((memq operation '(file-notify-rm-watch file-notify-valid-p))
(when (processp (nth 0 args))
(tramp-get-default-directory (process-buffer (nth 0 args)))))
;; VEC.
- ((member operation
- '(tramp-get-home-directory tramp-get-remote-gid
- tramp-get-remote-groups tramp-get-remote-uid))
+ ((memq operation
+ '(tramp-get-home-directory tramp-get-remote-gid
+ tramp-get-remote-groups tramp-get-remote-uid))
(tramp-make-tramp-file-name (nth 0 args)))
+ ;; FILE resp DIRECTORY.
+ ((and (memq operation tramp-file-name-for-operation-external)
+ (or (stringp (nth 0 args)) (null (nth 0 args))))
+ (if (and (stringp (nth 0 args)) (file-name-absolute-p (nth 0 args)))
+ (nth 0 args)
+ default-directory))
;; Unknown file primitive.
- (t (error "Unknown file I/O primitive: %s" operation))))
+ (t (unless (member 'remote-file-error debug-ignored-errors)
+ (tramp-error
+ nil 'remote-file-error "Unknown file I/O primitive: %s" operation)))))
(defun tramp-find-foreign-file-name-handler (vec &optional _operation)
"Return foreign file name handler if exists."
@@ -2494,6 +2527,63 @@ Must be handled by the callers."
res (cdr elt))))
res)))
+(defun tramp-add-external-operation (operation function backend)
+ "Add FUNTION to Tramp BACKEND as handler for OPERATION.
+OPERATION must not be one of the magic operations listed in Info
+node `(elisp) Magic File Names'. FUNCTION must have the same argument
+list as OPERATION. BACKEND, a symbol, must be one of the Tramp backend
+packages like `tramp-sh' (except `tramp-ftp')."
+ (require backend)
+ (when-let* ((fnha
+ (intern-soft
+ (concat (symbol-name backend) "-file-name-handler-alist")))
+ ((boundp fnha)))
+ ;; Make BACKEND aware of the new operation.
+ (add-to-list fnha (cons operation function))
+ (unless (memq operation tramp-file-name-for-operation-external)
+ ;; Make Tramp aware of the new operation.
+ (add-to-list 'tramp-file-name-for-operation-external operation)
+ (put #'tramp-file-name-handler
+ 'operations
+ (cons operation (get 'tramp-file-name-handler 'operations)))
+ ;; Add an advice for OPERATION, in order to invoke the handler FUNCTION.
+ (advice-add
+ operation :around
+ `(lambda (orig-fun &rest args)
+ (if-let* ((handler
+ (find-file-name-handler
+ (or (car args) default-directory) #',operation)))
+ (apply handler #',operation args)
+ (apply orig-fun args)))
+ `((name . ,(concat "tramp-advice-" (symbol-name operation))))))))
+
+(defun tramp-remove-external-operation (operation backend)
+ "Remove OPERATION from Tramp BACKEND as handler for OPERATION.
+OPERATION must not be one of the magic operations listed in Info
+node `(elisp) Magic File Names'. BACKEND, a symbol, must be one of the
+Tramp backend packages like `tramp-sh'."
+ ;; Remove OPERATION from BACKEND.
+ (when-let* ((fnha
+ (intern-soft
+ (concat (symbol-name backend) "-file-name-handler-alist")))
+ ((boundp fnha)))
+ (setf (alist-get operation (symbol-value fnha) nil 'remove) nil))
+ ;; Check, whether OPERATION is still used in any backend.
+ (unless (seq-some
+ (lambda (item)
+ (when-let*
+ ((fnha (intern-soft (concat (symbol-name (cdr item))
"-alist")))
+ ((boundp fnha)))
+ (alist-get operation (symbol-value fnha))))
+ tramp-foreign-file-name-handler-alist)
+ ;; Make Tramp unaware of OPERATION.
+ (setq tramp-file-name-for-operation-external
+ (delq operation tramp-file-name-for-operation-external))
+ (put #'tramp-file-name-handler
+ 'operations (delq operation (get 'tramp-file-name-handler
'operations)))
+ ;; Remove the advice for OPERATION.
+ (advice-remove operation (concat "tramp-advice-" (symbol-name
operation)))))
+
;; Main function.
;;;###autoload
(defun tramp-file-name-handler (operation &rest args)
@@ -2831,19 +2921,23 @@ not in completion mode."
;; We need special handling only when a method is needed. Then we
;; regard all files "/method:" or "/[method/" as existent, if
;; "method" is a valid Tramp method.
- (or (string-equal filename "/")
- (and ;; Is it a valid method?
- (not (string-empty-p tramp-postfix-method-format))
- (string-match
- (rx
- (regexp tramp-prefix-regexp)
- (* (regexp tramp-remote-file-name-spec-regexp)
- (regexp tramp-postfix-hop-regexp))
- (group-n 9 (regexp tramp-method-regexp))
- (? (regexp tramp-postfix-method-regexp))
- eos)
- filename)
- (assoc (match-string 9 filename) tramp-methods)
+ (or (and (cond
+ ;; Completion styles like `flex' and `substring' check for
+ ;; the file name "/". This does exist.
+ ((string-equal filename "/"))
+ ;; Is it a valid method?
+ ((and (not (string-empty-p tramp-postfix-method-format))
+ (string-match
+ (rx
+ (regexp tramp-prefix-regexp)
+ (* (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))
+ (group-n 9 (regexp tramp-method-regexp))
+ (| (regexp tramp-postfix-method-regexp) eos))
+ filename))
+ (assoc (match-string 9 filename) tramp-methods))
+ ;; Is it a completion file name?
+ ((string-match-p tramp-completion-file-name-regexp filename)))
t)
(tramp-run-real-handler #'file-directory-p (list filename))))
@@ -2852,10 +2946,7 @@ not in completion mode."
"Like `file-exists-p' for partial Tramp files."
;; We need special handling only when a method is needed. Then we
;; regard all files "/method:" or "/[method/" as existent, if
- ;; "method" is a valid Tramp method. And we regard all files
- ;; "/method:user@", "/user@" or "/[method/user@" as existent, if
- ;; "user@" is a valid file name completion. Host completion is
- ;; performed in the respective backend operation.
+ ;; "method" is a valid Tramp method.
(or (and (cond
;; Completion styles like `flex' and `substring' check for
;; the file name "/". This does exist.
@@ -2868,28 +2959,11 @@ not in completion mode."
(* (regexp tramp-remote-file-name-spec-regexp)
(regexp tramp-postfix-hop-regexp))
(group-n 9 (regexp tramp-method-regexp))
- (? (regexp tramp-postfix-method-regexp))
- eos)
+ (| (regexp tramp-postfix-method-regexp) eos))
filename))
(assoc (match-string 9 filename) tramp-methods))
- ;; Is it a valid user?
- ((string-match
- (rx
- (regexp tramp-prefix-regexp)
- (* (regexp tramp-remote-file-name-spec-regexp)
- (regexp tramp-postfix-hop-regexp))
- (group-n 10
- (regexp tramp-method-regexp)
- (regexp tramp-postfix-method-regexp))
- (group-n 11
- (regexp tramp-user-regexp)
- (regexp tramp-postfix-user-regexp))
- eos)
- filename)
- (member
- (match-string 11 filename)
- (file-name-all-completions
- "" (concat tramp-prefix-format (match-string 10 filename))))))
+ ;; Is it a completion file name?
+ ((string-match-p tramp-completion-file-name-regexp filename)))
t)
(tramp-run-real-handler #'file-exists-p (list filename))))
@@ -2900,7 +2974,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 "..".
@@ -2917,7 +2991,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.")
@@ -3004,15 +3078,14 @@ BODY is the backend specific code."
;; Method, host name and user name completion for a file.
(defun tramp-completion-handle-file-name-completion
- (filename directory &optional predicate)
- "Like `file-name-completion' for partial Tramp files."
+ (filename directory &optional _predicate)
+ "Like `file-name-completion' for partial Tramp files.
+It ignores PREDICATE, because there's no meaningful result."
;; Suppress eager completion on not connected hosts.
(let ((non-essential t))
(try-completion
filename
- (mapcar #'list (file-name-all-completions filename directory))
- (when (and predicate (tramp-connectable-p directory))
- (lambda (x) (funcall predicate (expand-file-name (car x)
directory)))))))
+ (mapcar #'list (file-name-all-completions filename directory)))))
;; I misuse a little bit the `tramp-file-name' structure in order to
;; handle completion possibilities for partial methods / user names /
@@ -3034,7 +3107,15 @@ BODY is the backend specific code."
(defun tramp-completion-dissect-file-name (name)
"Return a list of `tramp-file-name' structures for NAME.
They are collected by `tramp-completion-dissect-file-name1'."
- (let (;; "/method" "/[method"
+ ;; We don't need a special handling for "user%domain", because "%"
+ ;; is also hit by `tramp-user-regexp'. "host#port" is normalized
+ ;; for IPv6 hosts.
+ (let ((internal-name
+ (replace-regexp-in-string
+ (rx (regexp tramp-postfix-ipv6-regexp)
+ (regexp tramp-prefix-port-regexp))
+ tramp-prefix-port-format name))
+ ;; "/method" "/[method"
(tramp-completion-file-name-structure1
(list
(rx
@@ -3091,16 +3172,75 @@ They are collected by
`tramp-completion-dissect-file-name1'."
(regexp tramp-postfix-user-regexp)
(regexp tramp-prefix-ipv6-regexp)
(group (? (regexp tramp-ipv6-regexp))) eol)
+ 1 2 3 nil))
+ ;; "/method:host#port" "/[method/host#port"
+ (tramp-completion-file-name-structure7
+ (list
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-host-regexp)
+ (regexp tramp-prefix-port-regexp)
+ (? (regexp tramp-port-regexp)))
+ eol)
+ 1 nil 2 nil))
+ ;; "/method:[ipv6]#port" "/[method/ipv6#port"
+ (tramp-completion-file-name-structure8
+ (list
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (regexp tramp-prefix-ipv6-regexp)
+ (group (regexp tramp-ipv6-regexp)
+ (regexp tramp-prefix-port-regexp)
+ (? (regexp tramp-port-regexp)))
+ eol)
+ 1 nil 2 nil))
+ ;; "/method:user@host#port" "/[method/user@host#port"
+ (tramp-completion-file-name-structure9
+ (list
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-postfix-user-regexp)
+ (group (regexp tramp-host-regexp)
+ (regexp tramp-prefix-port-regexp)
+ (? (regexp tramp-port-regexp)))
+ eol)
+ 1 2 3 nil))
+ ;; "/method:user@[ipv6]#port" "/[method/user@ipv6#port"
+ (tramp-completion-file-name-structure10
+ (list
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (regexp tramp-method-regexp))
+ (regexp tramp-postfix-method-regexp)
+ (group (regexp tramp-user-regexp))
+ (regexp tramp-postfix-user-regexp)
+ (regexp tramp-prefix-ipv6-regexp)
+ (group (regexp tramp-ipv6-regexp)
+ (regexp tramp-prefix-port-regexp)
+ (? (regexp tramp-port-regexp)))
+ eol)
1 2 3 nil)))
(tramp-compat-seq-keep
- (lambda (structure) (tramp-completion-dissect-file-name1 structure name))
+ (lambda (structure)
+ (tramp-completion-dissect-file-name1 structure internal-name))
(list
tramp-completion-file-name-structure1
tramp-completion-file-name-structure2
tramp-completion-file-name-structure3
tramp-completion-file-name-structure4
tramp-completion-file-name-structure5
- tramp-completion-file-name-structure6))))
+ tramp-completion-file-name-structure6
+ tramp-completion-file-name-structure7
+ tramp-completion-file-name-structure8
+ tramp-completion-file-name-structure9
+ tramp-completion-file-name-structure10))))
(defun tramp-completion-dissect-file-name1 (structure name)
"Return a `tramp-file-name' structure for NAME matching STRUCTURE.
@@ -3202,7 +3342,10 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match
HOST."
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from default settings."
- `((,(tramp-find-user method nil nil) ,(tramp-find-host method nil nil))))
+ (let ((user (tramp-find-user method nil nil))
+ (host (tramp-find-host method nil nil)))
+ (when (or user host)
+ `((,user ,host)))))
;;;###tramp-autoload
(defcustom tramp-completion-multi-hop-methods nil
@@ -3224,10 +3367,11 @@ as for \"~/.authinfo.gpg\"."
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from default settings."
(and tramp-completion-use-auth-sources
- (mapcar
- (lambda (x) `(,(plist-get x :user) ,(plist-get x :host)))
- (auth-source-search
- :port method :require '(:port) :max most-positive-fixnum))))
+ (delete-dups
+ (tramp-compat-seq-keep
+ (lambda (x) `(,(plist-get x :user) ,(plist-get x :host)))
+ (auth-source-search
+ :port method :require '(:port) :max most-positive-fixnum)))))
;; Generic function.
(defun tramp-parse-group (regexp match-level skip-chars)
@@ -3252,7 +3396,8 @@ User is always nil."
(with-temp-buffer
(insert-file-contents-literally filename)
(goto-char (point-min))
- (cl-loop while (not (eobp)) collect (funcall function))))))
+ (delete-dups (delq nil
+ (cl-loop while (not (eobp)) collect (funcall function))))))))
(defun tramp-parse-rhosts (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3280,7 +3425,9 @@ User is always nil."
(defun tramp-parse-shosts-group ()
"Return a (user host) tuple allowed to access.
User is always nil."
- (tramp-parse-group (rx bol (group (regexp tramp-host-regexp))) 1 ","))
+ (tramp-parse-group
+ (rx bol (group (| (regexp tramp-ipv6-regexp) (regexp tramp-host-regexp))))
+ 1 ","))
(defun tramp-parse-sconfig (filename)
"Return a list of (user host) tuples allowed to access.
@@ -3386,11 +3533,12 @@ Host is always \"localhost\"."
(defun tramp-parse-netrc (filename)
"Return a list of (user host) tuples allowed to access.
User may be nil."
- (mapcar
- (lambda (item)
- (and (assoc "machine" item)
- `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item)))))
- (tramp-compat-auth-source-netrc-parse-all filename)))
+ (delete-dups
+ (tramp-compat-seq-keep
+ (lambda (item)
+ (and (assoc "machine" item)
+ `(,(cdr (assoc "login" item)) ,(cdr (assoc "machine" item)))))
+ (tramp-compat-auth-source-netrc-parse-all filename))))
(defun tramp-parse-putty (registry-or-dirname)
"Return a list of (user host) tuples allowed to access.
@@ -4191,10 +4339,18 @@ Let-bind it when necessary.")
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
- ;; `file-truename' could raise an error, for example due to a cyclic
- ;; symlink.
- (ignore-errors
- (eq (file-attribute-type (file-attributes (file-truename filename))) t)))
+ (or
+ ;; `file-directory-p' is used as predicate for file name
+ ;; completion. Sometimes, when a connection is not established
+ ;; yet, it is desirable to return t immediately for "/method:foo:"
+ ;; or "/method:foo:/". It can be expected that this is always a
+ ;; directory.
+ (tramp-string-empty-or-nil-p (tramp-file-local-name filename))
+ (string-equal (tramp-file-local-name filename) "/")
+ ;; `file-truename' could raise an error, for example due to a
+ ;; cyclic symlink.
+ (ignore-errors
+ (eq (file-attribute-type (file-attributes (file-truename filename))) t))))
(defun tramp-handle-file-equal-p (filename1 filename2)
"Like `file-equal-p' for Tramp files."
diff --git a/trampver.el b/trampver.el
index 9ee964613c..c3f7cc4966 100644
--- a/trampver.el
+++ b/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albi...@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.8.0.1
+;; Version: 2.8.0.2
;; Package-Requires: ((emacs "28.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.8.0.1"
+(defconst tramp-version "2.8.0.2"
"This version of Tramp.")
;;;###tramp-autoload
@@ -76,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-version-lessp emacs-version "28.1"))
"ok"
- (format "Tramp 2.8.0.1 is not fit for %s"
+ (format "Tramp 2.8.0.2 is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
