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

Sync with Tramp 2.7.3-pre

Browse source 
* doc/misc/tramp.texi: Use @dots{} where appropriate.
(External methods): Precise remark on rsync speed.
(Customizing Methods): Add incus-tramp.
(Password handling): Mention expiration of cached passwords when a
session timeout happens.
(Predefined connection information): Mention also "androidsu" as
special case of "tmpdir".
(Ad-hoc multi-hops, Frequently Asked Questions):
Improve description how ad-hoc multi-hop file names can be made
persistent.  (Bug#65039, Bug#76457)
(Remote processes): Signals are not delivered to remote direct
async processes.  Say, that there are restrictions for transfer of
binary data to remote direct async processes.
(Bug Reports): Explain bisecting.
(Frequently Asked Questions): Improve index.  Speak about
fingerprint readers.  Recommend `small-temporary-file-directory'
for ssh sockets.
(External packages): Rename subsection "Timers, process filters,
process sentinels, redisplay".
(Extension packages): New node.
(Top, Files directories and localnames): Add it to @menu.

* doc/misc/trampver.texi:
* lisp/net/trampver.el (tramp-version): Adapt Tramp versions.
(tramp-repository-branch, tramp-repository-version):
Remove ;;;###tramp-autoload cookie.

* lisp/net/tramp-adb.el:
* lisp/net/tramp-androidsu.el:
* lisp/net/tramp-cache.el:
* lisp/net/tramp-cmds.el:
* lisp/net/tramp-compat.el:
* lisp/net/tramp-container.el:
* lisp/net/tramp-crypt.el:
* lisp/net/tramp-ftp.el:
* lisp/net/tramp-fuse.el:
* lisp/net/tramp-gvfs.el:
* lisp/net/tramp-integration.el:
* lisp/net/tramp-message.el:
* lisp/net/tramp-rclone.el:
* lisp/net/tramp-sh.el:
* lisp/net/tramp-smb.el:
* lisp/net/tramp-sshfs.el:
* lisp/net/tramp-sudoedit.el:
* lisp/net/tramp.el: Use `when-let*', `if-let*' and `and-let*'
consequently.  (Bug#73441)

* lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection):
Move setting of sentinel up.

* lisp/net/tramp-archive.el (tramp-archive-file-name-p):
Add ;;;###tramp-autoload cookie.
(tramp-archive-local-file-name): New defun.

* lisp/net/tramp-cache.el (tramp-connection-properties): Add link
to the Tramp manual in the docstring.
(tramp-get-connection-property, tramp-set-connection-property):
Don't raise a debug message for the `tramp-cache-version' key.
(with-tramp-saved-connection-property)
(with-tramp-saved-connection-properties): Add traces.
(tramp-dump-connection-properties): Don't save connection property
"pw-spec".

* lisp/net/tramp-cmds.el (tramp-repository-branch)
(tramp-repository-version): Declare.

* lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file):
(tramp-gvfs-do-copy-or-rename-file): Don't use the truename.
Handle symlinks.
(tramp-gvfs-local-file-name): New defun.

* lisp/net/tramp-message.el (tramp-repository-branch)
(tramp-repository-version): Declare.
(tramp-error-with-buffer, tramp-user-error): Don't redisplay in
`sit-for'.  (Bug#73718)
(tramp-warning): Fix `lwarn' call.

* lisp/net/tramp.el (tramp-read-passwd):
* lisp/net/tramp-sh.el (tramp-maybe-open-connection):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command):
Rename connection property "password-vector" to "pw-vector".

* lisp/net/tramp-sh.el (tramp-methods) <pscp, psftp>:
Adapt `tramp-copy-args' argument.
(tramp-get-remote-pipe-buf, tramp-actions-before-shell):
Use `tramp-fingerprint-prompt-regexp'.
(tramp-sh-handle-copy-directory):
Apply `tramp-do-copy-or-rename-file-directly' if possible.
(tramp-do-copy-or-rename-file): Refactor.  Handle symlinks.
(Bug#76678)
(tramp-plink-option-exists-p): New defun.
(tramp-ssh-or-plink-options): Rename from
`tramp-ssh-controlmaster-options'.  Adapt further plink options.
(tramp-do-copy-or-rename-file-out-of-band)
(tramp-maybe-open-connection): Adapt calls.
(tramp-sh-handle-make-process): Don't set connection property
"remote-pid", it's unused.
(tramp-sh-handle-process-file): Do proper quoting.
(tramp-vc-file-name-handler): Add `file-directory-p', which is
used in `vc-find-root'.  (Bug#74026)
(tramp-maybe-open-connection): Use connection property "hop-vector".
(tramp-get-remote-pipe-buf): Make it more robust.

