procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Sync with Tramp 2.6.2-pre

Browse source 
* 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 <rcopley@gmail.com>.
(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.
This commit is contained in:
Michael Albinus 2023-08-05 18:07:58 +02:00
parent f2b2c752a5
commit 2695af297e
19 changed files with 1861 additions and 1240 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
doc/misc/tramp.texi
View file

@ -289,9 +289,11 @@ accumulated in the buffer, then decodes that output to produce the
file's contents. file's contents.
For external transfers, @value{tramp} sends a command as follows: For external transfers, @value{tramp} sends a command as follows:
@example @example
$ rcp user@@host:/path/to/remote/file /tmp/tramp.4711 $ scp user@@host:/path/to/remote/file /tmp/tramp.4711
@end example @end example
@value{tramp} reads the local temporary file @file{/tmp/tramp.4711} @value{tramp} reads the local temporary file @file{/tmp/tramp.4711}
into a buffer, and then deletes the temporary file. into a buffer, and then deletes the temporary file.
@ -361,7 +363,7 @@ Another way is to follow the terminal session below:
@example @example
@group @group
$ cd ~/emacs $ cd ~/emacs
$ git clone git://git.savannah.gnu.org/tramp.git $ git clone https://git.savannah.gnu.org/git/tramp.git
@end group @end group
@end example @end example
@ -2721,6 +2723,7 @@ entry, @option{Seconds between keepalives} option. Set this to 5.
There is no counter which could be set. There is no counter which could be set.
@anchor{Using ssh connection sharing}
@subsection Using ssh connection sharing @subsection Using ssh connection sharing
@vindex ControlPath@r{, ssh option} @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}. @samp{%%r}, @samp{%%h} and @samp{%%p}.
@vindex tramp-use-ssh-controlmaster-options @vindex tramp-use-ssh-controlmaster-options
If the @file{~/.ssh/config} file is configured appropriately for the Using a predefined string in @code{tramp-ssh-controlmaster-options},
above behavior, then any changes to @command{ssh} can be suppressed or puzzling an own string, happens only when user option
with this @code{nil} setting: @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 @lisp
(customize-set-variable 'tramp-use-ssh-controlmaster-options nil) (customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp @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 ProxyCommand@r{, ssh option}
@vindex ProxyJump@r{, ssh option} @vindex ProxyJump@r{, ssh option}
This should also be set to @code{nil} if you use the @code{tramp-use-ssh-controlmaster-options} should also be set to
@option{ProxyCommand} or @option{ProxyJump} options in your @code{nil} or @code{suppress} if you use the @option{ProxyCommand} or
@command{ssh} configuration. @option{ProxyJump} options in your @command{ssh} configuration.
In order to use the @option{ControlMaster} option, @value{tramp} must In order to use the @option{ControlMaster} option, @value{tramp} must
check whether the @command{ssh} client supports this option. This is 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 @value{tramp} can complete the following @value{tramp} file name
components: method names, user names, host names, and file names components: method names, user names, host names, and file names
located on remote hosts. User name and host name completion is located on remote hosts.
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
For example, type @kbd{C-x C-f @value{prefixwithspace} s @key{TAB}}, For example, type @kbd{C-x C-f @value{prefixwithspace} s @key{TAB}},
@value{tramp} completion choices show up as @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 Type @kbd{s h @value{postfixhop}} for the minibuffer completion to
@samp{@value{prefix}ssh@value{postfixhop}}. Typing @kbd{@key{TAB}} @samp{@value{prefix}ssh@value{postfixhop}}. Typing @kbd{@key{TAB}}
shows host names @value{tramp} extracts from @file{~/.ssh/config} shows host names @value{tramp} extracts from @file{~/.ssh/config}
@c bug#50387 file, for example:
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}}.}.
@example @example
@group @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 @code{tramp-default-proxies-alist} and is available for re-use during
that Emacs session. Subsequent @value{tramp} connections to the same that Emacs session. Subsequent @value{tramp} connections to the same
remote host can then use the shortcut form: remote host can then use the shortcut form:
@samp{@trampfn{ssh,you@@remotehost,/path}}. Ad-hoc definitions are @samp{@trampfn{ssh,you@@remotehost,/path}}.
removed from @code{tramp-default-proxies-alist} via the command
@kbd{M-x tramp-cleanup-all-connections @key{RET}} (@pxref{Cleanup @defopt tramp-show-ad-hoc-proxies
remote connections}). 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 @defopt tramp-save-ad-hoc-proxies
For ad-hoc definitions to be saved automatically in 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{start-file-process}. Furthermore, you might set
@code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to @code{tramp-use-ssh-controlmaster-options} to @code{nil} in order to
bypass @value{tramp}'s handling of the @option{ControlMaster} options, 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 @node Cleanup remote connections

2
doc/misc/trampver.texi
View file

@ -7,7 +7,7 @@
@c In the Tramp GIT, the version number and the bug report address @c In the Tramp GIT, the version number and the bug report address
@c are auto-frobbed from configure.ac. @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 trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org @set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 26.1 @set emacsver 26.1

95
lisp/net/tramp-adb.el
View file

