diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index ddd624db9c8..5a2e44456ee 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -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 +@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 diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index e88239dba1a..ca3300ee684 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.7.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 diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 199c4b7ed7f..1ecabd8165f 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -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." ;; ;; 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) diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 6fbd1938c50..4fb45cb16f3 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -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) diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 07870af5cd2..914499be9e5 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -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. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index a9ca6fa20dd..14ee10416ab 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -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. diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 6bdc940726d..f03fa5cf404 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -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. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 6a4cf4a9007..c9629a6f3c9 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -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))))) diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index afb82537663..8328b5c8684 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -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 diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 14d104f3563..ab36ffde6ed 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -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)) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index beaf818d122..4561518de17 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -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 diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el index 26cfdbdbe88..663ef8719b0 100644 --- a/lisp/net/tramp-fuse.el +++ b/lisp/net/tramp-fuse.el @@ -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))) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 3737a6dd1b9..3df69d79fce 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -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"))) diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 2e172a9037a..552d52835e9 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -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) diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index b2ff1c12556..73a0ea9ce28 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -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 diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 52863507c0e..07dd80deb9a 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -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) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 108d155fd01..ef4ddee8a53 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -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." diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 7b16d7f5a81..57fdd61a4c8 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -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." diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 2ad71de4022..0efa7bd53fb 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -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) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 4cfe2cd0808..ff01eac5b93 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -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 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 91d0865f53e..ec8835c13f0 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -126,9 +126,8 @@ :version "22.1" :link '(custom-manual "(tramp)Top")) -;; Maybe we need once a real Tramp mode, with key bindings etc. ;;;###autoload -(defcustom tramp-mode t +(defcustom tramp-mode (fboundp 'make-process) ; Disable on MS-DOS. "Whether Tramp is enabled. If it is set to nil, all remote file names are used literally." :type 'boolean) @@ -687,12 +686,15 @@ The `sudo' program appears to insert a `^@' character into the prompt." (defcustom tramp-otp-password-prompt-regexp (rx-to-string `(: bol (* nonl) - ;; JumpCloud. - (group (| "Verification code")) + (group (| + ;; JumpCloud. + "Verification code" + ;; TACC HPC. + "TACC Token Code")) (* nonl) (any . ,tramp-compat-password-colon-equivalents) (* blank))) "Regexp matching one-time password prompts. The regexp should match at end of buffer." - :version "29.2" + :version "30.2" :type 'regexp) (defcustom tramp-wrong-passwd-regexp @@ -706,12 +708,51 @@ The regexp should match at end of buffer." "No supported authentication methods left to try!" (: "Login " (| "Incorrect" "incorrect")) (: "Connection " (| "refused" "closed")) - (: "Received signal " (+ digit))) + (: "Received signal " (+ digit)) + ;; Fingerprint. + "Verification timed out" + "Failed to match fingerprint" + "An unknown error occurred") (* nonl)) "Regexp matching a `login failed' message. The regexp should match at end of buffer." :type 'regexp) +;; +(defcustom tramp-fingerprint-prompt-regexp + (rx (| "Place your finger on" + "Swipe your finger across" + "Place your left thumb on" + "Swipe your left thumb across" + "Place your left index finger on" + "Swipe your left index finger across" + "Place your left middle finger on" + "Swipe your left middle finger across" + "Place your left ring finger on" + "Swipe your left ring finger across" + "Place your left little finger on" + "Swipe your left little finger across" + "Place your right thumb on" + "Swipe your right thumb across" + "Place your right index finger on" + "Swipe your right index finger across" + "Place your right middle finger on" + "Swipe your right middle finger across" + "Place your right ring finger on" + "Swipe your right ring finger across" + "Place your right little finger on" + "Swipe your right little finger across" + "Place your finger on the reader again" + "Swipe your finger again" + "Swipe was too short, try again" + "Your finger was not centred, try swiping your finger again" + "Remove your finger, and try swiping your finger again") + (* nonl) (* (any "\r\n"))) + "Regexp matching fingerprint prompts. +The regexp should match at end of buffer." + :version "30.2" + :type 'regexp) + (defcustom tramp-yesno-prompt-regexp (rx "Are you sure you want to continue connecting (yes/no" (? "/[fingerprint]") ")?" @@ -1488,24 +1529,24 @@ calling HANDLER.") "method: " (tramp-compat-seq-keep (lambda (x) - (when-let ((name (symbol-name x)) - ;; It must match `tramp-enable-METHOD-method'. - ((string-match - (rx "tramp-enable-" - (group (regexp tramp-method-regexp)) - "-method") - name)) - (method (match-string 1 name)) - ;; It must not be enabled yet. - ((not (assoc method tramp-methods)))) + (when-let* ((name (symbol-name x)) + ;; It must match `tramp-enable-METHOD-method'. + ((string-match + (rx "tramp-enable-" + (group (regexp tramp-method-regexp)) + "-method") + name)) + (method (match-string 1 name)) + ;; It must not be enabled yet. + ((not (assoc method tramp-methods)))) method)) ;; All method enabling functions. (mapcar #'intern (all-completions "tramp-enable-" obarray #'functionp)))))) - (when-let (((not (assoc method tramp-methods))) - (fn (intern (format "tramp-enable-%s-method" method))) - ((functionp fn))) + (when-let* (((not (assoc method tramp-methods))) + (fn (intern (format "tramp-enable-%s-method" method))) + ((functionp fn))) (funcall fn) (message "Tramp method \"%s\" enabled" method))) @@ -1614,9 +1655,9 @@ entry does not exist, return DEFAULT." ;; We use the cached property. (tramp-get-connection-property vec hash-entry) ;; Use the static value from `tramp-methods'. - (if-let ((methods-entry - (assoc - param (assoc (tramp-file-name-method vec) tramp-methods)))) + (if-let* ((methods-entry + (assoc + param (assoc (tramp-file-name-method vec) tramp-methods)))) (cadr methods-entry) ;; Return the default value. default)))) @@ -1847,8 +1888,14 @@ See `tramp-dissect-file-name' for details." ;;;###tramp-autoload (defsubst tramp-string-empty-or-nil-p (string) "Check whether STRING is empty or nil." + ;; (declare (tramp-suppress-trace t)) (or (null string) (string= string ""))) +;; We cannot use the `declare' form for `tramp-suppress-trace' in +;; autoloaded functions, because the tramp-loaddefs.el generation +;; would fail. +(function-put #'tramp-string-empty-or-nil-p 'tramp-suppress-trace t) + (defun tramp-buffer-name (vec) "A name for the connection buffer VEC." (declare (tramp-suppress-trace t)) @@ -2053,7 +2100,7 @@ does not exist, otherwise propagate the error." `(condition-case ,err (progn ,@body) (error - (if (not (file-exists-p ,filename)) + (if (not (or (file-exists-p ,filename) (file-symlink-p ,filename))) (tramp-error ,vec 'file-missing ,filename) (signal (car ,err) (cdr ,err))))))) @@ -2127,9 +2174,9 @@ without a visible progress reporter." ;; We start a pulsing progress reporter after 3 seconds. ;; Start only when there is no other progress reporter ;; running, and when there is a minimum level. - (when-let ((pr (and (null tramp-inhibit-progress-reporter) - (<= ,level (min tramp-verbose 3)) - (make-progress-reporter ,message)))) + (when-let* ((pr (and (null tramp-inhibit-progress-reporter) + (<= ,level (min tramp-verbose 3)) + (make-progress-reporter ,message)))) (run-at-time 3 0.1 #'tramp-progress-reporter-update pr)))) (unwind-protect ;; Execute the body. @@ -2151,8 +2198,8 @@ without a visible progress reporter." (let ((seconds (car list)) (timeout-forms (cdr list))) ;; If non-nil, `seconds' must be a positive number. - `(if-let (((natnump ,seconds)) - ((not (zerop timeout)))) + `(if-let* (((natnump ,seconds)) + ((not (zerop timeout)))) (with-timeout (,seconds ,@timeout-forms) ,@body) ,@body))) @@ -2527,7 +2574,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler for OPERATION and ARGS. Falls back to normal file name handler if no Tramp file name handler exists." - (if-let + (if-let* ((fn (and tramp-mode minibuffer-completing-file-name (assoc operation tramp-completion-file-name-handler-alist)))) (save-match-data (apply (cdr fn) args)) @@ -2623,7 +2670,7 @@ remote file names." ;; If jka-compr or epa-file are already loaded, move them to the ;; front of `file-name-handler-alist'. (dolist (fnh '(epa-file-handler jka-compr-handler)) - (when-let ((entry (rassoc fnh file-name-handler-alist))) + (when-let* ((entry (rassoc fnh file-name-handler-alist))) (setq file-name-handler-alist (cons entry (delete entry file-name-handler-alist)))))) @@ -3492,12 +3539,19 @@ BODY is the backend specific code." (when (tramp-connectable-p ,filename) (with-parsed-tramp-file-name (expand-file-name ,filename) nil (with-tramp-file-property v localname "file-exists-p" - ;; Examine `file-attributes' cache to see if request can - ;; be satisfied without remote operation. - (if (tramp-file-property-p v localname "file-attributes") - (not - (null (tramp-get-file-property v localname "file-attributes"))) - ,@body)))))) + (cond + ;; Examine `file-attributes' cache to see if request can + ;; be satisfied without remote operation. + ((and-let* + (((tramp-file-property-p v localname "file-attributes")) + (fa (tramp-get-file-property v localname "file-attributes")) + ((not (stringp (car fa))))))) + ;; Symlink to a non-existing target counts as nil. + ;; Protect against cyclic symbolic links. + ((file-symlink-p ,filename) + (ignore-errors + (file-exists-p (file-truename ,filename)))) + (t ,@body))))))) (defmacro tramp-skeleton-file-local-copy (filename &rest body) "Skeleton for `tramp-*-handle-file-local-copy'. @@ -3639,7 +3693,9 @@ on the same host. Otherwise, TARGET is quoted." (setf ,target (tramp-file-local-name (expand-file-name ,target)))) ;; There could be a cyclic link. (tramp-flush-file-properties - v (expand-file-name ,target (tramp-file-local-name default-directory)))) + v (tramp-drop-volume-letter + (expand-file-name + ,target (tramp-file-local-name default-directory))))) ;; If TARGET is still remote, quote it. (if (tramp-tramp-file-p ,target) @@ -3719,10 +3775,13 @@ BODY is the backend specific code." tmpstderr (tramp-make-tramp-file-name v stderr)))) ;; stderr to be discarded. ((null (cadr ,destination)) - (setq stderr (tramp-get-remote-null-device v))))) + (setq stderr (tramp-get-remote-null-device v))) + ((eq (cadr ,destination) tramp-cache-undefined) + ;; stderr is not impelmemted. + (tramp-warning v "%s" "STDERR not supported")))) ;; t (,destination - (setq outbuf (current-buffer)))) + (setq outbuf (current-buffer)))) ,@body @@ -3758,7 +3817,7 @@ BODY is the backend specific code." ;; We cannot add "file-attributes", "file-executable-p", ;; "file-ownership-preserved-p", "file-readable-p", ;; "file-writable-p". - '("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename") + '("file-directory-p" "file-exists-p" "file-symlink-p" "file-truename") (tramp-flush-file-properties v localname)) (condition-case err (progn ,@body) @@ -3840,7 +3899,7 @@ BODY is the backend specific code." (let (last-coding-system-used (need-chown t)) ;; Set file modification time. (when (or (eq ,visit t) (stringp ,visit)) - (when-let ((file-attr (file-attributes filename 'integer))) + (when-let* ((file-attr (file-attributes filename 'integer))) (set-visited-file-modtime ;; We must pass modtime explicitly, because FILENAME ;; can be different from (buffer-file-name), f.e. if @@ -3954,9 +4013,9 @@ Let-bind it when necessary.") (tramp-dont-suspend-timers t)) (with-tramp-timeout (timeout - (unless (when-let ((p (tramp-get-connection-process v))) - (and (process-live-p p) - (tramp-get-connection-property p "connected"))) + (unless (and-let* ((p (tramp-get-connection-process v)) + ((process-live-p p)) + ((tramp-get-connection-property p "connected")))) (tramp-cleanup-connection v 'keep-debug 'keep-password)) (tramp-error v 'file-error @@ -4100,10 +4159,9 @@ Let-bind it when necessary.") (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." ;; `file-truename' could raise an error, for example due to a cyclic - ;; symlink. We don't protect this despite it, because other errors - ;; might be worth to be visible, for example impossibility to mount - ;; in tramp-gvfs.el. - (eq (file-attribute-type (file-attributes (file-truename filename))) t)) + ;; symlink. + (ignore-errors + (eq (file-attribute-type (file-attributes (file-truename filename))) t))) (defun tramp-handle-file-equal-p (filename1 filename2) "Like `file-equalp-p' for Tramp files." @@ -4135,8 +4193,8 @@ Let-bind it when necessary.") (defun tramp-handle-file-modes (filename &optional flag) "Like `file-modes' for Tramp files." - (when-let ((attrs (file-attributes filename)) - (mode-string (file-attribute-modes attrs))) + (when-let* ((attrs (file-attributes filename)) + (mode-string (file-attribute-modes attrs))) (if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0))) (file-modes (file-truename filename)) (tramp-mode-string-to-int mode-string)))) @@ -4276,10 +4334,10 @@ Let-bind it when necessary.") (or (tramp-check-cached-permissions v ?r) ;; `tramp-check-cached-permissions' doesn't handle symbolic ;; links. - (when-let ((symlink (file-symlink-p filename))) - (and (stringp symlink) - (file-readable-p - (concat (file-remote-p filename) symlink)))))))) + (and-let* ((symlink (file-symlink-p filename)) + ((stringp symlink)) + ((file-readable-p + (concat (file-remote-p filename) symlink))))))))) (defun tramp-handle-file-regular-p (filename) "Like `file-regular-p' for Tramp files." @@ -4289,7 +4347,7 @@ Let-bind it when necessary.") ;; because `file-truename' could raise an error for cyclic ;; symlinks. (ignore-errors - (when-let ((attr (file-attributes filename))) + (when-let* ((attr (file-attributes filename))) (cond ((eq ?- (aref (file-attribute-modes attr) 0))) ((eq ?l (aref (file-attribute-modes attr) 0)) @@ -4729,7 +4787,7 @@ It is not guaranteed, that all process attributes as described in (defun tramp-get-lock-file (file) "Read lockfile info of FILE. Return nil when there is no lockfile." - (when-let ((lockname (tramp-compat-make-lock-file-name file))) + (when-let* ((lockname (tramp-compat-make-lock-file-name file))) (or (file-symlink-p lockname) (and (file-readable-p lockname) (with-temp-buffer @@ -4760,8 +4818,8 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defun tramp-handle-file-locked-p (file) "Like `file-locked-p' for Tramp files." - (when-let ((info (tramp-get-lock-file file)) - (match (string-match tramp-lock-file-info-regexp info))) + (when-let* ((info (tramp-get-lock-file file)) + (match (string-match tramp-lock-file-info-regexp info))) (or ; Locked by me. (and (string-equal (match-string 1 info) (user-login-name)) (string-equal (match-string 2 info) tramp-system-name) @@ -4783,20 +4841,20 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") ;; for remote files. (ask-user-about-supersession-threat file)) - (when-let ((info (tramp-get-lock-file file)) - (match (string-match tramp-lock-file-info-regexp info))) + (when-let* ((info (tramp-get-lock-file file)) + (match (string-match tramp-lock-file-info-regexp info))) (unless (ask-user-about-lock file (format "%s@%s (pid %s)" (match-string 1 info) (match-string 2 info) (match-string 3 info))) (throw 'dont-lock nil))) - (when-let ((lockname (tramp-compat-make-lock-file-name file)) - ;; USER@HOST.PID[:BOOT_TIME] - (info - (format - "%s@%s.%s" (user-login-name) tramp-system-name - (tramp-get-lock-pid file)))) + (when-let* ((lockname (tramp-compat-make-lock-file-name file)) + ;; USER@HOST.PID[:BOOT_TIME] + (info + (format + "%s@%s.%s" (user-login-name) tramp-system-name + (tramp-get-lock-pid file)))) ;; Protect against security hole. (with-parsed-tramp-file-name file nil @@ -4837,9 +4895,9 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") ;; When there is no connection, we don't do it. Otherwise, ;; functions like `kill-buffer' would try to reestablish the ;; connection. See Bug#61663. - (if-let ((v (tramp-dissect-file-name file)) - ((process-live-p (tramp-get-process v))) - (lockname (tramp-compat-make-lock-file-name file))) + (if-let* ((v (tramp-dissect-file-name file)) + ((process-live-p (tramp-get-process v))) + (lockname (tramp-compat-make-lock-file-name file))) (delete-file lockname) ;; Trigger the unlock error. Be quiet if user isn't ;; interested in lock files. See Bug#70900. @@ -4885,8 +4943,8 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (defun tramp-add-hops (vec) "Add ad-hoc proxy definitions to `tramp-default-proxies-alist'." - (when-let ((hops (tramp-file-name-hop vec)) - (item vec)) + (when-let* ((hops (tramp-file-name-hop vec)) + (item vec)) (let (signal-hook-function changed) (dolist (proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit))) @@ -4918,69 +4976,74 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") (item vec) choices proxy) - ;; Ad-hoc proxy definitions. - (tramp-add-hops vec) + ;; `tramp-compute-multi-hops' could be called also for other file + ;; name handlers, for example in `tramp-clear-passwd'. + (when (tramp-sh-file-name-handler-p vec) - ;; Look for proxy hosts to be passed. - (setq choices tramp-default-proxies-alist) - (while choices - (setq item (pop choices) - proxy (eval (nth 2 item) t)) - (when (and - ;; Host. - (string-match-p - (or (eval (nth 0 item) t) "") - (or (tramp-file-name-host-port (car target-alist)) "")) - ;; User. - (string-match-p - (or (eval (nth 1 item) t) "") - (or (tramp-file-name-user-domain (car target-alist)) ""))) - (if (null proxy) - ;; No more hops needed. - (setq choices nil) - ;; Replace placeholders. - (setq proxy - (format-spec - proxy - (format-spec-make - ?u (or (tramp-file-name-user (car target-alist)) "") - ?h (or (tramp-file-name-host (car target-alist)) "")))) - (with-parsed-tramp-file-name proxy l - ;; Add the hop. - (push l target-alist) - ;; Start next search. - (setq choices tramp-default-proxies-alist))))) + ;; Ad-hoc proxy definitions. + (tramp-add-hops vec) - ;; Foreign and out-of-band methods are not supported for multi-hops. - (when (cdr target-alist) - (setq choices target-alist) - (while (setq item (pop choices)) - (unless (tramp-multi-hop-p item) - (setq tramp-default-proxies-alist saved-tdpa) - (tramp-user-error - vec "Method `%s' is not supported for multi-hops" - (tramp-file-name-method item))))) + ;; Look for proxy hosts to be passed. + (setq choices tramp-default-proxies-alist) + (while choices + (setq item (pop choices) + proxy (eval (nth 2 item) t)) + (when (and + ;; Host. + (string-match-p + (or (eval (nth 0 item) t) "") + (or (tramp-file-name-host-port (car target-alist)) "")) + ;; User. + (string-match-p + (or (eval (nth 1 item) t) "") + (or (tramp-file-name-user-domain (car target-alist)) ""))) + (if (null proxy) + ;; No more hops needed. + (setq choices nil) + ;; Replace placeholders. + (setq proxy + (format-spec + proxy + (format-spec-make + ?u (or (tramp-file-name-user (car target-alist)) "") + ?h (or (tramp-file-name-host (car target-alist)) "")))) + (with-parsed-tramp-file-name proxy l + ;; Add the hop. + (push l target-alist) + ;; Start next search. + (setq choices tramp-default-proxies-alist))))) - ;; Some methods ("su", "sg", "sudo", "doas", "run0", "ksu") do not - ;; use the host name in their command template. In this case, the - ;; remote file name must use either a local host name (first hop), - ;; or a host name matching the previous hop. - (let ((previous-host (or tramp-local-host-regexp ""))) - (setq choices target-alist) - (while (setq item (pop choices)) - (let ((host (tramp-file-name-host item))) - (unless - (or - ;; The host name is used for the remote shell command. - (member - "%h" (flatten-tree - (tramp-get-method-parameter item 'tramp-login-args))) - ;; The host name must match previous hop. - (string-match-p previous-host host)) + ;; Foreign and out-of-band methods are not supported for + ;; multi-hops. + (when (cdr target-alist) + (setq choices target-alist) + (while (setq item (pop choices)) + (unless (tramp-multi-hop-p item) (setq tramp-default-proxies-alist saved-tdpa) (tramp-user-error - vec "Host name `%s' does not match `%s'" host previous-host)) - (setq previous-host (rx bol (literal host) eol))))) + vec "Method `%s' is not supported for multi-hops" + (tramp-file-name-method item))))) + + ;; Some methods ("su", "sg", "sudo", "doas", "run0", "ksu") do + ;; not use the host name in their command template. In this + ;; case, the remote file name must use either a local host name + ;; (first hop), or a host name matching the previous hop. + (let ((previous-host (or tramp-local-host-regexp ""))) + (setq choices target-alist) + (while (setq item (pop choices)) + (let ((host (tramp-file-name-host item))) + (unless + (or + ;; The host name is used for the remote shell command. + (member + "%h" (flatten-tree + (tramp-get-method-parameter item 'tramp-login-args))) + ;; The host name must match previous hop. + (string-match-p previous-host host)) + (setq tramp-default-proxies-alist saved-tdpa) + (tramp-user-error + vec "Host name `%s' does not match `%s'" host previous-host)) + (setq previous-host (rx bol (literal host) eol)))))) ;; Result. target-alist)) @@ -5094,13 +5157,13 @@ should be set connection-local.") elt (default-toplevel-value 'process-environment)))) (setq env (cons elt env))))) ;; Add remote path if exists. - (env (if-let ((sh-file-name-handler-p) - (remote-path - (string-join (tramp-get-remote-path v) ":"))) + (env (if-let* ((sh-file-name-handler-p) + (remote-path + (string-join (tramp-get-remote-path v) ":"))) (setenv-internal env "PATH" remote-path 'keep) env)) ;; Add HISTFILE if indicated. - (env (if-let ((sh-file-name-handler-p)) + (env (if sh-file-name-handler-p (cond ((stringp tramp-histfile-override) (setenv-internal @@ -5409,8 +5472,22 @@ support symbolic links." (insert-file-contents-literally error-file nil nil nil 'replace)) (delete-file error-file))))) - (display-buffer output-buffer '(nil (allow-no-window . t))))) - + (if async-shell-command-display-buffer + ;; Display buffer immediately. + (display-buffer output-buffer '(nil (allow-no-window . t))) + ;; Defer displaying buffer until first process output. + ;; Use disposable named advice so that the buffer is + ;; displayed at most once per process lifetime. + (let ((nonce (make-symbol "nonce"))) + (add-function + :before (process-filter p) + (lambda (proc _string) + (let ((buf (process-buffer proc))) + (when (buffer-live-p buf) + (remove-function (process-filter proc) + nonce) + (display-buffer buf '(nil (allow-no-window . t)))))) + `((name . ,nonce))))))) ;; Insert error messages if they were separated. (when (and error-file (not (process-live-p p))) (ignore-errors @@ -5649,7 +5726,11 @@ of." ;; Sometimes, the process returns a new password request ;; immediately after rejecting the previous (wrong) one. (unless (or tramp-password-prompt-not-unique - (tramp-get-connection-property vec "first-password-request")) + (tramp-get-connection-property + (tramp-get-connection-property + proc "hop-vector" + (process-get proc 'tramp-vector)) + "first-password-request")) (tramp-clear-passwd vec)) (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) @@ -5687,6 +5768,22 @@ of." (narrow-to-region (point-max) (point-max)))) t) +(defcustom tramp-use-fingerprint t + "Whether fingerprint prompts shall be used for authentication." + :version "30.2" + :type 'boolean) + +(defun tramp-action-fingerprint (proc vec) + "Query the user for a fingerprint verification. +Interrupt the query if `tramp-use-fingerprint' is nil." + (with-current-buffer (process-buffer proc) + (if tramp-use-fingerprint + (tramp-action-show-message proc vec) + (interrupt-process proc) + ;; Hide message. + (narrow-to-region (point-max) (point-max)))) + t) + (defun tramp-action-succeed (_proc _vec) "Signal success in finding shell prompt." (throw 'tramp-action 'ok)) @@ -5733,6 +5830,26 @@ The terminal type can be configured with `tramp-terminal-type'." (tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line)) t) +(defun tramp-action-show-message (proc vec) + "Show the user a message for confirmation. +Wait, until the connection buffer changes." + (with-current-buffer (process-buffer proc) + (let ((cursor-in-echo-area t) + set-message-function clear-message-function tramp-dont-suspend-timers) + (with-tramp-suspended-timers + ;; Silence byte compiler. + (ignore set-message-function clear-message-function) + (tramp-message vec 6 "\n%s" (buffer-string)) + (goto-char (point-min)) + (tramp-check-for-regexp proc tramp-process-action-regexp) + (with-temp-message (concat (string-trim (match-string 0)) " ") + ;; Hide message in buffer. + (narrow-to-region (point-max) (point-max)) + ;; Wait for new output. + (while (tramp-compat-length= (buffer-string) 0) + (tramp-accept-process-output proc)))))) + t) + (defun tramp-action-confirm-message (_proc vec) "Return RET in order to confirm the message." (tramp-message @@ -5750,6 +5867,7 @@ Wait, until the connection buffer changes." ;; Silence byte compiler. (ignore set-message-function clear-message-function) (tramp-message vec 6 "\n%s" (buffer-string)) + (goto-char (point-min)) (tramp-check-for-regexp proc tramp-process-action-regexp) (with-temp-message (concat (string-trim (match-string 0)) " ") ;; Hide message in buffer. @@ -5852,10 +5970,10 @@ because the shell prompt has been detected), it shall throw a result. The symbol `ok' means that all ACTIONs have been performed successfully. Any other value means an error." ;; Enable `auth-source', unless "emacs -Q" has been called. We must - ;; use the "password-vector" property in case we have several hops. + ;; use the "hop-vector" property in case we have several hops. (tramp-set-connection-property (tramp-get-connection-property - proc "password-vector" (process-get proc 'tramp-vector)) + proc "hop-vector" (process-get proc 'tramp-vector)) "first-password-request" tramp-cache-read-persistent-data) (save-restriction (with-tramp-progress-reporter @@ -5936,8 +6054,8 @@ If the user quits via `C-g', it is propagated up to `tramp-file-name-handler'." ;; communication. This could block the output for the current ;; process. Read such output first. (Bug#61350) ;; The process property isn't set anymore due to Bug#62194. - (when-let (((process-get proc 'tramp-shared-socket)) - (v (process-get proc 'tramp-vector))) + (when-let* (((process-get proc 'tramp-shared-socket)) + (v (process-get proc 'tramp-vector))) (dolist (p (delq proc (process-list))) (when (tramp-file-name-equal-p v (process-get p 'tramp-vector)) (with-tramp-suspended-timers @@ -6020,6 +6138,8 @@ nil." (let ((found (tramp-check-for-regexp proc regexp))) (with-tramp-timeout (timeout) (while (not found) + ;; This is needed to yield the CPU, otherwise we'll see 100% CPU load. + (sit-for 0 'nodisp) (tramp-accept-process-output proc) (unless (process-live-p proc) (tramp-error-with-buffer @@ -6247,10 +6367,10 @@ depending whether FILENAME is remote or local. Both parameters must be non-negative integers. The setgid bit of the upper directory is respected. If FILENAME is remote, a file name handler is called." - (let* ((dir (file-name-directory filename)) - (modes (file-modes dir))) - (when (and modes (not (zerop (logand modes #o2000)))) - (setq gid (file-attribute-group-id (file-attributes dir))))) + (when-let* ((dir (file-name-directory filename)) + (modes (file-modes dir)) + ((not (zerop (logand modes #o2000))))) + (setq gid (file-attribute-group-id (file-attributes dir)))) (if (tramp-tramp-file-p filename) (funcall (if (tramp-crypt-file-name-p filename) @@ -6308,14 +6428,14 @@ VEC is used for tracing." "Check `file-attributes' caches for VEC. Return t if according to the cache access type ACCESS is known to be granted." - (when-let ((offset (cond - ((eq ?r access) 1) - ((eq ?w access) 2) - ((eq ?x access) 3) - ((eq ?s access) 3))) - (file-attr (file-attributes (tramp-make-tramp-file-name vec))) - (remote-uid (tramp-get-remote-uid vec 'integer)) - (remote-gid (tramp-get-remote-gid vec 'integer))) + (when-let* ((offset (cond + ((eq ?r access) 1) + ((eq ?w access) 2) + ((eq ?x access) 3) + ((eq ?s access) 3))) + (file-attr (file-attributes (tramp-make-tramp-file-name vec))) + (remote-uid (tramp-get-remote-uid vec 'integer)) + (remote-gid (tramp-get-remote-gid vec 'integer))) (or ;; Not a symlink. (eq t (file-attribute-type file-attr)) @@ -6352,112 +6472,110 @@ Convert file mode bits to string and set virtual device number. Set file uid and gid according to ID-FORMAT. LOCALNAME is used to cache the result. Return the modified ATTR." (declare (indent 3) (debug t)) - `(with-tramp-file-property - ,vec ,localname (format "file-attributes-%s" (or ,id-format 'integer)) - (when-let - ((result - (with-tramp-file-property ,vec ,localname "file-attributes" - (when-let ((attr ,attr)) - (save-match-data - ;; Remove ANSI control escape sequences from symlink. + `(when-let* + ((result + (with-tramp-file-property ,vec ,localname "file-attributes" + (when-let* ((attr ,attr)) + (save-match-data + ;; Remove ANSI control escape sequences from symlink. + (when (stringp (car attr)) + (while (string-match ansi-color-control-seq-regexp (car attr)) + (setcar attr (replace-match "" nil nil (car attr))))) + ;; Convert uid and gid. Use `tramp-unknown-id-integer' + ;; as indication of unusable value. + (when (consp (nth 2 attr)) + (when (and (numberp (cdr (nth 2 attr))) + (< (cdr (nth 2 attr)) 0)) + (setcdr (car (nthcdr 2 attr)) tramp-unknown-id-integer)) + (when (and (floatp (cdr (nth 2 attr))) + (<= (cdr (nth 2 attr)) most-positive-fixnum)) + (setcdr (car (nthcdr 2 attr)) (round (cdr (nth 2 attr)))))) + (when (consp (nth 3 attr)) + (when (and (numberp (cdr (nth 3 attr))) + (< (cdr (nth 3 attr)) 0)) + (setcdr (car (nthcdr 3 attr)) tramp-unknown-id-integer)) + (when (and (floatp (cdr (nth 3 attr))) + (<= (cdr (nth 3 attr)) most-positive-fixnum)) + (setcdr (car (nthcdr 3 attr)) (round (cdr (nth 3 attr)))))) + ;; Convert last access time. + (unless (listp (nth 4 attr)) + (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr)))) + ;; Convert last modification time. + (unless (listp (nth 5 attr)) + (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr)))) + ;; Convert last status change time. + (unless (listp (nth 6 attr)) + (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr)))) + ;; Convert file size. + (when (< (nth 7 attr) 0) + (setcar (nthcdr 7 attr) -1)) + (when (and (floatp (nth 7 attr)) + (<= (nth 7 attr) most-positive-fixnum)) + (setcar (nthcdr 7 attr) (round (nth 7 attr)))) + ;; Convert file mode bits to string. + (unless (stringp (nth 8 attr)) + (setcar (nthcdr 8 attr) + (tramp-file-mode-from-int (nth 8 attr))) (when (stringp (car attr)) - (while (string-match ansi-color-control-seq-regexp (car attr)) - (setcar attr (replace-match "" nil nil (car attr))))) - ;; Convert uid and gid. Use `tramp-unknown-id-integer' - ;; as indication of unusable value. - (when (consp (nth 2 attr)) - (when (and (numberp (cdr (nth 2 attr))) - (< (cdr (nth 2 attr)) 0)) - (setcdr (car (nthcdr 2 attr)) tramp-unknown-id-integer)) - (when (and (floatp (cdr (nth 2 attr))) - (<= (cdr (nth 2 attr)) most-positive-fixnum)) - (setcdr (car (nthcdr 2 attr)) (round (cdr (nth 2 attr)))))) - (when (consp (nth 3 attr)) - (when (and (numberp (cdr (nth 3 attr))) - (< (cdr (nth 3 attr)) 0)) - (setcdr (car (nthcdr 3 attr)) tramp-unknown-id-integer)) - (when (and (floatp (cdr (nth 3 attr))) - (<= (cdr (nth 3 attr)) most-positive-fixnum)) - (setcdr (car (nthcdr 3 attr)) (round (cdr (nth 3 attr)))))) - ;; Convert last access time. - (unless (listp (nth 4 attr)) - (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr)))) - ;; Convert last modification time. - (unless (listp (nth 5 attr)) - (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr)))) - ;; Convert last status change time. - (unless (listp (nth 6 attr)) - (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr)))) - ;; Convert file size. - (when (< (nth 7 attr) 0) - (setcar (nthcdr 7 attr) -1)) - (when (and (floatp (nth 7 attr)) - (<= (nth 7 attr) most-positive-fixnum)) - (setcar (nthcdr 7 attr) (round (nth 7 attr)))) - ;; Convert file mode bits to string. - (unless (stringp (nth 8 attr)) - (setcar (nthcdr 8 attr) - (tramp-file-mode-from-int (nth 8 attr))) - (when (stringp (car attr)) - (aset (nth 8 attr) 0 ?l))) - ;; Convert directory indication bit. - (when (string-prefix-p "d" (nth 8 attr)) - (setcar attr t)) - ;; Convert symlink from `tramp-do-file-attributes-with-stat'. - ;; Decode also multibyte string. - (when (consp (car attr)) - (setcar attr - (and (stringp (caar attr)) - (string-match - (rx (+ nonl) " -> " nonl (group (+ nonl)) nonl) - (caar attr)) - (decode-coding-string - (match-string 1 (caar attr)) 'utf-8)))) - ;; Set file's gid change bit. - (setcar - (nthcdr 9 attr) - (not (= (cdr (nth 3 attr)) - (or (tramp-get-remote-gid ,vec 'integer) - tramp-unknown-id-integer)))) - ;; Convert inode. - (when (floatp (nth 10 attr)) - (setcar (nthcdr 10 attr) - (condition-case nil - (let ((high (nth 10 attr)) - middle low) + (aset (nth 8 attr) 0 ?l))) + ;; Convert directory indication bit. + (when (string-prefix-p "d" (nth 8 attr)) + (setcar attr t)) + ;; Convert symlink from `tramp-do-file-attributes-with-stat'. + ;; Decode also multibyte string. + (when (consp (car attr)) + (setcar attr + (and (stringp (caar attr)) + (string-match + (rx (+ nonl) " -> " nonl (group (+ nonl)) nonl) + (caar attr)) + (decode-coding-string + (match-string 1 (caar attr)) 'utf-8)))) + ;; Set file's gid change bit. + (setcar + (nthcdr 9 attr) + (not (= (cdr (nth 3 attr)) + (or (tramp-get-remote-gid ,vec 'integer) + tramp-unknown-id-integer)))) + ;; Convert inode. + (when (floatp (nth 10 attr)) + (setcar (nthcdr 10 attr) + (condition-case nil + (let ((high (nth 10 attr)) + middle low) + (if (<= high most-positive-fixnum) + (floor high) + ;; The low 16 bits. + (setq low (mod high #x10000) + high (/ high #x10000)) (if (<= high most-positive-fixnum) - (floor high) - ;; The low 16 bits. - (setq low (mod high #x10000) - high (/ high #x10000)) - (if (<= high most-positive-fixnum) - (cons (floor high) (floor low)) - ;; The middle 24 bits. - (setq middle (mod high #x1000000) - high (/ high #x1000000)) - (cons (floor high) - (cons (floor middle) (floor low)))))) - ;; Inodes can be incredible huge. We - ;; must hide this. - (error (tramp-get-inode ,vec))))) - ;; Set virtual device number. - (setcar (nthcdr 11 attr) - (tramp-get-device ,vec)) - ;; Set SELinux context. - (when (stringp (nth 12 attr)) - (tramp-set-file-property - ,vec ,localname "file-selinux-context" - (split-string (nth 12 attr) ":" 'omit))) - ;; Remove optional entries. - (setcdr (nthcdr 11 attr) nil) - attr))))) + (cons (floor high) (floor low)) + ;; The middle 24 bits. + (setq middle (mod high #x1000000) + high (/ high #x1000000)) + (cons (floor high) + (cons (floor middle) (floor low)))))) + ;; Inodes can be incredible huge. We must + ;; hide this. + (error (tramp-get-inode ,vec))))) + ;; Set virtual device number. + (setcar (nthcdr 11 attr) + (tramp-get-device ,vec)) + ;; Set SELinux context. + (when (stringp (nth 12 attr)) + (tramp-set-file-property + ,vec ,localname "file-selinux-context" + (split-string (nth 12 attr) ":" 'omit))) + ;; Remove optional entries. + (setcdr (nthcdr 11 attr) nil) + attr))))) - ;; Return normalized result. - (append (tramp-compat-take 2 result) - (if (eq ,id-format 'string) - (list (car (nth 2 result)) (car (nth 3 result))) - (list (cdr (nth 2 result)) (cdr (nth 3 result)))) - (nthcdr 4 result))))) + ;; Return normalized result. + (append (tramp-compat-take 2 result) + (if (eq ,id-format 'string) + (list (car (nth 2 result)) (car (nth 3 result))) + (list (cdr (nth 2 result)) (cdr (nth 3 result)))) + (nthcdr 4 result)))) (defun tramp-get-home-directory (vec &optional user) "The remote home directory for connection VEC as local file name. @@ -6775,13 +6893,15 @@ verbosity of 6." (catch 'result (let ((default-directory temporary-file-directory)) (dolist (pid (list-system-processes)) - (when-let ((attributes (process-attributes pid)) - (comm (cdr (assoc 'comm attributes)))) - (and (string-equal (cdr (assoc 'user attributes)) (user-login-name)) - ;; The returned command name could be truncated to 15 - ;; characters. Therefore, we cannot check for `string-equal'. - (string-prefix-p comm process-name) - (throw 'result t)))))))) + (and-let* ((attributes (process-attributes pid)) + (comm (cdr (assoc 'comm attributes))) + ((string-equal + (cdr (assoc 'user attributes)) (user-login-name))) + ;; The returned command name could be truncated + ;; to 15 characters. Therefore, we cannot check + ;; for `string-equal'. + ((string-prefix-p comm process-name)) + ((throw 'result t))))))))) ;; When calling "emacs -Q", `auth-source-search' won't be called. If ;; you want to debug exactly this case, call "emacs -Q --eval '(setq @@ -6796,15 +6916,16 @@ Consults the auth-source package." ;; adapt `default-directory'. (Bug#39389, Bug#39489) (default-directory tramp-compat-temporary-file-directory) (case-fold-search t) - ;; In tramp-sh.el, we must use "password-vector" due to - ;; multi-hop. - (vec (tramp-get-connection-property - proc "password-vector" (process-get proc 'tramp-vector))) - (key (tramp-make-tramp-file-name vec 'noloc)) - (method (tramp-file-name-method vec)) - (user-domain (or (tramp-file-name-user-domain vec) - (tramp-get-connection-property key "login-as"))) - (host-port (tramp-file-name-host-port vec)) + ;; In tramp-sh.el, we must use "hop-vector" and "pw-vector" + ;; due to multi-hop. + (vec (process-get proc 'tramp-vector)) + (hop-vec (tramp-get-connection-property proc "hop-vector" vec)) + (pw-vec (tramp-get-connection-property proc "pw-vector" hop-vec)) + (key (tramp-make-tramp-file-name pw-vec 'noloc)) + (method (tramp-file-name-method pw-vec)) + (user-domain (or (tramp-file-name-user-domain pw-vec) + (tramp-get-connection-property pw-vec "login-as"))) + (host-port (tramp-file-name-host-port pw-vec)) (pw-prompt (string-trim-left (or prompt @@ -6813,29 +6934,23 @@ Consults the auth-source package." (if (string-match-p "passphrase" (match-string 1)) (match-string 0) (format "%s for %s " (capitalize (match-string 1)) key)))))) + ;; If there is no user name, `:create' triggers to ask for. + ;; We suppress it. + (pw-spec (list :max 1 :user user-domain :host host-port :port method + :require (cons :secret (and user-domain '(:user))) + :create (and user-domain t))) (auth-source-creation-prompts `((secret . ,pw-prompt))) ;; Use connection-local value. (auth-sources (buffer-local-value 'auth-sources (process-buffer proc))) auth-info auth-passwd tramp-dont-suspend-timers) (unwind-protect - ;; We cannot use `with-parsed-tramp-file-name', because it - ;; expands the file name. (or (setq tramp-password-save-function nil) - ;; See if auth-sources contains something useful. + ;; See if `auth-sources' contains something useful. (ignore-errors - (and auth-sources - (tramp-get-connection-property vec "first-password-request") - ;; Try with Tramp's current method. If there is no - ;; user name, `:create' triggers to ask for. We - ;; suppress it. - (setq auth-info - (car - (auth-source-search - :max 1 :user user-domain :host host-port :port method - :require (cons :secret (and user-domain '(:user))) - :create (and user-domain t))) + (and (tramp-get-connection-property hop-vec "first-password-request") + (setq auth-info (car (apply #'auth-source-search pw-spec)) tramp-password-save-function (plist-get auth-info :save-function) auth-passwd @@ -6843,16 +6958,23 @@ Consults the auth-source package." ;; Try the password cache. (with-tramp-suspended-timers - (setq auth-passwd (password-read pw-prompt key) + (setq auth-passwd + (password-read + pw-prompt (auth-source-format-cache-entry pw-spec)) tramp-password-save-function - (lambda () (password-cache-add key auth-passwd))) + (when auth-source-do-cache + (lambda () + (password-cache-add + (auth-source-format-cache-entry pw-spec) auth-passwd)))) auth-passwd)) ;; Workaround. Prior Emacs 28.1, auth-source has saved empty ;; passwords. See discussion in Bug#50399. (when (tramp-string-empty-or-nil-p auth-passwd) (setq tramp-password-save-function nil)) - (tramp-set-connection-property vec "first-password-request" nil)))) + ;; Remember the values. + (tramp-set-connection-property hop-vec "pw-spec" pw-spec) + (tramp-set-connection-property hop-vec "first-password-request" nil)))) (defun tramp-read-passwd-without-cache (proc &optional prompt) "Read a password from user (compat function)." @@ -6869,17 +6991,11 @@ Consults the auth-source package." (defun tramp-clear-passwd (vec) "Clear password cache for connection related to VEC." (declare (tramp-suppress-trace t)) - (let ((method (tramp-file-name-method vec)) - (user-domain (tramp-file-name-user-domain vec)) - (host-port (tramp-file-name-host-port vec)) - (hop (tramp-file-name-hop vec))) - (when hop - ;; Clear also the passwords of the hops. - (tramp-clear-passwd (tramp-dissect-hop-name hop))) - (auth-source-forget - `(:max 1 ,(and user-domain :user) ,user-domain - :host ,host-port :port ,method)) - (password-cache-remove (tramp-make-tramp-file-name vec 'noloc)))) + (when-let* ((hop (cadr (reverse (tramp-compute-multi-hops vec))))) + ;; Clear also the passwords of the hops. + (tramp-clear-passwd hop)) + (when-let* ((pw-spec (tramp-get-connection-property vec "pw-spec"))) + (auth-source-forget pw-spec))) (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. @@ -7071,5 +7187,11 @@ If VEC is `tramp-null-hop', return local null device." ;; ;; * Implement user and host name completion for multi-hops. Some ;; methods in tramp-container.el have it already. +;; +;; * Make it configurable, which environment variables are set in +;; direct async processes. +;; +;; * Pass working dir for direct async processes, for example for +;; container methods. ;;; tramp.el ends here diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 9f990f3e9fb..38f824d876b 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.7.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))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3cff9c1b837..605b26206c4 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -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