* lisp/net/tramp-smb.el (tramp-smb-errors): Add string.
(tramp-smb-handle-copy-directory): Don't check existence of
DIRNAME, this is done in `tramp-skeleton-copy-directory' already.
(tramp-smb-handle-copy-file, tramp-smb-handle-rename-file): Refactor.

* lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file):
STDERR is not implemented.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file):
Don't use the truename.  Handle symlinks.

* lisp/net/tramp.el (tramp-mode): Set to nil on MS-DOS.
(tramp-otp-password-prompt-regexp): Add TACC HPC prompt.
(tramp-wrong-passwd-regexp): Add fingerprint messages.
(tramp-fingerprint-prompt-regexp, tramp-use-fingerprint):
New defcustoms.
(tramp-string-empty-or-nil-p):
Declare `tramp-suppress-trace' property.
(tramp-barf-if-file-missing): Accept also symlinks.
(tramp-skeleton-file-exists-p)
(tramp-handle-file-directory-p): Protect against cyclic symlinks.
(tramp-skeleton-make-symbolic-link): Drop volume letter when flushing.
(tramp-skeleton-process-file): Raise a warning if STDERR is not
implemented.
(tramp-skeleton-set-file-modes-times-uid-gid): Fix typo.
(tramp-compute-multi-hops): Check for
`tramp-sh-file-name-handler-p', it works only for this.
(tramp-handle-shell-command):
Respect `async-shell-command-display-buffer'.
(tramp-action-password, tramp-process-actions): Use connection
property "hop-vector".
(tramp-action-fingerprint, tramp-action-show-message): New defuns.
(tramp-action-show-and-confirm-message): Start check at (point-min).
(tramp-wait-for-regexp): Don't redisplay in `sit-for'.  (Bug#73718)
(tramp-convert-file-attributes): Don't cache
"file-attributes-ID-FORMAT".
(tramp-read-passwd, tramp-clear-passwd): Rewrite.  (Bug#74105)

* test/lisp/net/tramp-tests.el (auth-source-cache-expiry)
(ert-batch-backtrace-right-margin): Set them to nil.
(vc-handled-backends): Suppress if noninteractive.
(tramp--test-enabled): Cleanup also
`tramp-compat-temporary-file-directory'.
(tramp-test11-copy-file, tramp-test12-rename-file)
(tramp-test18-file-attributes, tramp--test-deftest-with-stat)
(tramp--test-deftest-with-perl, tramp--test-deftest-with-ls)
(tramp--test-deftest-without-file-attributes)
(tramp-test21-file-links, tramp-test28-process-file)
(tramp-test32-shell-command, tramp-test36-vc-registered)
(tramp-test39-make-lock-file-name, tramp--test-check-files)
(tramp-test42-utf8, tramp-test43-file-system-info)
(tramp-test44-file-user-group-ids, tramp-test47-read-password):
Adapt tests.
(tramp-test47-read-fingerprint): New test.
This commit is contained in:
Michael Albinus 2025-03-30 15:53:47 +02:00
parent e6b4c0bceb
commit 10991877c8
23 changed files with 1795 additions and 1181 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

304
doc/misc/tramp.texi
View file

@ -167,6 +167,7 @@ How file names, directories and localnames are mangled and managed
* Temporary directory:: Where temporary files are kept.
* Localname deconstruction:: Breaking a localname into its components.
* External packages:: Integration with external Lisp packages.
* Extension packages:: Adding new methods to @value{tramp}.
@end detailmenu
@end menu
@ -1112,7 +1113,8 @@ command to transfer is similar to the @option{scp} method.
@command{rsync} performs much better than @command{scp} when
transferring files that exist on both hosts. However, this advantage
is lost if the file exists only on one side of the connection.
is lost if the file exists only on one side of the connection, during
the first file transfer.
This method supports the @samp{-p} argument.
@ -1934,6 +1936,14 @@ They can be installed with Emacs's Package Manager. This includes
@c @item ibuffer-tramp.el
@c Contact Svend Sorensen <svend@@ciffer.net>
@cindex method @option{incus}
@cindex @option{incus} method
@item incus-tramp
Integration for Incus containers. A container is accessed via
@file{@trampfn{incus,user@@container,/path/to/file}}, @samp{user} and
@samp{container} have the same meaning as with the @option{docker}
method.
@cindex method @option{lxc}
@cindex @option{lxc} method
@item lxc-tramp
@ -2211,6 +2221,12 @@ this interactively.
@vindex auth-source-do-cache
Set @code{auth-source-do-cache} to @code{nil} to disable password caching.
For connections which use a session-timeout, like @option{sudo},
@option{doas} and @option{run0}, the password cache is expired by
@value{tramp} when the session expires (@pxref{Predefined connection
information}). However, this makes only sense if the password cannot
be retrieved from a persistent authentication file or store.
@node Connection caching
@section Reusing connection related information
@ -2332,9 +2348,9 @@ to a remote home directory, like @option{adb}, @option{rclone} and
@item @t{"tmpdir"}
The temporary directory on the remote host. If not specified, the
default value is @t{"/data/local/tmp"} for the @option{adb} method,
@t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise.
@ref{Temporary directory}.
default value is @t{"/data/local/tmp"} for the @option{adb} and
@option{androidsu} methods, @t{"/C$/Temp"} for the @option{smb}
method, and @t{"/tmp"} otherwise. @ref{Temporary directory}.
@item @t{"posix"}
@ -2623,7 +2639,7 @@ will help:
@example
@group
if test "$TERM" = "dumb"; then
...
@dots{}
fi
@end group
@end example
@ -3312,8 +3328,8 @@ Another option is to create better backup file naming with user and
host names prefixed to the file name. For example, transforming
@file{/etc/secretfile} to
@file{~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile}, set the
@value{tramp} user option @code{tramp-backup-directory-alist} from
the existing user option @code{backup-directory-alist}.
@value{tramp} user option @code{tramp-backup-directory-alist} from the
existing user option @code{backup-directory-alist}.
Then @value{tramp} backs up to a file name that is transformed with a
prefix consisting of the DIRECTORY name. This file name prefixing
@ -3335,10 +3351,12 @@ Example:
The backup file name of
@file{@trampfn{su,root@@localhost,/etc/secretfile}} would be
@ifset unified
@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile~}}.
@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/@c
!su:root@@localhost:!etc!secretfile~}}.
@end ifset
@ifset separate
@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/![su!root@@localhost]!etc!secretfile~}}.
@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/@c
![su!root@@localhost]!etc!secretfile~}}.
@end ifset
@vindex auto-save-file-name-transforms
@ -3783,15 +3801,21 @@ ssh@value{postfixhop}you@@remotehost@value{postfix}/path @key{RET}}
Each involved method must be an inline method (@pxref{Inline methods}).
@value{tramp} adds the ad-hoc definitions on the fly to
@code{tramp-default-proxies-alist} and is available for reuse during
that Emacs session. Subsequent @value{tramp} connections to the same
remote host can then use the shortcut form:
@samp{@trampfn{ssh,you@@remotehost,/path}}.
@value{tramp} adds the ad-hoc definitions as an ephemeral record to
@code{tramp-default-proxies-alist}, which are available for reuse
during that Emacs session. Subsequent @value{tramp} connections to
the same remote host can then use the abbreviated form
@file{@trampfn{ssh,you@@remotehost,/path}}.
@anchor{tramp-show-ad-hoc-proxies}
@defopt tramp-show-ad-hoc-proxies
If this user option is non-@code{nil}, ad-hoc definitions are kept in
remote file names instead of showing the shortcuts.
remote file names instead of showing the abbreviations. This is
useful if the ad-hoc proxy definition shall be used in further Emacs
sessions, kept in configuration files of recentf and other packages.
A non-@code{nil} setting of this option has effect only if set before
the connection is established.
@lisp
(customize-set-variable 'tramp-show-ad-hoc-proxies t)
@ -3802,10 +3826,18 @@ 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}).
@anchor{tramp-save-ad-hoc-proxies}
@defopt tramp-save-ad-hoc-proxies
For ad-hoc definitions to be saved automatically in
@code{tramp-default-proxies-alist} for future Emacs sessions, set
@code{tramp-save-ad-hoc-proxies} to non-@code{nil}.
@code{tramp-save-ad-hoc-proxies} to non-@code{nil}. The resulting
user option @code{tramp-default-proxies-alist} is saved in your
@file{.emacs} file.
If you use saved configuration files with abbreviated ad-hoc proxy
definitions on another host, for example by distribution of the
@code{recentf-save-file}, you must distribute your @file{.emacs} file
as well.
@lisp
(customize-set-variable 'tramp-save-ad-hoc-proxies t)
@ -4600,7 +4632,9 @@ It cannot be killed via @code{interrupt-process}.
It does not report the remote terminal name via @code{process-tty-name}.
@item
It does not set process property @code{remote-pid}.
It does not set process property @code{remote-pid}. Consequently,
signals cannot be sent to that remote process; they are sent to the
local process instead, which establishes the connection.
@item
It fails, when the command is too long. This can happen on
@ -4622,6 +4656,15 @@ by the connection property @t{"direct-async-process"}. This is still
supported but deprecated, and it will be removed in a future
@value{tramp} version.
@strong{Note}: For the @option{ssh} and @option{scp} methods,
@value{tramp} does not faithfully pass binary sequences on to the
process. You can change this by changing the respective connection
argument (@pxref{Predefined connection information}) via
@lisp
(add-to-list 'tramp-connection-properties (list "/ssh:" "direct-async" t))
@end lisp
@node Cleanup remote connections
@section Cleanup remote connections
@ -5013,8 +5056,8 @@ An archive file name can be a remote file name, as in
Since all file operations are mapped internally to @acronym{GVFS}
operations, remote file names supported by @code{tramp-gvfs} perform
better, because no local copy of the file archive must be downloaded
first. For example, @samp{/sftp:user@@host:...} performs better than
the similar @samp{/scp:user@@host:...}. See the constant
first. For example, @samp{/sftp:user@@host:@dots{}} performs better
than the similar @samp{/scp:user@@host:@dots{}}. See the constant
@code{tramp-archive-all-gvfs-methods} for a complete list of
@code{tramp-gvfs} supported method names.
@ -5138,6 +5181,17 @@ this stage. Also note that with a verbosity level of 6 or greater, the
contents of files and directories will be included in the debug buffer.
Passwords typed in @value{tramp} will never be included there.
If you find, that using @value{tramp} with @command{emacs -Q} doesn't
cause any problem, you might check your init file for the suspicious
configuration by bisecting it. That is, comment out about half of the
init file, and check whether the problem still arises when calling
@command{emacs}. If yes, comment out half of the still active code.
Otherwise, comment out the active code, and uncomment the just
commented code.
Call @command{emacs}, again. Reiterate, until you find the suspicious
configuration.
@node Frequently Asked Questions
@chapter Frequently Asked Questions
@ -5463,6 +5517,23 @@ nitrokey, or titankey.
(residential) keys by @command{ssh-agent}. As workaround, you might
disable @command{ssh-agent} for such keys.
@item
Does @value{tramp} support fingerprint readers?
Yes. A fingerprint reader can be used as an additional authentication
method for @option{sudo}-based logins. @value{tramp} supports the
required additional handshaking messages@footnote{It supports
fingerprint readers driven by @command{fprintd}.}. If the fingerprint
isn't recognized by the fingerprint reader in time, authentication
falls back to requesting a password.
@vindex tramp-use-fingerprint
If the user option @code{tramp-use-fingerprint} is @code{nil},
@value{tramp} interrupts the fingerprint request, falling back to
password authentication immediately.
@item
@value{tramp} does not connect to Samba or MS Windows hosts running
SMB1 connection protocol
@ -5646,6 +5717,7 @@ connection-local value.
@end group
@end lisp
@vindex XDG_DATA_HOME@r{, environment variable}
If Emacs is configured to use the XDG conventions for the trash
directory, remote files cannot be restored with the respective tools,
because those conventions don't specify remote paths. Such files must
@ -5895,18 +5967,30 @@ Thanks to @value{tramp} users for contributing to these recipes.
@item
Why saved multi-hop file names do not work in a new Emacs session?
Why don't saved ad-hoc multi-hop file names work in a new Emacs session?
When saving ad-hoc multi-hop @value{tramp} file names (@pxref{Ad-hoc
multi-hops}) via bookmarks, recent files, filecache, bbdb, or another
package, use the full ad-hoc file name including all hops, like
@file{@trampfn{ssh,bird@@bastion|ssh@value{postfixhop}@c
news.my.domain,/opt/news/etc}}.
By default, ad-hoc multi-hop file names are abbreviated after
completing the initial connection. These abbreviated forms retain
only the final hop, and so only the Emacs session that generated the
abbreviated form can understand it. @xref{Ad-hoc multi-hops}.
Alternatively, when saving abbreviated multi-hop file names
@file{@trampfn{ssh,news@@news.my.domain,/opt/news/etc}}, the user
option @code{tramp-save-ad-hoc-proxies} must be set non-@code{nil}
value.
For example, after connecting to @file{@trampfn{ssh,bird@@bastion|@c
ssh@value{postfixhop}news@@news.my.domain,/opt/news/etc}}, the file
name becomes @file{@trampfn{ssh,news@@news.my.domain,/opt/news/etc}}.
If the abbreviated form is saved in a bookmark, the recent files list,
bbdb, or similar, a new Emacs session has no way to know that the
connection must go through @samp{bird@@bastion} first.
There are two mechanisms to deal with this. The first is to customize
@code{tramp-show-ad-hoc-proxies} to a non-@code{nil} value, which
disables abbreviation. Then the fully-qualified ad-hoc multi-hop file
name is the one that will be both displayed and saved.
@xref{tramp-show-ad-hoc-proxies}.
Alternatively, you can customize @code{tramp-save-ad-hoc-proxies} to a
non-@code{nil} value which means to save the information how an
abbreviated multi-hop file name can be expanded.
@xref{tramp-save-ad-hoc-proxies}.
@item
@ -5965,6 +6049,8 @@ $ export EDITOR=/path/to/emacsclient.sh
@item
How to determine whether a buffer is remote?
@findex file-remote-p
@vindex default-directory
The buffer-local variable @code{default-directory} tells this. If the
form @code{(file-remote-p default-directory)} returns non-@code{nil},
the buffer is remote. See the optional arguments of
@ -6077,6 +6163,36 @@ as above in your @file{~/.emacs}:
@end lisp
@item
I get an error @samp{unix_listener: path
"/very/long/path/.cache/emacs/tramp.XXX" too long for Unix domain
socket} when connecting via @option{ssh} to a remote host.
@vindex small-temporary-file-directory
By default, @value{tramp} uses the directory @file{~/.cache/emacs/}
for creation of OpenSSH Unix domain sockets. On GNU/Linux, domain
sockets have a much lower maximum path length (currently 107
characters) than normal files.
You can change this directory by setting the user option
@code{small-temporary-file-directory} to another name, like
@lisp
@group
(unless small-temporary-file-directory
(customize-set-variable
'small-temporary-file-directory
(format "/run/user/%d/emacs/" (user-uid)))
(make-directory small-temporary-file-directory t))
@end group
@end lisp
@vindex XDG_RUNTIME_DIR@r{, environment variable}
@t{"/run/user/UID"} is the value of the environment variable
@env{XDG_RUNTIME_DIR}, which you can use instead via @code{(getenv
"XDG_RUNTIME_DIR")}.
@item
How to ignore errors when changing file attributes?
@ -6209,6 +6325,7 @@ programs.
* Temporary directory:: Where temporary files are kept.
* Localname deconstruction:: Splitting a localname into its component parts.
* External packages:: Integrating with external Lisp packages.
* Extension packages:: Adding new methods to @value{tramp}.
@end menu
@ -6326,7 +6443,7 @@ root directory, it is most likely sufficient to make the
@code{default-directory} of the process buffer as the root directory.
@subsection Timers
@subsection Timers, process filters, process sentinels, redisplay
@vindex remote-file-error
Timers run asynchronously at any time when Emacs is waiting for
@ -6345,6 +6462,133 @@ wrapping the timer function body as follows:
@end group
@end lisp
A similar problem could happen with process filters, process
sentinels, and redisplay (updating the mode line).
@node Extension packages
@section Adding new methods to @value{tramp}
There are two ways to add new methods to @value{tramp}: writing a new
backend including an own file name handler, or adding the new method,
using the existing @code{tramp-sh-file-name-handler}. The former
shall happen inside the @value{tramp} repository, and it isn't
discussed here. The latter means usually a new ELPA package.
@pxref{Customizing Methods} for some examples.
@subsection Writing an own ELPA package
An external ELPA package @file{foo-tramp.el}, which intends to
provide a new @value{tramp} method, say @option{foo}, must add this
new method to the variable @code{tramp-methods}. This variable is an
alist with elements @code{(@var{name} @var{param1} @var{param2}
@dots{})}.
@var{name} is the method name, @t{"foo"} in this case.
@var{param}@t{x} is a pair of the form @code{(@var{key} @var{value})}.
See the docstring of variable @code{tramp-methods} for possible
@var{key}s and @var{value}s. An example would be
@lisp
@group
(add-to-list
'tramp-methods
`("foo"
(tramp-login-program ,foo-tramp-executable)
(tramp-login-args (("exec") ("%h") ("--") ("su - %u")))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-i" "-c"))))
@end group
@end lisp
@code{foo-tramp-executable} in this example would be a Lisp constant,
which is the program name of @command{foo}.
Another initialization could tell @value{tramp} which are the default
user and host name for method @option{foo}. This is done by calling
@code{tramp-set-completion-function}:
@lisp
@group
(tramp-set-completion-function
"foo"
'((tramp-foo--completion-function @var{arg})))
@end group
@end lisp
@code{tramp-foo--completion-function} is a function, which returns
completion candidates. @var{arg}, a string, is the argument for the
completion function, for example a file name to read from.
@pxref{Customizing Completion} for details.
Finally, it might also be helpful to define default user or host names
for method @option{foo}, in case a remote file name leaves them empty.
This can be performed by calling
@lisp
@group
(add-to-list 'tramp-default-user-alist '("foo" nil "root"))
(add-to-list 'tramp-default-host-alist '("foo" nil "localhost"))
@end group
@end lisp
@pxref{Default User} and @ref{Default Host} explaining the user options
@code{tramp-default-user-alist} and @code{tramp-default-host-alist}.
@subsection Making a customized method optional
The settings of the previous subsection are global in the package
@file{foo-tramp.el}, meaning they are activated when loading
@code{foo-tramp}. Sometimes, it is desired to make these settings
available without loading the whole package @code{foo-tramp}, but
declaring the new method @option{foo} as optional method only. In
this case, declare a function @code{tramp-enable-foo-method} which
collects the initialization. This function must be auto loaded.
@lisp
@group
;;;###autoload
(defun tramp-enable-foo-method ()
(add-to-list 'tramp-methods '("foo" @dots{}))
(tramp-set-completion-function "foo" @dots{})
(add-to-list 'tramp-default-user-alist '("foo" @dots{}))
(add-to-list 'tramp-default-host-alist '("foo" @dots{})))
@end group
@end lisp
Then, you can activate method @option{foo} by calling @kbd{M-x
tramp-enable-method @key{RET} foo @key{RET}}. @pxref{Optional methods}.
@subsection Activating a customized method without loading the package
If you want to make method @option{foo} known after loading
@value{tramp}, without loading the package @file{foo-tramp.el}, you
must autoload the implementation of function
@code{tramp-enable-foo-method}. Add the following code in
@file{foo-tramp.el}:
@lisp
@group
;;;###autoload
(progn
(defun tramp-enable-foo-method ()
(add-to-list 'tramp-methods '("foo" @dots{}))
(tramp-set-completion-function "foo" @dots{})
(add-to-list 'tramp-default-user-alist '("foo" @dots{}))
(add-to-list 'tramp-default-host-alist '("foo" @dots{}))))
;;;###autoload
(with-eval-after-load 'tramp (tramp-enable-method "foo"))
@end group
@end lisp
The trick is to wrap the function definition of
@code{tramp-enable-foo-method} with @code{progn} for the
@code{;;;###autoload} cookie.
@node Traces and Profiles
@chapter How to Customize Traces

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 are auto-frobbed from configure.ac.
@set trampver 2.7.1.30.1
@set trampver 2.7.3-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 27.1

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

@ -201,15 +201,15 @@ It is used for TCP/IP devices."
;;;###tramp-autoload
(defsubst tramp-adb-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for ADB."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(string= (tramp-file-name-method vec) tramp-adb-method)))
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
((string= (tramp-file-name-method vec) tramp-adb-method)))))
;;;###tramp-autoload
(defun tramp-adb-file-name-handler (operation &rest args)
"Invoke the ADB handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
(if-let* ((fn (assoc operation tramp-adb-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
@ -616,7 +616,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-shell-quote-argument l2))
"Error copying %s to %s" filename newname))
(if-let ((tmpfile (file-local-copy filename)))
(if-let* ((tmpfile (file-local-copy filename)))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
@ -998,7 +998,7 @@ error and non-nil on success."
;; <https://android.stackexchange.com/questions/226638/how-to-use-multibyte-file-names-in-adb-shell/232379#232379>
;; mksh uses UTF-8 internally, but is currently limited to the
;; BMP (basic multilingua plane), which means U+0000 to
;; U+FFFD. If you want to use SMP codepoints (U-00010000 to
;; U+FFFD. If you want to use SMP codepoints (U-00010000 to
;; U-0010FFFD) on the input line, you currently have to disable
;; the UTF-8 mode (sorry).
(tramp-adb-execute-adb-command vec "shell" command)
@ -1125,6 +1125,11 @@ connection if a previous connection has died for some reason."
tramp-adb-program args)))
(prompt (md5 (concat (prin1-to-string process-environment)
(current-time-string)))))
;; Set sentinel. Initialize variables.
(set-process-sentinel p #'tramp-process-sentinel)
(tramp-post-process-creation p vec)
;; Wait for initial prompt. On some devices, it needs
;; an initial RET, in order to get it.
(sleep-for 0.1)
@ -1133,10 +1138,6 @@ connection if a previous connection has died for some reason."
(unless (process-live-p p)
(tramp-error vec 'file-error "Terminated!"))
;; Set sentinel. Initialize variables.
(set-process-sentinel p #'tramp-process-sentinel)
(tramp-post-process-creation p vec)
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)

6
lisp/net/tramp-androidsu.el
View file

@ -503,15 +503,15 @@ FUNCTION."
;;;###tramp-autoload
(defsubst tramp-androidsu-file-name-p (vec-or-filename)
"Check whether VEC-OR-FILENAME is for the `androidsu' method."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(equal (tramp-file-name-method vec) tramp-androidsu-method)))
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
((equal (tramp-file-name-method vec) tramp-androidsu-method)))))
;;;###tramp-autoload
(defun tramp-androidsu-file-name-handler (operation &rest args)
"Invoke the `androidsu' handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist)))
(if-let* ((fn (assoc operation tramp-androidsu-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)

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

@ -426,6 +426,7 @@ arguments to pass to the OPERATION."
;; File name conversions.
;;;###tramp-autoload
(defun tramp-archive-file-name-p (name)
"Return t if NAME is a string with archive file name syntax."
(and (stringp name)
@ -581,6 +582,12 @@ offered."
"Return NAME in GVFS syntax."
(tramp-make-tramp-file-name (tramp-archive-dissect-file-name name)))
;; This is used in GNU ELPA package tramp-locproc.el.
(defun tramp-archive-local-file-name (filename)
"Return local mount name of FILENAME."
(let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods)))
(tramp-gvfs-local-file-name (tramp-archive-gvfs-file-name filename))))
;; File name primitives.

42
lisp/net/tramp-cache.el
View file

@ -68,10 +68,10 @@
;; Some properties are handled special:
;;
;; - "process-name", "process-buffer" and "first-password-request" are
;; not saved in the file `tramp-persistency-file-name', although
;; being connection properties related to a `tramp-file-name'
;; structure.
;; - "process-name", "process-buffer", "first-password-request" and
;; "pw-spec" are not saved in the file
;; `tramp-persistency-file-name', although being connection
;; properties related to a `tramp-file-name' structure.
;;
;; - Reusable properties, which should not be saved, are kept in the
;; process key retrieved by `tramp-get-process' (the main connection
@ -97,8 +97,11 @@
Every entry has the form (REGEXP PROPERTY VALUE). The regexp
matches remote file names. It can be nil. PROPERTY is a string,
and VALUE the corresponding value. They are used, if there is no
matching entry for PROPERTY in `tramp-cache-data'. For more
details see the info pages."
matching entry for PROPERTY in `tramp-cache-data'.
PROPERTY can also be a string representing a parameter in
`tramp-methods'. For more details see the Info node `(tramp) Predefined
connection information'."
:group 'tramp
:version "24.4"
:type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
@ -234,8 +237,8 @@ Return VALUE."
"Remove some properties of FILE's upper directory."
(when (file-name-absolute-p file)
;; `file-name-directory' can return nil, for example for "~".
(when-let ((file (file-name-directory file))
(file (directory-file-name file)))
(when-let* ((file (file-name-directory file))
(file (directory-file-name file)))
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
@ -388,7 +391,8 @@ the connection, return DEFAULT."
(not (and (processp key) (not (process-live-p key)))))
(setq value cached
cache-used t))
(tramp-message key 7 "%s %s; cache used: %s" property value cache-used)
(unless (eq key tramp-cache-version)
(tramp-message key 7 "%s %s; cache used: %s" property value cache-used))
value))
;;;###tramp-autoload
@ -401,11 +405,12 @@ is `tramp-cache-undefined', nothing is set.
PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
Return VALUE."
(setq key (tramp-file-name-unify key))
(when-let ((hash (tramp-get-hash-table key)))
(when-let* ((hash (tramp-get-hash-table key)))
(puthash property value hash))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
(tramp-message key 7 "%s %s" property value)
(unless (eq key tramp-cache-version)
(tramp-message key 7 "%s %s" property value))
value)
;;;###tramp-autoload
@ -425,7 +430,7 @@ KEY identifies the connection, it is either a process or a
used to cache connection properties of the local machine.
PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
(setq key (tramp-file-name-unify key))
(when-let ((hash (tramp-get-hash-table key)))
(when-let* ((hash (tramp-get-hash-table key)))
(remhash property hash))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
@ -440,7 +445,7 @@ used to cache connection properties of the local machine."
(setq key (tramp-file-name-unify key))
(tramp-message
key 7 "%s %s" key
(when-let ((hash (gethash key tramp-cache-data)))
(when-let* ((hash (gethash key tramp-cache-data)))
(hash-table-keys hash)))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
@ -468,8 +473,10 @@ used to cache connection properties of the local machine."
(hash (tramp-get-hash-table key))
(cached (and (hash-table-p hash)
(gethash ,property hash tramp-cache-undefined))))
(tramp-message key 7 "Saved %s %s" property cached)
(unwind-protect (progn ,@body)
;; Reset PROPERTY. Recompute hash, it could have been flushed.
(tramp-message key 7 "Restored %s %s" property cached)
(setq hash (tramp-get-hash-table key))
(if (not (eq cached tramp-cache-undefined))
(puthash ,property cached hash)
@ -486,9 +493,13 @@ PROPERTIES is a list of file properties (strings)."
(mapcar
(lambda (property)
(cons property (gethash property hash tramp-cache-undefined)))
,properties)))
,properties))
;; Avoid superfluous debug buffers during host name completion.
(tramp-verbose (if minibuffer-completing-file-name 0 tramp-verbose)))
(tramp-message key 7 "Saved %s" values)
(unwind-protect (progn ,@body)
;; Reset PROPERTIES. Recompute hash, it could have been flushed.
(tramp-message key 7 "Restored %s" values)
(setq hash (tramp-get-hash-table key))
(dolist (value values)
(if (not (eq (cdr value) tramp-cache-undefined))
@ -579,7 +590,8 @@ PROPERTIES is a list of file properties (strings)."
(progn
(remhash "process-name" value)
(remhash "process-buffer" value)
(remhash "first-password-request" value))
(remhash "first-password-request" value)
(remhash "pw-spec" value))
(remhash key cache)))
cache)
;; Dump it.

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

@ -39,6 +39,8 @@
(defvar mm-7bit-chars)
(defvar reporter-eval-buffer)
(defvar reporter-prompt-for-summary-p)
(defvar tramp-repository-branch)
(defvar tramp-repository-version)
;;;###tramp-autoload
(defun tramp-change-syntax (&optional syntax)
@ -609,7 +611,9 @@ If the buffer runs `dired', the buffer is reverted."
(interactive)
(cond
((buffer-file-name)
(find-alternate-file (tramp-file-name-with-sudo (buffer-file-name))))
(let ((pos (point)))
(find-alternate-file (tramp-file-name-with-sudo (buffer-file-name)))
(goto-char pos)))
((tramp-dired-buffer-p)
(dired-unadvertise (expand-file-name default-directory))
(setq default-directory (tramp-file-name-with-sudo default-directory)
@ -644,7 +648,7 @@ This is needed if there are compatibility problems."
;; (declare (completion tramp-recompile-elpa-command-completion-p))
(interactive)
;; We expect just one Tramp package is installed.
(when-let
(when-let*
((dir (tramp-compat-funcall
'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
@ -741,8 +745,8 @@ buffer in your bug report.
(defun tramp-reporter-dump-variable (varsym mailbuf)
"Pretty-print the value of the variable in symbol VARSYM."
(when-let ((reporter-eval-buffer reporter-eval-buffer)
(val (buffer-local-value varsym reporter-eval-buffer)))
(when-let* ((reporter-eval-buffer reporter-eval-buffer)
(val (buffer-local-value varsym reporter-eval-buffer)))
(if (hash-table-p val)
;; Pretty print the cache.

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

@ -76,11 +76,10 @@
;; an infloop. We try to follow the XDG specification, for security reasons.
(defconst tramp-compat-temporary-file-directory
(file-name-as-directory
(if-let ((xdg (xdg-cache-home))
((file-directory-p xdg))
((file-writable-p xdg)))
;; We can use `file-name-concat' starting with Emacs 28.1.
(prog1 (setq xdg (concat (file-name-as-directory xdg) "emacs"))
(if-let* ((xdg (xdg-cache-home))
((file-directory-p xdg))
((file-writable-p xdg)))
(prog1 (setq xdg (expand-file-name "emacs" xdg))
(make-directory xdg t))
(eval (car (get 'temporary-file-directory 'standard-value)) t)))
"The default value of `temporary-file-directory' for Tramp.")
@ -368,7 +367,7 @@ value is the default binding of the variable."
(if (not criteria)
,variable
(hack-connection-local-variables criteria)
(if-let ((result (assq ',variable connection-local-variables-alist)))
(if-let* ((result (assq ',variable connection-local-variables-alist)))
(cdr result)
,variable)))))

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

@ -279,19 +279,19 @@ or `tramp-podmancp-method'.
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
(when-let ((raw-list
(shell-command-to-string
(concat program " ps --format '{{.ID}}\t{{.Names}}'")))
(lines (split-string raw-list "\n" 'omit))
(names
(tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (group (1+ nonl))
"\t" (? (group (1+ nonl))) eol)
line)
(or (match-string 2 line) (match-string 1 line))))
lines)))
(when-let* ((raw-list
(shell-command-to-string
(concat program " ps --format '{{.ID}}\t{{.Names}}'")))
(lines (split-string raw-list "\n" 'omit))
(names
(tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (group (1+ nonl))
"\t" (? (group (1+ nonl))) eol)
line)
(or (match-string 2 line) (match-string 1 line))))
lines)))
(mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
@ -301,19 +301,19 @@ see its function help for a description of the format."
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
(when-let ((raw-list
(shell-command-to-string
(concat
program " "
(tramp-kubernetes--context-namespace vec)
" get pods --no-headers"
;; We separate pods by "|". Inside a pod, its name
;; is separated from the containers by ":".
;; Containers are separated by ",".
" -o jsonpath='{range .items[*]}{\"|\"}{.metadata.name}"
"{\":\"}{range .spec.containers[*]}{.name}{\",\"}"
"{end}{end}'")))
(lines (split-string raw-list "|" 'omit)))
(when-let* ((raw-list
(shell-command-to-string
(concat
program " "
(tramp-kubernetes--context-namespace vec)
" get pods --no-headers"
;; We separate pods by "|". Inside a pod, its name
;; is separated from the containers by ":".
;; Containers are separated by ",".
" -o jsonpath='{range .items[*]}{\"|\"}{.metadata.name}"
"{\":\"}{range .spec.containers[*]}{.name}{\",\"}"
"{end}{end}'")))
(lines (split-string raw-list "|" 'omit)))
(let (names)
(dolist (line lines)
(setq line (split-string line ":" 'omit))
@ -382,7 +382,7 @@ Obey `tramp-kubernetes-context'"
(defun tramp-kubernetes--current-context-data (vec)
"Return Kubernetes current context data as JSON string."
(when-let ((current-context (tramp-kubernetes--current-context vec)))
(when-let* ((current-context (tramp-kubernetes--current-context vec)))
(tramp-skeleton-kubernetes-vector vec
(with-temp-buffer
(when (zerop
@ -398,7 +398,7 @@ Obey `tramp-kubernetes-context'"
"The kubectl options for context and namespace as string."
(mapconcat
#'identity
`(,(when-let ((context (tramp-kubernetes--current-context vec)))
`(,(when-let* ((context (tramp-kubernetes--current-context vec)))
(format "--context=%s" context))
,(when tramp-kubernetes-namespace
(format "--namespace=%s" tramp-kubernetes-namespace)))
@ -411,18 +411,18 @@ Obey `tramp-kubernetes-context'"
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
(when-let ((raw-list (shell-command-to-string (concat program " list -c")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n" 'omit)))
;; We do not show container IDs.
(names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (1+ (not space))
(1+ space) (group (1+ (not space))) space)
line)
(match-string 1 line)))
lines)))
(when-let* ((raw-list (shell-command-to-string (concat program " list -c")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n" 'omit)))
;; We do not show container IDs.
(names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (1+ (not space))
(1+ space) (group (1+ (not space))) space)
line)
(match-string 1 line)))
lines)))
(mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
@ -432,19 +432,19 @@ see its function help for a description of the format."
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
(when-let ((raw-list (shell-command-to-string (concat program " list")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n" 'omit)))
;; We do not show container IDs.
(names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (1+ (not space))
(1+ space) "|" (1+ space)
(group (1+ (not space))) space)
line)
(match-string 1 line)))
lines)))
(when-let* ((raw-list (shell-command-to-string (concat program " list")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n" 'omit)))
;; We do not show container IDs.
(names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (1+ (not space))
(1+ space) "|" (1+ space)
(group (1+ (not space))) space)
line)
(match-string 1 line)))
lines)))
(mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
@ -456,19 +456,19 @@ ID, instance IDs.
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
(when-let ((raw-list
(shell-command-to-string
;; Ignore header line.
(concat program " ps --columns=instance,application | cat -")))
(lines (split-string raw-list "\n" 'omit))
(names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (* space) (group (+ (not space)))
(? (+ space) (group (+ (not space)))) eol)
line)
(or (match-string 2 line) (match-string 1 line))))
lines)))
(when-let* ((raw-list
(shell-command-to-string
;; Ignore header line.
(concat program " ps --columns=instance,application | cat -")))
(lines (split-string raw-list "\n" 'omit))
(names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (* space) (group (+ (not space)))
(? (+ space) (group (+ (not space)))) eol)
line)
(or (match-string 2 line) (match-string 1 line))))
lines)))
(mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
@ -478,19 +478,19 @@ see its function help for a description of the format."
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
(when-let ((raw-list
(shell-command-to-string (concat program " instance list")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n" 'omit)))
(names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (group (1+ (not space)))
(1+ space) (1+ (not space))
(1+ space) (1+ (not space)))
line)
(match-string 1 line)))
lines)))
(when-let* ((raw-list
(shell-command-to-string (concat program " instance list")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n" 'omit)))
(names (tramp-compat-seq-keep
(lambda (line)
(when (string-match
(rx bol (group (1+ (not space)))
(1+ space) (1+ (not space))
(1+ space) (1+ (not space)))
line)
(match-string 1 line)))
lines)))
(mapcar (lambda (name) (list nil name)) names))))
(defun tramp-nspawn--completion-function (method)
@ -499,13 +499,13 @@ see its function help for a description of the format."
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
(when-let ((raw-list
(shell-command-to-string (concat program " list --all -q")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n")))
(first-words (mapcar (lambda (line) (car (split-string line)))
lines))
(machines (seq-take-while (lambda (name) name) first-words)))
(when-let* ((raw-list
(shell-command-to-string (concat program " list --all -q")))
;; Ignore header line.
(lines (cdr (split-string raw-list "\n")))
(first-words
(mapcar (lambda (line) (car (split-string line))) lines))
(machines (seq-take-while (lambda (name) name) first-words)))
(mapcar (lambda (m) (list nil m)) machines))))
;;;###tramp-autoload

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

@ -277,10 +277,10 @@ arguments to pass to the OPERATION."
"Invoke the encrypted remote file related OPERATION.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((filename
(apply #'tramp-crypt-file-name-for-operation operation args))
(fn (and (tramp-crypt-file-name-p filename)
(assoc operation tramp-crypt-file-name-handler-alist))))
(if-let* ((filename
(apply #'tramp-crypt-file-name-for-operation operation args))
((tramp-crypt-file-name-p filename))
(fn (assoc operation tramp-crypt-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-crypt-run-real-handler operation args)
@ -425,11 +425,11 @@ ARGS are the arguments. It returns t if ran successful, and nil otherwise."
"Return encrypted / decrypted NAME if NAME belongs to an encrypted directory.
OP must be `encrypt' or `decrypt'. Raise an error if this fails.
Otherwise, return NAME."
(if-let ((tramp-crypt-enabled t)
(dir (tramp-crypt-file-name-p name))
;; It must be absolute for the cache.
(localname (substring name (1- (length dir))))
(crypt-vec (tramp-crypt-dissect-file-name dir)))
(if-let* ((tramp-crypt-enabled t)
(dir (tramp-crypt-file-name-p name))
;; It must be absolute for the cache.
(localname (substring name (1- (length dir))))
(crypt-vec (tramp-crypt-dissect-file-name dir)))
;; Preserve trailing "/".
(funcall
(if (directory-name-p name) #'file-name-as-directory #'identity)
@ -465,9 +465,9 @@ Otherwise, return NAME."
Both files must be local files. OP must be `encrypt' or `decrypt'.
If OP is `decrypt', the basename of INFILE must be an encrypted file name.
Raise an error if this fails."
(when-let ((tramp-crypt-enabled t)
(dir (tramp-crypt-file-name-p root))
(crypt-vec (tramp-crypt-dissect-file-name dir)))
(when-let* ((tramp-crypt-enabled t)
(dir (tramp-crypt-file-name-p root))
(crypt-vec (tramp-crypt-dissect-file-name dir)))
(let ((coding-system-for-read
(if (eq op 'decrypt) 'binary coding-system-for-read))
(coding-system-for-write
@ -547,7 +547,7 @@ The structure consists of the `tramp-crypt-method' method, the
local user name, the hexlified directory NAME as host, and the
localname."
(save-match-data
(if-let ((dir (tramp-crypt-file-name-p name)))
(if-let* ((dir (tramp-crypt-file-name-p name)))
(make-tramp-file-name
:method tramp-crypt-method :user (user-login-name)
:host (url-hexify-string dir))

4
lisp/net/tramp-ftp.el
View file

@ -186,8 +186,8 @@ pass to the OPERATION."
;;;###tramp-autoload
(defsubst tramp-ftp-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME that should be forwarded to Ange-FTP."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(string= (tramp-file-name-method vec) tramp-ftp-method)))
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
((string= (tramp-file-name-method vec) tramp-ftp-method)))))
;;;###tramp-autoload
(tramp--with-startup

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

@ -129,8 +129,8 @@
(defun tramp-fuse-mount-spec (vec)
"Return local mount spec of VEC."
(if-let ((host (tramp-file-name-host vec))
(user (tramp-file-name-user vec)))
(if-let* ((host (tramp-file-name-host vec))
(user (tramp-file-name-user vec)))
(format "%s@%s:/" user host)
(format "%s:/" host)))

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

@ -879,9 +879,9 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
;;;###tramp-autoload
(defsubst tramp-gvfs-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME handled by the GVFS daemon."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(let ((method (tramp-file-name-method vec)))
(and (stringp method) (member method tramp-gvfs-methods)))))
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
(method (tramp-file-name-method vec))
((member method tramp-gvfs-methods)))))
;;;###tramp-autoload
(defun tramp-gvfs-file-name-handler (operation &rest args)
@ -891,11 +891,11 @@ arguments to pass to the OPERATION."
;; `file-remote-p' must not return an error. (Bug#68976)
(unless (or tramp-gvfs-enabled (eq operation 'file-remote-p))
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
(if-let ((filename (apply #'tramp-file-name-for-operation operation args))
(tramp-gvfs-dbus-event-vector
(and (tramp-tramp-file-p filename)
(tramp-dissect-file-name filename)))
(fn (assoc operation tramp-gvfs-file-name-handler-alist)))
(if-let* ((filename (apply #'tramp-file-name-for-operation operation args))
(tramp-gvfs-dbus-event-vector
(and (tramp-tramp-file-p filename)
(tramp-dissect-file-name filename)))
(fn (assoc operation tramp-gvfs-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
@ -928,9 +928,9 @@ arguments to pass to the OPERATION."
"Like `dbus-byte-array-to-string' but remove trailing \\0 if exists.
Return nil for null BYTE-ARRAY."
;; The byte array could be a variant. Take care.
(when-let ((byte-array
(if (and (consp byte-array) (atom (car byte-array)))
byte-array (car byte-array))))
(when-let* ((byte-array
(if (and (consp byte-array) (atom (car byte-array)))
byte-array (car byte-array))))
(dbus-byte-array-to-string
(if (and (consp byte-array) (zerop (car (last byte-array))))
(butlast byte-array) byte-array))))
@ -1042,105 +1042,113 @@ file names."
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
(setq filename (file-truename filename))
;; We cannot use `file-truename', this would fail for symlinks with
;; non-existing target.
(setq filename (expand-file-name filename))
(if (file-directory-p filename)
(progn
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
(if (file-symlink-p filename)
(progn
(make-symbolic-link
(file-symlink-p filename) newname ok-if-already-exists)
(when (eq op 'rename) (delete-file filename)))
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(equal-remote (tramp-equal-remote filename newname))
(volatile
(and (eq op 'rename) (tramp-gvfs-file-name-p filename)
(equal
(cdr
(assoc
"standard::is-volatile"
(tramp-gvfs-get-file-attributes filename)))
"TRUE")))
;; "gvfs-rename" is not trustworthy.
(gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(equal-remote (tramp-equal-remote filename newname))
(volatile
(and (eq op 'rename) (tramp-gvfs-file-name-p filename)
(equal
(cdr
(assoc
"standard::is-volatile"
(tramp-gvfs-get-file-attributes filename)))
"TRUE")))
;; "gvfs-rename" is not trustworthy.
(gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(when (file-regular-p newname)
(delete-file newname))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(when (file-regular-p newname)
(delete-file newname))
(cond
;; We cannot rename volatile files, as used by Google-drive.
((and (not equal-remote) volatile)
(prog1 (copy-file
filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
(delete-file filename)))
(cond
;; We cannot rename volatile files, as used by Google-drive.
((and (not equal-remote) volatile)
(prog1 (copy-file
filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes)
(delete-file filename)))
;; We cannot copy or rename directly.
((or (and equal-remote
(tramp-get-connection-property v "direct-copy-failed"))
(and t1 (not (tramp-gvfs-file-name-p filename)))
(and t2 (not (tramp-gvfs-file-name-p newname))))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(if (eq op 'copy)
(copy-file
filename tmpfile t keep-date preserve-uid-gid
preserve-extended-attributes)
(rename-file filename tmpfile t))
(rename-file tmpfile newname ok-if-already-exists)))
;; We cannot copy or rename directly.
((or (and equal-remote
(tramp-get-connection-property v "direct-copy-failed"))
(and t1 (not (tramp-gvfs-file-name-p filename)))
(and t2 (not (tramp-gvfs-file-name-p newname))))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(if (eq op 'copy)
(copy-file
filename tmpfile t keep-date preserve-uid-gid
preserve-extended-attributes)
(rename-file filename tmpfile t))
(rename-file tmpfile newname ok-if-already-exists)))
;; Direct action.
(t (with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless
(and (apply
#'tramp-gvfs-send-command v gvfs-operation
(append
(and (eq op 'copy) (or keep-date preserve-uid-gid)
'("--preserve"))
(list
(tramp-gvfs-url-file-name filename)
(tramp-gvfs-url-file-name newname))))
;; Some backends do not return a proper error
;; code in case of direct copy/move. Apply
;; sanity checks.
(or (not equal-remote)
(and
(tramp-gvfs-info newname)
(or (eq op 'copy)
(not (tramp-gvfs-info filename))))))
;; Direct action.
(t (with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless
(and (apply
#'tramp-gvfs-send-command v gvfs-operation
(append
(and (eq op 'copy) (or keep-date preserve-uid-gid)
'("--preserve"))
(list
(tramp-gvfs-url-file-name filename)
(tramp-gvfs-url-file-name newname))))
;; Some backends do not return a proper
;; error code in case of direct copy/move.
;; Apply sanity checks.
(or (not equal-remote)
(and
(tramp-gvfs-info newname)
(or (eq op 'copy)
(not (tramp-gvfs-info filename))))))
(if (or (not equal-remote)
(and equal-remote
(tramp-get-connection-property
v "direct-copy-failed")))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(tramp-error-with-buffer
nil v 'file-error
"%s failed, see buffer `%s' for details"
msg-operation (buffer-name)))
(if (or (not equal-remote)
(and equal-remote
(tramp-get-connection-property
v "direct-copy-failed")))
;; Propagate the error.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(tramp-error-with-buffer
nil v 'file-error
"%s failed, see buffer `%s' for details"
msg-operation (buffer-name)))
;; 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-gvfs-do-copy-or-rename-file
op filename newname ok-if-already-exists keep-date
preserve-uid-gid preserve-extended-attributes))))
;; 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-gvfs-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))
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)))
(when t2
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-properties v localname))))))))))
(when t2
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-properties v localname)))))))))))
(defun tramp-gvfs-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@ -1403,7 +1411,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(or (cdr (assoc "standard::size" attributes)) "0")))
;; ... file mode flags
(setq res-filemodes
(if-let ((n (cdr (assoc "unix::mode" attributes))))
(if-let* ((n (cdr (assoc "unix::mode" attributes))))
(tramp-file-mode-from-int (string-to-number n))
(format
"%s%s%s%s------"
@ -1419,11 +1427,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
"-" "x"))))
;; ... inode and device
(setq res-inode
(if-let ((n (cdr (assoc "unix::inode" attributes))))
(if-let* ((n (cdr (assoc "unix::inode" attributes))))
(string-to-number n)
(tramp-get-inode (tramp-dissect-file-name filename))))
(setq res-device
(if-let ((n (cdr (assoc "unix::device" attributes))))
(if-let* ((n (cdr (assoc "unix::device" attributes))))
(string-to-number n)
(tramp-get-device (tramp-dissect-file-name filename))))
@ -1677,19 +1685,21 @@ ID-FORMAT valid values are `string' and `integer'."
;; The result is cached in `tramp-get-remote-uid'.
(if (equal id-format 'string)
(tramp-file-name-user vec)
(when-let ((localname
(tramp-get-connection-property (tramp-get-process vec) "share")))
(file-attribute-user-id
(file-attributes (tramp-make-tramp-file-name vec localname) id-format)))))
(and-let* ((localname
(tramp-get-connection-property (tramp-get-process vec) "share"))
((file-attribute-user-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format)))))))
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
;; The result is cached in `tramp-get-remote-gid'.
(when-let ((localname
(tramp-get-connection-property (tramp-get-process vec) "share")))
(file-attribute-group-id
(file-attributes (tramp-make-tramp-file-name vec localname) id-format))))
(and-let* ((localname
(tramp-get-connection-property (tramp-get-process vec) "share"))
((file-attribute-group-id
(file-attributes
(tramp-make-tramp-file-name vec localname) id-format))))))
(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
@ -1722,12 +1732,12 @@ ID-FORMAT valid values are `string' and `integer'."
(setq method "davs"
localname
(concat (tramp-gvfs-get-remote-prefix v) localname)))
(when (string-equal "mtp" method)
(when-let
((media (tramp-get-connection-property v "media-device")))
(setq method (tramp-media-device-method media)
host (tramp-media-device-host media)
port (tramp-media-device-port media))))
(when-let*
(((string-equal "mtp" method))
(media (tramp-get-connection-property v "media-device")))
(setq method (tramp-media-device-method media)
host (tramp-media-device-host media)
port (tramp-media-device-port media)))
(when (and user domain)
(setq user (concat domain ";" user)))
(url-recreate-url
@ -1772,6 +1782,24 @@ a downcased host name only."
(string-match (rx bol (+ alnum) "://" (group (+ (not (any "/:"))))) url)
(match-string 1 url)))
;; This is used in GNU ELPA package tramp-locproc.el.
(defun tramp-gvfs-local-file-name (filename)
"Return local mount name of FILENAME."
(setq filename (file-name-unquote (expand-file-name filename)))
(with-parsed-tramp-file-name filename nil
(with-tramp-file-property v localname "local-file-name"
;; As long as we call `tramp-gvfs-maybe-open-connection' here,
;; we cache the result.
(tramp-gvfs-maybe-open-connection v)
(let ((quoted (file-name-quoted-p localname))
(localname (file-name-unquote localname)))
(funcall
(if quoted #'file-name-quote #'identity)
(expand-file-name
(if (file-name-absolute-p localname)
(substring localname 1) localname)
(tramp-get-file-property v "/" "fuse-mountpoint")))))))
;; D-Bus GVFS functions.
@ -1924,10 +1952,10 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and
(when (member method tramp-media-methods)
;; Ensure that media devices are cached.
(tramp-get-media-devices nil)
(when-let ((v (tramp-get-connection-property
(make-tramp-media-device
:method method :host host :port port)
"vector" nil)))
(when-let* ((v (tramp-get-connection-property
(make-tramp-media-device
:method method :host host :port port)
"vector" nil)))
(setq method (tramp-file-name-method v)
host (tramp-file-name-host v)
port (tramp-file-name-port v))))
@ -2024,10 +2052,10 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and
(when (member method tramp-media-methods)
;; Ensure that media devices are cached.
(tramp-get-media-devices vec)
(when-let ((v (tramp-get-connection-property
(make-tramp-media-device
:method method :host host :port port)
"vector")))
(when-let* ((v (tramp-get-connection-property
(make-tramp-media-device
:method method :host host :port port)
"vector")))
(setq method (tramp-file-name-method v)
host (tramp-file-name-host v)
port (tramp-file-name-port v))))
@ -2195,7 +2223,7 @@ connection if a previous connection has died for some reason."
method '(("smb" . "smb-share")
("davs" . "dav")
("nextcloud" . "dav")
("afp". "afp-volume")
("afp" . "afp-volume")
("gdrive" . "google-drive")))
method)
tramp-gvfs-mounttypes)
@ -2442,8 +2470,8 @@ It checks for registered GNOME Online Accounts."
(defun tramp-get-media-device (vec)
"Transform VEC into a `tramp-media-device' structure.
Check, that respective cache values do exist."
(if-let ((media (tramp-get-connection-property vec "media-device"))
(prop (tramp-get-connection-property media "vector")))
(if-let* ((media (tramp-get-connection-property vec "media-device"))
(prop (tramp-get-connection-property media "vector")))
media
(tramp-get-media-devices vec)
(tramp-get-connection-property vec "media-device")))

10
lisp/net/tramp-integration.el
View file

@ -551,11 +551,11 @@ See `tramp-process-attributes-ps-format'.")
;; Preset default "ps" profile for local hosts, based on system type.
(when-let ((local-profile
(cond ((eq system-type 'darwin)
'tramp-connection-local-darwin-ps-profile)
;; ... Add other system types here.
)))
(when-let* ((local-profile
(cond ((eq system-type 'darwin)
'tramp-connection-local-darwin-ps-profile)
;; ... Add other system types here.
)))
(connection-local-set-profiles
`(:application tramp :machine ,(system-name))
local-profile)

10
lisp/net/tramp-message.el
View file

@ -53,6 +53,8 @@
(declare-function tramp-file-name-host-port "tramp")
(declare-function tramp-file-name-user-domain "tramp")
(declare-function tramp-get-default-directory "tramp")
(defvar tramp-repository-branch)
(defvar tramp-repository-version)
;;;###tramp-autoload
(defcustom tramp-verbose 3
@ -422,7 +424,7 @@ an input event arrives. The other arguments are passed to `tramp-error'."
;; Show buffer.
(pop-to-buffer buf)
(discard-input)
(sit-for tramp-error-show-message-timeout)))
(sit-for tramp-error-show-message-timeout 'nodisp)))
;; Reset timestamp. It would be wrong after waiting for a while.
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
@ -444,7 +446,7 @@ an input event arrives. The other arguments are passed to `tramp-error'."
;; `tramp-error' does not show messages. So we must do it ourselves.
(apply #'message fmt-string arguments)
(discard-input)
(sit-for tramp-error-show-message-timeout)
(sit-for tramp-error-show-message-timeout 'nodisp)
;; Reset timestamp. It would be wrong after waiting for a while.
(when
(tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
@ -468,7 +470,7 @@ to `tramp-message'."
(declare (tramp-suppress-trace t))
(let (signal-hook-function)
(apply 'tramp-message vec-or-proc 2 fmt-string arguments)
(lwarn 'tramp :warning fmt-string arguments)))
(apply 'lwarn 'tramp :warning fmt-string arguments)))
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
@ -486,7 +488,7 @@ to `tramp-message'."
"Goto the linked message in debug buffer at place."
(declare (tramp-suppress-trace t))
(when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
(when-let ((point (button-get button 'position)))
(when-let* ((point (button-get button 'position)))
(goto-char point)))
(define-button-type 'tramp-debug-button-type

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

@ -166,15 +166,15 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
;;;###tramp-autoload
(defsubst tramp-rclone-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for rclone."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(string= (tramp-file-name-method vec) tramp-rclone-method)))
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
((string= (tramp-file-name-method vec) tramp-rclone-method)))))
;;;###tramp-autoload
(defun tramp-rclone-file-name-handler (operation &rest args)
"Invoke the rclone handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
(if-let* ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)

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

@ -354,7 +354,7 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp")
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp") ("%c")
("-p" "%k") ("-q") ("-r")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
@ -372,7 +372,7 @@ The string is used in `tramp-methods'.")
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp")
(tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("%c")
("-p" "%k")))
(tramp-copy-keep-date t)))
@ -597,6 +597,7 @@ shell from reading its init file."
'((tramp-login-prompt-regexp tramp-action-login)
(tramp-password-prompt-regexp tramp-action-password)
(tramp-otp-password-prompt-regexp tramp-action-otp-password)
(tramp-fingerprint-prompt-regexp tramp-action-fingerprint)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(shell-prompt-pattern tramp-action-succeed)
(tramp-shell-prompt-pattern tramp-action-succeed)
@ -1808,7 +1809,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; be expected that this is always a directory.
(or (tramp-string-empty-or-nil-p localname)
(with-tramp-file-property v localname "file-directory-p"
(if-let
(if-let*
((truename (tramp-get-file-property v localname "file-truename"))
((tramp-file-property-p
v (tramp-file-local-name truename) "file-attributes")))
@ -1852,7 +1853,10 @@ ID-FORMAT valid values are `string' and `integer'."
;; test.
(tramp-check-remote-uname v tramp-bsd-unames)
(= (file-attribute-group-id attributes)
(tramp-get-remote-gid v 'integer)))))))))
(tramp-get-remote-gid v 'integer))
;; FIXME: `file-ownership-preserved-p' tests also the
;; ownership of the parent directory. We don't.
)))))))
;; Directory listings.
@ -2023,49 +2027,56 @@ ID-FORMAT valid values are `string' and `integer'."
(t2 (tramp-tramp-file-p newname))
target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(unless (file-exists-p dirname)
(tramp-error v 'file-missing dirname))
(cond
;; `copy-directory-create-symlink' exists since Emacs 28.1.
((and (bound-and-true-p copy-directory-create-symlink)
(setq target (file-symlink-p dirname))
(tramp-equal-remote dirname newname))
(make-symbolic-link
target
(if (directory-name-p newname)
(concat newname (file-name-nondirectory dirname)) newname)
t))
;; `copy-directory-create-symlink' exists since Emacs 28.1.
(if (and (bound-and-true-p copy-directory-create-symlink)
(setq target (file-symlink-p dirname))
(tramp-equal-remote dirname newname))
(make-symbolic-link
target
(if (directory-name-p newname)
(concat newname (file-name-nondirectory dirname)) newname)
t)
;; Shortcut: if method, host, user are the same for both
;; files, we invoke `cp' on the remote host directly.
((and (not copy-contents)
(tramp-equal-remote dirname newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(setq dirname (directory-file-name (expand-file-name dirname))
newname (directory-file-name (expand-file-name newname)))
(tramp-do-copy-or-rename-file-directly
'copy dirname newname
'ok-if-already-exists keep-date 'preserve-uid-gid))
(if (and (not copy-contents)
(tramp-get-method-parameter v 'tramp-copy-recursive)
;; When DIRNAME and NEWNAME are remote, they must
;; have the same method.
(or (null t1) (null t2)
(string-equal
(tramp-file-name-method
(tramp-dissect-file-name dirname))
(tramp-file-name-method
(tramp-dissect-file-name newname)))))
;; scp or rsync DTRT.
(progn
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(setq dirname (directory-file-name (expand-file-name dirname))
newname (directory-file-name (expand-file-name newname)))
(when (and (file-directory-p newname)
(not (string-equal (file-name-nondirectory dirname)
(file-name-nondirectory newname))))
(setq newname
(expand-file-name
(file-name-nondirectory dirname) newname)))
(unless (file-directory-p (file-name-directory newname))
(make-directory (file-name-directory newname) parents))
(tramp-do-copy-or-rename-file-out-of-band
'copy dirname newname 'ok-if-already-exists keep-date))
;; scp or rsync DTRT.
((and (not copy-contents)
(tramp-get-method-parameter v 'tramp-copy-recursive)
;; When DIRNAME and NEWNAME are remote, they must have
;; the same method.
(or (null t1) (null t2)
(string-equal
(tramp-file-name-method (tramp-dissect-file-name dirname))
(tramp-file-name-method (tramp-dissect-file-name newname)))))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-already-exists newname))
(setq dirname (directory-file-name (expand-file-name dirname))
newname (directory-file-name (expand-file-name newname)))
(when (and (file-directory-p newname)
(not (string-equal (file-name-nondirectory dirname)
(file-name-nondirectory newname))))
(setq newname
(expand-file-name (file-name-nondirectory dirname) newname)))
(unless (file-directory-p (file-name-directory newname))
(make-directory (file-name-directory newname) parents))
(tramp-do-copy-or-rename-file-out-of-band
'copy dirname newname 'ok-if-already-exists keep-date))
;; We must do it file-wise.
(tramp-run-real-handler
;; We must do it file-wise.
(t (tramp-run-real-handler
#'copy-directory
(list dirname newname keep-date parents copy-contents))))
@ -2117,123 +2128,129 @@ file names."
(progn
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
(if (file-symlink-p filename)
(progn
(make-symbolic-link
(file-symlink-p filename) newname ok-if-already-exists)
(when (eq op 'rename) (delete-file filename)))
;; FIXME: This should be optimized. Computing `file-attributes'
;; checks already, whether the file exists.
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(length (file-attribute-size
(file-attributes (file-truename filename))))
(file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(msg-operation (if (eq op 'copy) "Copying" "Renaming"))
copy-keep-date)
;; FIXME: This should be optimized. Computing `file-attributes'
;; checks already, whether the file exists.
(let ((t1 (tramp-tramp-file-p filename))
(t2 (tramp-tramp-file-p newname))
(length (or (file-attribute-size
(file-attributes (file-truename filename)))
;; `filename' doesn't exist, for example due
;; to non-existent symlink target.
0))
(file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(msg-operation (if (eq op 'copy) "Copying" "Renaming"))
copy-keep-date)
(with-parsed-tramp-file-name (if t1 filename newname) nil
(unless length
(tramp-error v 'file-missing filename))
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(cond
;; Both are Tramp files.
((and t1 t2)
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(cond
;; Shortcut: if method, host, user are the same for
;; both files, we invoke `cp' or `mv' on the remote
;; host directly.
((tramp-equal-remote filename newname)
(setq copy-keep-date
(or (eq op 'rename) keep-date preserve-uid-gid))
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; Try out-of-band operation.
((and
(tramp-method-out-of-band-p v1 length)
(tramp-method-out-of-band-p v2 length))
(setq copy-keep-date
(tramp-get-method-parameter v 'tramp-copy-keep-date))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname ok-if-already-exists keep-date))
;; No shortcut was possible. So we copy the file
;; first. If the operation was `rename', we go
;; back and delete the original file (if the copy
;; was successful). The approach is simple-minded:
;; we create a new buffer, insert the contents of
;; the source file into it, then write out the
;; buffer to the target file. The advantage is
;; that it doesn't matter which file name handlers
;; are used for the source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
op filename newname ok-if-already-exists keep-date))))))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
(cond
;; Fast track on local machine.
((tramp-local-host-p v)
(setq copy-keep-date
(or (eq op 'rename) keep-date preserve-uid-gid))
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; Both are Tramp files.
((and t1 t2)
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(cond
;; Shortcut: if method, host, user are the same
;; for both files, we invoke `cp' or `mv' on the
;; remote host directly.
((tramp-equal-remote filename newname)
(setq copy-keep-date
(or (eq op 'rename) keep-date preserve-uid-gid))
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; If the Tramp file has an out-of-band method, the
;; corresponding copy-program can be invoked.
((tramp-method-out-of-band-p v length)
(setq copy-keep-date
(tramp-get-method-parameter v 'tramp-copy-keep-date))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname ok-if-already-exists keep-date))
;; Try out-of-band operation.
((and
(tramp-method-out-of-band-p v1 length)
(tramp-method-out-of-band-p v2 length))
(setq copy-keep-date
(tramp-get-method-parameter v 'tramp-copy-keep-date))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname ok-if-already-exists keep-date))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
op filename newname ok-if-already-exists keep-date))))
;; No shortcut was possible. So we copy the file
;; first. If the operation was `rename', we go
;; back and delete the original file (if the copy
;; was successful). The approach is simple-minded:
;; we create a new buffer, insert the contents of
;; the source file into it, then write out the
;; buffer to the target file. The advantage is
;; that it doesn't matter which file name handlers
;; are used for the source and target file.
(t
(tramp-do-copy-or-rename-file-via-buffer
op filename newname ok-if-already-exists keep-date))))))
(t
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
;; One file is a Tramp file, the other one is local.
((or t1 t2)
(cond
;; Fast track on local machine.
((tramp-local-host-p v)
(setq copy-keep-date
(or (eq op 'rename) keep-date preserve-uid-gid))
(tramp-do-copy-or-rename-file-directly
op filename newname
ok-if-already-exists keep-date preserve-uid-gid))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
;; If the Tramp file has an out-of-band method, the
;; corresponding copy-program can be invoked.
((tramp-method-out-of-band-p v length)
(setq copy-keep-date
(tramp-get-method-parameter v 'tramp-copy-keep-date))
(tramp-do-copy-or-rename-file-out-of-band
op filename newname ok-if-already-exists keep-date))
;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))
;; Use the inline method via a Tramp buffer.
(t (tramp-do-copy-or-rename-file-via-buffer
op filename newname ok-if-already-exists keep-date))))
;; Handle `preserve-extended-attributes'. We ignore
;; possible errors, because ACL strings could be
;; incompatible.
(when-let ((attributes (and preserve-extended-attributes
(file-extended-attributes filename))))
(ignore-errors
(set-file-extended-attributes newname attributes)))
(t
;; One of them must be a Tramp file.
(error "Tramp implementation says this cannot happen")))
;; KEEP-DATE handling.
(when (and keep-date (not copy-keep-date))
(tramp-compat-set-file-times
newname file-times (unless ok-if-already-exists 'nofollow)))
;; In case of `rename', we must flush the cache of the source file.
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
;; Set the mode.
(unless (and keep-date copy-keep-date)
(set-file-modes newname file-modes))))))))
;; NEWNAME has wrong cached values.
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))
;; Handle `preserve-extended-attributes'. We ignore
;; possible errors, because ACL strings could be
;; incompatible.
(when-let* ((attributes (and preserve-extended-attributes
(file-extended-attributes filename))))
(ignore-errors
(set-file-extended-attributes newname attributes)))
;; KEEP-DATE handling.
(when (and keep-date (not copy-keep-date))
(tramp-compat-set-file-times
newname file-times (unless ok-if-already-exists 'nofollow)))
;; Set the mode.
(unless (and keep-date copy-keep-date)
(set-file-modes newname file-modes)))))))))
(defun tramp-do-copy-or-rename-file-via-buffer
(op filename newname _ok-if-already-exists _keep-date)
@ -2474,7 +2491,7 @@ The method used must be an out-of-band method."
;; Compose copy command.
(setq options
(format-spec
(tramp-ssh-controlmaster-options v)
(tramp-ssh-or-plink-options v)
(format-spec-make
?t (tramp-get-connection-property
(tramp-get-connection-process v) "temp-file" "")))
@ -2859,7 +2876,7 @@ The method used must be an out-of-band method."
(rx bol (group (* blank) "total")) nil t)
;; Emacs 29.1 or later.
(not (fboundp 'dired--insert-disk-space)))
(when-let ((available (get-free-disk-space ".")))
(when-let* ((available (get-free-disk-space ".")))
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
(end-of-line)
@ -3094,8 +3111,7 @@ will be used."
;; needed when sending signals remotely.
(let ((pid (tramp-send-command-and-read v "echo $$")))
(setq p (tramp-get-connection-process v))
(process-put p 'remote-pid pid)
(tramp-set-connection-property p "remote-pid" pid))
(process-put p 'remote-pid pid))
(when (memq connection-type '(nil pipe))
;; Disable carriage return to newline
;; translation. This does not work on
@ -3110,7 +3126,7 @@ will be used."
;; character to read. When a process does
;; not read from stdin, like magit, it
;; should set a timeout
;; instead. See`tramp-pipe-stty-settings'.
;; instead. See `tramp-pipe-stty-settings'.
;; (Bug#62093)
;; FIXME: Shall we rather use "stty raw"?
(tramp-send-command
@ -3269,8 +3285,7 @@ will be used."
(setq ret (tramp-send-command-and-check
v (format
"cd %s && %s"
(tramp-unquote-shell-quote-argument localname)
command)
(tramp-shell-quote-argument localname) command)
t t t))
(unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
@ -3305,7 +3320,7 @@ will be used."
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(tramp-skeleton-file-local-copy filename
(if-let ((size (file-attribute-size (file-attributes filename))))
(if-let* ((size (file-attribute-size (file-attributes filename))))
(let (rem-enc loc-dec)
(condition-case err
@ -3619,14 +3634,14 @@ filled are described in `tramp-bundle-read-file-names'."
;; requires a remote command (the file cache must be invalidated).
;; Therefore, we apply a kind of optimization. We install the file
;; name handler `tramp-vc-file-name-handler', which does nothing but
;; remembers all file names for which `file-exists-p' or
;; `file-readable-p' has been applied. A first run of `vc-registered'
;; is performed. Afterwards, a script is applied for all collected
;; file names, using just one remote command. The result of this
;; script is used to fill the file cache with actual values. Now we
;; can reset the file name handlers, and we make a second run of
;; `vc-registered', which returns the expected result without sending
;; any other remote command.
;; remembers all file names for which `file-exists-p',
;; `file-readable-p' or `file-directory-p' has been applied. A first
;; run of `vc-registered' is performed. Afterwards, a script is
;; applied for all collected file names, using just one remote
;; command. The result of this script is used to fill the file cache
;; with actual values. Now we can reset the file name handlers, and
;; we make a second run of `vc-registered', which returns the expected
;; result without sending any other remote command.
;; When called during `revert-buffer', it shouldn't spam the echo area
;; and the *Messages* buffer.
(defun tramp-sh-handle-vc-registered (file)
@ -3658,10 +3673,11 @@ filled are described in `tramp-bundle-read-file-names'."
;; Send just one command, in order to fill the cache.
(tramp-bundle-read-file-names v tramp-vc-registered-file-names))
;; Second run. Now all `file-exists-p' or `file-readable-p'
;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
;; in order to keep the cache.
;; Second run. Now all `file-exists-p', `file-readable-p'
;; or `file-directory-p' calls shall be answered from the
;; file cache. We unset `process-file-side-effects' and
;; `remote-file-name-inhibit-cache' in order to keep the
;; cache.
(let ((vc-handled-backends (copy-sequence vc-handled-backends))
remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize
@ -3696,7 +3712,7 @@ filled are described in `tramp-bundle-read-file-names'."
(defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
(if-let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
(if-let* ((fn (assoc operation tramp-sh-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
@ -3718,33 +3734,35 @@ Fall back to normal file name handler if no Tramp handler exists."
(defun tramp-vc-file-name-handler (operation &rest args)
"Invoke special file name handler, which collects files to be handled."
(save-match-data
(let ((filename
(tramp-replace-environment-variables
(apply #'tramp-file-name-for-operation operation args)))
(fn (assoc operation tramp-sh-file-name-handler-alist)))
(if (tramp-tramp-file-p filename)
(with-parsed-tramp-file-name filename nil
(cond
;; That's what we want: file names, for which checks are
;; applied. We assume that VC uses only `file-exists-p'
;; and `file-readable-p' checks; otherwise we must extend
;; the list. We do not perform any action, but return
;; nil, in order to keep `vc-registered' running.
((and fn (memq operation '(file-exists-p file-readable-p)))
(add-to-list 'tramp-vc-registered-file-names localname 'append)
nil)
;; `process-file' and `start-file-process' shall be ignored.
((and fn (eq operation 'process-file) 0))
((and fn (eq operation 'start-file-process) nil))
;; Tramp file name handlers like `expand-file-name'. They
;; must still work.
(fn (save-match-data (apply (cdr fn) args)))
;; Default file name handlers, we don't care.
(t (tramp-run-real-handler operation args))))
(if-let* ((filename
(tramp-replace-environment-variables
(apply #'tramp-file-name-for-operation operation args)))
((tramp-tramp-file-p filename))
(fn (assoc operation tramp-sh-file-name-handler-alist)))
(with-parsed-tramp-file-name filename nil
(cond
;; That's what we want: file names, for which checks are
;; applied. We assume that VC uses only `file-exists-p',
;; `file-readable-p' and `file-directory-p' checks;
;; otherwise we must extend the list. The respective cache
;; value must be set for these functions in
;; `tramp-bundle-read-file-names'.
;; We do not perform any action, but return nil, in order
;; to keep `vc-registered' running.
((memq operation '(file-exists-p file-readable-p file-directory-p))
(add-to-list 'tramp-vc-registered-file-names localname 'append)
nil)
;; `process-file' and `start-file-process' shall be ignored.
((eq operation 'process-file) 0)
((eq operation 'start-file-process) nil)
;; Tramp file name handlers like `expand-file-name'. They
;; must still work.
(t (save-match-data (apply (cdr fn) args)))))
;; When `tramp-mode' is not enabled, or the file name is
;; quoted, we don't do anything.
(tramp-run-real-handler operation args)))))
;; When `tramp-mode' is not enabled, or the file name is not a
;; remote file name, we don't do anything. Same for default
;; file name handlers.
(tramp-run-real-handler operation args))))
(defun tramp-sh-handle-file-notify-add-watch (file-name flags _callback)
"Like `file-notify-add-watch' for Tramp files."
@ -4892,41 +4910,60 @@ Goes through the list `tramp-inline-compress-commands'."
(zerop
(tramp-call-process vec "ssh" nil nil nil "-G" "-o" option "0.0.0.1"))))
(defun tramp-ssh-controlmaster-options (vec)
"Return the Control* arguments of the local ssh."
(defun tramp-plink-option-exists-p (vec option)
"Check, whether local plink OPTION is applicable."
;; We don't want to cache it persistently.
(with-tramp-connection-property nil option
;; "plink" with valid options returns "plink: no valid host name
;; provided". We xcheck for this error message."
(with-temp-buffer
(tramp-call-process vec "plink" nil t nil option)
(not
(string-match-p
(rx (| (: "plink: unknown option \"" (literal option) "\"" )
(: "plink: option \"" (literal option)
"\" not available in this tool" )))
(buffer-string))))))
(defun tramp-ssh-or-plink-options (vec)
"Return additional arguments of the local ssh or plink."
(cond
;; No options to be computed.
((or (null tramp-use-connection-share)
(null (assoc "%c" (tramp-get-method-parameter vec 'tramp-login-args))))
"")
((null (assoc "%c" (tramp-get-method-parameter vec 'tramp-login-args))) "")
;; Use plink option.
;; Use plink options.
((string-match-p
(rx "plink" (? ".exe") eol)
(tramp-get-method-parameter vec 'tramp-login-program))
(if (eq tramp-use-connection-share 'suppress)
"-noshare" "-share"))
(concat
(if (eq tramp-use-connection-share 'suppress)
"-noshare" "-share")
;; Since PuTTY 0.82.
(when (tramp-plink-option-exists-p vec "-legacy-stdio-prompts")
" -legacy-stdio-prompts")))
;; There is already a value to be used.
((and (eq tramp-use-connection-share 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")))
"")
;; Use ssh options.
(tramp-use-connection-share
;; We can't auto-compute the options.
(if (ignore-errors
(not (tramp-ssh-option-exists-p vec "ControlMaster=auto")))
""
;; Determine the options.
(t (ignore-errors
;; ControlMaster and ControlPath options are introduced in OpenSSH 3.9.
(concat
"-o ControlMaster="
(if (eq tramp-use-connection-share 'suppress)
;; Determine the options.
(ignore-errors
;; ControlMaster and ControlPath options are introduced in OpenSSH 3.9.
(concat
"-o ControlMaster="
(if (eq tramp-use-connection-share 'suppress)
"no" "auto")
" -o ControlPath="
(if (eq tramp-use-connection-share 'suppress)
" -o ControlPath="
(if (eq tramp-use-connection-share 'suppress)
"none"
;; Hashed tokens are introduced in OpenSSH 6.7. On macOS
;; we cannot use an absolute file name, it is too long.
@ -4940,10 +4977,13 @@ Goes through the list `tramp-inline-compress-commands'."
(or small-temporary-file-directory
tramp-compat-temporary-file-directory))))
;; ControlPersist option is introduced in OpenSSH 5.6.
;; ControlPersist option is introduced in OpenSSH 5.6.
(when (and (not (eq tramp-use-connection-share 'suppress))
(tramp-ssh-option-exists-p vec "ControlPersist=no"))
" -o ControlPersist=no"))))))
" -o ControlPersist=no")))))
;; Return a string, whatsoever.
(t "")))
(defun tramp-scp-strict-file-name-checking (vec)
"Return the strict file name checking argument of the local scp."
@ -5159,9 +5199,9 @@ connection if a previous connection has died for some reason."
(let* ((current-host tramp-system-name)
(target-alist (tramp-compute-multi-hops vec))
(previous-hop tramp-null-hop)
;; We will apply `tramp-ssh-controlmaster-options'
;; We will apply `tramp-ssh-or-plink-options'
;; only for the first hop.
(options (tramp-ssh-controlmaster-options vec))
(options (tramp-ssh-or-plink-options vec))
(process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil)
;; There are unfortunate settings for "cmdproxy"
@ -5240,9 +5280,10 @@ connection if a previous connection has died for some reason."
(setq r-shell t)))
(setq current-host l-host)
;; Set password prompt vector.
;; Set hop and password prompt vector.
(tramp-set-connection-property p "hop-vector" hop)
(tramp-set-connection-property
p "password-vector"
p "pw-vector"
(if (tramp-get-method-parameter
hop 'tramp-password-previous-hop)
(let ((pv (copy-tramp-file-name previous-hop)))
@ -5253,9 +5294,9 @@ connection if a previous connection has died for some reason."
:host l-host :port l-port)))
;; Set session timeout.
(when-let ((timeout
(tramp-get-method-parameter
hop 'tramp-session-timeout)))
(when-let* ((timeout
(tramp-get-method-parameter
hop 'tramp-session-timeout)))
(tramp-set-connection-property
p "session-timeout" timeout))
@ -5298,6 +5339,8 @@ connection if a previous connection has died for some reason."
tramp-actions-before-shell connection-timeout))
;; Next hop.
(tramp-flush-connection-property p "hop-vector")
(tramp-flush-connection-property p "pw-vector")
(setq options ""
target-alist (cdr target-alist)
previous-hop hop)))
@ -5619,7 +5662,7 @@ Nonexistent directories are removed from spec."
(lambda (x) (not (tramp-get-file-property vec x "file-directory-p")))
remote-path))))))
;; The PIPE_BUF in POSIX [1] can be as low as 512 [2]. Here are the values
;; The PIPE_BUF in POSIX [1] can be as low as 512 [2]. Here are the values
;; on various platforms:
;; - 512 on macOS, FreeBSD, NetBSD, OpenBSD, MirBSD, native Windows.
;; - 4 KiB on Linux, OSF/1, Cygwin, Haiku.
@ -5627,6 +5670,7 @@ Nonexistent directories are removed from spec."
;; - 8 KiB on HP-UX, Plan9.
;; - 10 KiB on IRIX.
;; - 32 KiB on AIX, Minix.
;; - `undefined' on QNX.
;; [1] https://pubs.opengroup.org/onlinepubs/9699919799/functions/write.html
;; [2] https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/limits.h.html
;; See Bug#65324.
@ -5634,11 +5678,13 @@ Nonexistent directories are removed from spec."
(defun tramp-get-remote-pipe-buf (vec)
"Return PIPE_BUF config from the remote side."
(with-tramp-connection-property vec "pipe-buf"
(tramp-send-command-and-read
vec
(format "getconf PIPE_BUF / 2>%s || echo 4096"
(tramp-get-remote-null-device vec))
'noerror)))
(if-let* ((result
(tramp-send-command-and-read
vec (format "getconf PIPE_BUF / 2>%s"
(tramp-get-remote-null-device vec))
'noerror))
((natnump result)))
result 4096)))
(defun tramp-get-remote-locale (vec)
"Determine remote locale, supporting UTF8 if possible."
@ -5666,7 +5712,7 @@ Nonexistent directories are removed from spec."
(dolist (cmd
;; Prefer GNU ls on *BSD and macOS.
(if (tramp-check-remote-uname vec tramp-bsd-unames)
'( "gls" "ls" "gnuls") '("ls" "gnuls" "gls")))
'("gls" "ls" "gnuls") '("ls" "gnuls" "gls")))
(let ((dl (tramp-get-remote-path vec))
result)
(while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
@ -5903,37 +5949,37 @@ Nonexistent directories are removed from spec."
(with-tramp-connection-property vec "awk"
(tramp-message vec 5 "Finding a suitable `awk' command")
(or (tramp-find-executable vec "awk" (tramp-get-remote-path vec))
(let* ((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "awk")))
(and busybox
(tramp-send-command-and-check
vec (concat command " {} <" (tramp-get-remote-null-device vec)))
command)))))
(when-let*
((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "awk"))
((tramp-send-command-and-check
vec (concat command " {} <" (tramp-get-remote-null-device vec)))))
command))))
(defun tramp-get-remote-hexdump (vec)
"Determine remote `hexdump' command."
(with-tramp-connection-property vec "hexdump"
(tramp-message vec 5 "Finding a suitable `hexdump' command")
(or (tramp-find-executable vec "hexdump" (tramp-get-remote-path vec))
(let* ((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "hexdump")))
(and busybox
(tramp-send-command-and-check
vec (concat command " <" (tramp-get-remote-null-device vec)))
command)))))
(when-let*
((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "hexdump"))
((tramp-send-command-and-check
vec (concat command " <" (tramp-get-remote-null-device vec)))))
command))))
(defun tramp-get-remote-od (vec)
"Determine remote `od' command."
(with-tramp-connection-property vec "od"
(tramp-message vec 5 "Finding a suitable `od' command")
(or (tramp-find-executable vec "od" (tramp-get-remote-path vec))
(let* ((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "od")))
(and busybox
(tramp-send-command-and-check
vec
(concat command " -A n <" (tramp-get-remote-null-device vec)))
command)))))
(when-let*
((busybox (tramp-get-remote-busybox vec))
(command (format "%s %s" busybox "od"))
((tramp-send-command-and-check
vec
(concat command " -A n <" (tramp-get-remote-null-device vec)))))
command))))
(defun tramp-get-remote-chmod-h (vec)
"Check whether remote `chmod' supports nofollow argument."

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

@ -114,6 +114,7 @@ this variable \"client min protocol=NT1\"."
"Read from server failed, maybe it closed the connection"
"Call timed out: server did not respond"
(: (+ (not blank)) ": command not found")
(: (+ (not blank)) " does not exist")
"Server doesn't support UNIX CIFS calls"
(| ;; Samba.
"ERRDOS"
@ -340,15 +341,15 @@ This can be used to disable echo etc."
;;;###tramp-autoload
(defsubst tramp-smb-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for SMB servers."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(string= (tramp-file-name-method vec) tramp-smb-method)))
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
((string= (tramp-file-name-method vec) tramp-smb-method)))))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
"Invoke the SMB related OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
(if-let* ((fn (assoc operation tramp-smb-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
@ -428,9 +429,6 @@ arguments to pass to the OPERATION."
(t2 (tramp-tramp-file-p newname))
target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(unless (file-exists-p dirname)
(tramp-error v 'file-missing dirname))
;; `copy-directory-create-symlink' exists since Emacs 28.1.
(if (and (bound-and-true-p copy-directory-create-symlink)
(setq target (file-symlink-p dirname))
@ -600,66 +598,63 @@ KEEP-DATE has no effect in case NEWNAME resides on an SMB server.
PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
(with-tramp-progress-reporter
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
0 (format "Copying %s to %s" filename newname)
(if (file-directory-p filename)
(copy-directory filename newname keep-date 'parents 'copy-contents)
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" filename newname)
(unless (file-exists-p filename)
(tramp-error
(tramp-dissect-file-name
(if (tramp-tramp-file-p filename) filename newname))
'file-missing filename))
(if (file-directory-p filename)
(copy-directory filename newname keep-date 'parents 'copy-contents)
;; `file-local-copy' returns a file name also for a local file
;; with `jka-compr-handler', so we cannot trust its result as
;; indication for a remote file name.
(if-let ((tmpfile
(and (tramp-tramp-file-p filename) (file-local-copy filename))))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
((error quit)
(delete-file tmpfile)
(signal (car err) (cdr err))))
(tramp-barf-if-file-missing v filename
;; `file-local-copy' returns a file name also for a local
;; file with `jka-compr-handler', so we cannot trust its
;; result as indication for a remote file name.
(if-let* ((tmpfile
(and (tramp-tramp-file-p filename)
(file-local-copy filename))))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
((error quit)
(delete-file tmpfile)
(signal (car err) (cdr err))))
;; Remote newname.
(when (and (file-directory-p newname)
(directory-name-p newname))
(setq newname
(expand-file-name (file-name-nondirectory filename) newname)))
;; Remote newname.
(when (and (file-directory-p newname)
(directory-name-p newname))
(setq newname
(expand-file-name
(file-name-nondirectory filename) newname)))
(with-parsed-tramp-file-name newname nil
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(unless (tramp-smb-get-share v)
(tramp-error
v 'file-error "Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v (format "put %s %s"
(tramp-smb-shell-quote-argument filename)
(tramp-smb-shell-quote-localname v)))
(tramp-error
v 'file-error "Cannot copy `%s' to `%s'" filename newname))
(unless (tramp-smb-get-share v)
(tramp-error
v 'file-error "Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v (format "put %s %s"
(tramp-smb-shell-quote-argument filename)
(tramp-smb-shell-quote-localname v)))
(tramp-error
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))))))
;; When newname did exist, we have wrong cached values.
(when (tramp-tramp-file-p newname)
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname))))))
;; KEEP-DATE handling.
(when keep-date
(tramp-compat-set-file-times
newname
(file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow)))))
;; KEEP-DATE handling.
(when keep-date
(tramp-compat-set-file-times
newname
(file-attribute-modification-time (file-attributes filename))
(unless ok-if-already-exists 'nofollow))))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
@ -741,7 +736,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
;; Do not keep "/..".
;; Do not keep "/..".
(when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../"),
@ -769,7 +764,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(forward-line)
(delete-region (point-min) (point)))
(while (and (not (eobp)) (looking-at-p (rx bol (+ nonl) ":" (+ nonl))))
(forward-line))
(forward-line))
(delete-region (point) (point-max))
(throw 'tramp-action 'ok))))
@ -865,7 +860,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
"Implement `file-attributes' for Tramp files using `stat' command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
(let* (size id link uid gid atime mtime ctime mode inode)
(let (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
vec (format "stat %s" (tramp-smb-shell-quote-localname vec)))
@ -1311,46 +1306,45 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
(unless (file-exists-p filename)
(tramp-error v 'file-missing filename))
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-tramp-progress-reporter
v 0 (format "Renaming %s to %s" filename newname)
(with-tramp-progress-reporter
v 0 (format "Renaming %s to %s" filename newname)
(if (and (not (file-exists-p newname))
(tramp-equal-remote filename newname)
(string-equal
(tramp-smb-get-share (tramp-dissect-file-name filename))
(tramp-smb-get-share (tramp-dissect-file-name newname))))
;; We can rename directly.
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(if (and (not (file-exists-p newname))
(tramp-equal-remote filename newname)
(string-equal
(tramp-smb-get-share (tramp-dissect-file-name filename))
(tramp-smb-get-share (tramp-dissect-file-name newname))))
;; We can rename directly.
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v1 v1-localname)
(tramp-flush-file-properties v2 v2-localname)
(unless (tramp-smb-get-share v2)
(tramp-error
v2 'file-error
"Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v2 (format "rename %s %s"
(tramp-smb-shell-quote-localname v1)
(tramp-smb-shell-quote-localname v2)))
(tramp-error v2 'file-error "Cannot rename `%s'" filename))))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v1 v1-localname)
(tramp-flush-file-properties v2 v2-localname)
(unless (tramp-smb-get-share v2)
(tramp-error
v2 'file-error
"Target `%s' must contain a share name" newname))
(unless (tramp-smb-send-command
v2 (format "rename %s %s"
(tramp-smb-shell-quote-localname v1)
(tramp-smb-shell-quote-localname v2)))
(tramp-error v2 'file-error "Cannot rename `%s'" filename))))
;; We must rename via copy.
(copy-file
filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
(if (file-directory-p filename)
(delete-directory filename 'recursive)
(delete-file filename))))))
;; We must rename via copy.
(copy-file
filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
(if (file-directory-p filename)
(delete-directory filename 'recursive)
(delete-file filename)))))))
(defun tramp-smb-action-set-acl (proc vec)
"Set ACL data."

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

@ -169,15 +169,15 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
;;;###tramp-autoload
(defsubst tramp-sshfs-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for sshfs."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(string= (tramp-file-name-method vec) tramp-sshfs-method)))
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
((string= (tramp-file-name-method vec) tramp-sshfs-method)))))
;;;###tramp-autoload
(defun tramp-sshfs-file-name-handler (operation &rest args)
"Invoke the sshfs handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-sshfs-file-name-handler-alist)))
(if-let* ((fn (assoc operation tramp-sshfs-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
@ -250,6 +250,9 @@ arguments to pass to the OPERATION."
(defun tramp-sshfs-handle-process-file
(program &optional infile destination display &rest args)
"Like `process-file' for Tramp files."
;; STDERR is not impelmemted.
(when (consp destination)
(setcdr destination `(,tramp-cache-undefined)))
(tramp-skeleton-process-file program infile destination display args
(let ((coding-system-for-read 'utf-8-dos)) ; Is this correct?
@ -259,25 +262,18 @@ arguments to pass to the OPERATION."
(tramp-unquote-shell-quote-argument localname)
(mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
(when input (setq command (format "%s <%s" command input)))
(when stderr (setq command (format "%s 2>%s" command stderr)))
(unwind-protect
(setq ret
(apply
#'tramp-call-process
v (tramp-get-method-parameter v 'tramp-login-program)
nil outbuf display
(tramp-expand-args
v 'tramp-login-args nil
?h (or (tramp-file-name-host v) "")
?u (or (tramp-file-name-user v) "")
?p (or (tramp-file-name-port v) "")
?a "-t" ?l command)))
;; Synchronize stderr.
(when tmpstderr
(tramp-cleanup-connection v 'keep-debug 'keep-password)
(tramp-fuse-unmount v))))))
(setq ret
(apply
#'tramp-call-process
v (tramp-get-method-parameter v 'tramp-login-program)
nil outbuf display
(tramp-expand-args
v 'tramp-login-args nil
?h (or (tramp-file-name-host v) "")
?u (or (tramp-file-name-user v) "")
?p (or (tramp-file-name-port v) "")
?a "-t" ?l command))))))
(defun tramp-sshfs-handle-rename-file
(filename newname &optional ok-if-already-exists)

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

@ -161,15 +161,15 @@ See `tramp-actions-before-shell' for more info.")
;;;###tramp-autoload
(defsubst tramp-sudoedit-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for SUDOEDIT."
(when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
(string= (tramp-file-name-method vec) tramp-sudoedit-method)))
(and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
((string= (tramp-file-name-method vec) tramp-sudoedit-method)))))
;;;###tramp-autoload
(defun tramp-sudoedit-file-name-handler (operation &rest args)
"Invoke the SUDOEDIT handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
(if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
(if-let* ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
@ -244,84 +244,88 @@ absolute file names."
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
(setq filename (file-truename filename))
(if (file-directory-p filename)
(progn
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
(if (file-symlink-p filename)
(progn
(make-symbolic-link
(file-symlink-p filename) newname ok-if-already-exists)
(when (eq op 'rename) (delete-file filename)))
;; FIXME: This should be optimized. Computing `file-attributes'
;; checks already, whether the file exists.
(let ((t1 (tramp-sudoedit-file-name-p filename))
(t2 (tramp-sudoedit-file-name-p newname))
(file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
(file-extended-attributes filename)))
(sudoedit-operation
(cond
((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
((eq op 'copy) '("cp" "-f"))
((eq op 'rename) '("mv" "-f"))))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
;; FIXME: This should be optimized. Computing `file-attributes'
;; checks already, whether the file exists.
(let ((t1 (tramp-sudoedit-file-name-p filename))
(t2 (tramp-sudoedit-file-name-p newname))
(file-times (file-attribute-modification-time
(file-attributes filename)))
(file-modes (tramp-default-file-modes filename))
(attributes (and preserve-extended-attributes
(file-extended-attributes filename)))
(sudoedit-operation
(cond
((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
((eq op 'copy) '("cp" "-f"))
((eq op 'rename) '("mv" "-f"))))
(msg-operation (if (eq op 'copy) "Copying" "Renaming")))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(with-parsed-tramp-file-name (if t1 filename newname) nil
(tramp-barf-if-file-missing v filename
(when (and (not ok-if-already-exists) (file-exists-p newname))
(tramp-error v 'file-already-exists newname))
(when (and (file-directory-p newname)
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
(if (or (and (tramp-tramp-file-p filename) (not t1))
(and (tramp-tramp-file-p newname) (not t2)))
;; We cannot copy or rename directly.
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(if (eq op 'copy)
(copy-file filename tmpfile t)
(rename-file filename tmpfile t))
(rename-file tmpfile newname ok-if-already-exists))
(if (or (and (tramp-tramp-file-p filename) (not t1))
(and (tramp-tramp-file-p newname) (not t2)))
;; We cannot copy or rename directly.
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(if (eq op 'copy)
(copy-file filename tmpfile t)
(rename-file filename tmpfile t))
(rename-file tmpfile newname ok-if-already-exists))
;; Direct action.
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless (tramp-sudoedit-send-command
v sudoedit-operation
(tramp-unquote-file-local-name filename)
(tramp-unquote-file-local-name newname))
(tramp-error
v 'file-error
"Error %s `%s' `%s'" msg-operation filename newname))))
;; Direct action.
(with-tramp-progress-reporter
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless (tramp-sudoedit-send-command
v sudoedit-operation
(tramp-unquote-file-local-name filename)
(tramp-unquote-file-local-name newname))
(tramp-error
v 'file-error
"Error %s `%s' `%s'" msg-operation filename newname))))
;; When `newname' is local, we must change the ownership to
;; the local user.
(unless (tramp-tramp-file-p newname)
(tramp-set-file-uid-gid
(concat (file-remote-p filename) newname)
(tramp-get-local-uid 'integer)
(tramp-get-local-gid 'integer)))
;; When `newname' is local, we must change the ownership
;; to the local user.
(unless (tramp-tramp-file-p newname)
(tramp-set-file-uid-gid
(concat (file-remote-p filename) newname)
(tramp-get-local-uid 'integer)
(tramp-get-local-gid 'integer)))
;; Set the time and mode. Mask possible errors.
(when keep-date
(ignore-errors
(tramp-compat-set-file-times
newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes)))
;; Set the time and mode. Mask possible errors.
(when keep-date
(ignore-errors
(tramp-compat-set-file-times
newname file-times (unless ok-if-already-exists 'nofollow))
(set-file-modes newname file-modes)))
;; Handle `preserve-extended-attributes'. We ignore possible
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
(set-file-extended-attributes newname attributes)))
;; Handle `preserve-extended-attributes'. We ignore possible
;; errors, because ACL strings could be incompatible.
(when attributes
(ignore-errors
(set-file-extended-attributes newname attributes)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
(when (and t1 (eq op 'rename))
(with-parsed-tramp-file-name filename v1
(tramp-flush-file-properties v1 v1-localname)))
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname))))))))
(when t2
(with-parsed-tramp-file-name newname v2
(tramp-flush-file-properties v2 v2-localname)))))))))
(defun tramp-sudoedit-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@ -785,7 +789,7 @@ in case of error, t otherwise."
;; Avoid process status message in output buffer.
(set-process-sentinel p #'ignore)
(tramp-post-process-creation p vec)
(tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop)
(tramp-set-connection-property p "pw-vector" tramp-sudoedit-null-hop)
(tramp-process-actions p vec nil tramp-sudoedit-sudo-actions)
(tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string))
(prog1

720
lisp/net/tramp.el
View file

File diff suppressed because it is too large Load diff

8
lisp/net/trampver.el
View file

@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
;; Version: 2.7.1.30.1
;; Version: 2.7.3-pre
;; Package-Requires: ((emacs "27.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
@ -40,14 +40,13 @@
;; ./configure" to change them.
;;;###tramp-autoload
(defconst tramp-version "2.7.1.30.1"
(defconst tramp-version "2.7.3-pre"
"This version of Tramp.")
;;;###tramp-autoload
(defconst tramp-bug-report-address "tramp-devel@gnu.org"
"Email address to send bug reports to.")
;;;###tramp-autoload
(defconst tramp-repository-branch
(ignore-errors
;; Suppress message from `emacs-repository-get-branch'. We must
@ -61,7 +60,6 @@
(emacs-repository-get-branch dir))))
"The repository branch of the Tramp sources.")
;;;###tramp-autoload
(defconst tramp-repository-version
(ignore-errors
;; Suppress message from `emacs-repository-get-version'. We must
@ -78,7 +76,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-version-lessp emacs-version "27.1"))
"ok"
(format "Tramp 2.7.1.30.1 is not fit for %s"
(format "Tramp 2.7.3-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))

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

@ -179,7 +179,9 @@ A resource file is in the resource directory as per
(tramp-dissect-file-name ert-remote-temporary-file-directory))
"The used `tramp-file-name' structure.")
(setq auth-source-save-behavior nil
(setq auth-source-cache-expiry nil
auth-source-save-behavior nil
ert-batch-backtrace-right-margin nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
tramp-allow-unsafe-temporary-files t
@ -187,7 +189,8 @@ A resource file is in the resource directory as per
tramp-copy-size-limit nil
tramp-error-show-message-timeout nil
tramp-persistency-file-name nil
tramp-verbose 0)
tramp-verbose 0
vc-handled-backends (unless noninteractive vc-handled-backends))
(defvar tramp--test-enabled-checked nil
"Cached result of `tramp--test-enabled'.
@ -209,6 +212,7 @@ being the result.")
(when (cdr tramp--test-enabled-checked)
;; Remove old test files.
(dolist (dir `(,temporary-file-directory
,tramp-compat-temporary-file-directory
,ert-remote-temporary-file-directory))
(dolist (file (directory-files dir 'full (rx bos (? ".#") "tramp-test")))
(ignore-errors
@ -217,7 +221,7 @@ being the result.")
(delete-file file)))))
;; Cleanup connection.
(ignore-errors
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))
;; Return result.
(cdr tramp--test-enabled-checked))
@ -2176,7 +2180,7 @@ is greater than 10.
(when (assoc m tramp-methods)
(let (tramp-connection-properties tramp-default-proxies-alist)
(ignore-errors
(tramp-cleanup-connection tramp-test-vec nil 'keep-password))
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))
;; Single hop. The host name must match `tramp-local-host-regexp'.
(should-error
(find-file (format "/%s:foo:" m))
@ -2882,7 +2886,9 @@ This checks also `file-name-as-directory', `file-name-directory',
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))
(tmp-name4
(file-name-nondirectory (tramp--test-make-temp-name 'local quoted))))
(dolist (source-target
`(;; Copy on remote side.
(,tmp-name1 . ,tmp-name2)
@ -2890,8 +2896,12 @@ This checks also `file-name-as-directory', `file-name-directory',
(,tmp-name1 . ,tmp-name3)
;; Copy from local side to remote side.
(,tmp-name3 . ,tmp-name1)))
(let ((source (car source-target))
(target (cdr source-target)))
(let* ((source (car source-target))
(source-link
(expand-file-name tmp-name4 (file-name-directory source)))
(target (cdr source-target))
(target-link
(expand-file-name tmp-name4 (file-name-directory target))))
;; Copy simple file.
(unwind-protect
@ -2916,6 +2926,26 @@ This checks also `file-name-as-directory', `file-name-directory',
(ignore-errors (delete-file source))
(ignore-errors (delete-file target)))
;; Copy symlinked file.
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil source-link)
(should (file-exists-p source-link))
(make-symbolic-link tmp-name4 source)
(should (file-exists-p source))
(should (string-equal (file-symlink-p source) tmp-name4))
(copy-file source target)
;; Some backends like tramp-gvfs.el do not create the
;; link on the target.
(when (file-symlink-p target)
(should (string-equal (file-symlink-p target) tmp-name4))))
;; Cleanup.
(ignore-errors (delete-file source))
(ignore-errors (delete-file source-link))
(ignore-errors (delete-file target))
(ignore-errors (delete-file target-link)))
;; Copy file to directory.
(unwind-protect
;; This doesn't work on FTP.
@ -2991,7 +3021,9 @@ This checks also `file-name-as-directory', `file-name-directory',
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
(tmp-name3 (tramp--test-make-temp-name 'local quoted)))
(tmp-name3 (tramp--test-make-temp-name 'local quoted))
(tmp-name4
(file-name-nondirectory (tramp--test-make-temp-name 'local quoted))))
(dolist (source-target
`(;; Rename on remote side.
(,tmp-name1 . ,tmp-name2)
@ -2999,8 +3031,12 @@ This checks also `file-name-as-directory', `file-name-directory',
(,tmp-name1 . ,tmp-name3)
;; Rename from local side to remote side.
(,tmp-name3 . ,tmp-name1)))
(let ((source (car source-target))
(target (cdr source-target)))
(let* ((source (car source-target))
(source-link
(expand-file-name tmp-name4 (file-name-directory source)))
(target (cdr source-target))
(target-link
(expand-file-name tmp-name4 (file-name-directory target))))
;; Rename simple file.
(unwind-protect
@ -3029,6 +3065,27 @@ This checks also `file-name-as-directory', `file-name-directory',
(ignore-errors (delete-file source))
(ignore-errors (delete-file target)))
;; Rename symlinked file.
(unwind-protect
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil source-link)
(should (file-exists-p source-link))
(make-symbolic-link tmp-name4 source)
(should (file-exists-p source))
(should (string-equal (file-symlink-p source) tmp-name4))
(rename-file source target)
(should-not (file-exists-p source))
;; Some backends like tramp-gvfs.el do not create the
;; link on the target.
(when (file-symlink-p target)
(should (string-equal (file-symlink-p target) tmp-name4))))
;; Cleanup.
(ignore-errors (delete-file source))
(ignore-errors (delete-file source-link))
(ignore-errors (delete-file target))
(ignore-errors (delete-file target-link)))
;; Rename file to directory.
(unwind-protect
(progn
@ -3809,6 +3866,7 @@ This tests also `access-file', `file-readable-p',
(should (stringp (file-attribute-user-id attr)))
(should (stringp (file-attribute-group-id attr)))
;; Symbolic links.
(tramp--test-ignore-make-symbolic-link-error
(should-error
(access-file tmp-name2 "error")
@ -3828,7 +3886,26 @@ This tests also `access-file', `file-readable-p',
(if quoted #'file-name-quote #'identity)
(file-attribute-type attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
(delete-file tmp-name2))
(delete-file tmp-name2)
;; A non-existent or cyclic link target makes the file
;; unaccessible.
(dolist (target
`("does-not-exist" ,(file-name-nondirectory tmp-name2)))
(make-symbolic-link target tmp-name2)
(should (file-symlink-p tmp-name2))
(should-not (file-exists-p tmp-name2))
(should-not (file-directory-p tmp-name2))
(should-error
(access-file tmp-name2 "error")
:type
(if (string-equal target "does-not-exist")
'file-missing 'file-error))
;; `file-ownership-preserved-p' should return t for
;; symlinked files to a non-existing or cyclic target.
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(delete-file tmp-name2)))
;; Check, that "//" in symlinks are handled properly.
(with-temp-buffer
@ -3891,12 +3968,12 @@ The test is derived from TEST and COMMAND."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-stat tramp-test-vec))
(if-let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(cons '(nil "perl" nil)
tramp-connection-properties)))
(if-let* ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(cons '(nil "perl" nil)
tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
@ -3911,17 +3988,17 @@ The test is derived from TEST and COMMAND."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-perl tramp-test-vec))
(if-let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(append
'((nil "stat" nil)
;; See `tramp-sh-handle-file-truename'.
(nil "readlink" nil)
;; See `tramp-sh-handle-get-remote-*'.
(nil "id" nil))
tramp-connection-properties)))
(if-let* ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(append
'((nil "stat" nil)
;; See `tramp-sh-handle-file-truename'.
(nil "readlink" nil)
;; See `tramp-sh-handle-get-remote-*'.
(nil "id" nil))
tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
@ -3935,16 +4012,16 @@ The test is derived from TEST and COMMAND."
(tramp--test-set-ert-test-documentation ',test "ls")
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(if-let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(append
'((nil "perl" nil)
(nil "stat" nil)
;; See `tramp-sh-handle-file-truename'.
(nil "readlink" nil))
tramp-connection-properties)))
(if-let* ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test))
(tramp-connection-properties
(append
'((nil "perl" nil)
(nil "stat" nil)
;; See `tramp-sh-handle-file-truename'.
(nil "readlink" nil))
tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
@ -3971,9 +4048,9 @@ The test is derived from TEST and COMMAND."
(skip-unless (tramp--test-enabled))
(skip-unless
(or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sudoedit-p)))
(if-let ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test)))
(if-let* ((default-directory ert-remote-temporary-file-directory)
(ert-test (ert-get-test ',test))
(result (ert-test-most-recent-result ert-test)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(let (tramp-use-file-attributes)
@ -4484,13 +4561,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (file-symlink-p tmp-name1))
(should (file-symlink-p tmp-name2))
(should-not (file-regular-p tmp-name1))
(should-not (file-regular-p tmp-name2))
(should-error
(file-truename tmp-name1)
:type 'file-error)
(should-error
(file-truename tmp-name2)
:type 'file-error))))
(should-not (file-regular-p tmp-name2)))))
;; Cleanup.
(ignore-errors
@ -4946,7 +5017,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ert-deftest tramp-test26-interactive-file-name-completion ()
"Check interactive completion with different `completion-styles'."
;; Method, user and host name in completion mode.
(tramp-cleanup-connection tramp-test-vec nil 'keep-password)
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(let ((method (file-remote-p ert-remote-temporary-file-directory 'method))
(user (file-remote-p ert-remote-temporary-file-directory 'user))
@ -5270,19 +5341,20 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; (delete-file tmp-name)))
;; Check remote and local STDERR.
(dolist (local '(nil t))
(setq tmp-name (tramp--test-make-temp-name local quoted))
(should-not
(zerop
(process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist")))
(with-temp-buffer
(insert-file-contents tmp-name)
(should
(string-match-p
(rx "cat:" (* nonl) " No such file or directory")
(buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name))))
(unless (tramp--test-sshfs-p)
(dolist (local '(nil t))
(setq tmp-name (tramp--test-make-temp-name local quoted))
(should-not
(zerop
(process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist")))
(with-temp-buffer
(insert-file-contents tmp-name)
(should
(string-match-p
(rx "cat:" (* nonl) " No such file or directory")
(buffer-string)))
(should-not (get-buffer-window (current-buffer) t))
(delete-file tmp-name)))))
;; Cleanup.
(ignore-errors (kill-buffer buffer))
@ -5293,8 +5365,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Timeout handler, reporting a failed test."
(interactive)
(tramp--test-message "proc: %s" (get-buffer-process (current-buffer)))
(when-let ((proc (get-buffer-process (current-buffer)))
((processp proc)))
(when-let* ((proc (get-buffer-process (current-buffer)))
((processp proc)))
(tramp--test-message "cmd: %s" (process-command proc)))
(tramp--test-message "buf: %s\n%s\n---" (current-buffer) (buffer-string))
(ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
@ -5477,6 +5549,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
direct-async-process-profile)
connection-local-criteria-alist)))
(skip-unless (tramp-direct-async-process-p))
(when-let* ((result (ert-test-most-recent-result ert-test)))
(skip-unless (< (ert-test-result-duration result) 300)))
;; We do expect an established connection already,
;; `file-truename' does it by side-effect. Suppress
;; `tramp--test-enabled', in order to keep the connection.
@ -5885,8 +5959,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
(setq command '("sleep" "100")
proc (apply #'start-file-process "test" nil command))
(while (accept-process-output proc 0))
(when-let ((pid (process-get proc 'remote-pid))
(attributes (process-attributes pid)))
(when-let* ((pid (process-get proc 'remote-pid))
(attributes (process-attributes pid)))
;; (tramp--test-message "%s" attributes)
(should (equal (cdr (assq 'comm attributes)) (car command)))
(should (equal (cdr (assq 'args attributes))
@ -5903,8 +5977,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
;; `memory-info' is supported since Emacs 29.1.
(skip-unless (tramp--test-emacs29-p))
(when-let ((default-directory ert-remote-temporary-file-directory)
(mi (memory-info)))
(when-let* ((default-directory ert-remote-temporary-file-directory)
(mi (memory-info)))
(should (consp mi))
(should (tramp-compat-length= mi 4))
(dotimes (i (length mi))
@ -6015,7 +6089,9 @@ INPUT, if non-nil, is a string sent to the process."
;; Test `async-shell-command-width'.
(when (and (tramp--test-asynchronous-processes-p) (tramp--test-sh-p))
(let* ((async-shell-command-width 1024)
(let* (;; Since Fedora 41, this seems to be the upper limit. Used
;; to be 1024 before.
(async-shell-command-width 512)
(default-directory ert-remote-temporary-file-directory)
(cols (ignore-errors
(read (tramp--test-shell-command-to-string-asynchronously
@ -6536,6 +6612,7 @@ INPUT, if non-nil, is a string sent to the process."
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tramp-remote-process-environment tramp-remote-process-environment)
;; Suppress nasty messages.
(inhibit-message t)
(vc-handled-backends
(cond
@ -6558,9 +6635,7 @@ INPUT, if non-nil, is a string sent to the process."
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
'(Bzr))
(t nil)))
;; Suppress nasty messages.
(inhibit-message t))
(t nil))))
(skip-unless vc-handled-backends)
(unless quoted (tramp--test-message "%s" vc-handled-backends))
@ -6907,34 +6982,40 @@ INPUT, if non-nil, is a string sent to the process."
(should-not (with-no-warnings (file-locked-p tmp-name1)))
;; `kill-buffer' removes the lock.
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(with-temp-buffer
(set-visited-file-name tmp-name1)
(insert "foo")
(should (buffer-modified-p))
(cl-letf (((symbol-function #'read-from-minibuffer)
(lambda (&rest _args) "yes")))
(kill-buffer)))
(should-not (with-no-warnings (file-locked-p tmp-name1)))
;; `kill-buffer--possibly-save' exists since Emacs 29.1.
(when (fboundp 'kill-buffer--possibly-save)
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(with-temp-buffer
(set-visited-file-name tmp-name1)
(insert "foo")
(should (buffer-modified-p))
;; Modifying `read-from-minibuffer' doesn't work on MS Windows.
(cl-letf (((symbol-function #'kill-buffer--possibly-save)
#'tramp-compat-always))
(kill-buffer)))
(should-not (with-no-warnings (file-locked-p tmp-name1))))
;; `kill-buffer' should not remove the lock when the
;; connection is broken. See Bug#61663.
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(with-temp-buffer
(set-visited-file-name tmp-name1)
(insert "foo")
(should (buffer-modified-p))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'read-from-minibuffer)
(lambda (&rest _args) "yes")))
(kill-buffer)))
;; A new connection changes process id, and also the
;; lock file contents. But it still exists.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (stringp (with-no-warnings (file-locked-p tmp-name1))))
;; `kill-buffer--possibly-save' exists since Emacs 29.1.
(when (fboundp 'kill-buffer--possibly-save)
(with-no-warnings (lock-file tmp-name1))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
(with-temp-buffer
(set-visited-file-name tmp-name1)
(insert "foo")
(should (buffer-modified-p))
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
;; Modifying `read-from-minibuffer' doesn't work on MS Windows.
(cl-letf (((symbol-function #'kill-buffer--possibly-save)
#'tramp-compat-always))
(kill-buffer)))
;; A new connection changes process id, and also the
;; lock file contents. But it still exists.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
;; When `remote-file-name-inhibit-locks' is set, nothing happens.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
@ -6957,35 +7038,43 @@ INPUT, if non-nil, is a string sent to the process."
;; Steal the file lock.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s)))
;; Modifying `read-char' doesn't work on MS Windows.
(cl-letf (((symbol-function #'ask-user-about-lock)
#'tramp-compat-always))
(with-no-warnings (lock-file tmp-name1)))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
;; Ignore the file lock.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p)))
;; Modifying `read-char' doesn't work on MS Windows.
(cl-letf (((symbol-function #'ask-user-about-lock) #'ignore))
(with-no-warnings (lock-file tmp-name1)))
(should (stringp (with-no-warnings (file-locked-p tmp-name1))))
;; Quit the file lock machinery.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
(with-no-warnings
;; Quit the file lock machinery. There are problems with
;; "sftp" and "podman", so we test on Emacs 29.1 only.
(when (tramp--test-emacs29-p )
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
;; Modifying `read-char' doesn't work on MS Windows.
(cl-letf (((symbol-function #'ask-user-about-lock)
(lambda (&rest args)
(signal 'file-locked args))))
(with-no-warnings
(should-error
(lock-file tmp-name1)
:type 'file-locked))
;; The same for `write-region'.
(should-error
(lock-file tmp-name1)
:type 'file-locked))
;; The same for `write-region'.
(should-error
(write-region "foo" nil tmp-name1)
:type 'file-locked)
(should-error
(write-region "foo" nil tmp-name1 nil nil tmp-name1)
:type 'file-locked)
;; The same for `set-visited-file-name'.
(with-temp-buffer
(should-error
(set-visited-file-name tmp-name1)
:type 'file-locked)))
(write-region "foo" nil tmp-name1)
:type 'file-locked)
(should-error
(write-region "foo" nil tmp-name1 nil nil tmp-name1)
:type 'file-locked)
;; The same for `set-visited-file-name'.
(with-temp-buffer
(should-error
(set-visited-file-name tmp-name1)
:type 'file-locked))))
(should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
;; Cleanup.
@ -7418,10 +7507,6 @@ This requires restrictions of file name syntax."
(if quoted #'file-name-quote #'identity)
(file-attribute-type (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
;; Check file contents.
(with-temp-buffer
(insert-file-contents file3)
(should (string-equal (buffer-string) elt)))
(delete-file file3))))
;; Check file names.
@ -7447,7 +7532,7 @@ This requires restrictions of file name syntax."
(setq buffer (dired-noselect tmp-name1 "--dired -al"))
(goto-char (point-min))
(while (not (eobp))
(when-let ((name (dired-get-filename 'no-dir 'no-error)))
(when-let* ((name (dired-get-filename 'no-dir 'no-error)))
(unless
(string-match-p name directory-files-no-dot-files-regexp)
(should (member name files))))
@ -7687,7 +7772,7 @@ This requires restrictions of file name syntax."
;; to U+1FFFF).
"🌈🍒👋")
(when (tramp--test-expensive-test-p)
(when (and (tramp--test-expensive-test-p) (not (tramp--test-windows-nt-p)))
(delete-dups
(mapcar
;; Use all available language specific snippets.
@ -7727,7 +7812,7 @@ This requires restrictions of file name syntax."
"Check that `file-system-info' returns proper values."
(skip-unless (tramp--test-enabled))
(when-let ((fsi (file-system-info ert-remote-temporary-file-directory)))
(when-let* ((fsi (file-system-info ert-remote-temporary-file-directory)))
(should (consp fsi))
(should (tramp-compat-length= fsi 3))
(dotimes (i (length fsi))
@ -7759,10 +7844,10 @@ should all return proper values."
(should (or (stringp (tramp-get-remote-gid v 'string))
(null (tramp-get-remote-gid v 'string))))
(when-let ((groups (tramp-get-remote-groups v 'integer)))
(when-let* ((groups (tramp-get-remote-groups v 'integer)))
(should (consp groups))
(dolist (group groups) (should (integerp group))))
(when-let ((groups (tramp-get-remote-groups v 'string)))
(when-let* ((groups (tramp-get-remote-groups v 'string)))
(should (consp groups))
(dolist (group groups) (should (stringp group)))))))
@ -7948,9 +8033,9 @@ process sentinels. They shall not disturb each other."
buf)
(while buffers
(setq buf (seq-random-elt buffers))
(if-let ((proc (get-buffer-process buf))
(file (process-get proc 'foo))
(count (process-get proc 'bar)))
(if-let* ((proc (get-buffer-process buf))
(file (process-get proc 'foo))
(count (process-get proc 'bar)))
(progn
(tramp--test-message
"Start action %d %s %s" count buf (current-time-string))
@ -8063,7 +8148,7 @@ process sentinels. They shall not disturb each other."
(let ((pass "secret")
(mock-entry (copy-tree (assoc "mock" tramp-methods)))
mocked-input tramp-methods)
mocked-input tramp-methods auth-sources)
;; We must mock `read-string', in order to avoid interactive
;; arguments.
(cl-letf* (((symbol-function #'read-string)
@ -8107,7 +8192,37 @@ process sentinels. They shall not disturb each other."
"machine %s port mock password %s"
(file-remote-p ert-remote-temporary-file-directory 'host) pass)
(let ((auth-sources `(,netrc-file)))
(should (file-exists-p ert-remote-temporary-file-directory)))))))))
(should (file-exists-p ert-remote-temporary-file-directory))))))
;; Checking session-timeout.
(with-no-warnings (when (symbol-plist 'ert-with-temp-file)
(tramp-cleanup-connection tramp-test-vec 'keep-debug)
(let ((tramp-connection-properties
(cons '(nil "session-timeout" 1)
tramp-connection-properties)))
(setq mocked-input nil)
(auth-source-forget-all-cached)
(ert-with-temp-file netrc-file
:prefix "tramp-test" :suffix ""
:text (format
"machine %s port mock password %s"
(file-remote-p ert-remote-temporary-file-directory 'host)
pass)
(let ((auth-sources `(,netrc-file)))
(should (file-exists-p ert-remote-temporary-file-directory))))
;; Session established, password cached.
(should
(password-in-cache-p
(auth-source-format-cache-entry
(tramp-get-connection-property tramp-test-vec "pw-spec"))))
;; We want to see the timeout message.
(tramp--test-instrument-test-case 3
(sleep-for 2))
;; Session canceled, no password in cache.
(should-not
(password-in-cache-p
(auth-source-format-cache-entry
(tramp-get-connection-property tramp-test-vec "pw-spec"))))))))))
(ert-deftest tramp-test47-read-otp-password ()
"Check Tramp one-time password handling."
@ -8168,6 +8283,49 @@ process sentinels. They shall not disturb each other."
(should-error
(file-exists-p ert-remote-temporary-file-directory)))))))))
(ert-deftest tramp-test47-read-fingerprint ()
"Check Tramp fingerprint handling."
:tags '(:expensive-test)
(skip-unless (tramp--test-mock-p))
(let (;; Suppress "exec".
(tramp-restricted-shell-hosts-alist `(,tramp-system-name)))
;; Reading fingerprint works.
(tramp-cleanup-connection tramp-test-vec 'keep-debug)
(let ((tramp-connection-properties
`((nil "login-args"
(("-c")
(,(tramp-shell-quote-argument
"echo Place your finger on the fingerprint reader"))
(";") ("sleep" "1")
(";") ("sh" "-i"))))))
(should (file-exists-p ert-remote-temporary-file-directory)))
;; Falling back after a timeout works.
(tramp-cleanup-connection tramp-test-vec 'keep-debug)
(let ((tramp-connection-properties
`((nil "login-args"
(("-c")
(,(tramp-shell-quote-argument
"echo Place your finger on the fingerprint reader"))
(";") ("sleep" "1")
(";") ("echo" "Failed to match fingerprint")
(";") ("sh" "-i"))))))
(should (file-exists-p ert-remote-temporary-file-directory)))
;; Interrupting the fingerprint handshaking works.
(tramp-cleanup-connection tramp-test-vec 'keep-debug)
(let ((tramp-connection-properties
`((nil "login-args"
(("-c")
(,(tramp-shell-quote-argument
"echo Place your finger on the fingerprint reader"))
(";") ("sleep" "1")
(";") ("sh" "-i")))))
tramp-use-fingerprint)
(should (file-exists-p ert-remote-temporary-file-directory)))))
;; This test is inspired by Bug#29163.
(ert-deftest tramp-test48-auto-load ()
"Check that Tramp autoloads properly."
@ -8388,7 +8546,6 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * file-equal-p (partly done in `tramp-test21-file-links')
;; * file-in-directory-p
;; * file-name-case-insensitive-p
;; * memory-info
;; * tramp-get-home-directory
;; * tramp-set-file-uid-gid