@ -55,7 +55,7 @@ It is used for TCP/IP devices."
(defconst tramp-adb-method "adb" (defconst tramp-adb-method "adb"
"When this method name is used, forward all calls to Android Debug Bridge.") "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." "Regexp used as prompt in almquist shell."
:type 'regexp :type 'regexp
:version "28.1" :version "28.1"
@ -449,31 +449,32 @@ Emacs dired can't find files."
(defun tramp-adb-handle-file-name-all-completions (filename directory) (defun tramp-adb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(all-completions (tramp-compat-ignore-error file-missing
filename (all-completions
(with-parsed-tramp-file-name (expand-file-name directory) nil filename
(with-tramp-file-property v localname "file-name-all-completions" (with-parsed-tramp-file-name (expand-file-name directory) nil
(tramp-adb-send-command (with-tramp-file-property v localname "file-name-all-completions"
v (format "%s -a %s | cat" (tramp-adb-send-command
(tramp-adb-get-ls-command v) v (format "%s -a %s | cat"
(tramp-shell-quote-argument localname))) (tramp-adb-get-ls-command v)
(mapcar (tramp-shell-quote-argument localname)))
(lambda (f) (mapcar
(if (file-directory-p (expand-file-name f directory)) (lambda (f)
(file-name-as-directory f) (if (file-directory-p (expand-file-name f directory))
f)) (file-name-as-directory f)
(with-current-buffer (tramp-get-buffer v) f))
(delete-dups (with-current-buffer (tramp-get-buffer v)
(append (delete-dups
;; On some file systems like "sdcard", "." and ".." are (append
;; not included. We fix this by `delete-dups'. ;; On some file systems like "sdcard", "." and ".." are
'("." "..") ;; not included. We fix this by `delete-dups'.
(delq '("." "..")
nil (delq
(mapcar nil
(lambda (l) (mapcar
(and (not (string-match-p (rx bol (* blank) eol) l)) l)) (lambda (l)
(split-string (buffer-string) "\n"))))))))))) (and (not (string-match-p (rx bol (* blank) eol) l)) l))
(split-string (buffer-string) "\n"))))))))))))
(defun tramp-adb-handle-file-local-copy (filename) (defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files." "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) (defun tramp-adb-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files." "Like `file-exists-p' for Tramp files."
;; `file-exists-p' is used as predicate in file name completion. (tramp-skeleton-file-exists-p filename
;; We don't want to run it when `non-essential' is t, or there is (tramp-adb-send-command-and-check
;; no connection process yet. v (format "test -e %s" (tramp-shell-quote-argument localname)))))
(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))))))))
(defun tramp-adb-handle-file-readable-p (filename) (defun tramp-adb-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files." "Like `file-readable-p' for Tramp files."
@ -1023,7 +1017,7 @@ implementation will be used."
(progn (progn
(goto-char (point-min)) (goto-char (point-min))
(not (search-forward "\n" nil t))) (not (search-forward "\n" nil t)))
(tramp-accept-process-output p 0)) (tramp-accept-process-output p))
(delete-region (point-min) (point))) (delete-region (point-min) (point)))
;; Provide error buffer. This shows only ;; Provide error buffer. This shows only
;; initial error messages; messages ;; initial error messages; messages
@ -1032,17 +1026,19 @@ implementation will be used."
;; file will exist until the process is ;; file will exist until the process is
;; deleted. ;; deleted.
(when (bufferp stderr) (when (bufferp stderr)
(with-current-buffer stderr (ignore-errors
(insert-file-contents-literally (with-current-buffer stderr
remote-tmpstderr 'visit)) (insert-file-contents-literally
remote-tmpstderr 'visit)))
;; Delete tmpstderr file. ;; Delete tmpstderr file.
(add-function (add-function
:after (process-sentinel p) :after (process-sentinel p)
(lambda (_proc _msg) (lambda (_proc _msg)
(with-current-buffer stderr (ignore-errors
(insert-file-contents-literally (with-current-buffer stderr
remote-tmpstderr 'visit nil nil 'replace)) (insert-file-contents-literally
(delete-file remote-tmpstderr)))) remote-tmpstderr 'visit nil nil 'replace))
(delete-file remote-tmpstderr)))))
;; Return process. ;; Return process.
p)))) 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)) (format "%s:%s" host port))
;; An empty host name shall be mapped as well, when there ;; An empty host name shall be mapped as well, when there
;; is exactly one entry in `devices'. ;; 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)) (car devices))
;; Try to connect device. ;; Try to connect device.
((and tramp-adb-connect-if-not-connected ((and tramp-adb-connect-if-not-connected
(not (zerop (length host))) (tramp-compat-length> host 0)
(tramp-adb-execute-adb-command (tramp-adb-execute-adb-command
vec "connect" vec "connect"
(tramp-compat-string-replace (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. "Execute an adb command.
Insert the result into the connection buffer. Return nil on Insert the result into the connection buffer. Return nil on
error and non-nil on success." 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. ;; The -s switch is only available for ADB device commands.
(not (member (car args) '("connect" "disconnect")))) (not (member (car args) '("connect" "disconnect"))))
(setq args (append (list "-s" (tramp-adb-get-device vec)) args))) (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) (unless (process-live-p p)
(save-match-data (save-match-data
(when (and p (processp p)) (delete-process p)) (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)) (tramp-error vec 'file-error "Device %s not connected" host))
(with-tramp-progress-reporter vec 3 "Opening adb shell connection" (with-tramp-progress-reporter vec 3 "Opening adb shell connection"
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct? (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 sentinel and query flag. Initialize variables.
(set-process-sentinel p #'tramp-process-sentinel) (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) (process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)

37
lisp/net/tramp-archive.el
View file

@ -631,7 +631,7 @@ offered."
(defun tramp-archive-handle-directory-file-name (directory) (defun tramp-archive-handle-directory-file-name (directory)
"Like `directory-file-name' for file archives." "Like `directory-file-name' for file archives."
(with-parsed-tramp-archive-file-name directory nil (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))) ?/) (eq (aref localname (1- (length localname))) ?/)
(not (string= localname "/"))) (not (string= localname "/")))
(substring directory 0 -1) (substring directory 0 -1)
@ -643,23 +643,22 @@ offered."
(defun tramp-archive-handle-directory-files (defun tramp-archive-handle-directory-files
(directory &optional full match nosort count) (directory &optional full match nosort count)
"Like `directory-files' for Tramp files." "Like `directory-files' for Tramp files."
(unless (file-exists-p directory) (tramp-barf-if-file-missing (tramp-dissect-file-name directory) directory
(tramp-error (tramp-dissect-file-name directory) 'file-missing directory)) (when (file-directory-p directory)
(when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory)))
(setq directory (file-name-as-directory (expand-file-name directory))) (let ((temp (nreverse (file-name-all-completions "" directory)))
(let ((temp (nreverse (file-name-all-completions "" directory))) result item)
result item)
(while temp (while temp
(setq item (directory-file-name (pop temp))) (setq item (directory-file-name (pop temp)))
(when (or (null match) (string-match-p match item)) (when (or (null match) (string-match-p match item))
(push (if full (concat directory item) item) (push (if full (concat directory item) item)
result))) result)))
(unless nosort (unless nosort
(setq result (sort result #'string<))) (setq result (sort result #'string<)))
(when (and (natnump count) (> count 0)) (when (and (natnump count) (> count 0))
(setq result (tramp-compat-ntake count result))) (setq result (tramp-compat-ntake count result)))
result))) result))))
(defun tramp-archive-handle-dired-uncache (dir) (defun tramp-archive-handle-dired-uncache (dir)
"Like `dired-uncache' for file archives." "Like `dired-uncache' for file archives."
@ -683,7 +682,9 @@ offered."
(defun tramp-archive-handle-file-name-all-completions (filename directory) (defun tramp-archive-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for file archives." "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) (defun tramp-archive-handle-file-readable-p (filename)
"Like `file-readable-p' for file archives." "Like `file-readable-p' for file archives."

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

@ -123,11 +123,11 @@ When called interactively, a Tramp connection has to be selected."
;; Delete processes. ;; Delete processes.
(dolist (key (hash-table-keys tramp-cache-data)) (dolist (key (hash-table-keys tramp-cache-data))
(when (and (processp key) (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) (or (not keep-processes)
(eq key (tramp-get-process vec)))) (eq key (tramp-get-process vec))))
(tramp-flush-connection-properties key) (tramp-flush-connection-properties key)
(delete-process key))) (ignore-errors (delete-process key))))
;; Remove buffers. ;; Remove buffers.
(dolist (dolist
@ -319,7 +319,7 @@ The remote connection identified by SOURCE is flushed by
(read-file-name-function #'read-file-name-default) (read-file-name-function #'read-file-name-default)
source target) source target)
(if (null connections) (if (null connections)
(tramp-user-error nil "There are no remote connections.") (tramp-user-error nil "There are no remote connections")
(setq source (setq source
;; Likely, the source remote connection is broken. So we ;; Likely, the source remote connection is broken. So we
;; shall avoid any action on it. ;; shall avoid any action on it.
@ -367,15 +367,15 @@ The remote connection identified by SOURCE is flushed by
(list source target))) (list source target)))
(unless (tramp-tramp-file-p source) (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) (when (null target)
(or (setq target (tramp-default-rename-file source)) (or (setq target (tramp-default-rename-file source))
(tramp-user-error (tramp-user-error
nil nil
(concat "There is no target specified. " (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) (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. ;; Append local file name if none is specified.
(when (string-equal (file-remote-p target) target) (when (string-equal (file-remote-p target) target)
@ -461,7 +461,7 @@ For details, see `tramp-rename-files'."
nil nil
(substitute-command-keys (substitute-command-keys
(concat "Current buffer is not remote. " (concat "Current buffer is not remote. "
"Consider `\\[tramp-rename-files]' instead."))) "Consider `\\[tramp-rename-files]' instead")))
(setq target (setq target
(when (null current-prefix-arg) (when (null current-prefix-arg)
;; The source remote connection shall not trigger any action. ;; The source remote connection shall not trigger any action.

78
lisp/net/tramp-compat.el
View file

@ -29,19 +29,18 @@
;;; Code: ;;; Code:
(require 'ansi-color)
(require 'auth-source) (require 'auth-source)
(require 'format-spec) (require 'format-spec)
(require 'parse-time) (require 'parse-time)
(require 'shell) (require 'shell)
(require 'subr-x) (require 'subr-x)
(when (memq system-type '(ms-dos windows-nt))
(require 'ls-lisp))
(declare-function tramp-compat-rx "tramp") (declare-function tramp-compat-rx "tramp")
(declare-function tramp-error "tramp") (declare-function tramp-error "tramp")
(declare-function tramp-file-name-handler "tramp") (declare-function tramp-file-name-handler "tramp")
(declare-function tramp-tramp-file-p "tramp") (declare-function tramp-tramp-file-p "tramp")
(defvar tramp-syntax)
(defvar tramp-temp-name-prefix) (defvar tramp-temp-name-prefix)
(defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version) (defconst tramp-compat-emacs-compiled-version (eval-when-compile emacs-version)
@ -121,14 +120,14 @@ NAME is unquoted."
(localname (file-local-name name))) (localname (file-local-name name)))
(when (tramp-compat-file-name-quoted-p localname top) (when (tramp-compat-file-name-quoted-p localname top)
(setq (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))))) (concat (file-remote-p name) localname)))))
;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still ;; `tramp-syntax' has changed its meaning in Emacs 26.1. We still
;; support old settings. ;; support old settings.
(defsubst tramp-compat-tramp-syntax () (defsubst tramp-compat-tramp-syntax ()
"Return proper value of `tramp-syntax'." "Return proper value of `tramp-syntax'."
(defvar tramp-syntax)
(cond ((eq tramp-syntax 'ftp) 'default) (cond ((eq tramp-syntax 'ftp) 'default)
((eq tramp-syntax 'sep) 'separate) ((eq tramp-syntax 'sep) 'separate)
(t tramp-syntax))) (t tramp-syntax)))
@ -328,6 +327,48 @@ CONDITION can also be a list of error conditions."
(car components)) (car components))
(cdr 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. ;; `permission-denied' is introduced in Emacs 29.1.
(defconst tramp-permission-denied (defconst tramp-permission-denied
(if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error) (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error)
@ -355,7 +396,7 @@ CONDITION can also be a list of error conditions."
#'take #'take
(lambda (n list) (lambda (n list)
(when (and (natnump n) (> n 0)) (when (and (natnump n) (> n 0))
(if (>= n (length list)) (if (tramp-compat-length< list n)
list (butlast list (- (length list) n))))))) list (butlast list (- (length list) n)))))))
;; Function `ntake' is new in Emacs 29.1. ;; Function `ntake' is new in Emacs 29.1.
@ -364,7 +405,7 @@ CONDITION can also be a list of error conditions."
#'ntake #'ntake
(lambda (n list) (lambda (n list)
(when (and (natnump n) (> n 0)) (when (and (natnump n) (> n 0))
(if (>= n (length list)) (if (tramp-compat-length< list n)
list (nbutlast list (- (length list) n))))))) list (nbutlast list (- (length list) n)))))))
;; Function `string-equal-ignore-case' is new in Emacs 29.1. ;; 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") (autoload 'netrc-parse "netrc")
(netrc-parse file)))) (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)) (dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t)) (put (intern elt) 'tramp-suppress-trace t))

23
lisp/net/tramp-container.el
View file

@ -96,15 +96,16 @@
"Tramp method name to use to connect to Kubernetes containers.") "Tramp method name to use to connect to Kubernetes containers.")
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-docker--completion-function (&rest _args) (defun tramp-container--completion-function (program)
"List Docker-like containers available for connection. "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 This function is used by `tramp-set-completion-function', please
see its function help for a description of the format." see its function help for a description of the format."
(when-let ((default-directory tramp-compat-temporary-file-directory) (when-let ((default-directory tramp-compat-temporary-file-directory)
(raw-list (shell-command-to-string (raw-list (shell-command-to-string
(concat tramp-docker-program (concat program " ps --format '{{.ID}}\t{{.Names}}'")))
" ps --format '{{.ID}}\t{{.Names}}'")))
(lines (split-string raw-list "\n" 'omit)) (lines (split-string raw-list "\n" 'omit))
(names (mapcar (names (mapcar
(lambda (line) (lambda (line)
@ -114,7 +115,7 @@ see its function help for a description of the format."
line) line)
(or (match-string 2 line) (match-string 1 line)))) (or (match-string 2 line) (match-string 1 line))))
lines))) lines)))
(mapcar (lambda (m) (list nil m)) (delq nil names)))) (mapcar (lambda (name) (list nil name)) (delq nil names))))
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-kubernetes--completion-function (&rest _args) (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 " " get pods --no-headers "
"-o custom-columns=NAME:.metadata.name"))) "-o custom-columns=NAME:.metadata.name")))
(names (split-string raw-list "\n" 'omit))) (names (split-string raw-list "\n" 'omit)))
(mapcar (lambda (name) (mapcar (lambda (name) (list nil name)) names)))
(list nil name))
names)))
(defun tramp-kubernetes--current-context-data (vec) (defun tramp-kubernetes--current-context-data (vec)
"Return Kubernetes current context data as JSON string." "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 ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l")) (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c")))) (tramp-remote-shell-args ("-i" "-c"))))
(add-to-list 'tramp-methods (add-to-list 'tramp-methods
`(,tramp-podman-method `(,tramp-podman-method
(tramp-login-program ,tramp-podman-program) (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 ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l")) (tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c")))) (tramp-remote-shell-args ("-i" "-c"))))
(add-to-list 'tramp-methods (add-to-list 'tramp-methods
`(,tramp-kubernetes-method `(,tramp-kubernetes-method
(tramp-login-program ,tramp-kubernetes-program) (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-set-completion-function
tramp-docker-method tramp-docker-method
'((tramp-docker--completion-function ""))) `((tramp-container--completion-function
,(executable-find tramp-docker-program))))
(tramp-set-completion-function (tramp-set-completion-function
tramp-podman-method tramp-podman-method
'((tramp-docker--completion-function ""))) `((tramp-container--completion-function
,(executable-find tramp-podman-program))))
(tramp-set-completion-function (tramp-set-completion-function
tramp-kubernetes-method tramp-kubernetes-method

46
lisp/net/tramp-crypt.el
View file

@ -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-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p) (file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-crypt-handle-file-executable-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-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy) (file-local-copy . tramp-handle-file-local-copy)
(file-locked-p . tramp-crypt-handle-file-locked-p) (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) :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t))) :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-process-query-on-exit-flag p nil)))
;; The following operations must be performed without ;; The following operations must be performed without
@ -435,7 +435,7 @@ Otherwise, return NAME."
crypt-vec (if (eq op 'encrypt) "encode" "decode") crypt-vec (if (eq op 'encrypt) "encode" "decode")
tramp-compat-temporary-file-directory localname) tramp-compat-temporary-file-directory localname)
(tramp-error (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)) (if (eq op 'encrypt) "Encoding" "Decoding") name))
(with-current-buffer (tramp-get-connection-buffer crypt-vec) (with-current-buffer (tramp-get-connection-buffer crypt-vec)
(goto-char (point-min)) (goto-char (point-min))
@ -470,7 +470,7 @@ Raise an error if this fails."
(file-name-directory infile) (file-name-directory infile)
(concat "/" (file-name-nondirectory infile))) (concat "/" (file-name-nondirectory infile)))
(tramp-error (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)) (if (eq op 'encrypt) "Encrypting" "Decrypting") infile))
(with-current-buffer (tramp-get-connection-buffer crypt-vec) (with-current-buffer (tramp-get-connection-buffer crypt-vec)
(write-region nil nil outfile))))) (write-region nil nil outfile)))))
@ -494,11 +494,11 @@ directory. File names will be also encrypted."
;; (declare (completion tramp-crypt-command-completion-p)) ;; (declare (completion tramp-crypt-command-completion-p))
(interactive "DRemote directory name: ") (interactive "DRemote directory name: ")
(unless tramp-crypt-enabled (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)) (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) (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))) (setq name (file-name-as-directory (expand-file-name name)))
(unless (member name tramp-crypt-directories) (unless (member name tramp-crypt-directories)
(setq tramp-crypt-directories (cons 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)) ;; (declare (completion tramp-crypt-command-completion-p))
(interactive "DRemote directory name: ") (interactive "DRemote directory name: ")
(unless tramp-crypt-enabled (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))) (setq name (file-name-as-directory (expand-file-name name)))
(when (and (member name tramp-crypt-directories) (when (and (member name tramp-crypt-directories)
(delete (delete
@ -723,6 +723,11 @@ absolute file names."
(let (tramp-crypt-enabled) (let (tramp-crypt-enabled)
(file-executable-p (tramp-crypt-encrypt-file-name filename)))) (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) (defun tramp-crypt-handle-file-locked-p (filename)
"Like `file-locked-p' for Tramp files." "Like `file-locked-p' for Tramp files."
(let (tramp-crypt-enabled) (let (tramp-crypt-enabled)
@ -730,18 +735,19 @@ absolute file names."
(defun tramp-crypt-handle-file-name-all-completions (filename directory) (defun tramp-crypt-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(all-completions (tramp-compat-ignore-error file-missing
filename (all-completions
(let* (completion-regexp-list filename
tramp-crypt-enabled (let* (completion-regexp-list
(directory (file-name-as-directory directory)) tramp-crypt-enabled
(enc-dir (tramp-crypt-encrypt-file-name directory))) (directory (file-name-as-directory directory))
(mapcar (enc-dir (tramp-crypt-encrypt-file-name directory)))
(lambda (x) (mapcar
(substring (lambda (x)
(tramp-crypt-decrypt-file-name (concat enc-dir x)) (substring
(length directory))) (tramp-crypt-decrypt-file-name (concat enc-dir x))
(file-name-all-completions "" enc-dir))))) (length directory)))
(file-name-all-completions "" enc-dir))))))
(defun tramp-crypt-handle-file-readable-p (filename) (defun tramp-crypt-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files." "Like `file-readable-p' for Tramp files."

62
lisp/net/tramp-fuse.el
View file

@ -97,23 +97,29 @@
(with-tramp-file-property v localname "file-executable-p" (with-tramp-file-property v localname "file-executable-p"
(file-executable-p (tramp-fuse-local-file-name filename))))) (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) (defun tramp-fuse-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(tramp-fuse-remove-hidden-files (tramp-fuse-remove-hidden-files
(all-completions (tramp-compat-ignore-error file-missing
filename (all-completions
(delete-dups filename
(append (delete-dups
(file-name-all-completions (append
filename (tramp-fuse-local-file-name directory)) (file-name-all-completions
;; Some storage systems do not return "." and "..". filename (tramp-fuse-local-file-name directory))
(let (result) ;; Some storage systems do not return "." and "..".
(dolist (item '(".." ".") result) (let (result)
(when (string-prefix-p filename item) (dolist (item '(".." ".") result)
(catch 'match (when (string-prefix-p filename item)
(dolist (elt completion-regexp-list) (catch 'match
(unless (string-match-p elt item) (throw 'match nil))) (dolist (elt completion-regexp-list)
(setq result (cons (concat item "/") result))))))))))) (unless (string-match-p elt item) (throw 'match nil)))
(setq result (cons (concat item "/") result))))))))))))
;; This function isn't used. ;; This function isn't used.
(defun tramp-fuse-handle-insert-directory (defun tramp-fuse-handle-insert-directory
@ -146,23 +152,24 @@
(format "%s@%s:/" user host) (format "%s@%s:/" user host)
(format "%s:/" 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 (defconst tramp-fuse-mount-timeout
(eval (car (get 'remote-file-name-inhibit-cache 'standard-value)) t) (eval (car (get 'remote-file-name-inhibit-cache 'standard-value)) t)
"Time period to check whether the mount point still exists. "Time period to check whether the mount point still exists.
It has the same meaning as `remote-file-name-inhibit-cache'.") 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) (defun tramp-fuse-mounted-p (vec)
"Check, whether fuse volume determined by VEC is mounted." "Check, whether fuse volume determined by VEC is mounted."
;; Remember the mount status by using a file property on "/", ;; 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)) bol (group (regexp mount-spec))
" on " (group (+ (not blank))) blank) " on " (group (+ (not blank))) blank)
mount) mount)
(tramp-set-file-property
vec "/" "mount-point" (match-string 2 mount))
(match-string 1 mount))))))) (match-string 1 mount)))))))
(defun tramp-fuse-get-fusermount () (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))) (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-message vec 6 "%s\n%s" command (shell-command-to-string command))
(tramp-flush-file-property vec "/" "mounted") (tramp-flush-file-property vec "/" "mounted")
(tramp-flush-file-property vec "/" "mount-point")
(setq tramp-fuse-mount-points (setq tramp-fuse-mount-points
(delete (tramp-file-name-unify vec) tramp-fuse-mount-points)) (delete (tramp-file-name-unify vec) tramp-fuse-mount-points))
;; Give the caches a chance to expire. ;; Give the caches a chance to expire.

96
lisp/net/tramp-gvfs.el
View file

