From 2695af297e8811d98f3082013f5bf4a5d0281efe Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 5 Aug 2023 18:07:58 +0200 Subject: [PATCH] Sync with Tramp 2.6.2-pre * doc/misc/tramp.texi (Overview): Use "scp" in example. (Obtaining @value{tramp}): Prefer https: to git: URIs on Savannah. (Ssh setup): Extend for MS Windows and ssh. Explain tramp-use-ssh-controlmaster-options value `suppress'. (File name completion): Remove completion styles restrictions. (Ad-hoc multi-hops): Describe tramp-show-ad-hoc-proxies. (Remote processes): Add reference to "Using ssh connection sharing". * doc/misc/trampver.texi: * lisp/net/trampver.el (tramp-version): Set to "2.6.2-pre". * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions): * lisp/net/tramp-archive.el (tramp-archive-handle-file-name-all-completions): * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-name-all-completions): * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-name-all-completions): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions): * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): * lisp/net/tramp-smb.el (tramp-smb-handle-file-name-all-completions): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-name-all-completions): Return nil when DIRECTORY is missing. (Bug#61890) * lisp/net/tramp.el (tramp-accept-process-output): Don't use TIMEOUT anymore, default it to 0. When the connection uses a shared socket possibly, accept also the output from other processes over the same connection. (Bug#61350) (tramp-handle-file-notify-rm-watch, tramp-action-process-alive) (tramp-action-out-of-band, tramp-process-one-action) (tramp-interrupt-process): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch): * lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch): * lisp/net/tramp-smb.el (tramp-smb-action-get-acl) (tramp-smb-action-set-acl, tramp-smb-wait-for-output): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-action-sudo): Adapt callees. * lisp/net/tramp.el (tramp-get-process, tramp-message) (tramp-handle-make-process, tramp-handle-file-notify-valid-p) (tramp-process-actions, tramp-accept-process-output) (tramp-process-sentinel, tramp-read-passwd) (tramp-interrupt-process, tramp-signal-process): * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): * lisp/net/tramp-cmds.el (tramp-cleanup-connection): * lisp/net/tramp-crypt.el (tramp-crypt-maybe-open-connection): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch) (tramp-gvfs-monitor-process-filter) (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) (tramp-sh-handle-file-notify-add-watch) (tramp-sh-gio-monitor-process-filter) (tramp-sh-inotifywait-process-filter) (tramp-barf-if-no-shell-prompt, tramp-maybe-open-connection): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl) (tramp-smb-maybe-open-connection): * lisp/net/tramp-sshfs.el (tramp-sshfs-maybe-open-connection): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection) (tramp-sudoedit-send-command): Prefix internal process properties with "tramp-". * lisp/net/tramp.el (tramp-skeleton-file-exists-p): New defmacro, which also handles host name completion. (tramp-handle-file-exists-p): * lisp/net/tramp-adb.el (tramp-adb-handle-file-exists-p): * lisp/net/tramp-sh.el (tramp-sh-handle-file-exists-p): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-file-exists-p): Use it. * lisp/net/tramp.el (tramp-wrong-passwd-regexp): * lisp/net/tramp-adb.el (tramp-adb-prompt): * lisp/net/tramp-sh.el (tramp-sh-inotifywait-process-filter): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Unify regexps. * lisp/net/tramp.el: * lisp/net/tramp-cmds.el: * lisp/net/tramp-crypt.el: * lisp/net/tramp-gvfs.el: * lisp/net/tramp-sh.el: * lisp/net/tramp-smb.el: Fix error messages. * lisp/net/tramp-cmds.el (tramp-cleanup-connection): Protect `delete-process'. * lisp/net/tramp.el (tramp-prefix-format, tramp-prefix-regexp) (tramp-method-regexp, tramp-postfix-method-format) (tramp-postfix-method-regexp, tramp-prefix-ipv6-format) (tramp-prefix-ipv6-regexp, tramp-postfix-ipv6-format) (tramp-postfix-ipv6-regexp, tramp-postfix-host-format) (tramp-postfix-host-regexp, tramp-remote-file-name-spec-regexp) (tramp-file-name-structure, tramp-file-name-regexp) (tramp-completion-method-regexp) (tramp-completion-file-name-regexp): * lisp/net/tramp-compat.el (tramp-syntax): * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-event-vector): Rearrange declarations. * lisp/net/tramp-compat.el (ansi-color): Require. (ls-lisp): Don't require. (Bug#64124) (tramp-compat-replace-regexp-in-region): Move up. (tramp-compat-length<, tramp-compat-length>) (tramp-compat-length=): New defaliases. (tramp-compat-file-name-unquote, tramp-compat-take) (tramp-compat-ntake): Use them. * lisp/net/tramp-container.el (tramp-container--completion-function): Rename from `tramp-docker--completion-function'. Add argument PROGRAM. Use it for "docker" and "podman" host name completion. * lisp/net/tramp-crypt.el (tramp-crypt-handle-file-exists-p): New defun. (tramp-crypt-file-name-handler-alist): Add it. * lisp/net/tramp-fuse.el (tramp-fuse-handle-file-exists-p): New defun. (tramp-fuse-mount-timeout): Move up. (tramp-fuse-mount-point): Use `tramp-fuse-mount-timeout'. (tramp-fuse-unmount): Flush "mount-point" file property. (tramp-fuse-mount-point, tramp-fuse-mounted-p): Support existing mount points. (tramp-fuse-mounted-p): The mount-spec could contain an optional trailing slash. (Bug#64278) * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file) * lisp/net/tramp-rclone.el (tramp-rclone-do-copy-or-rename-file): Improve stability for WebDAV. (tramp-rclone-handle-file-system-info): Check return code of command. * lisp/net/tramp-gvfs.el (while-no-input-ignore-events): Add `dbus-event' for older Emacs versions. (tramp-gvfs-parse-device-names): Ignore errors. * lisp/net/tramp-sh.el (tramp-display-escape-sequence-regexp) (tramp-device-escape-sequence-regexp): Delete. (tramp-sh-handle-insert-directory, tramp-barf-if-no-shell-prompt) (tramp-wait-for-output): Use `ansi-color-control-seq-regexp'. (tramp-use-ssh-controlmaster-options): Allow new value `suppress'. (tramp-ssh-option-exists-p): New defun. (tramp-ssh-controlmaster-options): Implement `suppress' actions. Should never return nil, but empty string. (tramp-perl-file-name-all-completions): Don't print status message. (tramp-sh-handle-file-name-all-completions): Return nil when check fails. (Bug#61890) (tramp-run-test): Add VEC argument. (tramp-sh-handle-file-executable-p) (tramp-sh-handle-file-readable-p) (tramp-sh-handle-file-directory-p) (tramp-sh-handle-file-writable-p): Adapt callees. (tramp-sh-handle-insert-directory): (tramp-sh-handle-insert-directory): Test whether -N is understood by ls since that option is used along with --dired. Remove -N when we remove --dired. (Bug#63142) (tramp-sh-handle-insert-directory, tramp-barf-if-no-shell-prompt) (tramp-wait-for-output): Use `ansi-color-control-seq-regexp'. (tramp-sh-handle-expand-file-name): `null-device' could be nil. Reported by Richard Copley . (tramp-sh-handle-make-process): Improve handling of connection-type `pipe'. (Bug#61341) * lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-make-symbolic-link): Flush TARGET file properties. * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file): Flush proper file properties. (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl): Remove superfluous `unwind-protect'. * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): Use `tramp-fuse-handle-file-exists-p'. (tramp-sshfs-handle-insert-file-contents): Move result out of unwindform. * lisp/net/tramp.el (tramp-string-empty-or-nil-p): New defsubst. Use it everywhere when appropriate. * lisp/net/tramp.el (tramp-methods) <->: Add. (tramp-completion-file-name-handler-alist): Add `expand-file-name', `file-exists-p', `file-name-directory' and `file-name-nondirectory'. (tramp-dissect-file-name): Do not extra check for `tramp-default-method-marker'. (tramp-completion-handle-expand-file-name) (tramp-completion-handle-file-exists-p) (tramp-completion-handle-file-name-directory) (tramp-completion-handle-file-name-nondirectory): New defuns. (tramp-completion-handle-file-name-all-completions): Remove duplicates. (tramp-show-ad-hoc-proxies): New defcustom. (tramp-make-tramp-file-name): Use it. (tramp-make-tramp-hop-name): Don't add hop twice. (tramp-shell-prompt-pattern): Remove escape characters. (tramp-process-one-action, tramp-convert-file-attributes): Use `ansi-color-control-seq-regexp'. (Bug#63539) (tramp-wrong-passwd-regexp): Add "Authentication failed" string (from doas). (tramp-terminal-type): Fix docstring. (tramp-process-one-action): Delete ANSI control escape sequences in buffer. (Bug#63539) (tramp-build-completion-file-name-regexp): Support user name completion. (tramp-make-tramp-file-name): Keep hop while in file (tramp-set-completion-function): Check, that cdr of FUNCTION-LIST entries is a string. (tramp-completion-file-name-handler): Run only when `minibuffer-completing-file-name' is non-nil. (tramp-skeleton-write-region): Fix scoping. (Bug#65022) (tramp-handle-memory-info): Work on newly created objects, or use non-destructive operations. (tramp-accept-process-output): Use `with-local-quit'. (tramp-call-process, tramp-call-process-region): Let-bind `temporary-file-directory'. * test/lisp/net/tramp-archive-tests.el (tramp-archive--test-emacs28-p): New defun. (tramp-archive-test16-directory-files): Don't mutate. (tramp-archive-test47-auto-load): Adapt test. * test/lisp/net/tramp-tests.el (tramp-display-escape-sequence-regexp): Dont't declare. (tramp-action-yesno): Suppress run in tests. (tramp-test02-file-name-dissect): (tramp-test02-file-name-dissect-simplified) (tramp-test02-file-name-dissect-separate): Adapt tests. (tramp-test21-file-links): (tramp-test21-file-links, tramp-test26-file-name-completion) (tramp-test28-process-file, tramp-test29-start-file-process) (tramp-test30-make-process, tramp-test33-environment-variables) (tramp-test38-find-backup-file-name, tramp-test47-auto-load) (tramp-test39-detect-external-change, tramp-test42-utf8) (tramp-test47-auto-load, tramp-test47-delay-load) (tramp-test48-unload): Adapt tests. (tramp-test26-file-name-completion-with-perl): (tramp-test26-file-name-completion-with-ls) (tramp-test26-interactive-file-name-completion): New tests. (tramp-test44-asynchronous-requests): Mark as :unstable. --- doc/misc/tramp.texi | 65 +- doc/misc/trampver.texi | 2 +- lisp/net/tramp-adb.el | 95 +- lisp/net/tramp-archive.el | 39 +- lisp/net/tramp-cmds.el | 14 +- lisp/net/tramp-compat.el | 78 +- lisp/net/tramp-container.el | 23 +- lisp/net/tramp-crypt.el | 46 +- lisp/net/tramp-fuse.el | 62 +- lisp/net/tramp-gvfs.el | 96 +- lisp/net/tramp-rclone.el | 66 +- lisp/net/tramp-sh.el | 353 ++++--- lisp/net/tramp-smb.el | 217 ++-- lisp/net/tramp-sshfs.el | 8 +- lisp/net/tramp-sudoedit.el | 70 +- lisp/net/tramp.el | 464 ++++++--- lisp/net/trampver.el | 6 +- test/lisp/net/tramp-archive-tests.el | 19 +- test/lisp/net/tramp-tests.el | 1422 ++++++++++++++++---------- 19 files changed, 1883 insertions(+), 1262 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6ed7e0ac032..7387dfcd1e4 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -289,9 +289,11 @@ accumulated in the buffer, then decodes that output to produce the file's contents. For external transfers, @value{tramp} sends a command as follows: + @example -$ rcp user@@host:/path/to/remote/file /tmp/tramp.4711 +$ scp user@@host:/path/to/remote/file /tmp/tramp.4711 @end example + @value{tramp} reads the local temporary file @file{/tmp/tramp.4711} into a buffer, and then deletes the temporary file. @@ -361,7 +363,7 @@ Another way is to follow the terminal session below: @example @group $ cd ~/emacs -$ git clone git://git.savannah.gnu.org/tramp.git +$ git clone https://git.savannah.gnu.org/git/tramp.git @end group @end example @@ -2721,6 +2723,7 @@ entry, @option{Seconds between keepalives} option. Set this to 5. There is no counter which could be set. +@anchor{Using ssh connection sharing} @subsection Using ssh connection sharing @vindex ControlPath@r{, ssh option} @@ -2751,19 +2754,32 @@ Note how @samp{%r}, @samp{%h} and @samp{%p} must be encoded as @samp{%%r}, @samp{%%h} and @samp{%%p}. @vindex tramp-use-ssh-controlmaster-options -If the @file{~/.ssh/config} file is configured appropriately for the -above behavior, then any changes to @command{ssh} can be suppressed -with this @code{nil} setting: +Using a predefined string in @code{tramp-ssh-controlmaster-options}, +or puzzling an own string, happens only when user option +@code{tramp-use-ssh-controlmaster-options} is set to @code{t}. If the +@file{~/.ssh/config} file is configured appropriately for the above +behavior, then any changes to @command{ssh} can be suppressed with +this @code{nil} setting: @lisp (customize-set-variable 'tramp-use-ssh-controlmaster-options nil) @end lisp +Sometimes, it is not possible to use OpenSSH's @option{ControlMaster} +option for remote processes. This could result in concurrent access +to the OpenSSH socket when reading data by different processes, which +could block Emacs. In this case, setting +@code{tramp-use-ssh-controlmaster-options} to @code{suppress} disables +shared access. It is not needed to set this user option permanently +to @code{suppress}, binding the user option prior calling +@code{make-process} is sufficient. @value{tramp} does this for +esxample for compilation processes on its own. + @vindex ProxyCommand@r{, ssh option} @vindex ProxyJump@r{, ssh option} -This should also be set to @code{nil} if you use the -@option{ProxyCommand} or @option{ProxyJump} options in your -@command{ssh} configuration. +@code{tramp-use-ssh-controlmaster-options} should also be set to +@code{nil} or @code{suppress} if you use the @option{ProxyCommand} or +@option{ProxyJump} options in your @command{ssh} configuration. In order to use the @option{ControlMaster} option, @value{tramp} must check whether the @command{ssh} client supports this option. This is @@ -3472,12 +3488,7 @@ much more appropriate. @value{tramp} can complete the following @value{tramp} file name components: method names, user names, host names, and file names -located on remote hosts. User name and host name completion is -activated only, if file name completion has one of the styles -@code{basic}, @code{emacs21}, or @code{emacs22}. -@ifinfo -@xref{Completion Styles, , , emacs}. -@end ifinfo +located on remote hosts. For example, type @kbd{C-x C-f @value{prefixwithspace} s @key{TAB}}, @value{tramp} completion choices show up as @@ -3511,10 +3522,7 @@ directory @file{/sbin} on your local host. Type @kbd{s h @value{postfixhop}} for the minibuffer completion to @samp{@value{prefix}ssh@value{postfixhop}}. Typing @kbd{@key{TAB}} shows host names @value{tramp} extracts from @file{~/.ssh/config} -@c bug#50387 -file, for example@footnote{Some completion styles, like -@code{substring} or @code{flex}, require to type at least one -character after the trailing @samp{@value{postfixhop}}.}. +file, for example: @example @group @@ -3608,10 +3616,20 @@ Each involved method must be an inline method (@pxref{Inline methods}). @code{tramp-default-proxies-alist} and is available for re-use during that Emacs session. Subsequent @value{tramp} connections to the same remote host can then use the shortcut form: -@samp{@trampfn{ssh,you@@remotehost,/path}}. Ad-hoc definitions are -removed from @code{tramp-default-proxies-alist} via the command -@kbd{M-x tramp-cleanup-all-connections @key{RET}} (@pxref{Cleanup -remote connections}). +@samp{@trampfn{ssh,you@@remotehost,/path}}. + +@defopt tramp-show-ad-hoc-proxies +If this user option is non-@code{nil}, ad-hoc definitions are kept in +remote file names instead of showing the shortcuts. + +@lisp +(customize-set-variable 'tramp-show-ad-hoc-proxies t) +@end lisp +@end defopt + +Ad-hoc definitions are removed from @code{tramp-default-proxies-alist} +via the command @kbd{M-x tramp-cleanup-all-connections @key{RET}} +(@pxref{Cleanup remote connections}). @defopt tramp-save-ad-hoc-proxies For ad-hoc definitions to be saved automatically in @@ -4299,7 +4317,8 @@ In order to gain even more performance, it is recommended to bind @code{start-file-process}. Furthermore, you might set @code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to bypass @value{tramp}'s handling of the @option{ControlMaster} options, -and use your own settings in @file{~/.ssh/config}. +and use your own settings in @file{~/.ssh/config}, @ref{Using ssh +connection sharing}. @node Cleanup remote connections diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 299fb3fcb31..c2560169e31 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.6.0.29.1 +@set trampver 2.6.2-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 26.1 diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 4578f1fe073..58c93245335 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -55,7 +55,7 @@ It is used for TCP/IP devices." (defconst tramp-adb-method "adb" "When this method name is used, forward all calls to Android Debug Bridge.") -(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\n\r"))) (any "#$") blank) +(defcustom tramp-adb-prompt (rx bol (* (not (any "#$\r\n"))) (any "#$") blank) "Regexp used as prompt in almquist shell." :type 'regexp :version "28.1" @@ -449,31 +449,32 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (tramp-adb-send-command - v (format "%s -a %s | cat" - (tramp-adb-get-ls-command v) - (tramp-shell-quote-argument localname))) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (with-current-buffer (tramp-get-buffer v) - (delete-dups - (append - ;; On some file systems like "sdcard", "." and ".." are - ;; not included. We fix this by `delete-dups'. - '("." "..") - (delq - nil - (mapcar - (lambda (l) - (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string (buffer-string) "\n"))))))))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (tramp-adb-send-command + v (format "%s -a %s | cat" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname))) + (mapcar + (lambda (f) + (if (file-directory-p (expand-file-name f directory)) + (file-name-as-directory f) + f)) + (with-current-buffer (tramp-get-buffer v) + (delete-dups + (append + ;; On some file systems like "sdcard", "." and ".." are + ;; not included. We fix this by `delete-dups'. + '("." "..") + (delq + nil + (mapcar + (lambda (l) + (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string (buffer-string) "\n")))))))))))) (defun tramp-adb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." @@ -504,16 +505,9 @@ Emacs dired can't find files." (defun tramp-adb-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (if (tramp-file-property-p v localname "file-attributes") - (not (null (tramp-get-file-property v localname "file-attributes"))) - (tramp-adb-send-command-and-check - v (format "test -e %s" (tramp-shell-quote-argument localname)))))))) + (tramp-skeleton-file-exists-p filename + (tramp-adb-send-command-and-check + v (format "test -e %s" (tramp-shell-quote-argument localname))))) (defun tramp-adb-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -1023,7 +1017,7 @@ implementation will be used." (progn (goto-char (point-min)) (not (search-forward "\n" nil t))) - (tramp-accept-process-output p 0)) + (tramp-accept-process-output p)) (delete-region (point-min) (point))) ;; Provide error buffer. This shows only ;; initial error messages; messages @@ -1032,17 +1026,19 @@ implementation will be used." ;; file will exist until the process is ;; deleted. (when (bufferp stderr) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit)) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit))) ;; Delete tmpstderr file. (add-function :after (process-sentinel p) (lambda (_proc _msg) - (with-current-buffer stderr - (insert-file-contents-literally - remote-tmpstderr 'visit nil nil 'replace)) - (delete-file remote-tmpstderr)))) + (ignore-errors + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr))))) ;; Return process. p)))) @@ -1106,11 +1102,12 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" (format "%s:%s" host port)) ;; An empty host name shall be mapped as well, when there ;; is exactly one entry in `devices'. - ((and (zerop (length host)) (= (length devices) 1)) + ((and (tramp-string-empty-or-nil-p host) + (tramp-compat-length= devices 1)) (car devices)) ;; Try to connect device. ((and tramp-adb-connect-if-not-connected - (not (zerop (length host))) + (tramp-compat-length> host 0) (tramp-adb-execute-adb-command vec "connect" (tramp-compat-string-replace @@ -1127,7 +1124,7 @@ E.g. a host name \"192.168.1.1#5555\" returns \"192.168.1.1:5555\" "Execute an adb command. Insert the result into the connection buffer. Return nil on error and non-nil on success." - (when (and (> (length (tramp-file-name-host vec)) 0) + (when (and (tramp-compat-length> (tramp-file-name-host vec) 0) ;; The -s switch is only available for ADB device commands. (not (member (car args) '("connect" "disconnect")))) (setq args (append (list "-s" (tramp-adb-get-device vec)) args))) @@ -1254,7 +1251,7 @@ connection if a previous connection has died for some reason." (unless (process-live-p p) (save-match-data (when (and p (processp p)) (delete-process p)) - (if (zerop (length device)) + (if (tramp-string-empty-or-nil-p device) (tramp-error vec 'file-error "Device %s not connected" host)) (with-tramp-progress-reporter vec 3 "Opening adb shell connection" (let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? @@ -1279,7 +1276,7 @@ connection if a previous connection has died for some reason." ;; Set sentinel and query flag. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 36992014e13..72415efdf9f 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -631,7 +631,7 @@ offered." (defun tramp-archive-handle-directory-file-name (directory) "Like `directory-file-name' for file archives." (with-parsed-tramp-archive-file-name directory nil - (if (and (not (zerop (length localname))) + (if (and (tramp-compat-length> localname 0) (eq (aref localname (1- (length localname))) ?/) (not (string= localname "/"))) (substring directory 0 -1) @@ -643,23 +643,22 @@ offered." (defun tramp-archive-handle-directory-files (directory &optional full match nosort count) "Like `directory-files' for Tramp files." - (unless (file-exists-p directory) - (tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) - (when (file-directory-p directory) - (setq directory (file-name-as-directory (expand-file-name directory))) - (let ((temp (nreverse (file-name-all-completions "" directory))) - 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))) + (tramp-barf-if-file-missing (tramp-dissect-file-name directory) directory + (when (file-directory-p directory) + (setq directory (file-name-as-directory (expand-file-name directory))) + (let ((temp (nreverse (file-name-all-completions "" directory))) + 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)))) (defun tramp-archive-handle-dired-uncache (dir) "Like `dired-uncache' for file archives." @@ -683,7 +682,9 @@ offered." (defun tramp-archive-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for file archives." - (file-name-all-completions filename (tramp-archive-gvfs-file-name directory))) + (tramp-compat-ignore-error file-missing + (file-name-all-completions + filename (tramp-archive-gvfs-file-name directory)))) (defun tramp-archive-handle-file-readable-p (filename) "Like `file-readable-p' for file archives." diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index bf7d45d2a5a..9b20bc710fb 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -123,11 +123,11 @@ When called interactively, a Tramp connection has to be selected." ;; Delete processes. (dolist (key (hash-table-keys tramp-cache-data)) (when (and (processp key) - (tramp-file-name-equal-p (process-get key 'vector) vec) + (tramp-file-name-equal-p (process-get key 'tramp-vector) vec) (or (not keep-processes) (eq key (tramp-get-process vec)))) (tramp-flush-connection-properties key) - (delete-process key))) + (ignore-errors (delete-process key)))) ;; Remove buffers. (dolist @@ -319,7 +319,7 @@ The remote connection identified by SOURCE is flushed by (read-file-name-function #'read-file-name-default) source target) (if (null connections) - (tramp-user-error nil "There are no remote connections.") + (tramp-user-error nil "There are no remote connections") (setq source ;; Likely, the source remote connection is broken. So we ;; shall avoid any action on it. @@ -367,15 +367,15 @@ The remote connection identified by SOURCE is flushed by (list source target))) (unless (tramp-tramp-file-p source) - (tramp-user-error nil "Source %s must be remote." source)) + (tramp-user-error nil "Source %s must be remote" source)) (when (null target) (or (setq target (tramp-default-rename-file source)) (tramp-user-error nil (concat "There is no target specified. " - "Check `tramp-default-rename-alist' for a proper entry.")))) + "Check `tramp-default-rename-alist' for a proper entry")))) (when (tramp-equal-remote source target) - (tramp-user-error nil "Source and target must have different remote.")) + (tramp-user-error nil "Source and target must have different remote")) ;; Append local file name if none is specified. (when (string-equal (file-remote-p target) target) @@ -461,7 +461,7 @@ For details, see `tramp-rename-files'." nil (substitute-command-keys (concat "Current buffer is not remote. " - "Consider `\\[tramp-rename-files]' instead."))) + "Consider `\\[tramp-rename-files]' instead"))) (setq target (when (null current-prefix-arg) ;; The source remote connection shall not trigger any action. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 673c6679dbe..4aa0dccccb7 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -29,19 +29,18 @@ ;;; Code: +(require 'ansi-color) (require 'auth-source) (require 'format-spec) (require 'parse-time) (require 'shell) (require 'subr-x) -(when (memq system-type '(ms-dos windows-nt)) - (require 'ls-lisp)) - (declare-function tramp-compat-rx "tramp") (declare-function tramp-error "tramp") (declare-function tramp-file-name-handler "tramp") (declare-function tramp-tramp-file-p "tramp") +(defvar tramp-syntax) (defvar tramp-temp-name-prefix) (defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version) @@ -121,14 +120,14 @@ NAME is unquoted." (localname (file-local-name name))) (when (tramp-compat-file-name-quoted-p localname top) (setq - localname (if (= (length localname) 2) "/" (substring localname 2)))) + localname + (if (tramp-compat-length= localname 2) "/" (substring localname 2)))) (concat (file-remote-p name) localname))))) ;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still ;; support old settings. (defsubst tramp-compat-tramp-syntax () "Return proper value of `tramp-syntax'." - (defvar tramp-syntax) (cond ((eq tramp-syntax 'ftp) 'default) ((eq tramp-syntax 'sep) 'separate) (t tramp-syntax))) @@ -328,6 +327,48 @@ CONDITION can also be a list of error conditions." (car components)) (cdr components))))))) +;; Function `replace-regexp-in-region' is new in Emacs 28.1. +(defalias 'tramp-compat-replace-regexp-in-region + (if (fboundp 'replace-regexp-in-region) + #'replace-regexp-in-region + (lambda (regexp replacement &optional start end) + (if start + (when (< start (point-min)) + (error "Start before start of buffer")) + (setq start (point))) + (if end + (when (> end (point-max)) + (error "End after end of buffer")) + (setq end (point-max))) + (save-excursion + (let ((matches 0) + (case-fold-search nil)) + (goto-char start) + (while (re-search-forward regexp end t) + (replace-match replacement t) + (setq matches (1+ matches))) + (and (not (zerop matches)) + matches)))))) + +;; `length<', `length>' and `length=' are added to Emacs 28.1. +(defalias 'tramp-compat-length< + (if (fboundp 'length<) + #'length< + (lambda (sequence length) + (< (length sequence) length)))) + +(defalias 'tramp-compat-length> + (if (fboundp 'length>) + #'length> + (lambda (sequence length) + (> (length sequence) length)))) + +(defalias 'tramp-compat-length= + (if (fboundp 'length=) + #'length= + (lambda (sequence length) + (= (length sequence) length)))) + ;; `permission-denied' is introduced in Emacs 29.1. (defconst tramp-permission-denied (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error) @@ -355,7 +396,7 @@ CONDITION can also be a list of error conditions." #'take (lambda (n list) (when (and (natnump n) (> n 0)) - (if (>= n (length list)) + (if (tramp-compat-length< list n) list (butlast list (- (length list) n))))))) ;; Function `ntake' is new in Emacs 29.1. @@ -364,7 +405,7 @@ CONDITION can also be a list of error conditions." #'ntake (lambda (n list) (when (and (natnump n) (> n 0)) - (if (>= n (length list)) + (if (tramp-compat-length< list n) list (nbutlast list (- (length list) n))))))) ;; Function `string-equal-ignore-case' is new in Emacs 29.1. @@ -384,29 +425,6 @@ CONDITION can also be a list of error conditions." (autoload 'netrc-parse "netrc") (netrc-parse file)))) -;; Function `replace-regexp-in-region' is new in Emacs 28.1. -(defalias 'tramp-compat-replace-regexp-in-region - (if (fboundp 'replace-regexp-in-region) - #'replace-regexp-in-region - (lambda (regexp replacement &optional start end) - (if start - (when (< start (point-min)) - (error "Start before start of buffer")) - (setq start (point))) - (if end - (when (> end (point-max)) - (error "End after end of buffer")) - (setq end (point-max))) - (save-excursion - (let ((matches 0) - (case-fold-search nil)) - (goto-char start) - (while (re-search-forward regexp end t) - (replace-match replacement t) - (setq matches (1+ matches))) - (and (not (zerop matches)) - matches)))))) - (dolist (elt (all-completions "tramp-compat-" obarray 'functionp)) (put (intern elt) 'tramp-suppress-trace t)) diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 6cdd6c654ea..e45b73a2134 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -96,15 +96,16 @@ "Tramp method name to use to connect to Kubernetes containers.") ;;;###tramp-autoload -(defun tramp-docker--completion-function (&rest _args) - "List Docker-like containers available for connection. +(defun tramp-container--completion-function (program) + "List running containers available for connection. +PROGRAM is the program to be run for \"ps\", either +`tramp-docker-program' or `tramp-podman-program'. This function is used by `tramp-set-completion-function', please see its function help for a description of the format." (when-let ((default-directory tramp-compat-temporary-file-directory) (raw-list (shell-command-to-string - (concat tramp-docker-program - " ps --format '{{.ID}}\t{{.Names}}'"))) + (concat program " ps --format '{{.ID}}\t{{.Names}}'"))) (lines (split-string raw-list "\n" 'omit)) (names (mapcar (lambda (line) @@ -114,7 +115,7 @@ see its function help for a description of the format." line) (or (match-string 2 line) (match-string 1 line)))) lines))) - (mapcar (lambda (m) (list nil m)) (delq nil names)))) + (mapcar (lambda (name) (list nil name)) (delq nil names)))) ;;;###tramp-autoload (defun tramp-kubernetes--completion-function (&rest _args) @@ -128,9 +129,7 @@ see its function help for a description of the format." " get pods --no-headers " "-o custom-columns=NAME:.metadata.name"))) (names (split-string raw-list "\n" 'omit))) - (mapcar (lambda (name) - (list nil name)) - names))) + (mapcar (lambda (name) (list nil name)) names))) (defun tramp-kubernetes--current-context-data (vec) "Return Kubernetes current context data as JSON string." @@ -167,6 +166,7 @@ see its function help for a description of the format." (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods `(,tramp-podman-method (tramp-login-program ,tramp-podman-program) @@ -179,6 +179,7 @@ see its function help for a description of the format." (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) + (add-to-list 'tramp-methods `(,tramp-kubernetes-method (tramp-login-program ,tramp-kubernetes-program) @@ -195,11 +196,13 @@ see its function help for a description of the format." (tramp-set-completion-function tramp-docker-method - '((tramp-docker--completion-function ""))) + `((tramp-container--completion-function + ,(executable-find tramp-docker-program)))) (tramp-set-completion-function tramp-podman-method - '((tramp-docker--completion-function ""))) + `((tramp-container--completion-function + ,(executable-find tramp-podman-program)))) (tramp-set-completion-function tramp-kubernetes-method diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index c7696a51dae..62cd3f0a3b2 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -180,7 +180,7 @@ If NAME doesn't belong to an encrypted remote directory, return nil." (file-directory-p . tramp-handle-file-directory-p) (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-crypt-handle-file-executable-p) - (file-exists-p . tramp-handle-file-exists-p) + (file-exists-p . tramp-crypt-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-crypt-handle-file-locked-p) @@ -315,7 +315,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil))) ;; The following operations must be performed without @@ -435,7 +435,7 @@ Otherwise, return NAME." crypt-vec (if (eq op 'encrypt) "encode" "decode") tramp-compat-temporary-file-directory localname) (tramp-error - crypt-vec 'file-error "%s of file name %s failed." + crypt-vec 'file-error "%s of file name %s failed" (if (eq op 'encrypt) "Encoding" "Decoding") name)) (with-current-buffer (tramp-get-connection-buffer crypt-vec) (goto-char (point-min)) @@ -470,7 +470,7 @@ Raise an error if this fails." (file-name-directory infile) (concat "/" (file-name-nondirectory infile))) (tramp-error - crypt-vec 'file-error "%s of file %s failed." + crypt-vec 'file-error "%s of file %s failed" (if (eq op 'encrypt) "Encrypting" "Decrypting") infile)) (with-current-buffer (tramp-get-connection-buffer crypt-vec) (write-region nil nil outfile))))) @@ -494,11 +494,11 @@ directory. File names will be also encrypted." ;; (declare (completion tramp-crypt-command-completion-p)) (interactive "DRemote directory name: ") (unless tramp-crypt-enabled - (tramp-user-error nil "Feature is not enabled.")) + (tramp-user-error nil "Feature is not enabled")) (unless (and (tramp-tramp-file-p name) (file-directory-p name)) - (tramp-user-error nil "%s must be an existing remote directory." name)) + (tramp-user-error nil "%s must be an existing remote directory" name)) (when (tramp-compat-file-name-quoted-p name) - (tramp-user-error nil "%s must not be quoted." name)) + (tramp-user-error nil "%s must not be quoted" name)) (setq name (file-name-as-directory (expand-file-name name))) (unless (member name tramp-crypt-directories) (setq tramp-crypt-directories (cons name tramp-crypt-directories))) @@ -517,7 +517,7 @@ kept in their encrypted form." ;; (declare (completion tramp-crypt-command-completion-p)) (interactive "DRemote directory name: ") (unless tramp-crypt-enabled - (tramp-user-error nil "Feature is not enabled.")) + (tramp-user-error nil "Feature is not enabled")) (setq name (file-name-as-directory (expand-file-name name))) (when (and (member name tramp-crypt-directories) (delete @@ -723,6 +723,11 @@ absolute file names." (let (tramp-crypt-enabled) (file-executable-p (tramp-crypt-encrypt-file-name filename)))) +(defun tramp-crypt-handle-file-exists-p (filename) + "Like `file-exists-p' for Tramp files." + (let (tramp-crypt-enabled) + (file-exists-p (tramp-crypt-encrypt-file-name filename)))) + (defun tramp-crypt-handle-file-locked-p (filename) "Like `file-locked-p' for Tramp files." (let (tramp-crypt-enabled) @@ -730,18 +735,19 @@ absolute file names." (defun tramp-crypt-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (let* (completion-regexp-list - tramp-crypt-enabled - (directory (file-name-as-directory directory)) - (enc-dir (tramp-crypt-encrypt-file-name directory))) - (mapcar - (lambda (x) - (substring - (tramp-crypt-decrypt-file-name (concat enc-dir x)) - (length directory))) - (file-name-all-completions "" enc-dir))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (let* (completion-regexp-list + tramp-crypt-enabled + (directory (file-name-as-directory directory)) + (enc-dir (tramp-crypt-encrypt-file-name directory))) + (mapcar + (lambda (x) + (substring + (tramp-crypt-decrypt-file-name (concat enc-dir x)) + (length directory))) + (file-name-all-completions "" enc-dir)))))) (defun tramp-crypt-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index c10c715d70e..e4610b069ad 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -97,23 +97,29 @@ (with-tramp-file-property v localname "file-executable-p" (file-executable-p (tramp-fuse-local-file-name filename))))) +(defun tramp-fuse-handle-file-exists-p (filename) + "Like `file-exists-p' for Tramp files." + (tramp-skeleton-file-exists-p filename + (file-exists-p (tramp-fuse-local-file-name filename)))) + (defun tramp-fuse-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (tramp-fuse-remove-hidden-files - (all-completions - filename - (delete-dups - (append - (file-name-all-completions - filename (tramp-fuse-local-file-name directory)) - ;; Some storage systems do not return "." and "..". - (let (result) - (dolist (item '(".." ".") result) - (when (string-prefix-p filename item) - (catch 'match - (dolist (elt completion-regexp-list) - (unless (string-match-p elt item) (throw 'match nil))) - (setq result (cons (concat item "/") result))))))))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (delete-dups + (append + (file-name-all-completions + filename (tramp-fuse-local-file-name directory)) + ;; Some storage systems do not return "." and "..". + (let (result) + (dolist (item '(".." ".") result) + (when (string-prefix-p filename item) + (catch 'match + (dolist (elt completion-regexp-list) + (unless (string-match-p elt item) (throw 'match nil))) + (setq result (cons (concat item "/") result)))))))))))) ;; This function isn't used. (defun tramp-fuse-handle-insert-directory @@ -146,23 +152,24 @@ (format "%s@%s:/" user host) (format "%s:/" host))) -(defun tramp-fuse-mount-point (vec) - "Return local mount point of VEC." - (or (tramp-get-connection-property vec "mount-point") - (expand-file-name - (concat - tramp-temp-name-prefix - (tramp-file-name-method vec) "." - (when (tramp-file-name-user vec) - (concat (tramp-file-name-user-domain vec) "@")) - (tramp-file-name-host-port vec)) - tramp-compat-temporary-file-directory))) - (defconst tramp-fuse-mount-timeout (eval (car (get 'remote-file-name-inhibit-cache 'standard-value)) t) "Time period to check whether the mount point still exists. It has the same meaning as `remote-file-name-inhibit-cache'.") +(defun tramp-fuse-mount-point (vec) + "Return local mount point of VEC." + (let ((remote-file-name-inhibit-cache tramp-fuse-mount-timeout)) + (or (tramp-get-file-property vec "/" "mount-point") + (expand-file-name + (concat + tramp-temp-name-prefix + (tramp-file-name-method vec) "." + (when (tramp-file-name-user vec) + (concat (tramp-file-name-user-domain vec) "@")) + (tramp-file-name-host-port vec)) + tramp-compat-temporary-file-directory)))) + (defun tramp-fuse-mounted-p (vec) "Check, whether fuse volume determined by VEC is mounted." ;; Remember the mount status by using a file property on "/", @@ -194,6 +201,8 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") bol (group (regexp mount-spec)) " on " (group (+ (not blank))) blank) mount) + (tramp-set-file-property + vec "/" "mount-point" (match-string 2 mount)) (match-string 1 mount))))))) (defun tramp-fuse-get-fusermount () @@ -213,6 +222,7 @@ It has the same meaning as `remote-file-name-inhibit-cache'.") (command (format "%s -u %s" (tramp-fuse-get-fusermount) mount-point))) (tramp-message vec 6 "%s\n%s" command (shell-command-to-string command)) (tramp-flush-file-property vec "/" "mounted") + (tramp-flush-file-property vec "/" "mount-point") (setq tramp-fuse-mount-points (delete (tramp-file-name-unify vec) tramp-fuse-mount-points)) ;; Give the caches a chance to expire. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0273c28beca..46342042880 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -114,6 +114,7 @@ (declare-function zeroconf-service-host "zeroconf") (declare-function zeroconf-service-port "zeroconf") (declare-function zeroconf-service-txt "zeroconf") +(defvar tramp-gvfs-dbus-event-vector) ;; We don't call `dbus-ping', because this would load dbus.el. (defconst tramp-gvfs-enabled @@ -848,8 +849,6 @@ Operations not mentioned here will be handled by the default Emacs primitives.") (let ((method (tramp-file-name-method vec))) (and (stringp method) (member method tramp-gvfs-methods))))) -(defvar tramp-gvfs-dbus-event-vector) - ;;;###tramp-autoload (defun tramp-gvfs-file-name-handler (operation &rest args) "Invoke the GVFS related OPERATION and ARGS. @@ -871,6 +870,14 @@ arguments to pass to the OPERATION." (tramp-register-foreign-file-name-handler #'tramp-gvfs-file-name-p #'tramp-gvfs-file-name-handler))) +;; Event type `dbus-event' is added to `while-no-input-ignore-events' +;; in Emacs 29.1. If it is missing, some packages like Helm report +;; problems. So we add it here. +(when (and (featurep 'dbusbind) + (not (memq 'dbus-event while-no-input-ignore-events))) + (setq while-no-input-ignore-events + (cons 'dbus-event while-no-input-ignore-events))) + ;; D-Bus helper function. @@ -1027,6 +1034,8 @@ file names." (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) + (when (file-regular-p newname) + (delete-file newname)) (cond ;; We cannot rename volatile files, as used by Google-drive. @@ -1079,7 +1088,7 @@ file names." (goto-char (point-min)) (tramp-error-with-buffer nil v 'file-error - "%s failed, see buffer `%s' for details." + "%s failed, see buffer `%s' for details" msg-operation (buffer-name))) ;; Some WebDAV server, like the one from QNAP, do @@ -1157,7 +1166,8 @@ file names." ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -1173,7 +1183,7 @@ file names." (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -1422,16 +1432,19 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (tramp-compat-string-search "/" filename) - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (let ((result '("./" "../"))) - ;; Get a list of directories and files. - (dolist (item (tramp-gvfs-get-directory-attributes directory) result) - (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory (car item)) result) - (push (car item) result))))))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let ((result '("./" "../"))) + ;; Get a list of directories and files. + (dolist (item + (tramp-gvfs-get-directory-attributes directory) + result) + (if (string-equal (cdr (assoc "type" item)) "directory") + (push (file-name-as-directory (car item)) result) + (push (car item) result)))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." @@ -1461,16 +1474,16 @@ If FILE-SYSTEM is non-nil, return file system attributes." v 'file-notify-error "Monitoring not supported for `%s'" file-name) (tramp-message v 6 "Run `%s', %S" (string-join (process-command p) " ") p) - (process-put p 'vector v) - (process-put p 'events events) - (process-put p 'watch-name localname) + (process-put p 'tramp-vector v) + (process-put p 'tramp-events events) + (process-put p 'tramp-watch-name localname) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (set-process-filter p #'tramp-gvfs-monitor-process-filter) (set-process-sentinel p #'tramp-file-notify-process-sentinel) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (unless (process-live-p p) (tramp-error p 'file-notify-error "Monitoring not supported for `%s'" file-name)) @@ -1482,8 +1495,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." (defun tramp-gvfs-monitor-process-filter (proc string) "Read output from \"gvfs-monitor-file\" and add corresponding \ `file-notify' events." - (let* ((events (process-get proc 'events)) - (rest-string (process-get proc 'rest-string)) + (let* ((events (process-get proc 'tramp-events)) + (rest-string (process-get proc 'tramp-rest-string)) (dd (tramp-get-default-directory (process-buffer proc))) (ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd))))) (when rest-string @@ -1526,7 +1539,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." (setq file1 (url-unhex-string file1))) ;; Remove watch when file or directory to be watched is deleted. (when (and (member action '(moved deleted)) - (string-equal file (process-get proc 'watch-name))) + (string-equal file (process-get proc 'tramp-watch-name))) (delete-process proc)) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at @@ -1536,9 +1549,9 @@ If FILE-SYSTEM is non-nil, return file system attributes." 'file-notify-callback (list proc action file file1))))) ;; Save rest of the string. - (when (zerop (length string)) (setq string nil)) + (when (string-empty-p string) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (process-put proc 'rest-string string))) + (process-put proc 'tramp-rest-string string))) (defun tramp-gvfs-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1636,7 +1649,7 @@ VEC or USER, or if there is no home directory, return nil." (let ((localname (tramp-get-connection-property vec "default-location")) result) (cond - ((zerop (length localname)) + ((tramp-string-empty-or-nil-p localname) (tramp-get-connection-property (tramp-get-process vec) "share")) ;; Google-drive. ((not (string-prefix-p "/" localname)) @@ -1769,11 +1782,11 @@ a downcased host name only." (condition-case nil (with-parsed-tramp-file-name filename l - (when (and (zerop (length user)) + (when (and (tramp-string-empty-or-nil-p user) (not (zerop (logand flags tramp-gvfs-password-need-username)))) (setq user (read-string "User name: "))) - (when (and (zerop (length domain)) + (when (and (tramp-string-empty-or-nil-p domain) (not (zerop (logand flags tramp-gvfs-password-need-domain)))) (setq domain (read-string "Domain name: "))) @@ -2175,7 +2188,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. @@ -2212,7 +2225,7 @@ connection if a previous connection has died for some reason." (with-tramp-progress-reporter vec 3 - (if (zerop (length user)) + (if (tramp-string-empty-or-nil-p user) (format "Opening connection for %s using %s" host method) (format "Opening connection for %s@%s using %s" user host method)) @@ -2262,7 +2275,7 @@ connection if a previous connection has died for some reason." (with-timeout ((or (tramp-get-method-parameter vec 'tramp-connection-timeout) tramp-connection-timeout) - (if (zerop (length (tramp-file-name-user vec))) + (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) (tramp-error vec 'file-error "Timeout reached mounting %s using %s" host method) @@ -2441,7 +2454,7 @@ VEC is used only for traces." ;; Adapt default host name, supporting /mtp:: when possible. (setq tramp-default-host-alist (append - `(("mtp" nil ,(if (= (length devices) 1) (car devices) ""))) + `(("mtp" nil ,(if (tramp-compat-length= devices 1) (car devices) ""))) (delete (assoc "mtp" tramp-default-host-alist) tramp-default-host-alist))))) @@ -2493,16 +2506,17 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (delete-dups (mapcar (lambda (x) - (let* ((list (split-string x ";")) - (host (nth 6 list)) - (text (split-string (nth 9 list) "\" \"" 'omit "\"")) - user) - ;; A user is marked in a TXT field like "u=guest". - (while text - (when (string-match (rx "u=" (group (+ nonl)) eol) (car text)) - (setq user (match-string 1 (car text)))) - (setq text (cdr text))) - (list user host))) + (ignore-errors + (let* ((list (split-string x ";")) + (host (nth 6 list)) + (text (split-string (nth 9 list) "\" \"" 'omit "\"")) + user) + ;; A user is marked in a TXT field like "u=guest". + (while text + (when (string-match (rx "u=" (group (+ nonl)) eol) (car text)) + (setq user (match-string 1 (car text)))) + (setq text (cdr text))) + (list user host)))) result)))) (when tramp-gvfs-enabled diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 2360abfb1dd..70bbf7e0192 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -224,6 +224,7 @@ file names." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) + (equal-remote (tramp-equal-remote filename newname)) (rclone-operation (if (eq op 'copy) "copyto" "moveto")) (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) @@ -234,8 +235,12 @@ file names." (when (and (file-directory-p newname) (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) + (when (file-regular-p newname) + (delete-file newname)) - (if (or (and t1 (not (tramp-rclone-file-name-p filename))) + (if (or (and equal-remote + (tramp-get-connection-property v "direct-copy-failed")) + (and t1 (not (tramp-rclone-file-name-p filename))) (and t2 (not (tramp-rclone-file-name-p newname)))) ;; We cannot copy or rename directly. @@ -255,9 +260,20 @@ file names." v rclone-operation (tramp-rclone-remote-file-name filename) (tramp-rclone-remote-file-name newname))) - (tramp-error - v 'file-error - "Error %s `%s' `%s'" msg-operation filename newname))) + (if (or (not equal-remote) + (and equal-remote + (tramp-get-connection-property + v "direct-copy-failed"))) + (tramp-error + v 'file-error + "Error %s `%s' `%s'" msg-operation filename newname) + + ;; Some WebDAV server, like the one from QNAP, do + ;; not support direct copy/move. Try a fallback. + (tramp-set-connection-property v "direct-copy-failed" t) + (tramp-rclone-do-copy-or-rename-file + op filename newname ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes)))) (when (and t1 (eq op 'rename)) (while (file-exists-p filename) @@ -298,25 +314,25 @@ file names." (setq filename (file-name-directory filename))) (with-parsed-tramp-file-name (expand-file-name filename) nil (tramp-message v 5 "file system info: %s" localname) - (tramp-rclone-send-command v "about" (concat host ":")) - (with-current-buffer (tramp-get-connection-buffer v) - (let (total used free) - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at (rx "Total: " (+ blank) (group (+ digit)))) - (setq total (string-to-number (match-string 1)))) - (when (looking-at (rx "Used: " (+ blank) (group (+ digit)))) - (setq used (string-to-number (match-string 1)))) - (when (looking-at (rx "Free: " (+ blank) (group (+ digit)))) - (setq free (string-to-number (match-string 1)))) - (forward-line)) - (when used - ;; The used number of bytes is not part of the result. As - ;; side effect, we store it as file property. - (tramp-set-file-property v localname "used-bytes" used)) - ;; Result. - (when (and total free) - (list total free (- total free)))))))) + (when (zerop (tramp-rclone-send-command v "about" (concat host ":"))) + (with-current-buffer (tramp-get-connection-buffer v) + (let (total used free) + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at (rx "Total: " (+ blank) (group (+ digit)))) + (setq total (string-to-number (match-string 1)))) + (when (looking-at (rx "Used: " (+ blank) (group (+ digit)))) + (setq used (string-to-number (match-string 1)))) + (when (looking-at (rx "Free: " (+ blank) (group (+ digit)))) + (setq free (string-to-number (match-string 1)))) + (forward-line)) + (when used + ;; The used number of bytes is not part of the result. + ;; As side effect, we store it as file property. + (tramp-set-file-property v localname "used-bytes" used)) + ;; Result. + (when (and total free) + (list total free (- total free))))))))) (defun tramp-rclone-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -361,7 +377,7 @@ connection if a previous connection has died for some reason." (let ((host (tramp-file-name-host vec))) (when (rassoc `(,host) (tramp-rclone-parse-device-names nil)) - (if (zerop (length host)) + (if (tramp-string-empty-or-nil-p host) (tramp-error vec 'file-error "Storage %s not connected" host)) ;; We need a process bound to the connection buffer. Therefore, ;; we create a dummy process. Maybe there is a better solution? @@ -370,7 +386,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 502040902e1..9895af92502 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -81,13 +81,6 @@ the default storage location, e.g. \"$HOME/.sh_history\"." (const :tag "Unset HISTFILE" t) (string :tag "Redirect to a file"))) -;;;###tramp-autoload -(defconst tramp-display-escape-sequence-regexp (rx "\e" (+ (any ";[" digit)) "m") - "Terminal control escape sequences for display attributes.") - -(defconst tramp-device-escape-sequence-regexp (rx "\e" (+ (any "[" digit)) "n") - "Terminal control escape sequences for device status.") - ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for ;; root users. It uses the `$' character for other users. In order ;; to guarantee a proper prompt, we use "#$ " for the prompt. @@ -109,11 +102,18 @@ detected as prompt when being sent on echoing hosts, therefore.") (defcustom tramp-use-ssh-controlmaster-options (not (eq system-type 'windows-nt)) "Whether to use `tramp-ssh-controlmaster-options'. +Set it to t, if you want Tramp to apply these options. Set it to nil, if you use Control* or Proxy* options in your ssh -configuration." +configuration. +Set it to `suppress' if you want to disable settings in your +\"~/.ssh/config¸\"." :group 'tramp - :version "28.1" - :type 'boolean) + :version "29.2" + :type '(choice (const :tag "Set ControlMaster" t) + (const :tag "Don't set ControlMaster" nil) + (const :tag "Suppress ControlMaster" suppress)) + ;; Check with (safe-local-variable-p 'tramp-use-ssh-controlmaster-options 'suppress) + :safe (lambda (val) (and (memq val '(t nil suppress)) t))) (defvar tramp-ssh-controlmaster-options nil "Which ssh Control* arguments to use. @@ -124,8 +124,8 @@ If it is a string, it should have the form spec must be doubled, because the string is used as format string. Otherwise, it will be auto-detected by Tramp, if -`tramp-use-ssh-controlmaster-options' is non-nil. The value -depends on the installed local ssh version. +`tramp-use-ssh-controlmaster-options' is t. The value depends on +the installed local ssh version. The string is used in `tramp-methods'.") @@ -632,7 +632,6 @@ foreach $f (@files) { print \"$f\\n\"; } } -print \"ok\\n\" ' \"$1\" %n" "Perl script to produce output suitable for use with `file-name-all-completions' on the remote file system. @@ -1159,8 +1158,8 @@ component is used as the target of the symlink." (unless ln (tramp-error v 'file-error - (concat "Making a symbolic link. " - "ln(1) does not exist on the remote host."))) + (concat "Making a symbolic link: " + "ln(1) does not exist on the remote host"))) ;; Do the 'confirm if exists' thing. (when (file-exists-p linkname) @@ -1252,20 +1251,13 @@ component is used as the target of the symlink." (defun tramp-sh-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (if (tramp-file-property-p v localname "file-attributes") - (not (null (tramp-get-file-property v localname "file-attributes"))) - (tramp-send-command-and-check - v - (format - "%s %s" - (tramp-get-file-exists-command v) - (tramp-shell-quote-argument localname)))))))) + (tramp-skeleton-file-exists-p filename + (tramp-send-command-and-check + v + (format + "%s %s" + (tramp-get-file-exists-command v) + (tramp-shell-quote-argument localname))))) (defun tramp-sh-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." @@ -1724,7 +1716,7 @@ ID-FORMAT valid values are `string' and `integer'." (if (tramp-file-property-p v localname "file-attributes") (or (tramp-check-cached-permissions v ?x) (tramp-check-cached-permissions v ?s)) - (tramp-run-test "-x" filename))))) + (tramp-run-test v "-x" localname))))) (defun tramp-sh-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -1734,7 +1726,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; satisfied without remote operation. (if (tramp-file-property-p v localname "file-attributes") (tramp-handle-file-readable-p filename) - (tramp-run-test "-r" filename))))) + (tramp-run-test v "-r" localname))))) ;; Functions implemented using the basic functions above. @@ -1745,7 +1737,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; Sometimes, when a connection is not established yet, it is ;; desirable to return t immediately for "/method:foo:". It can ;; be expected that this is always a directory. - (or (zerop (length localname)) + (or (tramp-string-empty-or-nil-p localname) (with-tramp-file-property v localname "file-directory-p" (if-let ((truename (tramp-get-file-property v localname "file-truename")) @@ -1755,7 +1747,7 @@ ID-FORMAT valid values are `string' and `integer'." (tramp-get-file-property v (tramp-file-local-name truename) "file-attributes")) t) - (tramp-run-test "-d" filename)))))) + (tramp-run-test v "-d" localname)))))) (defun tramp-sh-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -1766,7 +1758,7 @@ ID-FORMAT valid values are `string' and `integer'." ;; Examine `file-attributes' cache to see if request can ;; be satisfied without remote operation. (tramp-check-cached-permissions v ?w) - (tramp-run-test "-w" filename)) + (tramp-run-test v "-w" localname)) ;; If file doesn't exist, check if directory is writable. (and (file-directory-p (file-name-directory filename)) @@ -1840,64 +1832,43 @@ ID-FORMAT valid values are `string' and `integer'." (with-parsed-tramp-file-name (expand-file-name directory) nil (when (and (not (tramp-compat-string-search "/" filename)) (tramp-connectable-p v)) - (all-completions - filename - (with-tramp-file-property v localname "file-name-all-completions" - (let (result) - ;; Get a list of directories and files, including reliably - ;; tagging the directories with a trailing "/". Because I - ;; rock. --daniel@danann.net - (tramp-send-command - v - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (format "tramp_perl_file_name_all_completions %s" - (tramp-shell-quote-argument localname))) - - (format (concat - "(cd %s 2>&1 && %s -a 2>%s" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>%s;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - (tramp-get-remote-null-device v) - (tramp-get-test-command v) - (tramp-get-remote-null-device v)))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - - ;; Check result code, found in last line of output. - (forward-line -1) - (if (looking-at-p (rx bol "fail" eol)) - (progn - ;; Grab error message from line before last line - ;; (it was put there by `cd 2>&1'). - (forward-line -1) - (tramp-error - v 'file-error - "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring (point) (line-end-position)))) - ;; For peace of mind, if buffer doesn't end in `fail' - ;; then it should end in `ok'. If neither are in the - ;; buffer something went seriously wrong on the remote - ;; side. - (unless (looking-at-p (rx bol "ok" eol)) - (tramp-error - v 'file-error - (concat "tramp-sh-handle-file-name-all-completions: " - "internal error accessing `%s': `%s'") - (tramp-shell-quote-argument localname) (buffer-string)))) - - (while (zerop (forward-line -1)) - (push (buffer-substring (point) (line-end-position)) result))) - result)))))) + (unless (tramp-compat-string-search "/" filename) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including + ;; reliably tagging the directories with a trailing "/". + ;; Because I rock. --daniel@danann.net + (when (tramp-send-command-and-check + v + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname))) + + (format (concat + "cd %s 2>&1 && %s -a 2>%s" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>%s;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi;" + " done") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-remote-null-device v) + (tramp-get-test-command v) + (tramp-get-remote-null-device v)))) + + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + (while (zerop (forward-line -1)) + (push (buffer-substring (point) (line-end-position)) result))) + result))))))))) ;; cp, mv and ln @@ -2240,7 +2211,7 @@ the uid and gid from FILENAME." cmd-result) (tramp-error-with-buffer nil v 'file-error - "Copying directly failed, see buffer `%s' for details." + "Copying directly failed, see buffer `%s' for details" (buffer-name))))) ;; We are on the local host. @@ -2295,7 +2266,7 @@ the uid and gid from FILENAME." "%s %s %s" cmd (tramp-shell-quote-argument localname1) (tramp-shell-quote-argument tmpfile)) - "Copying directly failed, see buffer `%s' for details." + "Copying directly failed, see buffer `%s' for details" (tramp-get-buffer v)) ;; We must change the ownership as remote user. ;; Since this does not work reliable, we also @@ -2328,7 +2299,7 @@ the uid and gid from FILENAME." "cp -f -p %s %s" (tramp-shell-quote-argument tmpfile) (tramp-shell-quote-argument localname2)) - "Copying directly failed, see buffer `%s' for details." + "Copying directly failed, see buffer `%s' for details" (tramp-get-buffer v))) (t1 (tramp-run-real-handler @@ -2363,7 +2334,7 @@ The method used must be an out-of-band method." copy-program copy-args copy-env copy-keep-date listener spec options source target remote-copy-program remote-copy-args p) - (if (and v1 v2 (zerop (length (tramp-scp-direct-remote-copying v1 v2)))) + (if (and v1 v2 (string-empty-p (tramp-scp-direct-remote-copying v1 v2))) ;; Both are Tramp files. We cannot use direct remote copying. (let* ((dir-flag (file-directory-p filename)) @@ -2523,7 +2494,11 @@ The method used must be an out-of-band method." (tramp-get-connection-buffer v) copy-program copy-args))) (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, + ;; the setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -2673,7 +2648,7 @@ The method used must be an out-of-band method." (setq switches (append switches (split-string (tramp-sh--quoting-style-options v)))) (unless (tramp-get-ls-command-with v "--dired") - (setq switches (delete "--dired" switches))) + (setq switches (delete "-N" (delete "--dired" switches)))) (when wildcard (setq wildcard (tramp-run-real-handler #'file-name-nondirectory (list localname))) @@ -2711,9 +2686,9 @@ The method used must be an out-of-band method." (tramp-get-ls-command v) switches (if (or wildcard - (zerop (length - (tramp-run-real-handler - #'file-name-nondirectory (list localname))))) + (tramp-string-empty-or-nil-p + (tramp-run-real-handler + #'file-name-nondirectory (list localname)))) "" (tramp-shell-quote-argument (tramp-run-real-handler @@ -2761,7 +2736,7 @@ The method used must be an out-of-band method." (unless (tramp-compat-string-search "color" (tramp-get-connection-property v "ls" "")) (goto-char (point-min)) - (while (re-search-forward tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match ""))) ;; Now decode what read if necessary. Stolen from `insert-directory'. @@ -2830,13 +2805,15 @@ the result will be a local, non-Tramp, file name." ;; If DIR is not given, use `default-directory' or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; On MS Windows, some special file names are not returned properly ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified', ;; there could be the false positive "/:". (if (or (and (eq system-type 'windows-nt) (string-match-p - (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) + (tramp-compat-rx + bol (| (: alpha ":") (: (literal (or null-device "")) eol))) name)) (and (not (tramp-tramp-file-p name)) (not (tramp-tramp-file-p dir)))) @@ -2868,7 +2845,7 @@ the result will be a local, non-Tramp, file name." ;; the default user name for tilde expansion is not ;; appropriate either, because ssh and companions might ;; use a user name from the config file. - (when (and (zerop (length uname)) + (when (and (tramp-string-empty-or-nil-p uname) (string-match-p (rx bos "su" (? "do") eos) method)) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) @@ -2969,7 +2946,7 @@ implementation will be used." (heredoc (and (not (bufferp stderr)) (stringp program) (string-match-p (rx "sh" eol) program) - (= (length args) 2) + (tramp-compat-length= args 2) (string-equal "-c" (car args)) ;; Don't if there is a quoted string. (not @@ -2979,7 +2956,7 @@ implementation will be used." ;; When PROGRAM is nil, we just provide a tty. (args (if (not heredoc) args (let ((i 250)) - (while (and (< i (length (cadr args))) + (while (and (not (tramp-compat-length< (cadr args) i)) (string-match " " (cadr args) i)) (setcdr args @@ -3095,13 +3072,20 @@ implementation will be used." (process-put p 'remote-pid pid) (tramp-set-connection-property p "remote-pid" pid)) - ;; Disable carriage return to newline - ;; translation. This does not work on - ;; macOS, see Bug#50748. - (when (and (memq connection-type '(nil pipe)) - (not - (tramp-check-remote-uname v "Darwin"))) - (tramp-send-command v "stty -icrnl")) + (when (memq connection-type '(nil pipe)) + ;; Disable carriage return to newline + ;; translation. This does not work on + ;; macOS, see Bug#50748. + ;; We must also disable buffering, + ;; otherwise strings larger than 4096 + ;; bytes, sent by the process, could + ;; block, see termios(3) and Bug#61341. + ;; FIXME: Shall we rather use "stty raw"? + (if (tramp-check-remote-uname v "Darwin") + (tramp-send-command + v "stty -icanon min 1 time 0") + (tramp-send-command + v "stty -icrnl -icanon min 1 time 0"))) ;; `tramp-maybe-open-connection' and ;; `tramp-send-command-and-read' could ;; have trashed the connection buffer. @@ -3236,7 +3220,7 @@ implementation will be used." (if (tramp-compat-string-search "=" elt) (setq env (append env `(,elt))) (setq uenv (cons elt uenv))))) - (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep) + (setq env (setenv-internal env "INSIDE_EMACS" (tramp-inside-emacs) 'keep)) (when env (setq command (format @@ -3861,16 +3845,20 @@ Fall back to normal file name handler if no Tramp handler exists." "`%s' failed to start on remote host" (string-join sequence " ")) (tramp-message v 6 "Run `%s', %S" (string-join sequence " ") p) - (process-put p 'vector v) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and only if + ;; the respective options are set. Perhaps, the setting could + ;; be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) ;; Needed for process filter. - (process-put p 'events events) - (process-put p 'watch-name localname) + (process-put p 'tramp-events events) + (process-put p 'tramp-watch-name localname) (set-process-query-on-exit-flag p nil) (set-process-filter p filter) (set-process-sentinel p #'tramp-file-notify-process-sentinel) ;; There might be an error if the monitor is not supported. ;; Give the filter a chance to read the output. - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (unless (process-live-p p) (tramp-error p 'file-notify-error "Monitoring not supported for `%s'" file-name)) @@ -3878,10 +3866,10 @@ Fall back to normal file name handler if no Tramp handler exists." (defun tramp-sh-gio-monitor-process-filter (proc string) "Read output from \"gio monitor\" and add corresponding `file-notify' events." - (let ((events (process-get proc 'events)) + (let ((events (process-get proc 'tramp-events)) (remote-prefix (file-remote-p (tramp-get-default-directory (process-buffer proc)))) - (rest-string (process-get proc 'rest-string)) + (rest-string (process-get proc 'tramp-rest-string)) pos) (when rest-string (tramp-message proc 10 "Previous string:\n%s" rest-string)) @@ -3961,15 +3949,15 @@ Fall back to normal file name handler if no Tramp handler exists." ;; Save rest of the string. (while (string-match (rx bol "\n") string) (setq string (replace-match "" nil nil string))) - (when (zerop (length string)) (setq string nil)) + (when (string-empty-p string) (setq string nil)) (when string (tramp-message proc 10 "Rest string:\n%s" string)) - (process-put proc 'rest-string string))) + (process-put proc 'tramp-rest-string string))) (defun tramp-sh-inotifywait-process-filter (proc string) "Read output from \"inotifywait\" and add corresponding `file-notify' events." - (let ((events (process-get proc 'events))) + (let ((events (process-get proc 'tramp-events))) (tramp-message proc 6 "%S\n%s" proc string) - (dolist (line (split-string string "[\n\r]+" 'omit)) + (dolist (line (split-string string (rx (+ (any "\r\n"))) 'omit)) ;; Check, whether there is a problem. (unless (string-match (rx bol (+ (not blank)) (+ blank) (group (+ (not blank))) @@ -3986,7 +3974,8 @@ Fall back to normal file name handler if no Tramp handler exists." (tramp-compat-string-replace "_" "-" (downcase x)))) (split-string (match-string 1 line) "," 'omit)) (or (match-string 2 line) - (file-name-nondirectory (process-get proc 'watch-name)))))) + (file-name-nondirectory + (process-get proc 'tramp-watch-name)))))) ;; Usually, we would add an Emacs event now. Unfortunately, ;; `unread-command-events' does not accept several events at ;; once. Therefore, we apply the handler directly. @@ -4132,17 +4121,14 @@ Only send the definition if it has not already been done." (tramp-set-connection-property (tramp-get-connection-process vec) "scripts" (cons name scripts)))))) -(defun tramp-run-test (switch filename) - "Run `test' on the remote system, given a SWITCH and a FILENAME. +(defun tramp-run-test (vec switch localname) + "Run `test' on the remote system VEC, given a SWITCH and a LOCALNAME. Returns the exit code of the `test' program." - (with-parsed-tramp-file-name filename nil - (tramp-send-command-and-check - v - (format - "%s %s %s" - (tramp-get-test-command v) - switch - (tramp-shell-quote-argument localname))))) + (tramp-send-command-and-check + vec + (format + "%s %s %s" + (tramp-get-test-command vec) switch (tramp-shell-quote-argument localname)))) (defun tramp-find-executable (vec progname dirlist &optional ignore-tilde ignore-path) @@ -4217,7 +4203,7 @@ variable PATH." 'noerror))) tmpfile chunk chunksize) (tramp-message vec 5 "Setting $PATH environment variable") - (if (< (length command) pipe-buf) + (if (tramp-compat-length< command pipe-buf) (tramp-send-command vec command) ;; Use a temporary file. We cannot use `write-region' because ;; setting the remote path happens in the early connection @@ -4432,12 +4418,13 @@ file exists and nonzero exit status otherwise." "Wait for shell prompt and barf if none appears. Looks at process PROC to see if a shell prompt appears in TIMEOUT seconds. If not, it produces an error message with the given ERROR-ARGS." - (let ((vec (process-get proc 'vector))) + (let ((vec (process-get proc 'tramp-vector))) (condition-case nil (tramp-wait-for-regexp proc timeout (tramp-compat-rx (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern)) + (? (regexp ansi-color-control-seq-regexp)) eos)) (error (delete-process proc) @@ -4608,7 +4595,7 @@ process to set up. VEC specifies the connection." ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) - (unless (zerop (length tty)) + (unless (tramp-string-empty-or-nil-p tty) (process-put proc 'remote-tty tty) (tramp-set-connection-property proc "remote-tty" tty))) @@ -4942,6 +4929,16 @@ Goes through the list `tramp-inline-compress-commands'." (tramp-message vec 2 "Couldn't find an inline transfer compress command"))))) +(defun tramp-ssh-option-exists-p (vec option) + "Check, whether local ssh OPTION is applicable." + ;; We don't want to cache it persistently. + (with-tramp-connection-property nil option + ;; "ssh -G" is introduced in OpenSSH 6.7. + ;; We use a non-existing IP address for check, in order to avoid + ;; useless connections, and DNS timeouts. + (zerop + (tramp-call-process vec "ssh" nil nil nil "-G" "-o" option "0.0.0.1")))) + (defun tramp-ssh-controlmaster-options (vec) "Return the Control* arguments of the local ssh." (cond @@ -4951,40 +4948,34 @@ Goes through the list `tramp-inline-compress-commands'." "") ;; There is already a value to be used. - ((stringp tramp-ssh-controlmaster-options) tramp-ssh-controlmaster-options) + ((and (eq tramp-use-ssh-controlmaster-options t) + (stringp tramp-ssh-controlmaster-options)) + tramp-ssh-controlmaster-options) + + ;; We can't auto-compute the options. + ((ignore-errors + (not (tramp-ssh-option-exists-p vec "ControlMaster=auto"))) + "") ;; Determine the options. - (t (setq tramp-ssh-controlmaster-options "") - (let ((case-fold-search t)) - (ignore-errors - (with-tramp-progress-reporter - vec 4 "Computing ControlMaster options" - ;; We use a non-existing IP address, in order to avoid - ;; useless connections, and DNS timeouts. - (when (zerop - (tramp-call-process - vec "ssh" nil nil nil - "-G" "-o" "ControlMaster=auto" "0.0.0.1")) - (setq tramp-ssh-controlmaster-options - "-o ControlMaster=auto") - (if (zerop - (tramp-call-process - vec "ssh" nil nil nil - "-G" "-o" "ControlPath=tramp.%C" "0.0.0.1")) - (setq tramp-ssh-controlmaster-options - (concat tramp-ssh-controlmaster-options - " -o ControlPath=tramp.%%C")) - (setq tramp-ssh-controlmaster-options - (concat tramp-ssh-controlmaster-options - " -o ControlPath=tramp.%%r@%%h:%%p"))) - (when (zerop - (tramp-call-process - vec "ssh" nil nil nil - "-G" "-o" "ControlPersist=no" "0.0.0.1")) - (setq tramp-ssh-controlmaster-options - (concat tramp-ssh-controlmaster-options - " -o ControlPersist=no"))))))) - tramp-ssh-controlmaster-options))) + (t (ignore-errors + ;; ControlMaster and ControlPath options are introduced in OpenSSH 3.9. + (concat + "-o ControlMaster=" + (if (eq tramp-use-ssh-controlmaster-options 'suppress) + "no" "auto") + + " -o ControlPath=" + (if (eq tramp-use-ssh-controlmaster-options 'suppress) + "none" + ;; Hashed tokens are introduced in OpenSSH 6.7. + (if (tramp-ssh-option-exists-p vec "ControlPath=tramp.%C") + "tramp.%%C" "tramp.%%r@%%h:%%p")) + + ;; ControlPersist option is introduced in OpenSSH 5.6. + (when (and (not (eq tramp-use-ssh-controlmaster-options 'suppress)) + (tramp-ssh-option-exists-p vec "ControlPersist=no")) + " -o ControlPersist=no")))))) (defun tramp-scp-strict-file-name-checking (vec) "Return the strict file name checking argument of the local scp." @@ -5181,7 +5172,7 @@ connection if a previous connection has died for some reason." (unless (process-live-p p) (with-tramp-progress-reporter vec 3 - (if (zerop (length (tramp-file-name-user vec))) + (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec)) (format "Opening connection %s for %s using %s" process-name (tramp-file-name-host vec) @@ -5238,7 +5229,11 @@ connection if a previous connection has died for some reason." ;; Set sentinel and query flag. Initialize variables. (set-process-sentinel p #'tramp-process-sentinel) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, + ;; the setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (setq tramp-current-connection (cons vec (current-time))) @@ -5405,14 +5400,14 @@ function waits for output unless NOOUTPUT is set." (tramp-error proc 'file-error "Process `%s' not available, try again" proc)) (with-current-buffer (process-buffer proc) (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might - ;; be leading escape sequences, which must be ignored. - ;; Busyboxes built with the EDITING_ASK_TERMINAL config - ;; option send also escape sequences, which must be - ;; ignored. + ;; be leading ANSI control escape sequences, which must be + ;; ignored. Busyboxes built with the EDITING_ASK_TERMINAL + ;; config option send also ANSI control escape sequences, + ;; which must be ignored. (regexp (tramp-compat-rx (* (not (any "#$\n"))) (literal tramp-end-of-output) - (? (regexp tramp-device-escape-sequence-regexp)) + (? (regexp ansi-color-control-seq-regexp)) (? "\r") eol)) ;; Sometimes, the commands do not return a newline but a ;; null byte before the shell prompt, for example "git @@ -5555,7 +5550,7 @@ raises an error." (cond ((tramp-get-method-parameter vec 'tramp-remote-copy-program) localname) - ((zerop (length user)) (format "%s:%s" host localname)) + ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname)) (t (format "%s@%s:%s" user host localname))))) (defun tramp-method-out-of-band-p (vec size) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index cad6cb335cc..c50bd5b387f 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -487,9 +487,9 @@ arguments to pass to the OPERATION." (args (list (concat "//" host "/" share) "-E")) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (if (tramp-string-empty-or-nil-p user) + (setq args (append args (list "-N"))) + (setq args (append args (list "-U" user)))) (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) @@ -558,7 +558,7 @@ arguments to pass to the OPERATION." (tramp-message v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) + (process-put p 'tramp-vector v) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -641,9 +641,6 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) (unless (tramp-smb-get-share v) (tramp-error v 'file-error "Target `%s' must contain a share name" newname)) @@ -652,7 +649,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-smb-shell-quote-argument filename) (tramp-smb-shell-quote-localname v))) (tramp-error - v 'file-error "Cannot copy `%s' to `%s'" filename newname))))) + v 'file-error "Cannot copy `%s' to `%s'" filename newname)) + + ;; When newname did exist, we have wrong cached values. + (when (tramp-tramp-file-p newname) + (with-parsed-tramp-file-name newname v2 + (tramp-flush-file-properties v2 v2-localname)))))) ;; KEEP-DATE handling. (when keep-date @@ -691,7 +693,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; "rmdir" does not report an error. So we check ourselves. (when (file-exists-p directory) - (tramp-error v 'file-error "`%s' not removed." directory))))) + (tramp-error v 'file-error "`%s' not removed" directory))))) (defun tramp-smb-handle-delete-file (filename &optional trash) "Like `delete-file' for Tramp files." @@ -719,7 +721,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -735,7 +738,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -789,9 +792,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (args (list (concat "//" host "/" share) "-E")) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (if (tramp-string-empty-or-nil-p user) + (setq args (append args (list "-N"))) + (setq args (append args (list "-U" user)))) (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) @@ -806,32 +809,31 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (append args (list (tramp-unquote-shell-quote-argument localname) (concat "2>" (tramp-get-remote-null-device v))))) - (unwind-protect - (with-tramp-saved-connection-properties - v '("process-name" "process-buffer") - (with-temp-buffer - ;; Set the transfer process properties. - (tramp-set-connection-property - v "process-name" (buffer-name (current-buffer))) - (tramp-set-connection-property - v "process-buffer" (current-buffer)) - - ;; Use an asynchronous process. By this, password - ;; can be handled. - (let ((p (apply - #'start-process - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - tramp-smb-acl-program args))) - - (tramp-message - v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) - (process-put p 'adjust-window-size-function #'ignore) - (set-process-query-on-exit-flag p nil) - (tramp-process-actions p v nil tramp-smb-actions-get-acl) - (when (> (point-max) (point-min)) - (substring-no-properties (buffer-string))))))))))))) + (with-tramp-saved-connection-properties + v '("process-name" "process-buffer") + (with-temp-buffer + ;; Set the transfer process properties. + (tramp-set-connection-property + v "process-name" (buffer-name (current-buffer))) + (tramp-set-connection-property + v "process-buffer" (current-buffer)) + + ;; Use an asynchronous process. By this, password + ;; can be handled. + (let ((p (apply + #'start-process + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + tramp-smb-acl-program args))) + + (tramp-message + v 6 "%s" (string-join (process-command p) " ")) + (process-put p 'tramp-vector v) + (process-put p 'adjust-window-size-function #'ignore) + (set-process-query-on-exit-flag p nil) + (tramp-process-actions p v nil tramp-smb-actions-get-acl) + (when (> (point-max) (point-min)) + (substring-no-properties (buffer-string)))))))))))) (defun tramp-smb-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." @@ -982,18 +984,20 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; files. (defun tramp-smb-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (delete-dups - (mapcar - (lambda (x) - (list - (if (tramp-compat-string-search "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory))))))) + (tramp-compat-ignore-error file-missing + (all-completions + filename + (when (file-directory-p directory) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (delete-dups + (mapcar + (lambda (x) + (list + (if (tramp-compat-string-search "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory))))))))) (defun tramp-smb-handle-file-system-info (filename) "Like `file-system-info' for Tramp files." @@ -1079,7 +1083,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq entries (delq nil - (if (or wildcard (zerop (length base))) + (if (or wildcard (string-empty-p base)) ;; Check for matching entries. (mapcar (lambda (x) @@ -1105,7 +1109,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when (tramp-compat-string-search "F" switches) (mapc (lambda (x) - (unless (zerop (length (car x))) + (unless (string-empty-p (car x)) (cond ((char-equal ?d (string-to-char (nth 1 x))) (setcar x (concat (car x) "/"))) @@ -1125,7 +1129,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Print entries. (mapc (lambda (x) - (unless (zerop (length (nth 0 x))) + (unless (string-empty-p (nth 0 x)) (let ((attr (when (tramp-smb-get-stat-capability v) (ignore-errors @@ -1229,7 +1233,10 @@ component is used as the target of the symlink." (let ((non-essential t)) (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) + (setq target (tramp-file-local-name (expand-file-name target)))) + ;; There could be a cyclic link. + (tramp-flush-file-properties + v (expand-file-name target (tramp-file-local-name default-directory)))) ;; If TARGET is still remote, quote it. (if (tramp-tramp-file-p target) @@ -1455,9 +1462,9 @@ component is used as the target of the symlink." "\n" "," acl-string))) (options tramp-smb-options)) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (if (tramp-string-empty-or-nil-p user) + (setq args (append args (list "-N"))) + (setq args (append args (list "-U" user)))) (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) @@ -1473,44 +1480,43 @@ component is used as the target of the symlink." "&&" "echo" "tramp_exit_status" "0" "||" "echo" "tramp_exit_status" "1"))) - (unwind-protect - (with-tramp-saved-connection-properties - v '("process-name" "process-buffer") - (with-temp-buffer - ;; Set the transfer process properties. - (tramp-set-connection-property - v "process-name" (buffer-name (current-buffer))) - (tramp-set-connection-property - v "process-buffer" (current-buffer)) - - ;; Use an asynchronous process. By this, password - ;; can be handled. - (let ((p (apply - #'start-process - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - tramp-smb-acl-program args))) - - (tramp-message - v 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector v) - (process-put p 'adjust-window-size-function #'ignore) - (set-process-query-on-exit-flag p nil) - (tramp-process-actions p v nil tramp-smb-actions-set-acl) - ;; This is meant for traces, and returning from - ;; the function. No error is propagated outside, - ;; due to the `ignore-errors' closure. - (unless - (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) - (tramp-error - v 'file-error - "Couldn't find exit status of `%s'" - tramp-smb-acl-program)) - (skip-chars-forward "^ ") - (when (zerop (read (current-buffer))) - ;; Success. - (tramp-set-file-property v localname "file-acl" acl-string) - t)))))))))) + (with-tramp-saved-connection-properties + v '("process-name" "process-buffer") + (with-temp-buffer + ;; Set the transfer process properties. + (tramp-set-connection-property + v "process-name" (buffer-name (current-buffer))) + (tramp-set-connection-property + v "process-buffer" (current-buffer)) + + ;; Use an asynchronous process. By this, password + ;; can be handled. + (let ((p (apply + #'start-process + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + tramp-smb-acl-program args))) + + (tramp-message + v 6 "%s" (string-join (process-command p) " ")) + (process-put p 'tramp-vector v) + (process-put p 'adjust-window-size-function #'ignore) + (set-process-query-on-exit-flag p nil) + (tramp-process-actions p v nil tramp-smb-actions-set-acl) + ;; This is meant for traces, and returning from + ;; the function. No error is propagated outside, + ;; due to the `ignore-errors' closure. + (unless + (tramp-search-regexp (rx "tramp_exit_status " (+ digit))) + (tramp-error + v 'file-error + "Couldn't find exit status of `%s'" + tramp-smb-acl-program)) + (skip-chars-forward "^ ") + (when (zerop (read (current-buffer))) + ;; Success. + (tramp-set-file-property v localname "file-acl" acl-string) + t))))))))) (defun tramp-smb-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." @@ -1607,7 +1613,7 @@ If USER is a string, return its home directory instead of the user identified by VEC. If there is no user specified in either VEC or USER, or if there is no home directory, return nil." (let ((user (or user (tramp-file-name-user vec)))) - (unless (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) (concat "/" user)))) (defun tramp-smb-handle-write-region @@ -1956,7 +1962,7 @@ If ARGUMENT is non-nil, use it as argument for (setq tramp-smb-version (shell-command-to-string command)) (tramp-message vec 6 command) (tramp-message vec 6 "\n%s" tramp-smb-version) - (if (string-match (rx (+ (any " \t\n\r")) eos) tramp-smb-version) + (if (string-match (rx (+ (any " \t\r\n")) eos) tramp-smb-version) (setq tramp-smb-version (replace-match "" nil nil tramp-smb-version)))) @@ -2009,9 +2015,9 @@ If ARGUMENT is non-nil, use it as argument for (t (setq args (list "-g" "-L" host )))) - (if (not (zerop (length user))) - (setq args (append args (list "-U" user))) - (setq args (append args (list "-N")))) + (if (tramp-string-empty-or-nil-p user) + (setq args (append args (list "-N"))) + (setq args (append args (list "-U" user)))) (when domain (setq args (append args (list "-W" domain)))) (when port (setq args (append args (list "-p" port)))) @@ -2026,7 +2032,8 @@ If ARGUMENT is non-nil, use it as argument for (with-tramp-progress-reporter vec 3 (format "Opening connection for //%s%s/%s" - (if (not (zerop (length user))) (concat user "@") "") + (if (tramp-string-empty-or-nil-p user) + "" (concat user "@")) host (or share "")) (let* (coding-system-for-read @@ -2044,7 +2051,7 @@ If ARGUMENT is non-nil, use it as argument for args)))) (tramp-message vec 6 "%s" (string-join (process-command p) " ")) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) @@ -2098,7 +2105,7 @@ Removes smb prompt. Returns nil if an error message has appeared." ;; Read pending output. (while (not (re-search-forward tramp-smb-prompt nil t)) - (while (tramp-accept-process-output p 0)) + (while (tramp-accept-process-output p)) (goto-char (point-min))) (tramp-message vec 6 "\n%s" (buffer-string)) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 2d3c436632f..0ec2a1e74b8 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -100,7 +100,7 @@ (file-directory-p . tramp-handle-file-directory-p) (file-equal-p . tramp-handle-file-equal-p) (file-executable-p . tramp-fuse-handle-file-executable-p) - (file-exists-p . tramp-handle-file-exists-p) + (file-exists-p . tramp-fuse-handle-file-exists-p) (file-in-directory-p . tramp-handle-file-in-directory-p) (file-local-copy . tramp-handle-file-local-copy) (file-locked-p . tramp-handle-file-locked-p) @@ -244,8 +244,8 @@ arguments to pass to the OPERATION." (setq result (insert-file-contents (tramp-fuse-local-file-name filename) visit beg end replace)) - (when visit (setq buffer-file-name filename)) - (cons filename (cdr result))))) + (when visit (setq buffer-file-name filename))) + (cons filename (cdr result)))) (defun tramp-sshfs-handle-process-file (program &optional infile destination display &rest args) @@ -399,7 +399,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 88dacdc7893..d167bf13b14 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -366,7 +366,8 @@ the result will be a local, non-Tramp, file name." ;; If DIR is not given, use `default-directory' or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -377,7 +378,7 @@ the result will be a local, non-Tramp, file name." ;; Tilde expansion if necessary. We cannot accept "~/", because ;; under sudo "~/" is expanded to the local user home directory ;; but to the root home directory. - (when (zerop (length localname)) + (when (tramp-string-empty-or-nil-p localname) (setq localname "~")) (unless (file-name-absolute-p localname) (setq localname (format "~%s/%s" user localname))) @@ -387,7 +388,7 @@ the result will be a local, non-Tramp, file name." (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -457,39 +458,33 @@ the result will be a local, non-Tramp, file name." (defun tramp-sudoedit-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (if (tramp-file-property-p v localname "file-attributes") - (not (null (tramp-get-file-property v localname "file-attributes"))) - (tramp-sudoedit-send-command - v "test" "-e" (tramp-compat-file-name-unquote localname))))))) + (tramp-skeleton-file-exists-p filename + (tramp-sudoedit-send-command + v "test" "-e" (tramp-compat-file-name-unquote localname)))) (defun tramp-sudoedit-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (with-tramp-file-property v localname "file-name-all-completions" - (tramp-sudoedit-send-command - v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" - (if (zerop (length localname)) - "" (tramp-compat-file-name-unquote localname))) - (mapcar - (lambda (f) - (if (file-directory-p (expand-file-name f directory)) - (file-name-as-directory f) - f)) - (delq - nil + (tramp-compat-ignore-error file-missing + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (tramp-sudoedit-send-command + v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" + (if (tramp-string-empty-or-nil-p localname) + "" (tramp-compat-file-name-unquote localname))) (mapcar - (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) - (split-string - (tramp-get-buffer-string (tramp-get-connection-buffer v)) - "\n" 'omit)))))))) + (lambda (f) + (if (ignore-errors (file-directory-p (expand-file-name f directory))) + (file-name-as-directory f) + f)) + (delq + nil + (mapcar + (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) + (split-string + (tramp-get-buffer-string (tramp-get-connection-buffer v)) + "\n" 'omit))))))))) (defun tramp-sudoedit-handle-file-readable-p (filename) "Like `file-readable-p' for Tramp files." @@ -653,7 +648,10 @@ component is used as the target of the symlink." (let ((non-essential t)) (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target (tramp-file-local-name (expand-file-name target))))) + (setq target (tramp-file-local-name (expand-file-name target)))) + ;; There could be a cyclic link. + (tramp-flush-file-properties + v (expand-file-name target (tramp-file-local-name default-directory)))) ;; If TARGET is still remote, quote it. (if (tramp-tramp-file-p target) @@ -774,7 +772,7 @@ ID-FORMAT valid values are `string' and `integer'." "Check, whether a sudo process has finished. Remove unneeded output." ;; There might be pending output for the exit status. (unless (process-live-p proc) - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) ;; Delete narrowed region, it would be in the way reading a Lisp form. (goto-char (point-min)) (widen) @@ -802,7 +800,7 @@ connection if a previous connection has died for some reason." :name (tramp-get-connection-name vec) :buffer (tramp-get-connection-buffer vec) :server t :host 'local :service t :noquery t))) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (set-process-query-on-exit-flag p nil) ;; Set connection-local variables. @@ -840,7 +838,7 @@ in case of error, t otherwise." (tramp-message vec 6 "%s" (string-join (process-command p) " ")) ;; Avoid process status message in output buffer. (set-process-sentinel p #'ignore) - (process-put p 'vector vec) + (process-put p 'tramp-vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 29361f8a113..9fa698293ce 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -64,6 +64,22 @@ (declare-function netrc-parse "netrc") (defvar auto-save-file-name-transforms) (defvar ls-lisp-use-insert-directory-program) +(defvar tramp-prefix-format) +(defvar tramp-prefix-regexp) +(defvar tramp-method-regexp) +(defvar tramp-postfix-method-format) +(defvar tramp-postfix-method-regexp) +(defvar tramp-prefix-ipv6-format) +(defvar tramp-prefix-ipv6-regexp) +(defvar tramp-postfix-ipv6-format) +(defvar tramp-postfix-ipv6-regexp) +(defvar tramp-postfix-host-format) +(defvar tramp-postfix-host-regexp) +(defvar tramp-remote-file-name-spec-regexp) +(defvar tramp-file-name-structure) +(defvar tramp-file-name-regexp) +(defvar tramp-completion-method-regexp) +(defvar tramp-completion-file-name-regexp) ;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU ;; ELPA package. @@ -83,6 +99,7 @@ (progn (defvar tramp--startup-hook nil "Forms to be executed at the end of tramp.el.") + (put 'tramp--startup-hook 'tramp-suppress-trace t) (defmacro tramp--with-startup (&rest body) @@ -441,6 +458,8 @@ See `tramp-methods' for a list of possibilities for METHOD." (defconst tramp-default-method-marker "-" "Marker for default method in remote file names.") +(add-to-list 'tramp-methods `(,tramp-default-method-marker)) + (defcustom tramp-default-user nil "Default user to use for transferring files. It is nil by default; otherwise settings in configuration files like @@ -520,6 +539,11 @@ interpreted as a regular expression which always matches." :version "24.3" :type 'boolean) +(defcustom tramp-show-ad-hoc-proxies nil + "Whether to show ad-hoc proxies in file names." + :version "29.2" + :type 'boolean) + ;; For some obscure technical reasons, `system-name' on w32 returns ;; either lower case or upper case letters. See ;; . @@ -624,9 +648,7 @@ Sometimes the prompt is reported to look like \"login as:\"." ;; connection initialization; Tramp redefines the prompt afterwards. (rx (| bol "\r") (* (not (any "\n#$%>]"))) - (? "#") (any "#$%>]") (* blank) - ;; Escape characters. - (* "[" (* (any ";" digit)) alpha (* blank))) + (? "#") (any "#$%>]") (* blank)) "Regexp to match prompts from remote shell. Normally, Tramp expects you to configure `shell-prompt-pattern' correctly, but sometimes it happens that you are connecting to a @@ -660,14 +682,14 @@ The `sudo' program appears to insert a `^@' character into the prompt." (defcustom tramp-wrong-passwd-regexp (rx bol (* nonl) (| "Permission denied" - (: "Login " (| "Incorrect" "incorrect")) - "Connection refused" - "Connection closed" "Timeout, server not responding." "Sorry, try again." "Name or service not known" "Host key verification failed." + "Authentication failed" "No supported authentication methods left to try!" + (: "Login " (| "Incorrect" "incorrect")) + (: "Connection " (| "refused" "closed")) (: "Received signal " (+ digit))) (* nonl)) "Regexp matching a `login failed' message. @@ -698,7 +720,7 @@ See also `tramp-yesno-prompt-regexp'." (defcustom tramp-terminal-type "dumb" "Value of TERM environment variable for logging in to remote host. Because Tramp wants to parse the output of the remote shell, it is easily -confused by ANSI color escape sequences and suchlike. Often, shell init +confused by ANSI control escape sequences and suchlike. Often, shell init files conditionalize this setup based on the TERM environment variable." :group 'tramp :type 'string) @@ -725,7 +747,8 @@ The regexp should match at end of buffer." ;; A security key requires the user physically to touch the device ;; with their finger. We must tell it to the user. -;; Added in OpenSSH 8.2. I've tested it with yubikey. +;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey, +;; which has also passed the tests, does not show such a message. (defcustom tramp-security-key-confirm-regexp (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) "Regular expression matching security key confirmation message. @@ -790,6 +813,7 @@ It shall be used in combination with `generate-new-buffer-name'.") (defvar tramp-temp-buffer-file-name nil "File name of a persistent local temporary file. Useful for \"rsync\" like methods.") + (make-variable-buffer-local 'tramp-temp-buffer-file-name) (put 'tramp-temp-buffer-file-name 'permanent-local t) @@ -813,23 +837,6 @@ Customize. See also `tramp-change-syntax'." :initialize #'custom-initialize-default :set #'tramp-set-syntax) -(defvar tramp-prefix-format) -(defvar tramp-prefix-regexp) -(defvar tramp-method-regexp) -(defvar tramp-postfix-method-format) -(defvar tramp-postfix-method-regexp) -(defvar tramp-prefix-ipv6-format) -(defvar tramp-prefix-ipv6-regexp) -(defvar tramp-postfix-ipv6-format) -(defvar tramp-postfix-ipv6-regexp) -(defvar tramp-postfix-host-format) -(defvar tramp-postfix-host-regexp) -(defvar tramp-remote-file-name-spec-regexp) -(defvar tramp-file-name-structure) -(defvar tramp-file-name-regexp) -(defvar tramp-completion-method-regexp) -(defvar tramp-completion-file-name-regexp) - (defun tramp-set-syntax (symbol value) "Set SYMBOL to value VALUE. Used in user option `tramp-syntax'. There are further variables @@ -1218,9 +1225,12 @@ The `ftp' syntax does not support methods.") (? (regexp tramp-completion-method-regexp) ;; Method separator, user name and host name. (? (regexp tramp-postfix-method-regexp) - ;; This is a little bit lax, but it serves. - (? (regexp tramp-host-regexp)))) - + (? (regexp tramp-user-regexp) + (regexp tramp-postfix-user-regexp)) + (? (| (regexp tramp-host-regexp) ;; This includes a user. + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp) + (? (regexp tramp-postfix-ipv6-regexp)))))))) eos))) (defvar tramp-completion-file-name-regexp @@ -1430,6 +1440,7 @@ the (optional) timestamp of last activity on this connection.") "Password save function. Will be called once the password has been verified by successful authentication.") + (put 'tramp-password-save-function 'tramp-suppress-trace t) (defvar tramp-password-prompt-not-unique nil @@ -1438,9 +1449,13 @@ This shouldn't be set explicitly. It is let-bound, for example during direct remote copying with scp.") (defconst tramp-completion-file-name-handler-alist - '((file-name-all-completions + '((expand-file-name . tramp-completion-handle-expand-file-name) + (file-exists-p . tramp-completion-handle-file-exists-p) + (file-name-all-completions . tramp-completion-handle-file-name-all-completions) - (file-name-completion . tramp-completion-handle-file-name-completion)) + (file-name-completion . tramp-completion-handle-file-name-completion) + (file-name-directory . tramp-completion-handle-file-name-directory) + (file-name-nondirectory . tramp-completion-handle-file-name-nondirectory)) "Alist of completion handler functions. Used for file names matching `tramp-completion-file-name-regexp'. Operations not mentioned here will be handled by Tramp's file @@ -1657,7 +1672,7 @@ This is USER, if non-nil. Otherwise, do a lookup in This is HOST, if non-nil. Otherwise, do a lookup in `tramp-default-host-alist' and `tramp-default-host'." (let ((result - (or (and (> (length host) 0) host) + (or (and (tramp-compat-length> host 0) host) (let ((choices tramp-default-host-alist) lhost item) (while choices @@ -1669,7 +1684,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in lhost) tramp-default-host))) ;; We must mark, whether a default value has been used. - (if (or (> (length host) 0) (null result)) + (if (or (tramp-compat-length> host 0) (null result)) result (propertize result 'tramp-default t)))) @@ -1732,14 +1747,13 @@ default values are used." :port port :localname localname :hop hop)) ;; The method must be known. (unless (or nodefault non-essential - (string-equal method tramp-default-method-marker) (assoc method tramp-methods)) (tramp-user-error - v "Method `%s' is not known." method)) + v "Method `%s' is not known" method)) ;; Only some methods from tramp-sh.el do support multi-hops. (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v)) (tramp-user-error - v "Method `%s' is not supported for multi-hops." method))))))) + v "Method `%s' is not supported for multi-hops" method))))))) (put #'tramp-dissect-file-name 'tramp-suppress-trace t) @@ -1768,21 +1782,25 @@ See `tramp-dissect-file-name' for details." ;; Only some methods from tramp-sh.el do support multi-hops. (unless (or nodefault non-essential (tramp-multi-hop-p v)) (tramp-user-error - v "Method `%s' is not supported for multi-hops." + v "Method `%s' is not supported for multi-hops" (tramp-file-name-method v))) ;; Return result. v)) (put #'tramp-dissect-hop-name 'tramp-suppress-trace t) +(defsubst tramp-string-empty-or-nil-p (string) + "Check whether STRING is empty or nil." + (or (null string) (string= string ""))) + (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." (let ((method (tramp-file-name-method vec)) (user-domain (tramp-file-name-user-domain vec)) (host-port (tramp-file-name-host-port vec))) - (if (not (zerop (length user-domain))) - (format "*tramp/%s %s@%s*" method user-domain host-port) - (format "*tramp/%s %s*" method host-port)))) + (if (tramp-string-empty-or-nil-p user-domain) + (format "*tramp/%s %s*" method host-port) + (format "*tramp/%s %s@%s*" method user-domain host-port)))) (put #'tramp-buffer-name 'tramp-suppress-trace t) @@ -1811,7 +1829,9 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." (when (cadr args) (setq localname (and (stringp (cadr args)) (cadr args)))) (when hop - (setq hop nil) + ;; Keep hop in file name for completion or when indicated. + (unless (or minibuffer-completing-file-name tramp-show-ad-hoc-proxies) + (setq hop nil)) ;; Assure that the hops are in `tramp-default-proxies-alist'. ;; In tramp-archive.el, the slot `hop' is used for the archive ;; file name. @@ -1827,23 +1847,23 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." hop (nth 6 args)))) ;; Unless `tramp-syntax' is `simplified', we need a method. - (when (and (not (zerop (length tramp-postfix-method-format))) - (zerop (length method))) + (when (and (not (string-empty-p tramp-postfix-method-format)) + (tramp-string-empty-or-nil-p method)) (signal 'wrong-type-argument (list #'stringp method))) (concat tramp-prefix-format hop - (unless (zerop (length tramp-postfix-method-format)) + (unless (string-empty-p tramp-postfix-method-format) (concat method tramp-postfix-method-format)) user - (unless (zerop (length domain)) + (unless (tramp-string-empty-or-nil-p domain) (concat tramp-prefix-domain-format domain)) - (unless (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) tramp-postfix-user-format) (when host (if (string-match-p tramp-ipv6-regexp host) (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host)) - (unless (zerop (length port)) + (unless (tramp-string-empty-or-nil-p port) (concat tramp-prefix-port-format port)) tramp-postfix-host-format localname))) @@ -1861,19 +1881,19 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." (tramp-compat-rx (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format - (tramp-make-tramp-file-name vec 'noloc))))) + (tramp-make-tramp-file-name (tramp-file-name-unify vec)))))) (defun tramp-completion-make-tramp-file-name (method user host localname) "Construct a Tramp file name from METHOD, USER, HOST and LOCALNAME. It must not be a complete Tramp file name, but as long as there are necessary only. This function will be used in file name completion." (concat tramp-prefix-format - (unless (or (zerop (length method)) - (zerop (length tramp-postfix-method-format))) + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-postfix-method-format)) (concat method tramp-postfix-method-format)) - (unless (zerop (length user)) + (unless (tramp-string-empty-or-nil-p user) (concat user tramp-postfix-user-format)) - (unless (zerop (length host)) + (unless (tramp-string-empty-or-nil-p host) (concat (if (string-match-p tramp-ipv6-regexp host) (concat @@ -1920,7 +1940,7 @@ Return `tramp-cache-undefined' in case it doesn't exist." (or (and (tramp-file-name-p vec-or-proc) (get-buffer-process (tramp-buffer-name vec-or-proc))) (and (processp vec-or-proc) - (tramp-get-process (process-get vec-or-proc 'vector))) + (tramp-get-process (process-get vec-or-proc 'tramp-vector))) tramp-cache-undefined)) (defun tramp-get-connection-process (vec) @@ -1970,9 +1990,9 @@ of `current-buffer'." (let ((method (tramp-file-name-method vec)) (user-domain (tramp-file-name-user-domain vec)) (host-port (tramp-file-name-host-port vec))) - (if (not (zerop (length user-domain))) - (format "*debug tramp/%s %s@%s*" method user-domain host-port) - (format "*debug tramp/%s %s*" method host-port)))) + (if (tramp-string-empty-or-nil-p user-domain) + (format "*debug tramp/%s %s*" method host-port) + (format "*debug tramp/%s %s@%s*" method user-domain host-port)))) (put #'tramp-debug-buffer-name 'tramp-suppress-trace t) @@ -2202,7 +2222,7 @@ applicable)." vec-or-proc 'dont-create)))))))) ;; Translate proc to vec. (when (processp vec-or-proc) - (setq vec-or-proc (process-get vec-or-proc 'vector)))) + (setq vec-or-proc (process-get vec-or-proc 'tramp-vector)))) ;; Do it. (when (tramp-file-name-p vec-or-proc) (apply #'tramp-debug-message @@ -2325,12 +2345,12 @@ the resulting error message." (progn ,@body) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) -;; This macro shall optimize the cases where an `file-exists-p' call -;; is invoked first. Often, the file exists, so the remote command is +;; This macro shall optimize the cases where a `file-exists-p' call is +;; invoked first. Often, the file exists, so the remote command is ;; superfluous. (defmacro tramp-barf-if-file-missing (vec filename &rest body) "Execute BODY and return the result. -In case if an error, raise a `file-missing' error if FILENAME +In case of an error, raise a `file-missing' error if FILENAME does not exist, otherwise propagate the error." (declare (indent 2) (debug (symbolp form body))) (let ((err (make-symbol "err"))) @@ -2483,13 +2503,14 @@ Example: (setcdr v (delete (car v) (cdr v)))) ;; Check for function and file or registry key. (unless (and (functionp (nth 0 (car v))) + (stringp (nth 1 (car v))) (cond ;; Windows registry. ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v))) (and (memq system-type '(cygwin windows-nt)) (zerop (tramp-call-process - v "reg" nil nil nil "query" (nth 1 (car v)))))) + nil "reg" nil nil nil "query" (nth 1 (car v)))))) ;; DNS-SD service type. ((string-match-p tramp-dns-sd-service-regexp (nth 1 (car v)))) @@ -2794,7 +2815,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." "Invoke Tramp file name completion handler for OPERATION and ARGS. Falls back to normal file name handler if no Tramp file name handler exists." (if-let - ((fn (and tramp-mode + ((fn (and tramp-mode minibuffer-completing-file-name (assoc operation tramp-completion-file-name-handler-alist)))) (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args))) @@ -2967,6 +2988,75 @@ not in completion mode." (and vec (process-live-p (get-process (tramp-buffer-name vec)))) (not non-essential)))) +(defun tramp-completion-handle-expand-file-name (filename &optional directory) + "Like `expand-file-name' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; check, whether DIRECTORY is "/method:" or "/[method/". + (let ((dir (or directory default-directory "/"))) + (cond + ((file-name-absolute-p filename) filename) + ((and (eq tramp-syntax 'simplified) + (string-match-p + (tramp-compat-rx (regexp tramp-postfix-host-regexp) eos) dir)) + (concat dir filename)) + ((string-match-p + (tramp-compat-rx + bos (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (? (regexp tramp-method-regexp) (regexp tramp-postfix-method-regexp) + (? (regexp tramp-user-regexp) (regexp tramp-postfix-user-regexp))) + eos) + dir) + (concat dir filename)) + (t (tramp-run-real-handler #'expand-file-name (list filename directory)))))) + +(defun tramp-completion-handle-file-exists-p (filename) + "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 backen operation. + (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 + (tramp-compat-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 valid user? + ((string-match + (tramp-compat-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)))))) + t) + + (tramp-run-real-handler #'file-exists-p (list filename)))) + ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of ;; `tramp-file-name' structures. For all of them we return possible @@ -2977,10 +3067,10 @@ not in completion mode." (tramp-drop-volume-letter (expand-file-name filename directory))) ;; When `tramp-syntax' is `simplified', we need a default method. (tramp-default-method - (and (zerop (length tramp-postfix-method-format)) + (and (string-empty-p tramp-postfix-method-format) tramp-default-method)) (tramp-default-method-alist - (and (zerop (length tramp-postfix-method-format)) + (and (string-empty-p tramp-postfix-method-format) tramp-default-method-alist)) tramp-default-user tramp-default-user-alist tramp-default-host tramp-default-host-alist @@ -3040,11 +3130,12 @@ not in completion mode." result1))) ;; Complete local parts. - (append - result1 - (ignore-errors - (tramp-run-real-handler - #'file-name-all-completions (list filename directory)))))) + (delete-dups + (append + result1 + (ignore-errors + (tramp-run-real-handler + #'file-name-all-completions (list filename directory))))))) ;; Method, host name and user name completion for a file. (defun tramp-completion-handle-file-name-completion @@ -3202,6 +3293,47 @@ PARTIAL-USER must match USER, PARTIAL-HOST must match HOST." (unless (zerop (+ (length user) (length host))) (tramp-completion-make-tramp-file-name method user host nil))) +(defun tramp-completion-handle-file-name-directory (filename) + "Like `file-name-directory' for partial Tramp files." + ;; We need special handling only when a method is needed. Then we + ;; return "/method:" or "/[method/", if "method" is a valid Tramp + ;; method. In the `separate' file name syntax, we return "/[" when + ;; `filename' is "/[string" w/o a trailing method separator "/". + (cond + ((string-match + (tramp-compat-rx + (group (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp))) + (? (regexp tramp-completion-method-regexp)) eos) + filename) + (match-string 1 filename)) + ((and (string-match + (tramp-compat-rx + (group + (regexp tramp-prefix-regexp) + (* (regexp tramp-remote-file-name-spec-regexp) + (regexp tramp-postfix-hop-regexp)) + (group (regexp tramp-method-regexp)) + (regexp tramp-postfix-method-regexp) + (? (regexp tramp-user-regexp) + (regexp tramp-postfix-user-regexp))) + (? (| (regexp tramp-host-regexp) + (: (regexp tramp-prefix-ipv6-regexp) + (? (regexp tramp-ipv6-regexp) + (? (regexp tramp-postfix-ipv6-regexp)))))) + eos) + filename) + ;; Is it a valid method? + (or (tramp-string-empty-or-nil-p (match-string 2 filename)) + (assoc (match-string 2 filename) tramp-methods))) + (match-string 1 filename)) + (t (tramp-run-real-handler #'file-name-directory (list filename))))) + +(defun tramp-completion-handle-file-name-nondirectory (filename) + "Like `file-name-nondirectory' for partial Tramp files." + (tramp-compat-string-replace (file-name-directory filename) "" filename)) + (defun tramp-parse-default-user-host (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' @@ -3527,6 +3659,25 @@ BODY is the backend specific code." (tramp-dissect-file-name ,directory) 'file-missing ,directory) nil))) +(defmacro tramp-skeleton-file-exists-p (filename &rest body) + "Skeleton for `tramp-*-handle-file-exists-p'. +BODY is the backend specific code." + (declare (indent 1) (debug t)) + ;; `file-exists-p' is used as predicate in file name completion. + `(or (and minibuffer-completing-file-name + (file-name-absolute-p ,filename) + (tramp-string-empty-or-nil-p + (tramp-file-name-localname (tramp-dissect-file-name ,filename)))) + ;; We don't want to run it when `non-essential' is t, or there + ;; is no connection process yet. + (when (tramp-connectable-p ,filename) + (with-parsed-tramp-file-name (expand-file-name ,filename) nil + (with-tramp-file-property v localname "file-exists-p" + (if (tramp-file-property-p v localname "file-attributes") + (not + (null (tramp-get-file-property v localname "file-attributes"))) + ,@body)))))) + (defmacro tramp-skeleton-file-local-copy (filename &rest body) "Skeleton for `tramp-*-handle-file-local-copy'. BODY is the backend specific code." @@ -3640,29 +3791,29 @@ BODY is the backend specific code." ;; Set the ownership. (when need-chown - (tramp-set-file-uid-gid filename uid gid))) - - ;; Set extended attributes. We ignore possible errors, - ;; because ACL strings could be incompatible. - (when attributes - (ignore-errors - (set-file-extended-attributes filename attributes))) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; Sanity check. - (unless (equal curbuf (current-buffer)) - (tramp-error - v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - - (when (and (null noninteractive) - (or (eq ,visit t) (string-or-null-p ,visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))))) + (tramp-set-file-uid-gid filename uid gid)) + + ;; Set extended attributes. We ignore possible errors, + ;; because ACL strings could be incompatible. + (when attributes + (ignore-errors + (set-file-extended-attributes filename attributes))) + + ;; Unlock file. + (when file-locked + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file lockname)) + + ;; Sanity check. + (unless (equal curbuf (current-buffer)) + (tramp-error + v 'file-error + "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) + + (when (and (null noninteractive) + (or (eq ,visit t) (string-or-null-p ,visit))) + (tramp-message v 0 "Wrote %s" filename)) + (run-hooks 'tramp-handle-write-region-hook))))))) ;;; Common file name handler functions for different backends: @@ -3711,7 +3862,7 @@ Let-bind it when necessary.") (defun tramp-handle-access-file (filename string) "Like `access-file' for Tramp files." (setq filename (file-truename filename)) - (with-parsed-tramp-file-name filename v + (with-parsed-tramp-file-name filename nil (if (file-exists-p filename) (unless (funcall @@ -3766,7 +3917,7 @@ Let-bind it when necessary.") ;; Otherwise, remove any trailing slash from localname component. ;; Method, host, etc, are unchanged. (while (with-parsed-tramp-file-name directory nil - (and (not (zerop (length localname))) + (and (tramp-compat-length> localname 0) (eq (aref localname (1- (length localname))) ?/) (not (string= localname "/")))) (setq directory (substring directory 0 -1))) @@ -3797,7 +3948,8 @@ Let-bind it when necessary.") ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". (setq dir (or dir default-directory "/")) ;; Handle empty NAME. - (when (zerop (length name)) (setq name ".")) + (when (string-empty-p name) + (setq name ".")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) (setq name (tramp-compat-file-name-concat dir name))) @@ -3817,7 +3969,7 @@ Let-bind it when necessary.") (let ((uname (match-string 1 localname)) (fname (match-string 2 localname)) hname) - (when (zerop (length uname)) + (when (tramp-string-empty-or-nil-p uname) (setq uname user)) (when (setq hname (tramp-get-home-directory v uname)) (setq localname (concat hname fname))))) @@ -3846,9 +3998,10 @@ 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))) + ;; symlink. We don't protect this despite it, because other errors + ;; might be worth to be visible, for example impossibility to mount + ;; in tramp-gvfs.el. + (eq (file-attribute-type (file-attributes (file-truename filename))) t)) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equalp-p' for Tramp files." @@ -3861,13 +4014,8 @@ Let-bind it when necessary.") (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." - ;; `file-exists-p' is used as predicate in file name completion. - ;; We don't want to run it when `non-essential' is t, or there is - ;; no connection process yet. - (when (tramp-connectable-p filename) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (with-tramp-file-property v localname "file-exists-p" - (not (null (file-attributes filename))))))) + (tramp-skeleton-file-exists-p filename + (not (null (file-attributes filename))))) (defun tramp-handle-file-in-directory-p (filename directory) "Like `file-in-directory-p' for Tramp files." @@ -3902,7 +4050,7 @@ Let-bind it when necessary.") ;; Run the command on the localname portion only unless we are in ;; completion mode. (tramp-make-tramp-file-name - v (or (and (zerop (length (tramp-file-name-localname v))) + v (or (and (tramp-string-empty-or-nil-p (tramp-file-name-localname v)) (not (tramp-connectable-p file))) (tramp-run-real-handler #'file-name-as-directory @@ -3965,7 +4113,8 @@ Let-bind it when necessary.") ;; "." and ".." are never interesting as completions, and are ;; actually in the way in a directory with only one file. See ;; file_name_completion() in dired.c. - (when (and (consp fnac) (= (length (delete "./" (delete "../" fnac))) 1)) + (when (and (consp fnac) + (tramp-compat-length= (delete "./" (delete "../" fnac)) 1)) (setq fnac (delete "./" (delete "../" fnac)))) (or (try-completion @@ -4698,7 +4847,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (unless (tramp-multi-hop-p item) (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error - vec "Method `%s' is not supported for multi-hops." + vec "Method `%s' is not supported for multi-hops" (tramp-file-name-method item))))) ;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the @@ -4752,7 +4901,7 @@ substitution. SPEC-LIST is a list of char/value pairs used for (tramp-get-connection-property v "direct-async-process") ;; There's no multi-hop. (or (not (tramp-multi-hop-p v)) - (= (length (tramp-compute-multi-hops v)) 1)) + (null (cdr (tramp-compute-multi-hops v)))) ;; There's no remote stdout or stderr file. (or (not (stringp buffer)) (not (tramp-tramp-file-p buffer))) (or (not (stringp stderr)) (not (tramp-tramp-file-p stderr)))))) @@ -4891,6 +5040,11 @@ substitution. SPEC-LIST is a list of char/value pairs used for ;; t. See Bug#51177. (when filter (set-process-filter p filter)) + (process-put p 'tramp-vector v) + ;; This is neded for ssh or PuTTY based processes, and + ;; only if the respective options are set. Perhaps, the + ;; setting could be more fine-grained. + ;; (process-put p 'tramp-shared-socket t) (process-put p 'remote-command orig-command) (tramp-set-connection-property p "remote-command" orig-command) @@ -4908,7 +5062,7 @@ support symbolic links." (defun tramp-handle-memory-info () "Like `memory-info' for Tramp files." - (let ((result '(0 0 0 0)) + (let ((result (list 0 0 0 0)) process-file-side-effects) (with-temp-buffer (cond @@ -5108,17 +5262,19 @@ support symbolic links." (add-function :after (process-sentinel p) (lambda (_proc _string) - (with-current-buffer error-buffer - (insert-file-contents-literally - error-file nil nil nil 'replace)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally + error-file nil nil nil 'replace)) + (delete-file error-file))))) (display-buffer output-buffer '(nil (allow-no-window . t))))) ;; Insert error messages if they were separated. (when (and error-file (not (process-live-p p))) - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)))) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))))) ;; Synchronous case. (prog1 @@ -5126,9 +5282,10 @@ support symbolic links." (process-file-shell-command command nil buffer) ;; Insert error messages if they were separated. (when error-file - (with-current-buffer error-buffer - (insert-file-contents-literally error-file)) - (delete-file error-file)) + (ignore-errors + (with-current-buffer error-buffer + (insert-file-contents-literally error-file)) + (delete-file error-file))) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, @@ -5300,7 +5457,7 @@ of." ;; There might be pending output. Avoid problems with reentrant ;; call of Tramp. (ignore-errors - (while (tramp-accept-process-output proc 0))) + (while (tramp-accept-process-output proc))) (tramp-message proc 6 "Kill %S" proc) (delete-process proc)) @@ -5312,7 +5469,7 @@ of." (with-current-buffer (process-buffer proc) (file-exists-p (concat (file-remote-p default-directory) - (process-get proc 'watch-name)))))) + (process-get proc 'tramp-watch-name)))))) (defun tramp-file-notify-process-sentinel (proc event) "Call `file-notify-rm-watch'." @@ -5438,7 +5595,7 @@ Wait, until the connection buffer changes." ;; Hide message in buffer. (narrow-to-region (point-max) (point-max)) ;; Wait for new output. - (while (not (tramp-compat-ignore-error 'file-error + (while (not (tramp-compat-ignore-error file-error (tramp-wait-for-regexp proc 0.1 tramp-security-key-confirmed-regexp))) (when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp) @@ -5452,13 +5609,13 @@ Wait, until the connection buffer changes." "Check, whether a process has finished." (unless (process-live-p proc) ;; There might be pending output. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (throw 'tramp-action 'process-died))) (defun tramp-action-out-of-band (proc vec) "Check, whether an out-of-band copy has finished." ;; There might be pending output for the exit status. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (cond ((and (not (process-live-p proc)) (zerop (process-exit-status proc))) (tramp-message vec 3 "Process has finished.") @@ -5489,12 +5646,18 @@ See `tramp-process-actions' for the format of ACTIONS." (while (not found) ;; Reread output once all actions have been performed. ;; Obviously, the output was not complete. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) + ;; Remove ANSI control escape sequences. + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-min)) + (while (re-search-forward ansi-color-control-seq-regexp nil t) + (replace-match ""))) (setq todo actions) (while todo (setq item (pop todo) tramp-process-action-regexp (symbol-value (nth 0 item)) - pattern (format "\\(%s\\)\\'" tramp-process-action-regexp) + pattern + (tramp-compat-rx (group (regexp tramp-process-action-regexp)) eos) action (nth 1 item)) (tramp-message vec 5 "Looking for regexp \"%s\" from remote shell" pattern) @@ -5532,7 +5695,7 @@ performed successfully. Any other value means an error." ;; use the "password-vector" property in case we have several hops. (tramp-set-connection-property (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector)) + proc "password-vector" (process-get proc 'tramp-vector)) "first-password-request" tramp-cache-read-persistent-data) (save-restriction (with-tramp-progress-reporter @@ -5606,11 +5769,22 @@ Mostly useful to protect BODY from being interrupted by timers." ,@body) (tramp-flush-connection-property ,proc "locked")))) -(defun tramp-accept-process-output (proc &optional timeout) +(defun tramp-accept-process-output (proc &optional _timeout) "Like `accept-process-output' for Tramp processes. This is needed in order to hide `last-coding-system-used', which is set for process communication also. If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." + (declare (advertised-calling-convention (proc) "29.2")) + ;; There could be other processes which use the same socket for + ;; communication. This could block the output for the current + ;; process. Read such output first. (Bug#61350) + ;; The process property isn't set anymore due to Bug#62194. + (when-let (((process-get proc 'tramp-shared-socket)) + (v (process-get proc 'tramp-vector))) + (dolist (p (delq proc (process-list))) + (when (tramp-file-name-equal-p v (process-get p 'tramp-vector)) + (with-local-quit (accept-process-output p 0 nil t))))) + (with-current-buffer (process-buffer proc) (let ((inhibit-read-only t) last-coding-system-used @@ -5620,10 +5794,10 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit' ;; returns t in order to report success. (if (with-local-quit - (setq result (accept-process-output proc timeout nil t)) t) + (setq result (accept-process-output proc 0 nil t)) t) (tramp-message - proc 10 "%s %s %s %s\n%s" - proc timeout (process-status proc) result (buffer-string)) + proc 10 "%s %s %s\n%s" + proc (process-status proc) result (buffer-string)) ;; Propagate quit. (keyboard-quit))) result))) @@ -5761,7 +5935,7 @@ the remote host use line-endings as defined in the variable (defun tramp-process-sentinel (proc event) "Flush file caches and remove shell prompt." (unless (process-live-p proc) - (let ((vec (process-get proc 'vector)) + (let ((vec (process-get proc 'tramp-vector)) (buf (process-buffer proc)) (prompt (tramp-get-connection-property proc "prompt"))) (when vec @@ -6039,10 +6213,9 @@ to cache the result. Return the modified ATTR." (with-tramp-file-property ,vec ,localname "file-attributes" (when-let ((attr ,attr)) (save-match-data - ;; Remove color escape sequences from symlink. + ;; Remove ANSI control escape sequences from symlink. (when (stringp (car attr)) - (while (string-match - tramp-display-escape-sequence-regexp (car attr)) + (while (string-match ansi-color-control-seq-regexp (car attr)) (setcar attr (replace-match "" nil nil (car attr))))) ;; Convert uid and gid. Use `tramp-unknown-id-integer' ;; as indication of unusable value. @@ -6364,6 +6537,7 @@ It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (destination (if (eq destination t) (current-buffer) destination)) (vec (or vec (car tramp-current-connection))) @@ -6384,7 +6558,7 @@ are written with verbosity of 6." (error (setq error (error-message-string err) result 1))) - (if (zerop (length error)) + (if (tramp-string-empty-or-nil-p error) (tramp-message vec 6 "%s\n%s" result output) (tramp-message vec 6 "%s\n%s\n%s" result output error)) result)) @@ -6396,6 +6570,7 @@ It always returns a return code. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." (let ((default-directory tramp-compat-temporary-file-directory) + (temporary-file-directory tramp-compat-temporary-file-directory) (process-environment (default-toplevel-value 'process-environment)) (buffer (if (eq buffer t) (current-buffer) buffer)) result) @@ -6469,7 +6644,7 @@ Consults the auth-source package." ;; In tramp-sh.el, we must use "password-vector" due to ;; multi-hop. (vec (tramp-get-connection-property - proc "password-vector" (process-get proc 'vector))) + proc "password-vector" (process-get proc 'tramp-vector))) (key (tramp-make-tramp-file-name vec 'noloc)) (method (tramp-file-name-method vec)) (user (or (tramp-file-name-user-domain vec) @@ -6520,7 +6695,7 @@ Consults the auth-source package." ;; Workaround. Prior Emacs 28.1, auth-source has saved empty ;; passwords. See discussion in Bug#50399. - (when (zerop (length auth-passwd)) + (when (tramp-string-empty-or-nil-p auth-passwd) (setq tramp-password-save-function nil)) (tramp-set-connection-property vec "first-password-request" nil) @@ -6632,13 +6807,14 @@ name of a process or buffer, or nil to default to the current buffer." ;; negative pid, so we try both variants. (tramp-compat-funcall 'tramp-send-command - (process-get proc 'vector) + (process-get proc 'tramp-vector) (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s" pid pid - (tramp-get-remote-null-device (process-get proc 'vector)))) + (tramp-get-remote-null-device + (process-get proc 'tramp-vector)))) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. - (while (tramp-accept-process-output proc 0)) + (while (tramp-accept-process-output proc)) (not (process-live-p proc)))))) (add-hook 'interrupt-process-functions #'tramp-interrupt-process) @@ -6661,7 +6837,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name." (cond ((processp process) (setq pid (process-get process 'remote-pid) - vec (process-get process 'vector))) + vec (process-get process 'tramp-vector))) ((numberp process) (setq pid process vec (and (stringp remote) (tramp-dissect-file-name remote)))) @@ -6739,5 +6915,7 @@ If VEC is `tramp-null-hop', return local null device." ;; "/ssh:user1@host:~user2". ;; ;; * Implement file name abbreviation for user and host names. +;; +;; * Implement user and host name completion for multi-hops. ;;; tramp.el ends here diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 0d27829b915..f96ffac2e13 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.6.0.29.1 +;; Version: 2.6.2-pre ;; Package-Requires: ((emacs "26.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.6.0.29.1" +(defconst tramp-version "2.6.2-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -78,7 +78,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "26.1")) "ok" - (format "Tramp 2.6.0.29.1 is not fit for %s" + (format "Tramp 2.6.2-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-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index b28b32bc7d3..a23f72635fe 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -127,6 +127,12 @@ Some semantics has been changed for there, without new functions or variables, so we check the Emacs version directly." (>= emacs-major-version 27)) +(defun tramp-archive--test-emacs28-p () + "Check for Emacs version >= 28.1. +Some semantics has been changed for there, without new functions or +variables, so we check the Emacs version directly." + (>= emacs-major-version 28)) + (ert-deftest tramp-archive-test00-availability () "Test availability of archive file name functions." :expected-result (if tramp-archive-enabled :passed :failed) @@ -593,11 +599,11 @@ This checks also `file-name-as-directory', `file-name-directory', (mapcar (lambda (x) (concat tmp-name x)) files))) (should (equal (directory-files tmp-name nil directory-files-no-dot-files-regexp) - (delete "." (delete ".." files)))) + (remove "." (remove ".." files)))) (should (equal (directory-files tmp-name 'full directory-files-no-dot-files-regexp) (mapcar (lambda (x) (concat tmp-name x)) - (delete "." (delete ".." files)))))) + (remove "." (remove ".." files)))))) ;; Cleanup. (tramp-archive-cleanup-hash)))) @@ -888,7 +894,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (let ((fsi (with-no-warnings (file-system-info tramp-archive-test-archive)))) (skip-unless fsi) (should (and (consp fsi) - (= (length fsi) 3) + (tramp-compat-length= fsi 3) (numberp (nth 0 fsi)) ;; FREE and AVAIL are always 0. (zerop (nth 1 fsi)) @@ -913,12 +919,15 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (featurep 'tramp-archive))))")) (dolist (enabled '(t nil)) (dolist (default-directory - `(,temporary-file-directory + (append + `(,temporary-file-directory) ;; Starting Emacs in a directory which has ;; `tramp-archive-file-name-regexp' syntax is ;; supported only with Emacs > 27.2 (sigh!). ;; (Bug#48476) - ,(file-name-as-directory tramp-archive-test-directory))) + (and (tramp-archive--test-emacs28-p) + `(,(file-name-as-directory + tramp-archive-test-directory))))) (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) (should (string-match diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 0a777617c1d..00e368abe4d 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -66,7 +66,6 @@ (defvar ange-ftp-make-backup-files) (defvar tramp-connection-properties) (defvar tramp-copy-size-limit) -(defvar tramp-display-escape-sequence-regexp) (defvar tramp-fuse-remove-hidden-files) (defvar tramp-fuse-unmount-on-cleanup) (defvar tramp-inline-compress-start-size) @@ -166,6 +165,9 @@ A resource file is in the resource directory as per ;; Suppress nasty messages. (fset #'shell-command-sentinel #'ignore) ;; We do not want to be interrupted. + (fset #'tramp-action-yesno + (lambda (_proc vec) + (tramp-send-string vec (concat "yes" tramp-local-end-of-line)) t)) (eval-after-load 'tramp-gvfs '(fset 'tramp-gvfs-handler-askquestion (lambda (_message _choices) '(t nil 0))))) @@ -529,6 +531,7 @@ Also see `ignore'." tramp-default-method-alist tramp-default-user-alist tramp-default-host-alist + tramp-default-proxies-alist ;; Suppress method name check. (non-essential t) ;; Suppress check for multihops. @@ -855,154 +858,203 @@ Also see `ignore'." "/path/to/file")) ;; Multihop. - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file") - "/method2:user2@host2:")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) - "method2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) - "user2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) - "host2")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop) - (format "%s:%s@%s|" - "method1" "user1" "host1"))) + (dolist (tramp-show-ad-hoc-proxies '(nil t)) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file")) - "/method3:user3@host3:")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'method) - "method3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'user) - "user3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'host) - "host3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@host2" - "|method3:user3@host3:/path/to/file") - 'hop) - (format "%s:%s@%s|%s:%s@%s|" - "method1" "user1" "host1" "method2" "user2" "host2"))) - - ;; Expand `tramp-default-method-alist'. - (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1")) - (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2")) - (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3")) - (should - (string-equal - (file-remote-p - (concat - "/-:user1@host1" - "|-:user2@host2" - "|-:user3@host3:/path/to/file")) - "/method3:user3@host3:")) - - ;; Expand `tramp-default-user-alist'. - (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) - (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) - (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:host1" - "|method2:host2" - "|method3:host3:/path/to/file")) - "/method3:user3@host3:")) - - ;; Expand `tramp-default-host-alist'. - (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) - (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) - (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@" - "|method2:user2@" - "|method3:user3@:/path/to/file")) - "/method3:user3@host3:")) - - ;; Ad-hoc user name and host name expansion. - (setq tramp-default-method-alist nil - tramp-default-user-alist nil - tramp-default-host-alist nil) - (should - (string-equal - (file-remote-p - (concat - "/method1:user1@host1" - "|method2:user2@" - "|method3:user3@:/path/to/file")) - "/method3:user3@host1:")) - (should - (string-equal - (file-remote-p - (concat - "/method1:%u@%h" - "|method2:user2@host2" - "|method3:%u@%h" - "|method4:user4%domain4@host4#1234:/path/to/file")) - "/method4:user4%domain4@host4#1234:"))) + ;; Explicit settings in `tramp-default-proxies-alist' + ;; shouldn't show hops. + (setq tramp-default-proxies-alist + '(("^host2$" "^user2$" "/method1:user1@host1:"))) + (should + (string-equal + (file-remote-p "/method2:user2@host2:/path/to/file") + "/method2:user2@host2:")) + (setq tramp-default-proxies-alist nil) + + ;; Ad-hoc settings. + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file") + (if tramp-show-ad-hoc-proxies + "/method1:user1@host1|method2:user2@host2:" + "/method2:user2@host2:"))) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'method) + "method2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'user) + "user2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'host) + "host2")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + "/method1:user1@host1|method2:user2@host2:/path/to/file" 'hop) + (format "%s:%s@%s|" + "method1" "user1" "host1"))) + + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:") + "/method3:user3@host3:"))) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'method) + "method3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'user) + "user3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'host) + "host3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:/path/to/file") + 'hop) + (format "%s:%s@%s|%s:%s@%s|" + "method1" "user1" "host1" "method2" "user2" "host2"))) + + ;; Expand `tramp-default-method-alist'. + (add-to-list + 'tramp-default-method-alist '("host1" "user1" "method1")) + (add-to-list + 'tramp-default-method-alist '("host2" "user2" "method2")) + (add-to-list + 'tramp-default-method-alist '("host3" "user3" "method3")) + (should + (string-equal + (file-remote-p + (concat + "/-:user1@host1" + "|-:user2@host2" + "|-:user3@host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:") + "/method3:user3@host3:"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) + (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) + (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:host1" + "|method2:host2" + "|method3:host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:") + "/method3:user3@host3:"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) + (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) + (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@" + "|method2:user2@" + "|method3:user3@:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host2" + "|method3:user3@host3:") + "/method3:user3@host3:"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-method-alist nil + tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/method1:user1@host1" + "|method2:user2@" + "|method3:user3@:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user1@host1" + "|method2:user2@host1" + "|method3:user3@host1:") + "/method3:user3@host1:"))) + (should + (string-equal + (file-remote-p + (concat + "/method1:%u@%h" + "|method2:user2@host2" + "|method3:%u@%h" + "|method4:user4%domain4@host4#1234:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/method1:user2@host2" + "|method2:user2@host2" + "|method3:user4@host4" + "|method4:user4%domain4@host4#1234:") + "/method4:user4%domain4@host4#1234:"))))) ;; Exit. (tramp-change-syntax syntax)))) @@ -1015,6 +1067,7 @@ Also see `ignore'." (tramp-default-host "default-host") tramp-default-user-alist tramp-default-host-alist + tramp-default-proxies-alist ;; Suppress method name check. (non-essential t) ;; Suppress check for multihops. @@ -1186,137 +1239,178 @@ Also see `ignore'." "/path/to/file")) ;; Multihop. - (should - (string-equal - (file-remote-p "/user1@host1|user2@host2:/path/to/file") - "/user2@host2:")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'method) - "default-method")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'user) - "user2")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'host) - "host2")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/user1@host1|user2@host2:/path/to/file" 'hop) - (format "%s@%s|" "user1" "host1"))) + (dolist (tramp-show-ad-hoc-proxies '(nil t)) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file")) - "/user3@host3:")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'method) - "default-method")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'user) - "user3")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'host) - "host3")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@host2" - "|user3@host3:/path/to/file") - 'hop) - (format "%s@%s|%s@%s|" - "user1" "host1" "user2" "host2"))) - - ;; Expand `tramp-default-user-alist'. - (add-to-list 'tramp-default-user-alist '(nil "host1" "user1")) - (add-to-list 'tramp-default-user-alist '(nil "host2" "user2")) - (add-to-list 'tramp-default-user-alist '(nil "host3" "user3")) - (should - (string-equal - (file-remote-p - (concat - "/host1" - "|host2" - "|host3:/path/to/file")) - "/user3@host3:")) - - ;; Expand `tramp-default-host-alist'. - (add-to-list 'tramp-default-host-alist '(nil "user1" "host1")) - (add-to-list 'tramp-default-host-alist '(nil "user2" "host2")) - (add-to-list 'tramp-default-host-alist '(nil "user3" "host3")) - (should - (string-equal - (file-remote-p - (concat - "/user1@" - "|user2@" - "|user3@:/path/to/file")) - "/user3@host3:")) - - ;; Ad-hoc user name and host name expansion. - (setq tramp-default-user-alist nil - tramp-default-host-alist nil) - (should - (string-equal - (file-remote-p - (concat - "/user1@host1" - "|user2@" - "|user3@:/path/to/file")) - "/user3@host1:")) - (should - (string-equal - (file-remote-p - (concat - "/%u@%h" - "|user2@host2" - "|%u@%h" - "|user4%domain4@host4#1234:/path/to/file")) - "/user4%domain4@host4#1234:"))) + ;; Explicit settings in `tramp-default-proxies-alist' + ;; shouldn't show hops. + (setq tramp-default-proxies-alist + '(("^host2$" "^user2$" "/user1@host1:"))) + (should + (string-equal + (file-remote-p "/user2@host2:/path/to/file") + "/user2@host2:")) + (setq tramp-default-proxies-alist nil) + + ;; Ad-hoc settings. + (should + (string-equal + (file-remote-p "/user1@host1|user2@host2:/path/to/file") + (if tramp-show-ad-hoc-proxies + "/user1@host1|user2@host2:" + "/user2@host2:"))) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'method) + "default-method")) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'user) + "user2")) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'host) + "host2")) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + "/user1@host1|user2@host2:/path/to/file" 'hop) + (format "%s@%s|" "user1" "host1"))) + + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:") + "/user3@host3:"))) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'method) + "default-method")) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'user) + "user3")) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'host) + "host3")) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:/path/to/file") + 'hop) + (format "%s@%s|%s@%s|" + "user1" "host1" "user2" "host2"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '(nil "host1" "user1")) + (add-to-list 'tramp-default-user-alist '(nil "host2" "user2")) + (add-to-list 'tramp-default-user-alist '(nil "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/host1" + "|host2" + "|host3:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:") + "/user3@host3:"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '(nil "user1" "host1")) + (add-to-list 'tramp-default-host-alist '(nil "user2" "host2")) + (add-to-list 'tramp-default-host-alist '(nil "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/user1@" + "|user2@" + "|user3@:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user1@host1" + "|user2@host2" + "|user3@host3:") + "/user3@host3:"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/user1@host1" + "|user2@" + "|user3@:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user1@host1" + "|user2@host1" + "|user3@host1:") + "/user3@host1:"))) + (should + (string-equal + (file-remote-p + (concat + "/%u@%h" + "|user2@host2" + "|%u@%h" + "|user4%domain4@host4#1234:/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/user2@host2" + "|user2@host2" + "|user4@host4" + "|user4%domain4@host4#1234:") + "/user4%domain4@host4#1234:"))))) ;; Exit. (tramp-change-syntax syntax)))) @@ -1330,6 +1424,7 @@ Also see `ignore'." tramp-default-method-alist tramp-default-user-alist tramp-default-host-alist + tramp-default-proxies-alist ;; Suppress method name check. (non-essential t) ;; Suppress check for multihops. @@ -1802,154 +1897,203 @@ Also see `ignore'." "/path/to/file")) ;; Multihop. - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file") - "/[method2/user2@host2]")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method) - "method2")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user) - "user2")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host) - "host2")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop) - (format "%s/%s@%s|" - "method1" "user1" "host1"))) + (dolist (tramp-show-ad-hoc-proxies '(nil t)) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file")) - "/[method3/user3@host3]")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'method) - "method3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'user) - "user3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'host) - "host3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'localname) - "/path/to/file")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@host2" - "|method3/user3@host3]/path/to/file") - 'hop) - (format "%s/%s@%s|%s/%s@%s|" - "method1" "user1" "host1" "method2" "user2" "host2"))) - - ;; Expand `tramp-default-method-alist'. - (add-to-list 'tramp-default-method-alist '("host1" "user1" "method1")) - (add-to-list 'tramp-default-method-alist '("host2" "user2" "method2")) - (add-to-list 'tramp-default-method-alist '("host3" "user3" "method3")) - (should - (string-equal - (file-remote-p - (concat - "/[/user1@host1" - "|/user2@host2" - "|/user3@host3]/path/to/file")) - "/[method3/user3@host3]")) - - ;; Expand `tramp-default-user-alist'. - (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) - (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) - (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/host1" - "|method2/host2" - "|method3/host3]/path/to/file")) - "/[method3/user3@host3]")) - - ;; Expand `tramp-default-host-alist'. - (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) - (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) - (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@" - "|method2/user2@" - "|method3/user3@]/path/to/file")) - "/[method3/user3@host3]")) - - ;; Ad-hoc user name and host name expansion. - (setq tramp-default-method-alist nil - tramp-default-user-alist nil - tramp-default-host-alist nil) - (should - (string-equal - (file-remote-p - (concat - "/[method1/user1@host1" - "|method2/user2@" - "|method3/user3@]/path/to/file")) - "/[method3/user3@host1]")) - (should - (string-equal - (file-remote-p - (concat - "/[method1/%u@%h" - "|method2/user2@host2" - "|method3/%u@%h" - "|method4/user4%domain4@host4#1234]/path/to/file")) - "/[method4/user4%domain4@host4#1234]"))) + ;; Explicit settings in `tramp-default-proxies-alist' + ;; shouldn't show hops. + (setq tramp-default-proxies-alist + '(("^host2$" "^user2$" "/[method1/user1@host1]"))) + (should + (string-equal + (file-remote-p "/[method2/user2@host2]/path/to/file") + "/[method2/user2@host2]")) + (setq tramp-default-proxies-alist nil) + + ;; Ad-hoc settings. + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file") + (if tramp-show-ad-hoc-proxies + "/[method1/user1@host1|method2/user2@host2]" + "/[method2/user2@host2]"))) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'method) + "method2")) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'user) + "user2")) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'host) + "host2")) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + "/[method1/user1@host1|method2/user2@host2]/path/to/file" 'hop) + (format "%s/%s@%s|" + "method1" "user1" "host1"))) + + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]") + "/[method3/user3@host3]"))) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'method) + "method3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'user) + "user3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'host) + "host3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'localname) + "/path/to/file")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]/path/to/file") + 'hop) + (format "%s/%s@%s|%s/%s@%s|" + "method1" "user1" "host1" "method2" "user2" "host2"))) + + ;; Expand `tramp-default-method-alist'. + (add-to-list + 'tramp-default-method-alist '("host1" "user1" "method1")) + (add-to-list + 'tramp-default-method-alist '("host2" "user2" "method2")) + (add-to-list + 'tramp-default-method-alist '("host3" "user3" "method3")) + (should + (string-equal + (file-remote-p + (concat + "/[/user1@host1" + "|/user2@host2" + "|/user3@host3]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]") + "/[method3/user3@host3]"))) + + ;; Expand `tramp-default-user-alist'. + (add-to-list 'tramp-default-user-alist '("method1" "host1" "user1")) + (add-to-list 'tramp-default-user-alist '("method2" "host2" "user2")) + (add-to-list 'tramp-default-user-alist '("method3" "host3" "user3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/host1" + "|method2/host2" + "|method3/host3]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]") + "/[method3/user3@host3]"))) + + ;; Expand `tramp-default-host-alist'. + (add-to-list 'tramp-default-host-alist '("method1" "user1" "host1")) + (add-to-list 'tramp-default-host-alist '("method2" "user2" "host2")) + (add-to-list 'tramp-default-host-alist '("method3" "user3" "host3")) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@" + "|method2/user2@" + "|method3/user3@]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host2" + "|method3/user3@host3]") + "/[method3/user3@host3]"))) + + ;; Ad-hoc user name and host name expansion. + (setq tramp-default-method-alist nil + tramp-default-user-alist nil + tramp-default-host-alist nil) + (should + (string-equal + (file-remote-p + (concat + "/[method1/user1@host1" + "|method2/user2@" + "|method3/user3@]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user1@host1" + "|method2/user2@host1" + "|method3/user3@host1]") + "/[method3/user3@host1]"))) + (should + (string-equal + (file-remote-p + (concat + "/[method1/%u@%h" + "|method2/user2@host2" + "|method3/%u@%h" + "|method4/user4%domain4@host4#1234]/path/to/file")) + (if tramp-show-ad-hoc-proxies + (concat + "/[method1/user2@host2" + "|method2/user2@host2" + "|method3/user4@host4" + "|method4/user4%domain4@host4#1234]") + "/[method4/user4%domain4@host4#1234]"))))) ;; Exit. (tramp-change-syntax syntax)))) @@ -2522,7 +2666,7 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Do not overwrite if excluded. (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always) ;; Ange-FTP. - ((symbol-function 'yes-or-no-p) #'tramp--test-always)) + ((symbol-function #'yes-or-no-p) #'tramp--test-always)) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) (should-error (cl-letf (((symbol-function #'y-or-n-p) #'ignore) @@ -4166,6 +4310,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-symlink-p tmp-name1)) (should-not (file-regular-p tmp-name1)) (should-not (file-regular-p tmp-name2)) + (should + (string-equal + (file-truename tmp-name1) + (file-truename tmp-name2))) (if (tramp--test-smb-p) ;; The symlink command of "smbclient" detects the ;; cycle already. @@ -4173,10 +4321,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (make-symbolic-link tmp-name1 tmp-name2) :type 'file-error) (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name1)) (should (file-symlink-p tmp-name2)) + (should-not (file-regular-p tmp-name1)) (should-not (file-regular-p tmp-name2)) (should-error (file-truename tmp-name1) + :type 'file-error) + (should-error + (file-truename tmp-name2) :type 'file-error)))) ;; Cleanup. @@ -4511,42 +4664,40 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (let ((tramp-fuse-remove-hidden-files t) (method (file-remote-p ert-remote-temporary-file-directory 'method)) (host (file-remote-p ert-remote-temporary-file-directory 'host)) - (orig-syntax tramp-syntax)) + (orig-syntax tramp-syntax) + (minibuffer-completing-file-name t)) (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) (setq host (match-string 1 host))) (unwind-protect - (dolist - (syntax - (if (tramp--test-expensive-test-p) - (tramp-syntax-values) `(,orig-syntax))) + (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. (tramp-set-connection-property tramp-test-vec "property" nil) - (let ;; This is needed for the `separate' syntax. - ((prefix-format (substring tramp-prefix-format 1)) - ;; This is needed for the IPv6 host name syntax. - (ipv6-prefix - (and (string-match-p tramp-ipv6-regexp host) - tramp-prefix-ipv6-format)) - (ipv6-postfix - (and (string-match-p tramp-ipv6-regexp host) - tramp-postfix-ipv6-format))) + (let (;; This is needed for the `separate' syntax. + (prefix-format (substring tramp-prefix-format 1)) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format))) ;; Complete method name. - (unless (or (zerop (length method)) - (zerop (length tramp-method-regexp))) + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp)) (should (member (concat prefix-format method tramp-postfix-method-format) (file-name-all-completions (concat prefix-format (substring method 0 1)) "/")))) ;; Complete host name. - (unless (or (zerop (length method)) - (zerop (length tramp-method-regexp)) - (zerop (length host)) - (tramp--test-gvfs-p method)) + (unless (or (tramp-string-empty-or-nil-p method) + (string-empty-p tramp-method-regexp) + (tramp-string-empty-or-nil-p host)) (should (member (concat @@ -4579,6 +4730,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (equal (file-name-completion "foo" tmp-name) t)) (should (equal (file-name-completion "b" tmp-name) "bo")) (should-not (file-name-completion "a" tmp-name)) + ;; `file-name-completion' should not err out if + ;; directory does not exist. (Bug#61890) + ;; Ange-FTP does not support this. + (unless (tramp--test-ange-ftp-p) + (should-not + (file-name-completion + "a" (tramp-compat-file-name-concat tmp-name "fuzz")))) ;; Ange-FTP does not support predicates. (unless (tramp--test-ange-ftp-p) (should @@ -4624,6 +4782,190 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-directory tmp-name 'recursive))))))) +(tramp--test-deftest-with-perl tramp-test26-file-name-completion) + +(tramp--test-deftest-with-ls tramp-test26-file-name-completion) + +;; This test is inspired by Bug#51386, Bug#52758, Bug#53513, Bug#54042 +;; and Bug#60505. +(ert-deftest tramp-test26-interactive-file-name-completion () + "Check interactive completion with different `completion-styles'." + ;; Method, user and host name in completion mode. This kind of + ;; completion does not work on MS Windows. + (skip-unless (not (memq system-type '(cygwin windows-nt)))) + (tramp-cleanup-connection tramp-test-vec nil 'keep-password) + + (let ((method (file-remote-p ert-remote-temporary-file-directory 'method)) + (user (file-remote-p ert-remote-temporary-file-directory 'user)) + (host (file-remote-p ert-remote-temporary-file-directory 'host)) + (hop (file-remote-p ert-remote-temporary-file-directory 'hop)) + (orig-syntax tramp-syntax) + (non-essential t) + (inhibit-message t)) + (when (and (stringp host) (string-match tramp-host-with-port-regexp host)) + (setq host (match-string 1 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. + (tramp-set-connection-property tramp-test-vec "property" nil) + + (dolist + (style + (if (tramp--test-expensive-test-p) + ;; It doesn't work for `initials' and `shorthand' + ;; completion styles. Should it? + '(emacs21 emacs22 basic partial-completion substring flex) + '(basic))) + + (when (assoc style completion-styles-alist) + (let* (;; Force the real minibuffer in batch mode. + (executing-kbd-macro noninteractive) + (completion-styles `(,style)) + completion-category-defaults + completion-category-overrides + ;; This is needed for the `simplified' syntax, + (tramp-default-method method) + (method-string + (unless (string-empty-p tramp-method-regexp) + (concat method tramp-postfix-method-format))) + (user-string + (unless (tramp-string-empty-or-nil-p user) + (concat user tramp-postfix-user-format))) + ;; This is needed for the IPv6 host name syntax. + (ipv6-prefix + (and (string-match-p tramp-ipv6-regexp host) + tramp-prefix-ipv6-format)) + (ipv6-postfix + (and (string-match-p tramp-ipv6-regexp host) + tramp-postfix-ipv6-format)) + (host-string + (unless (tramp-string-empty-or-nil-p host) + (concat + ipv6-prefix host + ipv6-postfix tramp-postfix-host-format))) + ;; The hop string fits only the initial syntax. + (hop (and (eq tramp-syntax orig-syntax) hop)) + test result completions) + + (dolist + (test-and-result + ;; These are triples of strings (TEST-STRING + ;; RESULT-CHECK COMPLETION-CHECK). RESULT-CHECK + ;; could be not unique, in this case it is a list + ;; (RESULT1 RESULT2 ...). + (append + ;; Complete method name. + (unless (string-empty-p tramp-method-regexp) + `((,(concat + tramp-prefix-format hop + (substring-no-properties + method 0 (min 2 (length method)))) + ,(concat tramp-prefix-format hop method-string) + ,method-string))) + ;; Complete user name. + (unless (tramp-string-empty-or-nil-p user) + `((,(concat + tramp-prefix-format hop method-string + (substring-no-properties + user 0 (min 2 (length user)))) + ,(concat + tramp-prefix-format hop method-string user-string) + ,user-string))) + ;; Complete host name. + (unless (tramp-string-empty-or-nil-p host) + `((,(concat + tramp-prefix-format hop method-string + ipv6-prefix + (substring-no-properties + host 0 (min 2 (length host)))) + (,(concat + tramp-prefix-format hop method-string host-string) + ,(concat + tramp-prefix-format hop method-string + user-string host-string)) + ,host-string))) + ;; Complete user and host name. + (unless (or (tramp-string-empty-or-nil-p user) + (tramp-string-empty-or-nil-p host)) + `((,(concat + tramp-prefix-format hop method-string user-string + ipv6-prefix + (substring-no-properties + host 0 (min 2 (length host)))) + ,(concat + tramp-prefix-format hop method-string + 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) + (tramp-compat-rx + (| (regexp tramp-postfix-user-regexp) + (regexp tramp-postfix-host-regexp)) + eos) + (tramp-compat-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) + (if (stringp (cadr test-and-result)) + (should + (string-prefix-p (cadr test-and-result) result)) + (should + (let (res) + (dolist (elem (cadr test-and-result) res) + (setq + res (or res (string-prefix-p elem result)))))))) + + (with-current-buffer "*Completions*" + ;; We must remove leading `default-directory'. + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (while (re-search-forward "//" nil 'noerror) + (delete-region (line-beginning-position) (point)))) + (goto-char (point-min)) + (re-search-forward + (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)))))))) + + ;; Cleanup. + ;; (tramp--test-message "%s" (tramp-get-buffer-string trace-buffer)) + ;; (untrace-function #'tramp-completion-file-name-handler) + ;; (untrace-function #'completion-file-name-table) + (tramp-change-syntax orig-syntax)))) + (ert-deftest tramp-test27-load () "Check `load'." (skip-unless (tramp--test-enabled)) @@ -4715,8 +5057,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (if (bufferp destination) destination (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while (re-search-forward - tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal (if destination (format "%s\n" fnnd) "") @@ -4730,8 +5071,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (if (bufferp destination) destination (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while (re-search-forward - tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal @@ -4871,8 +5211,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Disabled process filter. "sshfs" does not cooperate. - (unless (tramp--test-sshfs-p) + ;; Disabled process filter. It doesn't work reliable. + (unless t (unwind-protect (with-temp-buffer (setq command '("cat") @@ -4914,23 +5254,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) + ;; Give the pipe process a chance to start. + (when (memq process-connection-type '(nil pipe)) + (sit-for 0.1 'nodisp)) (process-send-string proc "foo\r\n") (process-send-eof proc) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (< (- (point-max) (point-min)) - (length "66\n6F\n6F\n0D\n0A\n")) - (while (accept-process-output proc 0 nil t)))) - (should - (string-match-p - (if (and (memq process-connection-type '(nil pipe)) - (not (tramp--test-macos-p))) - ;; On macOS, there is always newline conversion. - ;; "telnet" converts \r to if `crlf' - ;; flag is FALSE. See telnet(1) man page. - (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") - (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) - (buffer-string)))) + ;; Read output. On macOS, there is always newline + ;; conversion. "telnet" converts \r to if + ;; `crlf' flag is FALSE. See telnet(1) man page. + (let ((expected + (rx "66\n" "6F\n" "6F\n" + (| "0D\n" "0A\n") (? "00\n") "0A\n"))) + (with-timeout (10 (tramp--test-timeout-handler)) + (while (not (string-match-p expected (buffer-string))) + (while (accept-process-output proc 0 nil t)))) + (should (string-match-p expected (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc))))) @@ -5078,8 +5416,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Disabled process filter. "sshfs" does not cooperate. - (unless (tramp--test-sshfs-p) + ;; Disabled process filter. It doesn't work reliable. + (unless t (unwind-protect (with-temp-buffer (setq command '("cat") @@ -5209,7 +5547,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; `process-connection-type' is taken when ;; `:connection-type' is nil. (dolist (process-connection-type - (unless connection-type '(nil pipe t pty))) + (if connection-type '(nil pipe t pty) '(nil))) (unwind-protect (with-temp-buffer (setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"") @@ -5226,24 +5564,22 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (should (processp proc)) (should (equal (process-status proc) 'run)) (should (equal (process-get proc 'remote-command) command)) + ;; Give the pipe process a chance to start. + (when (or (eq connection-type 'pipe) + (memq process-connection-type '(nil pipe))) + (sit-for 0.1 'nodisp)) (process-send-string proc "foo\r\n") (process-send-eof proc) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (< (- (point-max) (point-min)) - (length "66\n6F\n6F\n0D\n0A\n")) - (while (accept-process-output proc 0 nil t)))) - (should - (string-match-p - (if (and (memq (or connection-type process-connection-type) - '(nil pipe)) - (not (tramp--test-macos-p))) - ;; On macOS, there is always newline conversion. - ;; "telnet" converts \r to if `crlf' - ;; flag is FALSE. See telnet(1) man page. - (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n") - (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n")) - (buffer-string)))) + ;; Read output. On macOS, there is always newline + ;; conversion. "telnet" converts \r to if + ;; `crlf' flag is FALSE. See telnet(1) man page. + (let ((expected + (rx "66\n" "6F\n" "6F\n" + (| "0D\n" "0A\n") (? "00\n") "0A\n"))) + (with-timeout (10 (tramp--test-timeout-handler)) + (while (not (string-match-p expected (buffer-string))) + (while (accept-process-output proc 0 nil t)))) + (should (string-match-p expected (buffer-string))))) ;; Cleanup. (ignore-errors (delete-process proc))))))))) @@ -5419,7 +5755,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (when-let ((default-directory ert-remote-temporary-file-directory) (mi (memory-info))) (should (consp mi)) - (should (= (length mi) 4)) + (should (tramp-compat-length= mi 4)) (dotimes (i (length mi)) (should (natnump (nth i mi)))))) @@ -5485,8 +5821,7 @@ INPUT, if non-nil, is a string sent to the process." (current-buffer)) ;; "ls" could produce colorized output. (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) + (while (re-search-forward ansi-color-control-seq-regexp nil t) (replace-match "" nil nil)) (should (string-equal @@ -5741,7 +6076,9 @@ INPUT, if non-nil, is a string sent to the process." ;; Unset the variable. (let ((tramp-remote-process-environment (cons (concat envvar "=foo") tramp-remote-process-environment))) - ;; Set the initial value, we want to unset below. + ;; Refill the cache; we don't want to run into timeouts. + (file-truename default-directory) + ;; Check the initial value, we want to unset below. (should (string-match-p "foo" @@ -6008,7 +6345,8 @@ INPUT, if non-nil, is a string sent to the process." ;; We make a super long `tramp-remote-path'. (make-directory tmp-name) (should (file-directory-p tmp-name)) - (while (< (length (mapconcat #'identity orig-exec-path ":")) 5000) + (while (tramp-compat-length< + (mapconcat #'identity orig-exec-path ":") 5000) (let ((dir (make-temp-file (file-name-as-directory tmp-name) 'dir))) (should (file-directory-p dir)) (setq tramp-remote-path @@ -6024,9 +6362,10 @@ INPUT, if non-nil, is a string sent to the process." ;; Ignore trailing newline. (setq path (substring (shell-command-to-string "echo $PATH") nil -1)) ;; The shell doesn't handle such long strings. - (when (<= (length path) - (tramp-get-connection-property - tramp-test-vec "pipe-buf" 4096)) + (unless (tramp-compat-length> + path + (tramp-get-connection-property + tramp-test-vec "pipe-buf" 4096)) ;; The last element of `exec-path' is `exec-directory'. (should (string-equal @@ -6260,7 +6599,10 @@ INPUT, if non-nil, is a string sent to the process." (if quoted #'tramp-compat-file-name-quote #'identity) (expand-file-name (format "%s~" (file-name-nondirectory tmp-name1)) - ert-remote-temporary-file-directory))))))) + ert-remote-temporary-file-directory)))))) + + ;; Cleanup. Nothing to do yet. + nil) (unwind-protect ;; Map `backup-directory-alist'. @@ -6540,8 +6882,9 @@ INPUT, if non-nil, is a string sent to the process." (insert "foo") ;; Bug#53207: with `create-lockfiles' nil, saving the ;; buffer results in a prompt. - (cl-letf (((symbol-function 'yes-or-no-p) - (lambda (_) (ert-fail "Test failed unexpectedly")))) + (cl-letf (((symbol-function #'read-from-minibuffer) + (lambda (&rest _) + (ert-fail "Test failed unexpectedly")))) (should (buffer-modified-p)) (save-buffer) (should-not (buffer-modified-p))) @@ -6559,7 +6902,7 @@ INPUT, if non-nil, is a string sent to the process." ;; modification time properly, for them it doesn't ;; make sense to test. (when (not (verify-visited-file-modtime)) - (cl-letf (((symbol-function 'read-char-choice) + (cl-letf (((symbol-function #'read-char-choice) (lambda (prompt &rest _) (message "%s" prompt) ?y))) (ert-with-message-capture captured-messages (insert "bar") @@ -6575,8 +6918,8 @@ INPUT, if non-nil, is a string sent to the process." (should (file-locked-p tmp-name))))) ;; `save-buffer' removes the file lock. - (cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always) - ((symbol-function 'read-char-choice) + (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always) + ((symbol-function #'read-char-choice) (lambda (&rest _) ?y))) (should (buffer-modified-p)) (save-buffer) @@ -7152,6 +7495,9 @@ This requires restrictions of file name syntax." ;; Use all available language specific snippets. (lambda (x) (and + ;; The "Oriya" and "Odia" languages use some problematic + ;; composition characters. + (not (member (car x) '("Oriya" "Odia"))) (stringp (setq x (eval (get-language-info (car x) 'sample-text) t))) ;; Filter out strings which use unencodable characters. (not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p)) @@ -7186,7 +7532,7 @@ This requires restrictions of file name syntax." (when-let ((fsi (with-no-warnings (file-system-info ert-remote-temporary-file-directory)))) (should (consp fsi)) - (should (= (length fsi) 3)) + (should (tramp-compat-length= fsi 3)) (dotimes (i (length fsi)) (should (natnump (or (nth i fsi) 0)))))) @@ -7234,10 +7580,7 @@ This is needed in timer functions as well as process filters and sentinels." "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." - :tags (append '(:expensive-test :tramp-asynchronous-processes) - (and (or (getenv "EMACS_HYDRA_CI") - (getenv "EMACS_EMBA_CI")) - '(:unstable))) + :tags '(:expensive-test :tramp-asynchronous-processes :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-supports-processes-p)) ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for @@ -7372,34 +7715,37 @@ process sentinels. They shall not disturb each other." ;; Send a string to the processes. Use a random order of ;; the buffers. Mix with regular operation. - (let ((buffers (copy-sequence buffers))) + (let ((buffers (copy-sequence buffers)) + buf) (while buffers - (let* ((buf (seq-random-elt buffers)) - (proc (get-buffer-process buf)) - (file (process-get proc 'foo)) - (count (process-get proc 'bar))) - (tramp--test-message - "Start action %d %s %s" count buf (current-time-string)) - ;; Regular operation prior process action. - (dired-uncache file) - (if (= count 0) - (should-not (file-attributes file)) - (should (file-attributes file))) - ;; Send string to process. - (process-send-string proc (format "%s\n" (buffer-name buf))) - (while (accept-process-output nil 0)) - (tramp--test-message - "Continue action %d %s %s" count buf (current-time-string)) - ;; Regular operation post process action. - (dired-uncache file) - (if (= count 2) - (should-not (file-attributes file)) - (should (file-attributes file))) - (tramp--test-message - "Stop action %d %s %s" count buf (current-time-string)) - (process-put proc 'bar (1+ count)) - (unless (process-live-p proc) - (setq buffers (delq buf buffers)))))) + (setq buf (seq-random-elt buffers)) + (if-let ((proc (get-buffer-process buf)) + (file (process-get proc 'foo)) + (count (process-get proc 'bar))) + (progn + (tramp--test-message + "Start action %d %s %s" count buf (current-time-string)) + ;; Regular operation prior process action. + (dired-uncache file) + (if (= count 0) + (should-not (file-attributes file)) + (should (file-attributes file))) + ;; Send string to process. + (process-send-string proc (format "%s\n" (buffer-name buf))) + (while (accept-process-output nil 0)) + (tramp--test-message + "Continue action %d %s %s" count buf (current-time-string)) + ;; Regular operation post process action. + (dired-uncache file) + (if (= count 2) + (should-not (file-attributes file)) + (should (file-attributes file))) + (tramp--test-message + "Stop action %d %s %s" count buf (current-time-string)) + (process-put proc 'bar (1+ count)) + (unless (process-live-p proc) + (setq buffers (delq buf buffers)))) + (setq buffers (delq buf buffers))))) ;; Checks. All process output shall exists in the ;; respective buffers. All created files shall be @@ -7549,7 +7895,7 @@ process sentinels. They shall not disturb each other." ert-remote-temporary-file-directory))) (should (string-match-p - (rx "Tramp loaded: t" (+ (any "\n\r"))) + (rx "Tramp loaded: t" (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7577,9 +7923,9 @@ process sentinels. They shall not disturb each other." (should (string-match-p (tramp-compat-rx - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: nil" (+ (any "\n\r")) - "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\n\r"))) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: nil" (+ (any "\r\n")) + "Tramp loaded: " (literal (symbol-name tm)) (+ (any "\r\n"))) (shell-command-to-string (format "%s -batch -Q -L %s --eval %s" @@ -7670,6 +8016,7 @@ Since it unloads Tramp, it shall be the last test to run." (and (functionp x) (null (autoloadp (symbol-function x)))) (macrop x)) (string-prefix-p "tramp" (symbol-name x)) + (string-match-p (rx bol "with" (| "tramp" "parsed")) (symbol-name x)) ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. (not (eq 'tramp-completion-mode x)) ;; `tramp-register-archive-file-name-handler' is autoloaded @@ -7744,6 +8091,9 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". +;; * Check, why a process filter t doesn't work in +;; `tramp-test29-start-file-process' and +;; `tramp-test30-make-process'. ;; * Implement `tramp-test31-interrupt-process' and ;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct ;; async processes. Check, why they don't run stable. -- 2.39.2