@ -114,6 +114,7 @@
(declare-function zeroconf-service-host "zeroconf") (declare-function zeroconf-service-host "zeroconf")
(declare-function zeroconf-service-port "zeroconf") (declare-function zeroconf-service-port "zeroconf")
(declare-function zeroconf-service-txt "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. ;; We don't call `dbus-ping', because this would load dbus.el.
(defconst tramp-gvfs-enabled (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))) (let ((method (tramp-file-name-method vec)))
(and (stringp method) (member method tramp-gvfs-methods))))) (and (stringp method) (member method tramp-gvfs-methods)))))
(defvar tramp-gvfs-dbus-event-vector)
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-gvfs-file-name-handler (operation &rest args) (defun tramp-gvfs-file-name-handler (operation &rest args)
"Invoke the GVFS related OPERATION and 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-register-foreign-file-name-handler
#'tramp-gvfs-file-name-p #'tramp-gvfs-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. ;; D-Bus helper function.
@ -1027,6 +1034,8 @@ file names."
(when (and (file-directory-p newname) (when (and (file-directory-p newname)
(not (directory-name-p newname))) (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname)) (tramp-error v 'file-error "File is a directory %s" newname))
(when (file-regular-p newname)
(delete-file newname))
(cond (cond
;; We cannot rename volatile files, as used by Google-drive. ;; We cannot rename volatile files, as used by Google-drive.
@ -1079,7 +1088,7 @@ file names."
(goto-char (point-min)) (goto-char (point-min))
(tramp-error-with-buffer (tramp-error-with-buffer
nil v 'file-error nil v 'file-error
"%s failed, see buffer `%s' for details." "%s failed, see buffer `%s' for details"
msg-operation (buffer-name))) msg-operation (buffer-name)))
;; Some WebDAV server, like the one from QNAP, do ;; Some WebDAV server, like the one from QNAP, do
@ -1157,7 +1166,8 @@ file names."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/". ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/")) (setq dir (or dir default-directory "/"))
;; Handle empty NAME. ;; 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 NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name) (unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name))) (setq name (tramp-compat-file-name-concat dir name)))
@ -1173,7 +1183,7 @@ file names."
(let ((uname (match-string 1 localname)) (let ((uname (match-string 1 localname))
(fname (match-string 2 localname)) (fname (match-string 2 localname))
hname) hname)
(when (zerop (length uname)) (when (tramp-string-empty-or-nil-p uname)
(setq uname user)) (setq uname user))
(when (setq hname (tramp-get-home-directory v uname)) (when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname))))) (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) (defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(unless (tramp-compat-string-search "/" filename) (unless (tramp-compat-string-search "/" filename)
(all-completions (tramp-compat-ignore-error file-missing
filename (all-completions
(with-parsed-tramp-file-name (expand-file-name directory) nil filename
(with-tramp-file-property v localname "file-name-all-completions" (with-parsed-tramp-file-name (expand-file-name directory) nil
(let ((result '("./" "../"))) (with-tramp-file-property v localname "file-name-all-completions"
;; Get a list of directories and files. (let ((result '("./" "../")))
(dolist (item (tramp-gvfs-get-directory-attributes directory) result) ;; Get a list of directories and files.
(if (string-equal (cdr (assoc "type" item)) "directory") (dolist (item
(push (file-name-as-directory (car item)) result) (tramp-gvfs-get-directory-attributes directory)
(push (car item) result))))))))) 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) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback)
"Like `file-notify-add-watch' for Tramp files." "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) v 'file-notify-error "Monitoring not supported for `%s'" file-name)
(tramp-message (tramp-message
v 6 "Run `%s', %S" (string-join (process-command p) " ") p) v 6 "Run `%s', %S" (string-join (process-command p) " ") p)
(process-put p 'vector v) (process-put p 'tramp-vector v)
(process-put p 'events events) (process-put p 'tramp-events events)
(process-put p 'watch-name localname) (process-put p 'tramp-watch-name localname)
(process-put p 'adjust-window-size-function #'ignore) (process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
(set-process-filter p #'tramp-gvfs-monitor-process-filter) (set-process-filter p #'tramp-gvfs-monitor-process-filter)
(set-process-sentinel p #'tramp-file-notify-process-sentinel) (set-process-sentinel p #'tramp-file-notify-process-sentinel)
;; There might be an error if the monitor is not supported. ;; There might be an error if the monitor is not supported.
;; Give the filter a chance to read the output. ;; 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) (unless (process-live-p p)
(tramp-error (tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name)) 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) (defun tramp-gvfs-monitor-process-filter (proc string)
"Read output from \"gvfs-monitor-file\" and add corresponding \ "Read output from \"gvfs-monitor-file\" and add corresponding \
`file-notify' events." `file-notify' events."
(let* ((events (process-get proc 'events)) (let* ((events (process-get proc 'tramp-events))
(rest-string (process-get proc 'rest-string)) (rest-string (process-get proc 'tramp-rest-string))
(dd (tramp-get-default-directory (process-buffer proc))) (dd (tramp-get-default-directory (process-buffer proc)))
(ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd))))) (ddu (tramp-compat-rx (literal (tramp-gvfs-url-file-name dd)))))
(when rest-string (when rest-string
@ -1526,7 +1539,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(setq file1 (url-unhex-string file1))) (setq file1 (url-unhex-string file1)))
;; Remove watch when file or directory to be watched is deleted. ;; Remove watch when file or directory to be watched is deleted.
(when (and (member action '(moved 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)) (delete-process proc))
;; Usually, we would add an Emacs event now. Unfortunately, ;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at ;; `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))))) 'file-notify-callback (list proc action file file1)))))
;; Save rest of the string. ;; 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)) (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) (defun tramp-gvfs-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files." "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")) (let ((localname (tramp-get-connection-property vec "default-location"))
result) result)
(cond (cond
((zerop (length localname)) ((tramp-string-empty-or-nil-p localname)
(tramp-get-connection-property (tramp-get-process vec) "share")) (tramp-get-connection-property (tramp-get-process vec) "share"))
;; Google-drive. ;; Google-drive.
((not (string-prefix-p "/" localname)) ((not (string-prefix-p "/" localname))
@ -1769,11 +1782,11 @@ a downcased host name only."
(condition-case nil (condition-case nil
(with-parsed-tramp-file-name filename l (with-parsed-tramp-file-name filename l
(when (and (zerop (length user)) (when (and (tramp-string-empty-or-nil-p user)
(not (not
(zerop (logand flags tramp-gvfs-password-need-username)))) (zerop (logand flags tramp-gvfs-password-need-username))))
(setq user (read-string "User name: "))) (setq user (read-string "User name: ")))
(when (and (zerop (length domain)) (when (and (tramp-string-empty-or-nil-p domain)
(not (not
(zerop (logand flags tramp-gvfs-password-need-domain)))) (zerop (logand flags tramp-gvfs-password-need-domain))))
(setq domain (read-string "Domain name: "))) (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) :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t))) :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-process-query-on-exit-flag p nil)
;; Set connection-local variables. ;; Set connection-local variables.
@ -2212,7 +2225,7 @@ connection if a previous connection has died for some reason."
(with-tramp-progress-reporter (with-tramp-progress-reporter
vec 3 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 using %s" host method)
(format "Opening connection for %s@%s using %s" user 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 (with-timeout
((or (tramp-get-method-parameter vec 'tramp-connection-timeout) ((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
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 (tramp-error
vec 'file-error vec 'file-error
"Timeout reached mounting %s using %s" host method) "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. ;; Adapt default host name, supporting /mtp:: when possible.
(setq tramp-default-host-alist (setq tramp-default-host-alist
(append (append
`(("mtp" nil ,(if (= (length devices) 1) (car devices) ""))) `(("mtp" nil ,(if (tramp-compat-length= devices 1) (car devices) "")))
(delete (delete
(assoc "mtp" tramp-default-host-alist) (assoc "mtp" tramp-default-host-alist)
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 (delete-dups
(mapcar (mapcar
(lambda (x) (lambda (x)
(let* ((list (split-string x ";")) (ignore-errors
(host (nth 6 list)) (let* ((list (split-string x ";"))
(text (split-string (nth 9 list) "\" \"" 'omit "\"")) (host (nth 6 list))
user) (text (split-string (nth 9 list) "\" \"" 'omit "\""))
;; A user is marked in a TXT field like "u=guest". user)
(while text ;; A user is marked in a TXT field like "u=guest".
(when (string-match (rx "u=" (group (+ nonl)) eol) (car text)) (while text
(setq user (match-string 1 (car text)))) (when (string-match (rx "u=" (group (+ nonl)) eol) (car text))
(setq text (cdr text))) (setq user (match-string 1 (car text))))
(list user host))) (setq text (cdr text)))
(list user host))))
result)))) result))))
(when tramp-gvfs-enabled (when tramp-gvfs-enabled

66
lisp/net/tramp-rclone.el
View file

@ -224,6 +224,7 @@ file names."
(let ((t1 (tramp-tramp-file-p filename)) (let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname)) (t2 (tramp-tramp-file-p newname))
(equal-remote (tramp-equal-remote filename newname))
(rclone-operation (if (eq op 'copy) "copyto" "moveto")) (rclone-operation (if (eq op 'copy) "copyto" "moveto"))
(msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
@ -234,8 +235,12 @@ file names."
(when (and (file-directory-p newname) (when (and (file-directory-p newname)
(not (directory-name-p newname))) (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" 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)))) (and t2 (not (tramp-rclone-file-name-p newname))))
;; We cannot copy or rename directly. ;; We cannot copy or rename directly.
@ -255,9 +260,20 @@ file names."
v rclone-operation v rclone-operation
(tramp-rclone-remote-file-name filename) (tramp-rclone-remote-file-name filename)
(tramp-rclone-remote-file-name newname))) (tramp-rclone-remote-file-name newname)))
(tramp-error (if (or (not equal-remote)
v 'file-error (and equal-remote
"Error %s `%s' `%s'" msg-operation filename newname))) (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)) (when (and t1 (eq op 'rename))
(while (file-exists-p filename) (while (file-exists-p filename)
@ -298,25 +314,25 @@ file names."
(setq filename (file-name-directory filename))) (setq filename (file-name-directory filename)))
(with-parsed-tramp-file-name (expand-file-name filename) nil (with-parsed-tramp-file-name (expand-file-name filename) nil
(tramp-message v 5 "file system info: %s" localname) (tramp-message v 5 "file system info: %s" localname)
(tramp-rclone-send-command v "about" (concat host ":")) (when (zerop (tramp-rclone-send-command v "about" (concat host ":")))
(with-current-buffer (tramp-get-connection-buffer v) (with-current-buffer (tramp-get-connection-buffer v)
(let (total used free) (let (total used free)
(goto-char (point-min)) (goto-char (point-min))
(while (not (eobp)) (while (not (eobp))
(when (looking-at (rx "Total: " (+ blank) (group (+ digit)))) (when (looking-at (rx "Total: " (+ blank) (group (+ digit))))
(setq total (string-to-number (match-string 1)))) (setq total (string-to-number (match-string 1))))
(when (looking-at (rx "Used: " (+ blank) (group (+ digit)))) (when (looking-at (rx "Used: " (+ blank) (group (+ digit))))
(setq used (string-to-number (match-string 1)))) (setq used (string-to-number (match-string 1))))
(when (looking-at (rx "Free: " (+ blank) (group (+ digit)))) (when (looking-at (rx "Free: " (+ blank) (group (+ digit))))
(setq free (string-to-number (match-string 1)))) (setq free (string-to-number (match-string 1))))
(forward-line)) (forward-line))
(when used (when used
;; The used number of bytes is not part of the result. As ;; The used number of bytes is not part of the result.
;; side effect, we store it as file property. ;; As side effect, we store it as file property.
(tramp-set-file-property v localname "used-bytes" used)) (tramp-set-file-property v localname "used-bytes" used))
;; Result. ;; Result.
(when (and total free) (when (and total free)
(list total free (- total free)))))))) (list total free (- total free)))))))))
(defun tramp-rclone-handle-rename-file (defun tramp-rclone-handle-rename-file
(filename newname &optional ok-if-already-exists) (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))) (let ((host (tramp-file-name-host vec)))
(when (rassoc `(,host) (tramp-rclone-parse-device-names nil)) (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)) (tramp-error vec 'file-error "Storage %s not connected" host))
;; We need a process bound to the connection buffer. Therefore, ;; We need a process bound to the connection buffer. Therefore,
;; we create a dummy process. Maybe there is a better solution? ;; 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) :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t))) :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-process-query-on-exit-flag p nil)
;; Set connection-local variables. ;; Set connection-local variables.

349
lisp/net/tramp-sh.el
View file

@ -81,13 +81,6 @@ the default storage location, e.g. \"$HOME/.sh_history\"."
(const :tag "Unset HISTFILE" t) (const :tag "Unset HISTFILE" t)
(string :tag "Redirect to a file"))) (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 ;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for
;; root users. It uses the `$' character for other users. In order ;; root users. It uses the `$' character for other users. In order
;; to guarantee a proper prompt, we use "#$ " for the prompt. ;; 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)) (defcustom tramp-use-ssh-controlmaster-options (not (eq system-type 'windows-nt))
"Whether to use `tramp-ssh-controlmaster-options'. "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 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 :group 'tramp
:version "28.1" :version "29.2"
:type 'boolean) :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 (defvar tramp-ssh-controlmaster-options nil
"Which ssh Control* arguments to use. "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. spec must be doubled, because the string is used as format string.
Otherwise, it will be auto-detected by Tramp, if Otherwise, it will be auto-detected by Tramp, if
`tramp-use-ssh-controlmaster-options' is non-nil. The value `tramp-use-ssh-controlmaster-options' is t. The value depends on
depends on the installed local ssh version. the installed local ssh version.
The string is used in `tramp-methods'.") The string is used in `tramp-methods'.")
@ -632,7 +632,6 @@ foreach $f (@files) {
print \"$f\\n\"; print \"$f\\n\";
} }
} }
print \"ok\\n\"
' \"$1\" %n" ' \"$1\" %n"
"Perl script to produce output suitable for use with "Perl script to produce output suitable for use with
`file-name-all-completions' on the remote file system. `file-name-all-completions' on the remote file system.
@ -1159,8 +1158,8 @@ component is used as the target of the symlink."
(unless ln (unless ln
(tramp-error (tramp-error
v 'file-error v 'file-error
(concat "Making a symbolic link. " (concat "Making a symbolic link: "
"ln(1) does not exist on the remote host."))) "ln(1) does not exist on the remote host")))
;; Do the 'confirm if exists' thing. ;; Do the 'confirm if exists' thing.
(when (file-exists-p linkname) (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) (defun tramp-sh-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files." "Like `file-exists-p' for Tramp files."
;; `file-exists-p' is used as predicate in file name completion. (tramp-skeleton-file-exists-p filename
;; We don't want to run it when `non-essential' is t, or there is (tramp-send-command-and-check
;; no connection process yet. v
(when (tramp-connectable-p filename) (format
(with-parsed-tramp-file-name (expand-file-name filename) nil "%s %s"
(with-tramp-file-property v localname "file-exists-p" (tramp-get-file-exists-command v)
(if (tramp-file-property-p v localname "file-attributes") (tramp-shell-quote-argument localname)))))
(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))))))))
(defun tramp-sh-handle-file-attributes (filename &optional id-format) (defun tramp-sh-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files." "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") (if (tramp-file-property-p v localname "file-attributes")
(or (tramp-check-cached-permissions v ?x) (or (tramp-check-cached-permissions v ?x)
(tramp-check-cached-permissions v ?s)) (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) (defun tramp-sh-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files." "Like `file-readable-p' for Tramp files."
@ -1734,7 +1726,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; satisfied without remote operation. ;; satisfied without remote operation.
(if (tramp-file-property-p v localname "file-attributes") (if (tramp-file-property-p v localname "file-attributes")
(tramp-handle-file-readable-p filename) (tramp-handle-file-readable-p filename)
(tramp-run-test "-r" filename))))) (tramp-run-test v "-r" localname)))))
;; Functions implemented using the basic functions above. ;; 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 ;; Sometimes, when a connection is not established yet, it is
;; desirable to return t immediately for "/method:foo:". It can ;; desirable to return t immediately for "/method:foo:". It can
;; be expected that this is always a directory. ;; 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" (with-tramp-file-property v localname "file-directory-p"
(if-let (if-let
((truename (tramp-get-file-property v localname "file-truename")) ((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 (tramp-get-file-property
v (tramp-file-local-name truename) "file-attributes")) v (tramp-file-local-name truename) "file-attributes"))
t) t)
(tramp-run-test "-d" filename)))))) (tramp-run-test v "-d" localname))))))
(defun tramp-sh-handle-file-writable-p (filename) (defun tramp-sh-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files." "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 ;; Examine `file-attributes' cache to see if request can
;; be satisfied without remote operation. ;; be satisfied without remote operation.
(tramp-check-cached-permissions v ?w) (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. ;; If file doesn't exist, check if directory is writable.
(and (and
(file-directory-p (file-name-directory filename)) (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 (with-parsed-tramp-file-name (expand-file-name directory) nil
(when (and (not (tramp-compat-string-search "/" filename)) (when (and (not (tramp-compat-string-search "/" filename))
(tramp-connectable-p v)) (tramp-connectable-p v))
(all-completions (unless (tramp-compat-string-search "/" filename)
filename (tramp-compat-ignore-error file-missing
(with-tramp-file-property v localname "file-name-all-completions" (all-completions
(let (result) filename
;; Get a list of directories and files, including reliably (with-tramp-file-property v localname "file-name-all-completions"
;; tagging the directories with a trailing "/". Because I (let (result)
;; rock. --daniel@danann.net ;; Get a list of directories and files, including
(tramp-send-command ;; reliably tagging the directories with a trailing "/".
v ;; Because I rock. --daniel@danann.net
(if (tramp-get-remote-perl v) (when (tramp-send-command-and-check
(progn v
(tramp-maybe-send-script (if (tramp-get-remote-perl v)
v tramp-perl-file-name-all-completions (progn
"tramp_perl_file_name_all_completions") (tramp-maybe-send-script
(format "tramp_perl_file_name_all_completions %s" v tramp-perl-file-name-all-completions
(tramp-shell-quote-argument localname))) "tramp_perl_file_name_all_completions")
(format "tramp_perl_file_name_all_completions %s"
(tramp-shell-quote-argument localname)))
(format (concat (format (concat
"(cd %s 2>&1 && %s -a 2>%s" "cd %s 2>&1 && %s -a 2>%s"
" | while IFS= read f; do" " | while IFS= read f; do"
" if %s -d \"$f\" 2>%s;" " if %s -d \"$f\" 2>%s;"
" then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" " then \\echo \"$f/\"; else \\echo \"$f\"; fi;"
" && \\echo ok) || \\echo fail") " done")
(tramp-shell-quote-argument localname) (tramp-shell-quote-argument localname)
(tramp-get-ls-command v) (tramp-get-ls-command v)
(tramp-get-remote-null-device v) (tramp-get-remote-null-device v)
(tramp-get-test-command v) (tramp-get-test-command v)
(tramp-get-remote-null-device v)))) (tramp-get-remote-null-device v))))
;; Now grab the output. ;; Now grab the output.
(with-current-buffer (tramp-get-buffer v) (with-current-buffer (tramp-get-buffer v)
(goto-char (point-max)) (goto-char (point-max))
(while (zerop (forward-line -1))
;; Check result code, found in last line of output. (push (buffer-substring (point) (line-end-position)) result)))
(forward-line -1) result)))))))))
(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))))))
;; cp, mv and ln ;; cp, mv and ln
@ -2240,7 +2211,7 @@ the uid and gid from FILENAME."
cmd-result) cmd-result)
(tramp-error-with-buffer (tramp-error-with-buffer
nil v 'file-error nil v 'file-error
"Copying directly failed, see buffer `%s' for details." "Copying directly failed, see buffer `%s' for details"
(buffer-name))))) (buffer-name)))))
;; We are on the local host. ;; We are on the local host.
@ -2295,7 +2266,7 @@ the uid and gid from FILENAME."
"%s %s %s" cmd "%s %s %s" cmd
(tramp-shell-quote-argument localname1) (tramp-shell-quote-argument localname1)
(tramp-shell-quote-argument tmpfile)) (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)) (tramp-get-buffer v))
;; We must change the ownership as remote user. ;; We must change the ownership as remote user.
;; Since this does not work reliable, we also ;; Since this does not work reliable, we also
@ -2328,7 +2299,7 @@ the uid and gid from FILENAME."
"cp -f -p %s %s" "cp -f -p %s %s"
(tramp-shell-quote-argument tmpfile) (tramp-shell-quote-argument tmpfile)
(tramp-shell-quote-argument localname2)) (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))) (tramp-get-buffer v)))
(t1 (t1
(tramp-run-real-handler (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 copy-program copy-args copy-env copy-keep-date listener spec
options source target remote-copy-program remote-copy-args p) 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. ;; Both are Tramp files. We cannot use direct remote copying.
(let* ((dir-flag (file-directory-p filename)) (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) (tramp-get-connection-buffer v)
copy-program copy-args))) copy-program copy-args)))
(tramp-message v 6 "%s" (string-join (process-command p) " ")) (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) (process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
@ -2673,7 +2648,7 @@ The method used must be an out-of-band method."
(setq switches (setq switches
(append switches (split-string (tramp-sh--quoting-style-options v)))) (append switches (split-string (tramp-sh--quoting-style-options v))))
(unless (tramp-get-ls-command-with v "--dired") (unless (tramp-get-ls-command-with v "--dired")
(setq switches (delete "--dired" switches))) (setq switches (delete "-N" (delete "--dired" switches))))
(when wildcard (when wildcard
(setq wildcard (tramp-run-real-handler (setq wildcard (tramp-run-real-handler
#'file-name-nondirectory (list localname))) #'file-name-nondirectory (list localname)))
@ -2711,9 +2686,9 @@ The method used must be an out-of-band method."
(tramp-get-ls-command v) (tramp-get-ls-command v)
switches switches
(if (or wildcard (if (or wildcard
(zerop (length (tramp-string-empty-or-nil-p
(tramp-run-real-handler (tramp-run-real-handler
#'file-name-nondirectory (list localname))))) #'file-name-nondirectory (list localname))))
"" ""
(tramp-shell-quote-argument (tramp-shell-quote-argument
(tramp-run-real-handler (tramp-run-real-handler
@ -2761,7 +2736,7 @@ The method used must be an out-of-band method."
(unless (tramp-compat-string-search (unless (tramp-compat-string-search
"color" (tramp-get-connection-property v "ls" "")) "color" (tramp-get-connection-property v "ls" ""))
(goto-char (point-min)) (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 ""))) (replace-match "")))
;; Now decode what read if necessary. Stolen from `insert-directory'. ;; 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 "/". ;; If DIR is not given, use `default-directory' or "/".
(setq dir (or dir default-directory "/")) (setq dir (or dir default-directory "/"))
;; Handle empty NAME. ;; 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 ;; On MS Windows, some special file names are not returned properly
;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified', ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified',
;; there could be the false positive "/:". ;; there could be the false positive "/:".
(if (or (and (eq system-type 'windows-nt) (if (or (and (eq system-type 'windows-nt)
(string-match-p (string-match-p
(tramp-compat-rx bol (| (: alpha ":") (: (literal null-device) eol))) (tramp-compat-rx
bol (| (: alpha ":") (: (literal (or null-device "")) eol)))
name)) name))
(and (not (tramp-tramp-file-p name)) (and (not (tramp-tramp-file-p name))
(not (tramp-tramp-file-p dir)))) (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 ;; the default user name for tilde expansion is not
;; appropriate either, because ssh and companions might ;; appropriate either, because ssh and companions might
;; use a user name from the config file. ;; 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)) (string-match-p (rx bos "su" (? "do") eos) method))
(setq uname user)) (setq uname user))
(when (setq hname (tramp-get-home-directory v uname)) (when (setq hname (tramp-get-home-directory v uname))
@ -2969,7 +2946,7 @@ implementation will be used."
(heredoc (and (not (bufferp stderr)) (heredoc (and (not (bufferp stderr))
(stringp program) (stringp program)
(string-match-p (rx "sh" eol) program) (string-match-p (rx "sh" eol) program)
(= (length args) 2) (tramp-compat-length= args 2)
(string-equal "-c" (car args)) (string-equal "-c" (car args))
;; Don't if there is a quoted string. ;; Don't if there is a quoted string.
(not (not
@ -2979,7 +2956,7 @@ implementation will be used."
;; When PROGRAM is nil, we just provide a tty. ;; When PROGRAM is nil, we just provide a tty.
(args (if (not heredoc) args (args (if (not heredoc) args
(let ((i 250)) (let ((i 250))
(while (and (< i (length (cadr args))) (while (and (not (tramp-compat-length< (cadr args) i))
(string-match " " (cadr args) i)) (string-match " " (cadr args) i))
(setcdr (setcdr
args args
@ -3095,13 +3072,20 @@ implementation will be used."
(process-put p 'remote-pid pid) (process-put p 'remote-pid pid)
(tramp-set-connection-property (tramp-set-connection-property
p "remote-pid" pid)) p "remote-pid" pid))
;; Disable carriage return to newline (when (memq connection-type '(nil pipe))
;; translation. This does not work on ;; Disable carriage return to newline
;; macOS, see Bug#50748. ;; translation. This does not work on
(when (and (memq connection-type '(nil pipe)) ;; macOS, see Bug#50748.
(not ;; We must also disable buffering,
(tramp-check-remote-uname v "Darwin"))) ;; otherwise strings larger than 4096
(tramp-send-command v "stty -icrnl")) ;; 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-maybe-open-connection' and
;; `tramp-send-command-and-read' could ;; `tramp-send-command-and-read' could
;; have trashed the connection buffer. ;; have trashed the connection buffer.
@ -3236,7 +3220,7 @@ implementation will be used."
(if (tramp-compat-string-search "=" elt) (if (tramp-compat-string-search "=" elt)
(setq env (append env `(,elt))) (setq env (append env `(,elt)))
(setq uenv (cons elt uenv))))) (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 (when env
(setq command (setq command
(format (format
@ -3861,16 +3845,20 @@ Fall back to normal file name handler if no Tramp handler exists."
"`%s' failed to start on remote host" "`%s' failed to start on remote host"
(string-join sequence " ")) (string-join sequence " "))
(tramp-message v 6 "Run `%s', %S" (string-join sequence " ") p) (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. ;; Needed for process filter.
(process-put p 'events events) (process-put p 'tramp-events events)
(process-put p 'watch-name localname) (process-put p 'tramp-watch-name localname)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
(set-process-filter p filter) (set-process-filter p filter)
(set-process-sentinel p #'tramp-file-notify-process-sentinel) (set-process-sentinel p #'tramp-file-notify-process-sentinel)
;; There might be an error if the monitor is not supported. ;; There might be an error if the monitor is not supported.
;; Give the filter a chance to read the output. ;; 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) (unless (process-live-p p)
(tramp-error (tramp-error
p 'file-notify-error "Monitoring not supported for `%s'" file-name)) 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) (defun tramp-sh-gio-monitor-process-filter (proc string)
"Read output from \"gio monitor\" and add corresponding `file-notify' events." "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 (remote-prefix
(file-remote-p (tramp-get-default-directory (process-buffer proc)))) (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) pos)
(when rest-string (when rest-string
(tramp-message proc 10 "Previous string:\n%s" 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. ;; Save rest of the string.
(while (string-match (rx bol "\n") string) (while (string-match (rx bol "\n") string)
(setq string (replace-match "" nil nil 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)) (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) (defun tramp-sh-inotifywait-process-filter (proc string)
"Read output from \"inotifywait\" and add corresponding `file-notify' events." "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) (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. ;; Check, whether there is a problem.
(unless (string-match (unless (string-match
(rx bol (+ (not blank)) (+ blank) (group (+ (not blank))) (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)))) (tramp-compat-string-replace "_" "-" (downcase x))))
(split-string (match-string 1 line) "," 'omit)) (split-string (match-string 1 line) "," 'omit))
(or (match-string 2 line) (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, ;; Usually, we would add an Emacs event now. Unfortunately,
;; `unread-command-events' does not accept several events at ;; `unread-command-events' does not accept several events at
;; once. Therefore, we apply the handler directly. ;; 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-set-connection-property
(tramp-get-connection-process vec) "scripts" (cons name scripts)))))) (tramp-get-connection-process vec) "scripts" (cons name scripts))))))
(defun tramp-run-test (switch filename) (defun tramp-run-test (vec switch localname)
"Run `test' on the remote system, given a SWITCH and a FILENAME. "Run `test' on the remote system VEC, given a SWITCH and a LOCALNAME.
Returns the exit code of the `test' program." Returns the exit code of the `test' program."
(with-parsed-tramp-file-name filename nil (tramp-send-command-and-check
(tramp-send-command-and-check vec
v (format
(format "%s %s %s"
"%s %s %s" (tramp-get-test-command vec) switch (tramp-shell-quote-argument localname))))
(tramp-get-test-command v)
switch
(tramp-shell-quote-argument localname)))))
(defun tramp-find-executable (defun tramp-find-executable
(vec progname dirlist &optional ignore-tilde ignore-path) (vec progname dirlist &optional ignore-tilde ignore-path)
@ -4217,7 +4203,7 @@ variable PATH."
'noerror))) 'noerror)))
tmpfile chunk chunksize) tmpfile chunk chunksize)
(tramp-message vec 5 "Setting $PATH environment variable") (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) (tramp-send-command vec command)
;; Use a temporary file. We cannot use `write-region' because ;; Use a temporary file. We cannot use `write-region' because
;; setting the remote path happens in the early connection ;; 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. "Wait for shell prompt and barf if none appears.
Looks at process PROC to see if a shell prompt appears in TIMEOUT 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." 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 (condition-case nil
(tramp-wait-for-regexp (tramp-wait-for-regexp
proc timeout proc timeout
(tramp-compat-rx (tramp-compat-rx
(| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern)) (| (regexp shell-prompt-pattern) (regexp tramp-shell-prompt-pattern))
(? (regexp ansi-color-control-seq-regexp))
eos)) eos))
(error (error
(delete-process proc) (delete-process proc)
@ -4608,7 +4595,7 @@ process to set up. VEC specifies the connection."
;; Set `remote-tty' process property. ;; Set `remote-tty' process property.
(let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) (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) (process-put proc 'remote-tty tty)
(tramp-set-connection-property 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 (tramp-message
vec 2 "Couldn't find an inline transfer compress command"))))) 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) (defun tramp-ssh-controlmaster-options (vec)
"Return the Control* arguments of the local ssh." "Return the Control* arguments of the local ssh."
(cond (cond
@ -4951,40 +4948,34 @@ Goes through the list `tramp-inline-compress-commands'."
"") "")
;; There is already a value to be used. ;; 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. ;; Determine the options.
(t (setq tramp-ssh-controlmaster-options "") (t (ignore-errors
(let ((case-fold-search t)) ;; ControlMaster and ControlPath options are introduced in OpenSSH 3.9.
(ignore-errors (concat
(with-tramp-progress-reporter "-o ControlMaster="
vec 4 "Computing ControlMaster options" (if (eq tramp-use-ssh-controlmaster-options 'suppress)
;; We use a non-existing IP address, in order to avoid "no" "auto")
;; useless connections, and DNS timeouts.
(when (zerop " -o ControlPath="
(tramp-call-process (if (eq tramp-use-ssh-controlmaster-options 'suppress)
vec "ssh" nil nil nil "none"
"-G" "-o" "ControlMaster=auto" "0.0.0.1")) ;; Hashed tokens are introduced in OpenSSH 6.7.
(setq tramp-ssh-controlmaster-options (if (tramp-ssh-option-exists-p vec "ControlPath=tramp.%C")
"-o ControlMaster=auto") "tramp.%%C" "tramp.%%r@%%h:%%p"))
(if (zerop
(tramp-call-process ;; ControlPersist option is introduced in OpenSSH 5.6.
vec "ssh" nil nil nil (when (and (not (eq tramp-use-ssh-controlmaster-options 'suppress))
"-G" "-o" "ControlPath=tramp.%C" "0.0.0.1")) (tramp-ssh-option-exists-p vec "ControlPersist=no"))
(setq tramp-ssh-controlmaster-options " -o ControlPersist=no"))))))
(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)))
(defun tramp-scp-strict-file-name-checking (vec) (defun tramp-scp-strict-file-name-checking (vec)
"Return the strict file name checking argument of the local scp." "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) (unless (process-live-p p)
(with-tramp-progress-reporter (with-tramp-progress-reporter
vec 3 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" (format "Opening connection %s for %s using %s"
process-name process-name
(tramp-file-name-host vec) (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 sentinel and query flag. Initialize variables.
(set-process-sentinel p #'tramp-process-sentinel) (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) (process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
(setq tramp-current-connection (cons vec (current-time))) (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)) (tramp-error proc 'file-error "Process `%s' not available, try again" proc))
(with-current-buffer (process-buffer proc) (with-current-buffer (process-buffer proc)
(let* (;; Initially, `tramp-end-of-output' is "#$ ". There might (let* (;; Initially, `tramp-end-of-output' is "#$ ". There might
;; be leading escape sequences, which must be ignored. ;; be leading ANSI control escape sequences, which must be
;; Busyboxes built with the EDITING_ASK_TERMINAL config ;; ignored. Busyboxes built with the EDITING_ASK_TERMINAL
;; option send also escape sequences, which must be ;; config option send also ANSI control escape sequences,
;; ignored. ;; which must be ignored.
(regexp (tramp-compat-rx (regexp (tramp-compat-rx
(* (not (any "#$\n"))) (* (not (any "#$\n")))
(literal tramp-end-of-output) (literal tramp-end-of-output)
(? (regexp tramp-device-escape-sequence-regexp)) (? (regexp ansi-color-control-seq-regexp))
(? "\r") eol)) (? "\r") eol))
;; Sometimes, the commands do not return a newline but a ;; Sometimes, the commands do not return a newline but a
;; null byte before the shell prompt, for example "git ;; null byte before the shell prompt, for example "git
@ -5555,7 +5550,7 @@ raises an error."
(cond (cond
((tramp-get-method-parameter vec 'tramp-remote-copy-program) ((tramp-get-method-parameter vec 'tramp-remote-copy-program)
localname) 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))))) (t (format "%s@%s:%s" user host localname)))))
(defun tramp-method-out-of-band-p (vec size) (defun tramp-method-out-of-band-p (vec size)

209
lisp/net/tramp-smb.el
View file

@ -487,9 +487,9 @@ arguments to pass to the OPERATION."
(args (list (concat "//" host "/" share) "-E")) (args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options)) (options tramp-smb-options))
(if (not (zerop (length user))) (if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-U" user))) (setq args (append args (list "-N")))
(setq args (append args (list "-N")))) (setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain)))) (when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port)))) (when port (setq args (append args (list "-p" port))))
@ -558,7 +558,7 @@ arguments to pass to the OPERATION."
(tramp-message (tramp-message
v 6 "%s" (string-join (process-command p) " ")) v 6 "%s" (string-join (process-command p) " "))
(process-put p 'vector v) (process-put p 'tramp-vector v)
(process-put (process-put
p 'adjust-window-size-function #'ignore) p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (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))) (not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" 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) (unless (tramp-smb-get-share v)
(tramp-error (tramp-error
v 'file-error "Target `%s' must contain a share name" newname)) 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-argument filename)
(tramp-smb-shell-quote-localname v))) (tramp-smb-shell-quote-localname v)))
(tramp-error (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. ;; KEEP-DATE handling.
(when keep-date (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. ;; "rmdir" does not report an error. So we check ourselves.
(when (file-exists-p directory) (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) (defun tramp-smb-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files." "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 "/". ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/")) (setq dir (or dir default-directory "/"))
;; Handle empty NAME. ;; 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 NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name) (unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir 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)) (let ((uname (match-string 1 localname))
(fname (match-string 2 localname)) (fname (match-string 2 localname))
hname) hname)
(when (zerop (length uname)) (when (tramp-string-empty-or-nil-p uname)
(setq uname user)) (setq uname user))
(when (setq hname (tramp-get-home-directory v uname)) (when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname))))) (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")) (args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options)) (options tramp-smb-options))
(if (not (zerop (length user))) (if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-U" user))) (setq args (append args (list "-N")))
(setq args (append args (list "-N")))) (setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain)))) (when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port)))) (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) (append args (list (tramp-unquote-shell-quote-argument localname)
(concat "2>" (tramp-get-remote-null-device v))))) (concat "2>" (tramp-get-remote-null-device v)))))
(unwind-protect (with-tramp-saved-connection-properties
(with-tramp-saved-connection-properties v '("process-name" "process-buffer")
v '("process-name" "process-buffer") (with-temp-buffer
(with-temp-buffer ;; Set the transfer process properties.
;; Set the transfer process properties. (tramp-set-connection-property
(tramp-set-connection-property v "process-name" (buffer-name (current-buffer)))
v "process-name" (buffer-name (current-buffer))) (tramp-set-connection-property
(tramp-set-connection-property v "process-buffer" (current-buffer))
v "process-buffer" (current-buffer))
;; Use an asynchronous process. By this, password ;; Use an asynchronous process. By this, password
;; can be handled. ;; can be handled.
(let ((p (apply (let ((p (apply
#'start-process #'start-process
(tramp-get-connection-name v) (tramp-get-connection-name v)
(tramp-get-connection-buffer v) (tramp-get-connection-buffer v)
tramp-smb-acl-program args))) tramp-smb-acl-program args)))
(tramp-message (tramp-message
v 6 "%s" (string-join (process-command p) " ")) 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) (process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-get-acl) (tramp-process-actions p v nil tramp-smb-actions-get-acl)
(when (> (point-max) (point-min)) (when (> (point-max) (point-min))
(substring-no-properties (buffer-string))))))))))))) (substring-no-properties (buffer-string))))))))))))
(defun tramp-smb-handle-file-attributes (filename &optional id-format) (defun tramp-smb-handle-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files." "Like `file-attributes' for Tramp files."
@ -982,18 +984,20 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; files. ;; files.
(defun tramp-smb-handle-file-name-all-completions (filename directory) (defun tramp-smb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(all-completions (tramp-compat-ignore-error file-missing
filename (all-completions
(with-parsed-tramp-file-name (expand-file-name directory) nil filename
(with-tramp-file-property v localname "file-name-all-completions" (when (file-directory-p directory)
(delete-dups (with-parsed-tramp-file-name (expand-file-name directory) nil
(mapcar (with-tramp-file-property v localname "file-name-all-completions"
(lambda (x) (delete-dups
(list (mapcar
(if (tramp-compat-string-search "d" (nth 1 x)) (lambda (x)
(file-name-as-directory (nth 0 x)) (list
(nth 0 x)))) (if (tramp-compat-string-search "d" (nth 1 x))
(tramp-smb-get-file-entries directory))))))) (file-name-as-directory (nth 0 x))
(nth 0 x))))
(tramp-smb-get-file-entries directory)))))))))
(defun tramp-smb-handle-file-system-info (filename) (defun tramp-smb-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files." "Like `file-system-info' for Tramp files."
@ -1079,7 +1083,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq entries (setq entries
(delq (delq
nil nil
(if (or wildcard (zerop (length base))) (if (or wildcard (string-empty-p base))
;; Check for matching entries. ;; Check for matching entries.
(mapcar (mapcar
(lambda (x) (lambda (x)
@ -1105,7 +1109,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when (tramp-compat-string-search "F" switches) (when (tramp-compat-string-search "F" switches)
(mapc (mapc
(lambda (x) (lambda (x)
(unless (zerop (length (car x))) (unless (string-empty-p (car x))
(cond (cond
((char-equal ?d (string-to-char (nth 1 x))) ((char-equal ?d (string-to-char (nth 1 x)))
(setcar x (concat (car x) "/"))) (setcar x (concat (car x) "/")))
@ -1125,7 +1129,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; Print entries. ;; Print entries.
(mapc (mapc
(lambda (x) (lambda (x)
(unless (zerop (length (nth 0 x))) (unless (string-empty-p (nth 0 x))
(let ((attr (let ((attr
(when (tramp-smb-get-stat-capability v) (when (tramp-smb-get-stat-capability v)
(ignore-errors (ignore-errors
@ -1229,7 +1233,10 @@ component is used as the target of the symlink."
(let ((non-essential t)) (let ((non-essential t))
(when (and (tramp-tramp-file-p target) (when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name 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 TARGET is still remote, quote it.
(if (tramp-tramp-file-p target) (if (tramp-tramp-file-p target)
@ -1455,9 +1462,9 @@ component is used as the target of the symlink."
"\n" "," acl-string))) "\n" "," acl-string)))
(options tramp-smb-options)) (options tramp-smb-options))
(if (not (zerop (length user))) (if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-U" user))) (setq args (append args (list "-N")))
(setq args (append args (list "-N")))) (setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain)))) (when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port)))) (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" "0"
"||" "echo" "tramp_exit_status" "1"))) "||" "echo" "tramp_exit_status" "1")))
(unwind-protect (with-tramp-saved-connection-properties
(with-tramp-saved-connection-properties v '("process-name" "process-buffer")
v '("process-name" "process-buffer") (with-temp-buffer
(with-temp-buffer ;; Set the transfer process properties.
;; Set the transfer process properties. (tramp-set-connection-property
(tramp-set-connection-property v "process-name" (buffer-name (current-buffer)))
v "process-name" (buffer-name (current-buffer))) (tramp-set-connection-property
(tramp-set-connection-property v "process-buffer" (current-buffer))
v "process-buffer" (current-buffer))
;; Use an asynchronous process. By this, password ;; Use an asynchronous process. By this, password
;; can be handled. ;; can be handled.
(let ((p (apply (let ((p (apply
#'start-process #'start-process
(tramp-get-connection-name v) (tramp-get-connection-name v)
(tramp-get-connection-buffer v) (tramp-get-connection-buffer v)
tramp-smb-acl-program args))) tramp-smb-acl-program args)))
(tramp-message (tramp-message
v 6 "%s" (string-join (process-command p) " ")) 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) (process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
(tramp-process-actions p v nil tramp-smb-actions-set-acl) (tramp-process-actions p v nil tramp-smb-actions-set-acl)
;; This is meant for traces, and returning from ;; This is meant for traces, and returning from
;; the function. No error is propagated outside, ;; the function. No error is propagated outside,
;; due to the `ignore-errors' closure. ;; due to the `ignore-errors' closure.
(unless (unless
(tramp-search-regexp (rx "tramp_exit_status " (+ digit))) (tramp-search-regexp (rx "tramp_exit_status " (+ digit)))
(tramp-error (tramp-error
v 'file-error v 'file-error
"Couldn't find exit status of `%s'" "Couldn't find exit status of `%s'"
tramp-smb-acl-program)) tramp-smb-acl-program))
(skip-chars-forward "^ ") (skip-chars-forward "^ ")
(when (zerop (read (current-buffer))) (when (zerop (read (current-buffer)))
;; Success. ;; Success.
(tramp-set-file-property v localname "file-acl" acl-string) (tramp-set-file-property v localname "file-acl" acl-string)
t)))))))))) t)))))))))
(defun tramp-smb-handle-set-file-modes (filename mode &optional flag) (defun tramp-smb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files." "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 user identified by VEC. If there is no user specified in either
VEC or USER, or if there is no home directory, return nil." VEC or USER, or if there is no home directory, return nil."
(let ((user (or user (tramp-file-name-user vec)))) (let ((user (or user (tramp-file-name-user vec))))
(unless (zerop (length user)) (unless (tramp-string-empty-or-nil-p user)
(concat "/" user)))) (concat "/" user))))
(defun tramp-smb-handle-write-region (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)) (setq tramp-smb-version (shell-command-to-string command))
(tramp-message vec 6 command) (tramp-message vec 6 command)
(tramp-message vec 6 "\n%s" tramp-smb-version) (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 (setq tramp-smb-version
(replace-match "" nil nil 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 (t
(setq args (list "-g" "-L" host )))) (setq args (list "-g" "-L" host ))))
(if (not (zerop (length user))) (if (tramp-string-empty-or-nil-p user)
(setq args (append args (list "-U" user))) (setq args (append args (list "-N")))
(setq args (append args (list "-N")))) (setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain)))) (when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port)))) (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 (with-tramp-progress-reporter
vec 3 vec 3
(format "Opening connection for //%s%s/%s" (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 "")) host (or share ""))
(let* (coding-system-for-read (let* (coding-system-for-read
@ -2044,7 +2051,7 @@ If ARGUMENT is non-nil, use it as argument for
args)))) args))))
(tramp-message vec 6 "%s" (string-join (process-command p) " ")) (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) (process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (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. ;; Read pending output.
(while (not (re-search-forward tramp-smb-prompt nil t)) (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))) (goto-char (point-min)))
(tramp-message vec 6 "\n%s" (buffer-string)) (tramp-message vec 6 "\n%s" (buffer-string))

8
lisp/net/tramp-sshfs.el
View file

@ -100,7 +100,7 @@
(file-directory-p . tramp-handle-file-directory-p) (file-directory-p . tramp-handle-file-directory-p)
(file-equal-p . tramp-handle-file-equal-p) (file-equal-p . tramp-handle-file-equal-p)
(file-executable-p . tramp-fuse-handle-file-executable-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-in-directory-p . tramp-handle-file-in-directory-p)
(file-local-copy . tramp-handle-file-local-copy) (file-local-copy . tramp-handle-file-local-copy)
(file-locked-p . tramp-handle-file-locked-p) (file-locked-p . tramp-handle-file-locked-p)
@ -244,8 +244,8 @@ arguments to pass to the OPERATION."
(setq result (setq result
(insert-file-contents (insert-file-contents
(tramp-fuse-local-file-name filename) visit beg end replace)) (tramp-fuse-local-file-name filename) visit beg end replace))
(when visit (setq buffer-file-name filename)) (when visit (setq buffer-file-name filename)))
(cons filename (cdr result))))) (cons filename (cdr result))))
(defun tramp-sshfs-handle-process-file (defun tramp-sshfs-handle-process-file
(program &optional infile destination display &rest args) (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) :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t))) :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-process-query-on-exit-flag p nil)
;; Set connection-local variables. ;; Set connection-local variables.

70
lisp/net/tramp-sudoedit.el
View file

@ -366,7 +366,8 @@ the result will be a local, non-Tramp, file name."
;; If DIR is not given, use `default-directory' or "/". ;; If DIR is not given, use `default-directory' or "/".
(setq dir (or dir default-directory "/")) (setq dir (or dir default-directory "/"))
;; Handle empty NAME. ;; 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 NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name) (unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir 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 ;; Tilde expansion if necessary. We cannot accept "~/", because
;; under sudo "~/" is expanded to the local user home directory ;; under sudo "~/" is expanded to the local user home directory
;; but to the root home directory. ;; but to the root home directory.
(when (zerop (length localname)) (when (tramp-string-empty-or-nil-p localname)
(setq localname "~")) (setq localname "~"))
(unless (file-name-absolute-p localname) (unless (file-name-absolute-p localname)
(setq localname (format "~%s/%s" user 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)) (let ((uname (match-string 1 localname))
(fname (match-string 2 localname)) (fname (match-string 2 localname))
hname) hname)
(when (zerop (length uname)) (when (tramp-string-empty-or-nil-p uname)
(setq uname user)) (setq uname user))
(when (setq hname (tramp-get-home-directory v uname)) (when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname))))) (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) (defun tramp-sudoedit-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files." "Like `file-exists-p' for Tramp files."
;; `file-exists-p' is used as predicate in file name completion. (tramp-skeleton-file-exists-p filename
;; We don't want to run it when `non-essential' is t, or there is (tramp-sudoedit-send-command
;; no connection process yet. v "test" "-e" (tramp-compat-file-name-unquote localname))))
(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)))))))
(defun tramp-sudoedit-handle-file-name-all-completions (filename directory) (defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files." "Like `file-name-all-completions' for Tramp files."
(all-completions (tramp-compat-ignore-error file-missing
filename (all-completions
(with-parsed-tramp-file-name (expand-file-name directory) nil filename
(with-tramp-file-property v localname "file-name-all-completions" (with-parsed-tramp-file-name (expand-file-name directory) nil
(tramp-sudoedit-send-command (with-tramp-file-property v localname "file-name-all-completions"
v "ls" "-a1" "--quoting-style=literal" "--show-control-chars" (tramp-sudoedit-send-command
(if (zerop (length localname)) v "ls" "-a1" "--quoting-style=literal" "--show-control-chars"
"" (tramp-compat-file-name-unquote localname))) (if (tramp-string-empty-or-nil-p localname)
(mapcar "" (tramp-compat-file-name-unquote localname)))
(lambda (f)
(if (file-directory-p (expand-file-name f directory))
(file-name-as-directory f)
f))
(delq
nil
(mapcar (mapcar
(lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l)) (lambda (f)
(split-string (if (ignore-errors (file-directory-p (expand-file-name f directory)))
(tramp-get-buffer-string (tramp-get-connection-buffer v)) (file-name-as-directory f)
"\n" 'omit)))))))) 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) (defun tramp-sudoedit-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files." "Like `file-readable-p' for Tramp files."
@ -653,7 +648,10 @@ component is used as the target of the symlink."
(let ((non-essential t)) (let ((non-essential t))
(when (and (tramp-tramp-file-p target) (when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name 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 TARGET is still remote, quote it.
(if (tramp-tramp-file-p target) (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." "Check, whether a sudo process has finished. Remove unneeded output."
;; There might be pending output for the exit status. ;; There might be pending output for the exit status.
(unless (process-live-p proc) (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. ;; Delete narrowed region, it would be in the way reading a Lisp form.
(goto-char (point-min)) (goto-char (point-min))
(widen) (widen)
@ -802,7 +800,7 @@ connection if a previous connection has died for some reason."
:name (tramp-get-connection-name vec) :name (tramp-get-connection-name vec)
:buffer (tramp-get-connection-buffer vec) :buffer (tramp-get-connection-buffer vec)
:server t :host 'local :service t :noquery t))) :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-process-query-on-exit-flag p nil)
;; Set connection-local variables. ;; Set connection-local variables.
@ -840,7 +838,7 @@ in case of error, t otherwise."
(tramp-message vec 6 "%s" (string-join (process-command p) " ")) (tramp-message vec 6 "%s" (string-join (process-command p) " "))
;; Avoid process status message in output buffer. ;; Avoid process status message in output buffer.
(set-process-sentinel p #'ignore) (set-process-sentinel p #'ignore)
(process-put p 'vector vec) (process-put p 'tramp-vector vec)
(process-put p 'adjust-window-size-function #'ignore) (process-put p 'adjust-window-size-function #'ignore)
(set-process-query-on-exit-flag p nil) (set-process-query-on-exit-flag p nil)
(tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop) (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop)

456
lisp/net/tramp.el
View file

@ -64,6 +64,22 @@
(declare-function netrc-parse "netrc") (declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms) (defvar auto-save-file-name-transforms)
(defvar ls-lisp-use-insert-directory-program) (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 ;; Reload `tramp-compat' when we reload `tramp-autoloads' of the GNU
;; ELPA package. ;; ELPA package.
@ -83,6 +99,7 @@
(progn (progn
(defvar tramp--startup-hook nil (defvar tramp--startup-hook nil
"Forms to be executed at the end of tramp.el.") "Forms to be executed at the end of tramp.el.")
(put 'tramp--startup-hook 'tramp-suppress-trace t) (put 'tramp--startup-hook 'tramp-suppress-trace t)
(defmacro tramp--with-startup (&rest body) (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 "-" (defconst tramp-default-method-marker "-"
"Marker for default method in remote file names.") "Marker for default method in remote file names.")
(add-to-list 'tramp-methods `(,tramp-default-method-marker))
(defcustom tramp-default-user nil (defcustom tramp-default-user nil
"Default user to use for transferring files. "Default user to use for transferring files.
It is nil by default; otherwise settings in configuration files like 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" :version "24.3"
:type 'boolean) :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 ;; For some obscure technical reasons, `system-name' on w32 returns
;; either lower case or upper case letters. See ;; either lower case or upper case letters. See
;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>. ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=38079#20>.
@ -624,9 +648,7 @@ Sometimes the prompt is reported to look like \"login as:\"."
;; connection initialization; Tramp redefines the prompt afterwards. ;; connection initialization; Tramp redefines the prompt afterwards.
(rx (| bol "\r") (rx (| bol "\r")
(* (not (any "\n#$%>]"))) (* (not (any "\n#$%>]")))
(? "#") (any "#$%>]") (* blank) (? "#") (any "#$%>]") (* blank))
;; Escape characters.
(* "[" (* (any ";" digit)) alpha (* blank)))
"Regexp to match prompts from remote shell. "Regexp to match prompts from remote shell.
Normally, Tramp expects you to configure `shell-prompt-pattern' Normally, Tramp expects you to configure `shell-prompt-pattern'
correctly, but sometimes it happens that you are connecting to a 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 (defcustom tramp-wrong-passwd-regexp
(rx bol (* nonl) (rx bol (* nonl)
(| "Permission denied" (| "Permission denied"
(: "Login " (| "Incorrect" "incorrect"))
"Connection refused"
"Connection closed"
"Timeout, server not responding." "Timeout, server not responding."
"Sorry, try again." "Sorry, try again."
"Name or service not known" "Name or service not known"
"Host key verification failed." "Host key verification failed."
"Authentication failed"
"No supported authentication methods left to try!" "No supported authentication methods left to try!"
(: "Login " (| "Incorrect" "incorrect"))
(: "Connection " (| "refused" "closed"))
(: "Received signal " (+ digit))) (: "Received signal " (+ digit)))
(* nonl)) (* nonl))
"Regexp matching a `login failed' message. "Regexp matching a `login failed' message.
@ -698,7 +720,7 @@ See also `tramp-yesno-prompt-regexp'."
(defcustom tramp-terminal-type "dumb" (defcustom tramp-terminal-type "dumb"
"Value of TERM environment variable for logging in to remote host. "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 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." files conditionalize this setup based on the TERM environment variable."
:group 'tramp :group 'tramp
:type 'string) :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 ;; A security key requires the user physically to touch the device
;; with their finger. We must tell it to the user. ;; 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 (defcustom tramp-security-key-confirm-regexp
(rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n"))) (rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n")))
"Regular expression matching security key confirmation message. "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 (defvar tramp-temp-buffer-file-name nil
"File name of a persistent local temporary file. "File name of a persistent local temporary file.
Useful for \"rsync\" like methods.") Useful for \"rsync\" like methods.")
(make-variable-buffer-local 'tramp-temp-buffer-file-name) (make-variable-buffer-local 'tramp-temp-buffer-file-name)
(put 'tramp-temp-buffer-file-name 'permanent-local t) (put 'tramp-temp-buffer-file-name 'permanent-local t)
@ -813,23 +837,6 @@ Customize. See also `tramp-change-syntax'."
:initialize #'custom-initialize-default :initialize #'custom-initialize-default
:set #'tramp-set-syntax) :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) (defun tramp-set-syntax (symbol value)
"Set SYMBOL to value VALUE. "Set SYMBOL to value VALUE.
Used in user option `tramp-syntax'. There are further variables 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) (? (regexp tramp-completion-method-regexp)
;; Method separator, user name and host name. ;; Method separator, user name and host name.
(? (regexp tramp-postfix-method-regexp) (? (regexp tramp-postfix-method-regexp)
;; This is a little bit lax, but it serves. (? (regexp tramp-user-regexp)
(? (regexp tramp-host-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))) eos)))
(defvar tramp-completion-file-name-regexp (defvar tramp-completion-file-name-regexp
@ -1430,6 +1440,7 @@ the (optional) timestamp of last activity on this connection.")
"Password save function. "Password save function.
Will be called once the password has been verified by successful Will be called once the password has been verified by successful
authentication.") authentication.")
(put 'tramp-password-save-function 'tramp-suppress-trace t) (put 'tramp-password-save-function 'tramp-suppress-trace t)
(defvar tramp-password-prompt-not-unique nil (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.") during direct remote copying with scp.")
(defconst tramp-completion-file-name-handler-alist (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) . 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. "Alist of completion handler functions.
Used for file names matching `tramp-completion-file-name-regexp'. Used for file names matching `tramp-completion-file-name-regexp'.
Operations not mentioned here will be handled by Tramp's file 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 This is HOST, if non-nil. Otherwise, do a lookup in
`tramp-default-host-alist' and `tramp-default-host'." `tramp-default-host-alist' and `tramp-default-host'."
(let ((result (let ((result
(or (and (> (length host) 0) host) (or (and (tramp-compat-length> host 0) host)
(let ((choices tramp-default-host-alist) (let ((choices tramp-default-host-alist)
lhost item) lhost item)
(while choices (while choices
@ -1669,7 +1684,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in
lhost) lhost)
tramp-default-host))) tramp-default-host)))
;; We must mark, whether a default value has been used. ;; 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 result
(propertize result 'tramp-default t)))) (propertize result 'tramp-default t))))
@ -1732,14 +1747,13 @@ default values are used."
:port port :localname localname :hop hop)) :port port :localname localname :hop hop))
;; The method must be known. ;; The method must be known.
(unless (or nodefault non-essential (unless (or nodefault non-essential
(string-equal method tramp-default-method-marker)
(assoc method tramp-methods)) (assoc method tramp-methods))
(tramp-user-error (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. ;; Only some methods from tramp-sh.el do support multi-hops.
(unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v)) (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error (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) (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. ;; Only some methods from tramp-sh.el do support multi-hops.
(unless (or nodefault non-essential (tramp-multi-hop-p v)) (unless (or nodefault non-essential (tramp-multi-hop-p v))
(tramp-user-error (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))) (tramp-file-name-method v)))
;; Return result. ;; Return result.
v)) v))
(put #'tramp-dissect-hop-name 'tramp-suppress-trace t) (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) (defun tramp-buffer-name (vec)
"A name for the connection buffer VEC." "A name for the connection buffer VEC."
(let ((method (tramp-file-name-method vec)) (let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec)) (user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec))) (host-port (tramp-file-name-host-port vec)))
(if (not (zerop (length user-domain))) (if (tramp-string-empty-or-nil-p user-domain)
(format "*tramp/%s %s@%s*" method user-domain host-port) (format "*tramp/%s %s*" method host-port)
(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) (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) (when (cadr args)
(setq localname (and (stringp (cadr args)) (cadr args)))) (setq localname (and (stringp (cadr args)) (cadr args))))
(when hop (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'. ;; Assure that the hops are in `tramp-default-proxies-alist'.
;; In tramp-archive.el, the slot `hop' is used for the archive ;; In tramp-archive.el, the slot `hop' is used for the archive
;; file name. ;; file name.
@ -1827,23 +1847,23 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
hop (nth 6 args)))) hop (nth 6 args))))
;; Unless `tramp-syntax' is `simplified', we need a method. ;; Unless `tramp-syntax' is `simplified', we need a method.
(when (and (not (zerop (length tramp-postfix-method-format))) (when (and (not (string-empty-p tramp-postfix-method-format))
(zerop (length method))) (tramp-string-empty-or-nil-p method))
(signal 'wrong-type-argument (list #'stringp method))) (signal 'wrong-type-argument (list #'stringp method)))
(concat tramp-prefix-format hop (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)) (concat method tramp-postfix-method-format))
user user
(unless (zerop (length domain)) (unless (tramp-string-empty-or-nil-p domain)
(concat tramp-prefix-domain-format domain)) (concat tramp-prefix-domain-format domain))
(unless (zerop (length user)) (unless (tramp-string-empty-or-nil-p user)
tramp-postfix-user-format) tramp-postfix-user-format)
(when host (when host
(if (string-match-p tramp-ipv6-regexp host) (if (string-match-p tramp-ipv6-regexp host)
(concat (concat
tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host)) host))
(unless (zerop (length port)) (unless (tramp-string-empty-or-nil-p port)
(concat tramp-prefix-port-format port)) (concat tramp-prefix-port-format port))
tramp-postfix-host-format tramp-postfix-host-format
localname))) localname)))
@ -1861,19 +1881,19 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)."
(tramp-compat-rx (tramp-compat-rx
(regexp tramp-postfix-host-regexp) eos) (regexp tramp-postfix-host-regexp) eos)
tramp-postfix-hop-format 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) (defun tramp-completion-make-tramp-file-name (method user host localname)
"Construct a Tramp file name from METHOD, USER, HOST and 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 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." necessary only. This function will be used in file name completion."
(concat tramp-prefix-format (concat tramp-prefix-format
(unless (or (zerop (length method)) (unless (or (tramp-string-empty-or-nil-p method)
(zerop (length tramp-postfix-method-format))) (string-empty-p tramp-postfix-method-format))
(concat method 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)) (concat user tramp-postfix-user-format))
(unless (zerop (length host)) (unless (tramp-string-empty-or-nil-p host)
(concat (concat
(if (string-match-p tramp-ipv6-regexp host) (if (string-match-p tramp-ipv6-regexp host)
(concat (concat
@ -1920,7 +1940,7 @@ Return `tramp-cache-undefined' in case it doesn't exist."
(or (and (tramp-file-name-p vec-or-proc) (or (and (tramp-file-name-p vec-or-proc)
(get-buffer-process (tramp-buffer-name vec-or-proc))) (get-buffer-process (tramp-buffer-name vec-or-proc)))
(and (processp 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)) tramp-cache-undefined))
(defun tramp-get-connection-process (vec) (defun tramp-get-connection-process (vec)
@ -1970,9 +1990,9 @@ of `current-buffer'."
(let ((method (tramp-file-name-method vec)) (let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec)) (user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec))) (host-port (tramp-file-name-host-port vec)))
(if (not (zerop (length user-domain))) (if (tramp-string-empty-or-nil-p user-domain)
(format "*debug tramp/%s %s@%s*" method user-domain host-port) (format "*debug tramp/%s %s*" method host-port)
(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) (put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
@ -2202,7 +2222,7 @@ applicable)."
vec-or-proc 'dont-create)))))))) vec-or-proc 'dont-create))))))))
;; Translate proc to vec. ;; Translate proc to vec.
(when (processp vec-or-proc) (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. ;; Do it.
(when (tramp-file-name-p vec-or-proc) (when (tramp-file-name-p vec-or-proc)
(apply #'tramp-debug-message (apply #'tramp-debug-message
@ -2325,12 +2345,12 @@ the resulting error message."
(progn ,@body) (progn ,@body)
(error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
;; This macro shall optimize the cases where an `file-exists-p' call ;; This macro shall optimize the cases where a `file-exists-p' call is
;; is invoked first. Often, the file exists, so the remote command is ;; invoked first. Often, the file exists, so the remote command is
;; superfluous. ;; superfluous.
(defmacro tramp-barf-if-file-missing (vec filename &rest body) (defmacro tramp-barf-if-file-missing (vec filename &rest body)
"Execute BODY and return the result. "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." does not exist, otherwise propagate the error."
(declare (indent 2) (debug (symbolp form body))) (declare (indent 2) (debug (symbolp form body)))
(let ((err (make-symbol "err"))) (let ((err (make-symbol "err")))
@ -2483,13 +2503,14 @@ Example:
(setcdr v (delete (car v) (cdr v)))) (setcdr v (delete (car v) (cdr v))))
;; Check for function and file or registry key. ;; Check for function and file or registry key.
(unless (and (functionp (nth 0 (car v))) (unless (and (functionp (nth 0 (car v)))
(stringp (nth 1 (car v)))
(cond (cond
;; Windows registry. ;; Windows registry.
((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v))) ((string-prefix-p "HKEY_CURRENT_USER" (nth 1 (car v)))
(and (memq system-type '(cygwin windows-nt)) (and (memq system-type '(cygwin windows-nt))
(zerop (zerop
(tramp-call-process (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. ;; DNS-SD service type.
((string-match-p ((string-match-p
tramp-dns-sd-service-regexp (nth 1 (car v)))) 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. "Invoke Tramp file name completion handler for OPERATION and ARGS.
Falls back to normal file name handler if no Tramp file name handler exists." Falls back to normal file name handler if no Tramp file name handler exists."
(if-let (if-let
((fn (and tramp-mode ((fn (and tramp-mode minibuffer-completing-file-name
(assoc operation tramp-completion-file-name-handler-alist)))) (assoc operation tramp-completion-file-name-handler-alist))))
(save-match-data (apply (cdr fn) args)) (save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation 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)))) (and vec (process-live-p (get-process (tramp-buffer-name vec))))
(not non-essential)))) (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. ;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of ;; `tramp-completion-dissect-file-name' returns a list of
;; `tramp-file-name' structures. For all of them we return possible ;; `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))) (tramp-drop-volume-letter (expand-file-name filename directory)))
;; When `tramp-syntax' is `simplified', we need a default method. ;; When `tramp-syntax' is `simplified', we need a default method.
(tramp-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))
(tramp-default-method-alist (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-method-alist))
tramp-default-user tramp-default-user-alist tramp-default-user tramp-default-user-alist
tramp-default-host tramp-default-host-alist tramp-default-host tramp-default-host-alist
@ -3040,11 +3130,12 @@ not in completion mode."
result1))) result1)))
;; Complete local parts. ;; Complete local parts.
(append (delete-dups
result1 (append
(ignore-errors result1
(tramp-run-real-handler (ignore-errors
#'file-name-all-completions (list filename directory)))))) (tramp-run-real-handler
#'file-name-all-completions (list filename directory)))))))
;; Method, host name and user name completion for a file. ;; Method, host name and user name completion for a file.
(defun tramp-completion-handle-file-name-completion (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))) (unless (zerop (+ (length user) (length host)))
(tramp-completion-make-tramp-file-name method user host nil))) (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) (defun tramp-parse-default-user-host (method)
"Return a list of (user host) tuples allowed to access for METHOD. "Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function' 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) (tramp-dissect-file-name ,directory) 'file-missing ,directory)
nil))) 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) (defmacro tramp-skeleton-file-local-copy (filename &rest body)
"Skeleton for `tramp-*-handle-file-local-copy'. "Skeleton for `tramp-*-handle-file-local-copy'.
BODY is the backend specific code." BODY is the backend specific code."
@ -3640,29 +3791,29 @@ BODY is the backend specific code."
;; Set the ownership. ;; Set the ownership.
(when need-chown (when need-chown
(tramp-set-file-uid-gid filename uid gid))) (tramp-set-file-uid-gid filename uid gid))
;; Set extended attributes. We ignore possible errors, ;; Set extended attributes. We ignore possible errors,
;; because ACL strings could be incompatible. ;; because ACL strings could be incompatible.
(when attributes (when attributes
(ignore-errors (ignore-errors
(set-file-extended-attributes filename attributes))) (set-file-extended-attributes filename attributes)))
;; Unlock file. ;; Unlock file.
(when file-locked (when file-locked
;; `unlock-file' exists since Emacs 28.1. ;; `unlock-file' exists since Emacs 28.1.
(tramp-compat-funcall 'unlock-file lockname)) (tramp-compat-funcall 'unlock-file lockname))
;; Sanity check. ;; Sanity check.
(unless (equal curbuf (current-buffer)) (unless (equal curbuf (current-buffer))
(tramp-error (tramp-error
v 'file-error v 'file-error
"Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
(when (and (null noninteractive) (when (and (null noninteractive)
(or (eq ,visit t) (string-or-null-p ,visit))) (or (eq ,visit t) (string-or-null-p ,visit)))
(tramp-message v 0 "Wrote %s" filename)) (tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook)))))) (run-hooks 'tramp-handle-write-region-hook)))))))
;;; Common file name handler functions for different backends: ;;; Common file name handler functions for different backends:
@ -3711,7 +3862,7 @@ Let-bind it when necessary.")
(defun tramp-handle-access-file (filename string) (defun tramp-handle-access-file (filename string)
"Like `access-file' for Tramp files." "Like `access-file' for Tramp files."
(setq filename (file-truename filename)) (setq filename (file-truename filename))
(with-parsed-tramp-file-name filename v (with-parsed-tramp-file-name filename nil
(if (file-exists-p filename) (if (file-exists-p filename)
(unless (unless
(funcall (funcall
@ -3766,7 +3917,7 @@ Let-bind it when necessary.")
;; Otherwise, remove any trailing slash from localname component. ;; Otherwise, remove any trailing slash from localname component.
;; Method, host, etc, are unchanged. ;; Method, host, etc, are unchanged.
(while (with-parsed-tramp-file-name directory nil (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))) ?/) (eq (aref localname (1- (length localname))) ?/)
(not (string= localname "/")))) (not (string= localname "/"))))
(setq directory (substring directory 0 -1))) (setq directory (substring directory 0 -1)))
@ -3797,7 +3948,8 @@ Let-bind it when necessary.")
;; If DIR is not given, use DEFAULT-DIRECTORY or "/". ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/")) (setq dir (or dir default-directory "/"))
;; Handle empty NAME. ;; 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 NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name) (unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir 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)) (let ((uname (match-string 1 localname))
(fname (match-string 2 localname)) (fname (match-string 2 localname))
hname) hname)
(when (zerop (length uname)) (when (tramp-string-empty-or-nil-p uname)
(setq uname user)) (setq uname user))
(when (setq hname (tramp-get-home-directory v uname)) (when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname))))) (setq localname (concat hname fname)))))
@ -3846,9 +3998,10 @@ Let-bind it when necessary.")
(defun tramp-handle-file-directory-p (filename) (defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files." "Like `file-directory-p' for Tramp files."
;; `file-truename' could raise an error, for example due to a cyclic ;; `file-truename' could raise an error, for example due to a cyclic
;; symlink. ;; symlink. We don't protect this despite it, because other errors
(ignore-errors ;; might be worth to be visible, for example impossibility to mount
(eq (file-attribute-type (file-attributes (file-truename filename))) t))) ;; in tramp-gvfs.el.
(eq (file-attribute-type (file-attributes (file-truename filename))) t))
(defun tramp-handle-file-equal-p (filename1 filename2) (defun tramp-handle-file-equal-p (filename1 filename2)
"Like `file-equalp-p' for Tramp files." "Like `file-equalp-p' for Tramp files."
@ -3861,13 +4014,8 @@ Let-bind it when necessary.")
(defun tramp-handle-file-exists-p (filename) (defun tramp-handle-file-exists-p (filename)
"Like `file-exists-p' for Tramp files." "Like `file-exists-p' for Tramp files."
;; `file-exists-p' is used as predicate in file name completion. (tramp-skeleton-file-exists-p filename
;; We don't want to run it when `non-essential' is t, or there is (not (null (file-attributes filename)))))
;; 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)))))))
(defun tramp-handle-file-in-directory-p (filename directory) (defun tramp-handle-file-in-directory-p (filename directory)
"Like `file-in-directory-p' for Tramp files." "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 ;; Run the command on the localname portion only unless we are in
;; completion mode. ;; completion mode.
(tramp-make-tramp-file-name (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))) (not (tramp-connectable-p file)))
(tramp-run-real-handler (tramp-run-real-handler
#'file-name-as-directory #'file-name-as-directory
@ -3965,7 +4113,8 @@ Let-bind it when necessary.")
;; "." and ".." are never interesting as completions, and are ;; "." and ".." are never interesting as completions, and are
;; actually in the way in a directory with only one file. See ;; actually in the way in a directory with only one file. See
;; file_name_completion() in dired.c. ;; 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)))) (setq fnac (delete "./" (delete "../" fnac))))
(or (or
(try-completion (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) (unless (tramp-multi-hop-p item)
(setq tramp-default-proxies-alist saved-tdpa) (setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error (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))))) (tramp-file-name-method item)))))
;; Some methods ("su", "sg", "sudo", "doas", "ksu") do not use the ;; 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") (tramp-get-connection-property v "direct-async-process")
;; There's no multi-hop. ;; There's no multi-hop.
(or (not (tramp-multi-hop-p v)) (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. ;; There's no remote stdout or stderr file.
(or (not (stringp buffer)) (not (tramp-tramp-file-p buffer))) (or (not (stringp buffer)) (not (tramp-tramp-file-p buffer)))
(or (not (stringp stderr)) (not (tramp-tramp-file-p stderr)))))) (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. ;; t. See Bug#51177.
(when filter (when filter
(set-process-filter p 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) (process-put p 'remote-command orig-command)
(tramp-set-connection-property 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 () (defun tramp-handle-memory-info ()
"Like `memory-info' for Tramp files." "Like `memory-info' for Tramp files."
(let ((result '(0 0 0 0)) (let ((result (list 0 0 0 0))
process-file-side-effects) process-file-side-effects)
(with-temp-buffer (with-temp-buffer
(cond (cond
@ -5108,17 +5262,19 @@ support symbolic links."
(add-function (add-function
:after (process-sentinel p) :after (process-sentinel p)
(lambda (_proc _string) (lambda (_proc _string)
(with-current-buffer error-buffer (ignore-errors
(insert-file-contents-literally (with-current-buffer error-buffer
error-file nil nil nil 'replace)) (insert-file-contents-literally
(delete-file error-file)))) error-file nil nil nil 'replace))
(delete-file error-file)))))
(display-buffer output-buffer '(nil (allow-no-window . t))))) (display-buffer output-buffer '(nil (allow-no-window . t)))))
;; Insert error messages if they were separated. ;; Insert error messages if they were separated.
(when (and error-file (not (process-live-p p))) (when (and error-file (not (process-live-p p)))
(with-current-buffer error-buffer (ignore-errors
(insert-file-contents-literally error-file)) (with-current-buffer error-buffer
(delete-file error-file)))) (insert-file-contents-literally error-file))
(delete-file error-file)))))
;; Synchronous case. ;; Synchronous case.
(prog1 (prog1
@ -5126,9 +5282,10 @@ support symbolic links."
(process-file-shell-command command nil buffer) (process-file-shell-command command nil buffer)
;; Insert error messages if they were separated. ;; Insert error messages if they were separated.
(when error-file (when error-file
(with-current-buffer error-buffer (ignore-errors
(insert-file-contents-literally error-file)) (with-current-buffer error-buffer
(delete-file error-file)) (insert-file-contents-literally error-file))
(delete-file error-file)))
(if current-buffer-p (if current-buffer-p
;; This is like exchange-point-and-mark, but doesn't ;; This is like exchange-point-and-mark, but doesn't
;; activate the mark. It is cleaner to avoid activation, ;; activate the mark. It is cleaner to avoid activation,
@ -5300,7 +5457,7 @@ of."
;; There might be pending output. Avoid problems with reentrant ;; There might be pending output. Avoid problems with reentrant
;; call of Tramp. ;; call of Tramp.
(ignore-errors (ignore-errors
(while (tramp-accept-process-output proc 0))) (while (tramp-accept-process-output proc)))
(tramp-message proc 6 "Kill %S" proc) (tramp-message proc 6 "Kill %S" proc)
(delete-process proc)) (delete-process proc))
@ -5312,7 +5469,7 @@ of."
(with-current-buffer (process-buffer proc) (with-current-buffer (process-buffer proc)
(file-exists-p (file-exists-p
(concat (file-remote-p default-directory) (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) (defun tramp-file-notify-process-sentinel (proc event)
"Call `file-notify-rm-watch'." "Call `file-notify-rm-watch'."
@ -5438,7 +5595,7 @@ Wait, until the connection buffer changes."
;; Hide message in buffer. ;; Hide message in buffer.
(narrow-to-region (point-max) (point-max)) (narrow-to-region (point-max) (point-max))
;; Wait for new output. ;; Wait for new output.
(while (not (tramp-compat-ignore-error 'file-error (while (not (tramp-compat-ignore-error file-error
(tramp-wait-for-regexp (tramp-wait-for-regexp
proc 0.1 tramp-security-key-confirmed-regexp))) proc 0.1 tramp-security-key-confirmed-regexp)))
(when (tramp-check-for-regexp proc tramp-security-key-timeout-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." "Check, whether a process has finished."
(unless (process-live-p proc) (unless (process-live-p proc)
;; There might be pending output. ;; There might be pending output.
(while (tramp-accept-process-output proc 0)) (while (tramp-accept-process-output proc))
(throw 'tramp-action 'process-died))) (throw 'tramp-action 'process-died)))
(defun tramp-action-out-of-band (proc vec) (defun tramp-action-out-of-band (proc vec)
"Check, whether an out-of-band copy has finished." "Check, whether an out-of-band copy has finished."
;; There might be pending output for the exit status. ;; 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)) (cond ((and (not (process-live-p proc))
(zerop (process-exit-status proc))) (zerop (process-exit-status proc)))
(tramp-message vec 3 "Process has finished.") (tramp-message vec 3 "Process has finished.")
@ -5489,12 +5646,18 @@ See `tramp-process-actions' for the format of ACTIONS."
(while (not found) (while (not found)
;; Reread output once all actions have been performed. ;; Reread output once all actions have been performed.
;; Obviously, the output was not complete. ;; 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) (setq todo actions)
(while todo (while todo
(setq item (pop todo) (setq item (pop todo)
tramp-process-action-regexp (symbol-value (nth 0 item)) 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)) action (nth 1 item))
(tramp-message (tramp-message
vec 5 "Looking for regexp \"%s\" from remote shell" pattern) 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. ;; use the "password-vector" property in case we have several hops.
(tramp-set-connection-property (tramp-set-connection-property
(tramp-get-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) "first-password-request" tramp-cache-read-persistent-data)
(save-restriction (save-restriction
(with-tramp-progress-reporter (with-tramp-progress-reporter
@ -5606,11 +5769,22 @@ Mostly useful to protect BODY from being interrupted by timers."
,@body) ,@body)
(tramp-flush-connection-property ,proc "locked")))) (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. "Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set This is needed in order to hide `last-coding-system-used', which is set
for process communication also. for process communication also.
If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." 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) (with-current-buffer (process-buffer proc)
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
last-coding-system-used 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' ;; JUST-THIS-ONE is set due to Bug#12145. `with-local-quit'
;; returns t in order to report success. ;; returns t in order to report success.
(if (with-local-quit (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 (tramp-message
proc 10 "%s %s %s %s\n%s" proc 10 "%s %s %s\n%s"
proc timeout (process-status proc) result (buffer-string)) proc (process-status proc) result (buffer-string))
;; Propagate quit. ;; Propagate quit.
(keyboard-quit))) (keyboard-quit)))
result))) result)))
@ -5761,7 +5935,7 @@ the remote host use line-endings as defined in the variable
(defun tramp-process-sentinel (proc event) (defun tramp-process-sentinel (proc event)
"Flush file caches and remove shell prompt." "Flush file caches and remove shell prompt."
(unless (process-live-p proc) (unless (process-live-p proc)
(let ((vec (process-get proc 'vector)) (let ((vec (process-get proc 'tramp-vector))
(buf (process-buffer proc)) (buf (process-buffer proc))
(prompt (tramp-get-connection-property proc "prompt"))) (prompt (tramp-get-connection-property proc "prompt")))
(when vec (when vec
@ -6039,10 +6213,9 @@ to cache the result. Return the modified ATTR."
(with-tramp-file-property ,vec ,localname "file-attributes" (with-tramp-file-property ,vec ,localname "file-attributes"
(when-let ((attr ,attr)) (when-let ((attr ,attr))
(save-match-data (save-match-data
;; Remove color escape sequences from symlink. ;; Remove ANSI control escape sequences from symlink.
(when (stringp (car attr)) (when (stringp (car attr))
(while (string-match (while (string-match ansi-color-control-seq-regexp (car attr))
tramp-display-escape-sequence-regexp (car attr))
(setcar attr (replace-match "" nil nil (car attr))))) (setcar attr (replace-match "" nil nil (car attr)))))
;; Convert uid and gid. Use `tramp-unknown-id-integer' ;; Convert uid and gid. Use `tramp-unknown-id-integer'
;; as indication of unusable value. ;; 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 PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6." are written with verbosity of 6."
(let ((default-directory tramp-compat-temporary-file-directory) (let ((default-directory tramp-compat-temporary-file-directory)
(temporary-file-directory tramp-compat-temporary-file-directory)
(process-environment (default-toplevel-value 'process-environment)) (process-environment (default-toplevel-value 'process-environment))
(destination (if (eq destination t) (current-buffer) destination)) (destination (if (eq destination t) (current-buffer) destination))
(vec (or vec (car tramp-current-connection))) (vec (or vec (car tramp-current-connection)))
@ -6384,7 +6558,7 @@ are written with verbosity of 6."
(error (error
(setq error (error-message-string err) (setq error (error-message-string err)
result 1))) 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" result output)
(tramp-message vec 6 "%s\n%s\n%s" result output error)) (tramp-message vec 6 "%s\n%s\n%s" result output error))
result)) 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 PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6." are written with verbosity of 6."
(let ((default-directory tramp-compat-temporary-file-directory) (let ((default-directory tramp-compat-temporary-file-directory)
(temporary-file-directory tramp-compat-temporary-file-directory)
(process-environment (default-toplevel-value 'process-environment)) (process-environment (default-toplevel-value 'process-environment))
(buffer (if (eq buffer t) (current-buffer) buffer)) (buffer (if (eq buffer t) (current-buffer) buffer))
result) result)
@ -6469,7 +6644,7 @@ Consults the auth-source package."
;; In tramp-sh.el, we must use "password-vector" due to ;; In tramp-sh.el, we must use "password-vector" due to
;; multi-hop. ;; multi-hop.
(vec (tramp-get-connection-property (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)) (key (tramp-make-tramp-file-name vec 'noloc))
(method (tramp-file-name-method vec)) (method (tramp-file-name-method vec))
(user (or (tramp-file-name-user-domain 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 ;; Workaround. Prior Emacs 28.1, auth-source has saved empty
;; passwords. See discussion in Bug#50399. ;; 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)) (setq tramp-password-save-function nil))
(tramp-set-connection-property vec "first-password-request" 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. ;; negative pid, so we try both variants.
(tramp-compat-funcall (tramp-compat-funcall
'tramp-send-command 'tramp-send-command
(process-get proc 'vector) (process-get proc 'tramp-vector)
(format "(\\kill -2 -%d || \\kill -2 %d) 2>%s" (format "(\\kill -2 -%d || \\kill -2 %d) 2>%s"
pid pid 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, ;; Wait, until the process has disappeared. If it doesn't,
;; fall back to the default implementation. ;; fall back to the default implementation.
(while (tramp-accept-process-output proc 0)) (while (tramp-accept-process-output proc))
(not (process-live-p proc)))))) (not (process-live-p proc))))))
(add-hook 'interrupt-process-functions #'tramp-interrupt-process) (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 (cond
((processp process) ((processp process)
(setq pid (process-get process 'remote-pid) (setq pid (process-get process 'remote-pid)
vec (process-get process 'vector))) vec (process-get process 'tramp-vector)))
((numberp process) ((numberp process)
(setq pid process (setq pid process
vec (and (stringp remote) (tramp-dissect-file-name remote)))) 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". ;; "/ssh:user1@host:~user2".
;; ;;
;; * Implement file name abbreviation for user and host names. ;; * Implement file name abbreviation for user and host names.
;;
;; * Implement user and host name completion for multi-hops.
;;; tramp.el ends here ;;; tramp.el ends here

6
lisp/net/trampver.el
View file

@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes ;; Keywords: comm, processes
;; Package: tramp ;; Package: tramp
;; Version: 2.6.0.29.1 ;; Version: 2.6.2-pre
;; Package-Requires: ((emacs "26.1")) ;; Package-Requires: ((emacs "26.1"))
;; Package-Type: multi ;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/ ;; URL: https://www.gnu.org/software/tramp/
@ -40,7 +40,7 @@
;; ./configure" to change them. ;; ./configure" to change them.
;;;###tramp-autoload ;;;###tramp-autoload
(defconst tramp-version "2.6.0.29.1" (defconst tramp-version "2.6.2-pre"
"This version of Tramp.") "This version of Tramp.")
;;;###tramp-autoload ;;;###tramp-autoload
@ -78,7 +78,7 @@
;; Check for Emacs version. ;; Check for Emacs version.
(let ((x (if (not (string-version-lessp emacs-version "26.1")) (let ((x (if (not (string-version-lessp emacs-version "26.1"))
"ok" "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)))))) (replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x))) (unless (string-equal "ok" x) (error "%s" x)))

19
test/lisp/net/tramp-archive-tests.el
View file

@ -127,6 +127,12 @@ Some semantics has been changed for there, without new functions or
variables, so we check the Emacs version directly." variables, so we check the Emacs version directly."
(>= emacs-major-version 27)) (>= 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 () (ert-deftest tramp-archive-test00-availability ()
"Test availability of archive file name functions." "Test availability of archive file name functions."
:expected-result (if tramp-archive-enabled :passed :failed) :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))) (mapcar (lambda (x) (concat tmp-name x)) files)))
(should (equal (directory-files (should (equal (directory-files
tmp-name nil directory-files-no-dot-files-regexp) tmp-name nil directory-files-no-dot-files-regexp)
(delete "." (delete ".." files)))) (remove "." (remove ".." files))))
(should (equal (directory-files (should (equal (directory-files
tmp-name 'full directory-files-no-dot-files-regexp) tmp-name 'full directory-files-no-dot-files-regexp)
(mapcar (lambda (x) (concat tmp-name x)) (mapcar (lambda (x) (concat tmp-name x))
(delete "." (delete ".." files)))))) (remove "." (remove ".." files))))))
;; Cleanup. ;; Cleanup.
(tramp-archive-cleanup-hash)))) (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)))) (let ((fsi (with-no-warnings (file-system-info tramp-archive-test-archive))))
(skip-unless fsi) (skip-unless fsi)
(should (and (consp fsi) (should (and (consp fsi)
(= (length fsi) 3) (tramp-compat-length= fsi 3)
(numberp (nth 0 fsi)) (numberp (nth 0 fsi))
;; FREE and AVAIL are always 0. ;; FREE and AVAIL are always 0.
(zerop (nth 1 fsi)) (zerop (nth 1 fsi))
@ -913,12 +919,15 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(featurep 'tramp-archive))))")) (featurep 'tramp-archive))))"))
(dolist (enabled '(t nil)) (dolist (enabled '(t nil))
(dolist (default-directory (dolist (default-directory
`(,temporary-file-directory (append
`(,temporary-file-directory)
;; Starting Emacs in a directory which has ;; Starting Emacs in a directory which has
;; `tramp-archive-file-name-regexp' syntax is ;; `tramp-archive-file-name-regexp' syntax is
;; supported only with Emacs > 27.2 (sigh!). ;; supported only with Emacs > 27.2 (sigh!).
;; (Bug#48476) ;; (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"))) (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo")))
(should (should
(string-match (string-match

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

File diff suppressed because it is too large Load diff