mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 02:31:03 -08:00
Code Issues Projects Releases Wiki Activity

Sync with Tramp 2.4.5-pre

Browse source 
* doc/misc/tramp.texi: Adapt Tramp and Emacs version numbers.
(Remote processes): Describe `process-file-return-signal-string'
and $INSIDE_EMACS.
(Frequently Asked Questions): Mention Emacs 28.
Describe `tramp-smb-options'.

* doc/misc/trampver.texi: Change version to "2.4.5-pre".

* lisp/net/tramp-adb.el (process-file-return-signal-string): Declare.
(tramp-adb-handle-write-region): Flush the cache after the file
has been written.
(tramp-adb-handle-set-file-modes, tramp-adb-handle-set-file-times):
Add optional _FLAG.
(tramp-adb-handle-copy-file, tramp-adb-handle-rename-file)
(tramp-adb-handle-process-file): Use `tramp-file-local-name'.
(tramp-adb-get-signal-strings): New defun.
(tramp-adb-handle-process-file): Use it.
(tramp-adb-handle-make-process): Implement `stderr'.  Use
`insert-file-contents-literally'.
(tramp-adb-send-command-and-check): Add optional argument
EXIT-STATUS.
(tramp-adb-handle-process-file): Use it.

* lisp/net/tramp-archive.el (tramp-archive-file-name-handler):
Increase `max-specpdl-size' temporarily.

* lisp/net/tramp-cache.el (top):
Use `insert-file-contents-literally'.

* lisp/net/tramp-cmds.el (tramp-rename-files):
Use `tramp-file-local-name'.

* lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): Prevent crash for
older Emacsen.
(top): Adapt `tramp-gvfs-unload-hook'.
(tramp-gvfs-handle-file-system-info): Fix error.
(tramp-gvfs-handle-set-file-modes, tramp-gvfs-handle-set-file-times):
Add optional _FLAG.

* lisp/net/tramp-rclone.el (tramp-rclone-flush-directory-cache):
Fix a problem with older Emacsen.

* lisp/net/tramp-sh.el (process-file-return-signal-string): Declare.
(tramp-sh-extra-args): Add "-noediting" as bash arg.
(tramp-hexdump-encode, tramp-hexdump-awk-encode)
(tramp-od-encode, tramp-od-awk-encode): New defconst.
(tramp-awk-encode, tramp-awk-decode): Adapt.
(tramp-awk-coding-test): Remove.
(tramp-remote-coding-commands): Add hexdump/awk encoding.  (Bug#35639)
(tramp-find-inline-encoding): Adapt handling of awk, hexdump and od.
(tramp-get-remote-busybox, tramp-get-remote-awk)
(tramp-get-remote-hexdump, tramp-get-remote-od): New defuns.
(tramp-sh-handle-make-symbolic-link):
(tramp-do-copy-or-rename-file-directly)
(tramp-sh-handle-process-file, tramp-set-remote-path)
(tramp-find-inline-encoding, tramp-get-remote-touch):
Use `tramp-file-local-name'.
(tramp-do-file-attributes-with-stat): Simplify shell command.
Suppress errors (interpret as nil).
(tramp-sh-handle-set-file-modes, tramp-sh-handle-set-file-times):
Add optional _FLAG.
(tramp-sh-handle-make-process): Do not visit with
`insert-file-contents'.  Delete tmp file only if exists.  Support
`stderr' as file name.  Delete temporary stderr file.  Flush
connection properties in time.
(tramp-sh-get-signal-strings): New defun.
(tramp-sh-handle-process-file): Use it.
(tramp-sh-handle-write-region): Copy to temp file only if FILENAME
exists.  (Bug#40156)
(tramp-set-remote-path): Send the command in several chunks if it
is too large.  (Bug#42538)
(tramp-open-connection-setup-interactive-shell): Move up "set +o
vi +o emacs" command.   (Bug#39399)
(tramp-send-command-and-read): Suppress `signal-hook-function'
when reading expression.
(tramp-send-command-and-check): Add optional argument EXIT-STATUS.
(tramp-sh-handle-process-file): Use it.  (Bug#41099)

* lisp/net/tramp-smb.el (tramp-smb-conf): Fix docstring.
(tramp-smb-options): New defcustom.
(tramp-smb-handle-copy-directory, tramp-smb-handle-file-acl)
(tramp-smb-handle-set-file-acl, tramp-smb-maybe-open-connection):
Use it.
(tramp-smb-errors): Add "NT_STATUS_INVALID_PARAMETER".
(tramp-smb-handle-make-symbolic-link)
(tramp-smb-handle-process-file): Use `tramp-file-local-name'.

* lisp/net/tramp-sudoedit.el (tramp-sudoedit-do-copy-or-rename-file):
(tramp-sudoedit-handle-set-file-uid-gid):
Use `tramp-unquote-file-local-name'.
(tramp-sudoedit-handle-make-symbolic-link):
Use `tramp-file-local-name'.
(tramp-sudoedit-handle-file-system-info): Fix a scoping error.
(tramp-sudoedit-handle-set-file-modes):
(tramp-sudoedit-handle-set-file-times): Add optional _FLAG.

* lisp/net/tramp.el: Bump version to 2.4.5-pre.
(tramp-file-local-name, tramp-unquote-file-local-name): New defuns.
(tramp-set-connection-local-variables-for-buffer)
(tramp-equal-remote, tramp-handle-make-auto-save-file-name):
Use `tramp-tramp-file-p'.
(tramp-parse-file): Use `insert-file-contents-literally'.
(tramp-handle-file-modes, tramp-handle-file-times):
Add optional _FLAG.
(tramp-handle-shell-command): Fix `window-start' in output buffer.
(Bug#39171)
Handle `shell-command-dont-erase-buffer'.  (Bug#39067)
Reorganize error-buffer handling.  Set `default-directory'.
(Bug#39253)
(tramp-handle-shell-command, tramp-handle-start-file-process):
Implement asynchronous `error-buffer'.
(tramp-action-process-alive): Read pending output.
(tramp-read-passwd): Use `tramp-compat-temporary-file-directory'.
(Bug#39389, Bug#39489)
(tramp-interrupt-process): Improve command.

* lisp/net/trampver.el: Change version to "2.4.5-pre".
(tramp-repository-branch, tramp-repository-version):
Bind `debug-on-error' to nil.

* test/lisp/net/tramp-tests.el (tramp-get-remote-gid)
(process-file-return-signal-string)
(shell-command-dont-erase-buffer): Declare.
(tramp-test10-write-region, tramp-test28-process-file)
(tramp-test29-start-file-process, tramp-test30-make-process)
(tramp-test31-interrupt-process, tramp-test32-shell-command):
Extend test.
(tramp-test10-write-region, tramp-test21-file-links): Use function
symbols.
(tramp-test18-file-attributes): Check `file-ownership-preserved-p'
only if possible.
(tramp--test-async-shell-command): New defun.
(tramp--test-shell-command-to-string-asynchronously): Use it.
(tramp-test32-shell-command-dont-erase-buffer): New test.
This commit is contained in:
Michael Albinus 2020-08-25 15:18:57 +02:00
parent 44104a607a
commit 4657f08b7e
15 changed files with 1104 additions and 417 deletions
Download patch file Download diff file Expand all files Collapse all files

74
doc/misc/tramp.texi
View file

@ -318,14 +318,14 @@ behind the scenes when you open a file with @value{tramp}.
@uref{https://ftp.gnu.org/gnu/tramp/}. The version number of
@value{tramp} can be obtained by the variable @code{tramp-version}.
For released @value{tramp} versions, this is a three-number string
like ``2.4.2''.
like ``2.4.3''.
A @value{tramp} release, which is packaged with Emacs, could differ
slightly from the corresponding standalone release. This is because
it isn't always possible to synchronize release dates between Emacs
and @value{tramp}. Such version numbers have the Emacs version number
as suffix, like ``2.3.5.26.3''. This means @value{tramp} 2.3.5 as
integrated in Emacs 26.3. A complete list of @value{tramp} versions
as suffix, like ``2.4.3.27.1''. This means @value{tramp} 2.4.3 as
integrated in Emacs 27.1. A complete list of @value{tramp} versions
packaged with Emacs can be retrieved by
@vindex customize-package-emacs-version-alist
@ -337,12 +337,12 @@ packaged with Emacs can be retrieved by
ELPA} package. Besides the standalone releases, further minor version
of @value{tramp} will appear on GNU ELPA, until the next @value{tramp}
release appears. These minor versions have a four-number string, like
``2.4.2.1''.
``2.4.3.1''.
@value{tramp} development versions are available on Git servers.
Development versions contain new and incomplete features. The
development version of @value{tramp} is always the version number of
the next release, plus the suffix ``-pre'', like ``2.4.3-pre''.
the next release, plus the suffix ``-pre'', like ``2.4.4-pre''.
One way to obtain @value{tramp} from Git server is to visit the
Savannah project page at the following URL and then clicking on the
@ -2299,7 +2299,7 @@ string of that environment variable looks always like
@example
@group
echo $INSIDE_EMACS
@result{} 26.2,tramp:2.3.4
@result{} 27.1,tramp:2.4.3
@end group
@end example
@ -3034,6 +3034,17 @@ host when the variable @code{default-directory} is remote:
@end group
@end lisp
@vindex process-file-return-signal-string
@code{process-file} shall return either the exit code of the process,
or a string describing the signal, when the process has been
interrupted. Since it cannot be determined reliably whether a remote
process has been interrupted, @code{process-file} returns always the
exit code. When the user option
@code{process-file-return-signal-string} is non-nil,
@code{process-file} regards all exit codes greater than 128 as an
indication that the process has been interrupted, and returns a
respective string.
Remote processes do not apply to @acronym{GVFS} (see @ref{GVFS-based
methods}) because the remote file system is mounted on the local host
and @value{tramp} just accesses by changing the
@ -3041,9 +3052,17 @@ and @value{tramp} just accesses by changing the
@value{tramp} starts a remote process when a command is executed in a
remote file or directory buffer. As of now, these packages have been
integrated to work with @value{tramp}: @file{compile.el} (commands
like @code{compile} and @code{grep}) and @file{gud.el} (@code{gdb} or
@code{perldb}).
integrated to work with @value{tramp}: @file{shell.el},
@file{eshell.el}, @file{compile.el} (commands like @code{compile} and
@code{grep}) and @file{gud.el} (@code{gdb} or @code{perldb}).
@vindex INSIDE_EMACS@r{, environment variable}
@value{tramp} always modifies the @env{INSIDE_EMACS} environment
variable for remote processes. Per default, this environment variable
shows the Emacs version. @value{tramp} adds its own version string,
so it looks like @samp{27.1,tramp:2.4.3.1}. However, other packages
might also add their name to this environment variable, like
@samp{27.1,comint,tramp:2.4.3.1}.
For @value{tramp} to find the command on the remote, it must be
accessible through the default search path as setup by @value{tramp}
@ -3238,10 +3257,10 @@ variables.
@vindex async-shell-command-width
@vindex COLUMNS@r{, environment variable}
If Emacs supports the variable @code{async-shell-command-width} (since
Emacs 27.1), @value{tramp} cares about its value for asynchronous
shell commands. It specifies the number of display columns for
command output. For synchronous shell commands, a similar effect can
be achieved by adding the environment variable @env{COLUMNS} to
Emacs 27), @value{tramp} cares about its value for asynchronous shell
commands. It specifies the number of display columns for command
output. For synchronous shell commands, a similar effect can be
achieved by adding the environment variable @env{COLUMNS} to
@code{tramp-remote-process-environment}.
@ -3725,7 +3744,7 @@ row are possible, like @file{/path/to/dir/file.tar.gz.uu/dir/file}.
@vindex tramp-archive-all-gvfs-methods
An archive file name could be a remote file name, as in
@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}.
@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}.
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
@ -3736,7 +3755,7 @@ the similar @samp{/scp:user@@host:...}. See the constant
If @code{url-handler-mode} is enabled, archives could be visited via
URLs, like
@file{https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}. This
@file{https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}. This
allows complex file operations like
@lisp
@ -3744,8 +3763,8 @@ allows complex file operations like
(progn
(url-handler-mode 1)
(ediff-directories
"https://ftp.gnu.org/gnu/tramp/tramp-2.3.1.tar.gz/tramp-2.3.1"
"https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/tramp-2.3.2" ""))
"https://ftp.gnu.org/gnu/tramp/tramp-2.4.2.tar.gz/tramp-2.4.2"
"https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/tramp-2.4.3" ""))
@end group
@end lisp
@ -3860,8 +3879,8 @@ Where is the latest @value{tramp}?
@item
Which systems does it work on?
The package works successfully on Emacs 24, Emacs 25, Emacs 26, and
Emacs 27.
The package works successfully on Emacs 24, Emacs 25, Emacs 26, Emacs
27, and Emacs 28.
While Unix and Unix-like systems are the primary remote targets,
@value{tramp} has equal success connecting to other platforms, such as
@ -4127,6 +4146,23 @@ Check @command{man ssh_config} whether these options are supported on
your proxy host.
@item
@value{tramp} does not connect to Samba or MS Windows hosts running
SMB1 connection protocol.
@vindex tramp-smb-options
Recent versions of @command{smbclient} do not support old connection
protocols by default. In order to connect to such a host, add a
respective option:
@lisp
(add-to-list 'tramp-smb-options "client min protocol=NT1")
@end lisp
@strong{Note} that using a deprecated connection protocol raises
security problems, you should do it only if absolutely necessary.
@item
File name completion does not work with @value{tramp}

2
doc/misc/trampver.texi
View file

@ -8,7 +8,7 @@
@c In the Tramp GIT, the version numbers are auto-frobbed from
@c tramp.el, and the bug report address is auto-frobbed from
@c configure.ac.
@set trampver 2.4.3.27.1
@set trampver 2.4.5-pre
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 24.4

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

@ -35,6 +35,8 @@
(require 'tramp)
(defvar process-file-return-signal-string)
;;;###tramp-autoload
(defcustom tramp-adb-program "adb"
"Name of the Android Debug Bridge program."
@ -631,9 +633,6 @@ But handle the case, if the \"test\" command is not available."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
(let* ((curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
@ -650,6 +649,10 @@ But handle the case, if the \"test\" command is not available."
(tramp-error v 'file-error "Cannot write: `%s'" filename))
(delete-file tmpfile)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
(unless (equal curbuf (current-buffer))
(tramp-error
v 'file-error
@ -667,13 +670,13 @@ But handle the case, if the \"test\" command is not available."
(tramp-message v 0 "Wrote %s" filename))
(run-hooks 'tramp-handle-write-region-hook))))
(defun tramp-adb-handle-set-file-modes (filename mode)
(defun tramp-adb-handle-set-file-modes (filename mode &optional _flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
(tramp-adb-send-command-and-check v (format "chmod %o %s" mode localname))))
(defun tramp-adb-handle-set-file-times (filename &optional time)
(defun tramp-adb-handle-set-file-times (filename &optional time _flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@ -725,8 +728,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" filename newname)
(if (and t1 t2 (tramp-equal-remote filename newname))
(let ((l1 (tramp-compat-file-local-name filename))
(l2 (tramp-compat-file-local-name newname)))
(let ((l1 (tramp-file-local-name filename))
(l2 (tramp-file-local-name newname)))
;; We must also flush the cache of the directory,
;; because `file-attributes' reads the values from
;; there.
@ -809,8 +812,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(if (and t1 t2
(tramp-equal-remote filename newname)
(not (file-directory-p filename)))
(let ((l1 (tramp-compat-file-local-name filename))
(l2 (tramp-compat-file-local-name newname)))
(let ((l1 (tramp-file-local-name filename))
(l2 (tramp-file-local-name newname)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v l1)
@ -828,6 +831,33 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
(delete-file filename)))))))
(defun tramp-adb-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
(with-tramp-connection-property vec "signal-strings"
(let ((default-directory (tramp-make-tramp-file-name vec 'localname))
;; `shell-file-name' and `shell-command-switch' are needed
;; for Emacs < 27.1, which doesn't support connection-local
;; variables in `shell-command'.
(shell-file-name "/system/bin/sh")
(shell-command-switch "-c")
process-file-return-signal-string signals result)
(dotimes (i 128) (push (format "Signal %d" i) result))
(setq result (reverse result)
signals (split-string
(shell-command-to-string "COLUMNS=40 kill -l") "\n" 'omit))
(setcar result 0)
(dolist (line signals)
(when (string-match
(concat
"^[[:space:]]*\\([[:digit:]]+\\)"
"[[:space:]]+\\S-+[[:space:]]+"
"\\([[:alpha:]].*\\)$")
line)
(setcar
(nthcdr (string-to-number (match-string 1 line)) result)
(match-string 2 line))))
result)))
(defun tramp-adb-handle-process-file
(program &optional infile destination display &rest args)
"Like `process-file' for Tramp files."
@ -846,7 +876,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (with-parsed-tramp-file-name infile nil localname))
(setq input (tramp-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input))
@ -877,8 +907,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setcar (cdr destination) (expand-file-name (cadr destination)))
(if (tramp-equal-remote default-directory (cadr destination))
;; stderr is on the same remote host.
(setq stderr (with-parsed-tramp-file-name
(cadr destination) nil localname))
(setq stderr (tramp-file-local-name (cadr destination)))
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
@ -895,14 +924,13 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; it. Call it in a subshell, in order to preserve working
;; directory.
(condition-case nil
(progn
(setq ret
(if (tramp-adb-send-command-and-check
v
(format "(cd %s; %s)"
(tramp-shell-quote-argument localname) command))
;; Set return status accordingly.
0 1))
(unwind-protect
(setq ret (tramp-adb-send-command-and-check
v (format
"(cd %s; %s)"
(tramp-shell-quote-argument localname) command)
t))
(unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
(when outbuf
(with-current-buffer outbuf
@ -918,6 +946,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
;; Handle signals. `process-file-return-signal-string' exists
;; since Emacs 28.1.
(when (and (bound-and-true-p process-file-return-signal-string)
(natnump ret) (> ret 128))
(setq ret (nth (- ret 128) (tramp-adb-get-signal-strings v))))
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))
@ -936,6 +970,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
;; The complete STDERR buffer is available only when the process has
;; terminated.
(defun tramp-adb-handle-make-process (&rest args)
"Like `make-process' for Tramp files."
(when args
@ -969,17 +1005,29 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'stringp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
;; STDERR can also be a file name.
(tmpstderr
(and stderr
(if (and (stringp stderr) (tramp-tramp-file-p stderr))
(tramp-unquote-file-local-name stderr)
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
(program (car command))
(args (cdr command))
(command
(format "cd %s && exec %s"
(format "cd %s && exec %s %s"
(tramp-shell-quote-argument localname)
(if tmpstderr (format "2>'%s'" tmpstderr) "")
(mapconcat #'tramp-shell-quote-argument
(cons program args) " ")))
(tramp-process-connection-type
@ -1029,6 +1077,18 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already; otherwise
;; `rename-file', `delete-file' or
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Read initial output. Remove the first line,
;; which is the command echo.
(while
@ -1037,6 +1097,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(not (re-search-forward "[\n]" nil t)))
(tramp-accept-process-output p 0))
(delete-region (point-min) (point))
;; Provide error buffer. This shows only
;; initial error messages; messages arriving
;; later on will be inserted when the process
;; is deleted. The temporary file will exist
;; until the process is deleted.
(when (bufferp stderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr 'visit nil nil 'replace))
(delete-file remote-tmpstderr))))
;; Return process.
p))))
@ -1062,7 +1139,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(read (current-buffer)))
":" 'omit)))
;; The equivalent to `exec-directory'.
`(,(tramp-compat-file-local-name default-directory))))
`(,(tramp-file-local-name (expand-file-name default-directory)))))
(defun tramp-adb-get-device (vec)
"Return full host name from VEC to be used in shell execution.
@ -1146,11 +1223,14 @@ This happens for Android >= 4.0."
(while (re-search-forward "\r+$" nil t)
(replace-match "" nil nil))))))
(defun tramp-adb-send-command-and-check (vec command)
(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
"Run COMMAND and check its exit status.
Sends `echo $?' along with the COMMAND for checking the exit
status. If COMMAND is nil, just sends `echo $?'. Returns nil if
the exit status is not equal 0, and t otherwise."
the exit status is not equal 0, and t otherwise.
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
(tramp-adb-send-command
vec (if command
(format "%s; echo tramp_exit_status $?" command)
@ -1161,7 +1241,9 @@ the exit status is not equal 0, and t otherwise."
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
(prog1
(zerop (read (current-buffer)))
(if exit-status
(read (current-buffer))
(zerop (read (current-buffer))))
(let ((inhibit-read-only t))
(delete-region (match-beginning 0) (point-max))))))

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

@ -109,7 +109,7 @@
(eval-when-compile (require 'cl-lib))
;; Sometimes, compilation fails with "Variable binding depth exceeds
;; max-specpdl-size".
;; max-specpdl-size". Shall be fixed in Emacs 27.
(eval-and-compile
(let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs)))
@ -318,7 +318,10 @@ arguments to pass to the OPERATION."
(let* ((filename (apply #'tramp-archive-file-name-for-operation
operation args))
(archive (tramp-archive-file-name-archive filename)))
(archive (tramp-archive-file-name-archive filename))
;; Sometimes, it fails with "Variable binding depth exceeds
;; max-specpdl-size". Shall be fixed in Emacs 27.
(max-specpdl-size (* 2 max-specpdl-size)))
;; `filename' could be a quoted file name. Or the file
;; archive could be a directory, see Bug#30293.

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

@ -514,7 +514,7 @@ for all methods. Resulting data are derived from connection history."
tramp-cache-read-persistent-data)
(condition-case err
(with-temp-buffer
(insert-file-contents tramp-persistency-file-name)
(insert-file-contents-literally tramp-persistency-file-name)
(let ((list (read (current-buffer)))
(tramp-verbose 0)
element key item)

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

@ -358,7 +358,7 @@ The remote connection identified by SOURCE is flushed by
;; Append local file name if none is specified.
(when (string-equal (file-remote-p target) target)
(setq target (concat target (file-remote-p source 'localname))))
(setq target (concat target (tramp-file-local-name source))))
;; Make them directory names.
(setq source (directory-file-name source)
target (directory-file-name target))

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

@ -41,6 +41,7 @@
(require 'shell)
(require 'subr-x)
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
(declare-function tramp-handle-temporary-file-directory "tramp")
;; For not existing functions, obsolete functions, or functions with a

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

@ -121,7 +121,10 @@
(autoload 'zeroconf-init "zeroconf")
(tramp-compat-funcall 'dbus-get-unique-name :system)
(tramp-compat-funcall 'dbus-get-unique-name :session)
(or (tramp-compat-process-running-p "gvfs-fuse-daemon")
(or ;; Until Emacs 25, `process-attributes' could crash Emacs
;; for some processes. Better we don't check.
(<= emacs-major-version 25)
(tramp-compat-process-running-p "gvfs-fuse-daemon")
(tramp-compat-process-running-p "gvfsd-fuse"))))
"Non-nil when GVFS is available.")
@ -728,6 +731,10 @@ is no information where to trace the message.")
(tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
(add-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)
(add-hook
'tramp-gvfs-unload-hook
(lambda ()
(remove-hook 'dbus-event-error-functions #'tramp-gvfs-dbus-event-error)))
;; File name primitives.
@ -1301,10 +1308,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(size (cdr (assoc "filesystem::size" attr)))
(used (cdr (assoc "filesystem::used" attr)))
(free (cdr (assoc "filesystem::free" attr))))
(when (and (stringp size) (stringp used) (stringp free))
(list (string-to-number size)
(- (string-to-number size) (string-to-number used))
(string-to-number free))))))
(when (or size used free)
(list (string-to-number (or size "0"))
(string-to-number (or free "0"))
(- (string-to-number (or size "0"))
(string-to-number (or used "0"))))))))
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
@ -1341,7 +1349,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(tramp-run-real-handler
#'rename-file (list filename newname ok-if-already-exists))))
(defun tramp-gvfs-handle-set-file-modes (filename mode)
(defun tramp-gvfs-handle-set-file-modes (filename mode &optional _flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@ -1350,7 +1358,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
(tramp-gvfs-url-file-name (tramp-make-tramp-file-name v))
"unix::mode" (number-to-string mode))))
(defun tramp-gvfs-handle-set-file-times (filename &optional time)
(defun tramp-gvfs-handle-set-file-times (filename &optional time _flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)

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

@ -478,7 +478,18 @@ file names."
(with-tramp-connection-property
(tramp-get-connection-process vec) "rclone-pid"
(catch 'pid
(dolist (pid (list-system-processes)) ;; "pidof rclone" ?
(dolist
(pid
;; Until Emacs 25, `process-attributes' could
;; crash Emacs for some processes. So we use
;; "pidof", which might not work everywhere.
(if (<= emacs-major-version 25)
(let ((default-directory temporary-file-directory))
(mapcar
#'string-to-number
(split-string
(shell-command-to-string "pidof rclone"))))
(list-system-processes)))
(and (string-match-p
(regexp-quote
(format "rclone mount %s:" (tramp-file-name-host vec)))
@ -564,7 +575,7 @@ connection if a previous connection has died for some reason."
,(tramp-rclone-mount-point vec)
;; This could be nil.
,(tramp-get-method-parameter vec 'tramp-mount-args))))
(while (not (file-exists-p (tramp-make-tramp-file-name vec 'localname)))
(while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc)))
(tramp-cleanup-connection vec 'keep-debug 'keep-password))
;; Mark it as connected.

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

@ -36,6 +36,7 @@
(declare-function dired-remove-file "dired-aux")
(defvar dired-compress-file-suffixes)
(defvar process-file-return-signal-string)
(defvar vc-handled-backends)
(defvar vc-bzr-program)
(defvar vc-git-program)
@ -537,12 +538,13 @@ based on the Tramp and Emacs versions, and should not be set here."
;;;###tramp-autoload
(defcustom tramp-sh-extra-args
'(("/bash\\'" . "-norc -noprofile")
'(("/bash\\'" . "-noediting -norc -noprofile")
("/zsh\\'" . "-f +Z -V"))
"Alist specifying extra arguments to pass to the remote shell.
Entries are (REGEXP . ARGS) where REGEXP is a regular expression
matching the shell file name and ARGS is a string specifying the
arguments.
arguments. These arguments shall disable line editing, see
`tramp-open-shell'.
This variable is only used when Tramp needs to start up another shell
for tilde expansion. The extra arguments should typically prevent the
@ -866,8 +868,12 @@ Escape sequence %s is replaced with name of Perl binary.")
"Perl program to use for decoding a file.
Escape sequence %s is replaced with name of Perl binary.")
(defconst tramp-hexdump-encode "%h -v -e '16/1 \" %%02x\" \"\\n\"'"
"`hexdump' program to use for encoding a file.
This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-awk-encode
"od -v -t x1 -A n | busybox awk '\\
"%a '\\
BEGIN {
b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
b16 = \"0123456789abcdef\"
@ -897,11 +903,25 @@ END {
}
printf tail
}'"
"Awk program to use for encoding a file.
"`awk' program to use for encoding a file.
This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-hexdump-awk-encode
(format "%s | %s" tramp-hexdump-encode tramp-awk-encode)
"`hexdump' / `awk' pipe to use for encoding a file.
This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-od-encode "%o -v -t x1 -A n"
"`od' program to use for encoding a file.
This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-od-awk-encode
(format "%s | %s" tramp-od-encode tramp-awk-encode)
"`od' / `awk' pipe to use for encoding a file.
This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-awk-decode
"busybox awk '\\
"%a '\\
BEGIN {
b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"
}
@ -926,12 +946,6 @@ BEGIN {
"Awk program to use for decoding a file.
This string is passed to `format', so percent characters need to be doubled.")
(defconst tramp-awk-coding-test
"test -c /dev/zero && \
od -v -t x1 -A n </dev/null && \
busybox awk '{}' </dev/null"
"Test command for checking `tramp-awk-encode' and `tramp-awk-decode'.")
(defconst tramp-vc-registered-read-file-names
"echo \"(\"
while read file; do
@ -1051,9 +1065,7 @@ component is used as the target of the symlink."
(let ((non-essential t))
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target))))))
(setq target (tramp-file-local-name (expand-file-name target)))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@ -1263,8 +1275,8 @@ component is used as the target of the symlink."
(defun tramp-do-file-attributes-with-ls (vec localname &optional id-format)
"Implement `file-attributes' for Tramp files using the ls(1) command."
(let (symlinkp dirp
res-inode res-filemodes res-numlinks
res-uid res-gid res-size res-symlink-target)
res-inode res-filemodes res-numlinks
res-uid res-gid res-size res-symlink-target)
(tramp-message vec 5 "file attributes with ls: %s" localname)
;; We cannot send all three commands combined, it could exceed
;; NAME_MAX or PATH_MAX. Happened on macOS, for example.
@ -1368,18 +1380,11 @@ component is used as the target of the symlink."
(format
(eval-when-compile
(concat
;; On Opsware, pdksh (which is the true name of ksh there)
;; doesn't parse correctly the sequence "((". Therefore, we
;; add a space. Apostrophes in the stat output are masked as
;; Apostrophes in the stat output are masked as
;; `tramp-stat-marker', in order to make a proper shell escape
;; of them in file names.
"( (%s %s || %s -h %s) && (%s -c "
"'((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
"%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g') || echo nil)"))
(tramp-get-file-exists-command vec)
(tramp-shell-quote-argument localname)
(tramp-get-test-command vec)
(tramp-shell-quote-argument localname)
"(%s -c '((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' %s |"
" sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g')"))
(tramp-get-remote-stat vec)
tramp-stat-marker tramp-stat-marker
(if (eq id-format 'integer)
@ -1390,7 +1395,8 @@ component is used as the target of the symlink."
(eval-when-compile (concat tramp-stat-marker "%G" tramp-stat-marker)))
tramp-stat-marker tramp-stat-marker
(tramp-shell-quote-argument localname)
tramp-stat-quoted-marker)))
tramp-stat-quoted-marker)
'noerror))
(defun tramp-sh-handle-set-visited-file-modtime (&optional time-list)
"Like `set-visited-file-modtime' for Tramp files."
@ -1468,7 +1474,7 @@ of."
;; only if that agrees with the buffer's record.
(t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist)))))))))
(defun tramp-sh-handle-set-file-modes (filename mode)
(defun tramp-sh-handle-set-file-modes (filename mode &optional _flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@ -1478,7 +1484,7 @@ of."
(format "chmod %o %s" mode (tramp-shell-quote-argument localname))
"Error while changing file's mode %s" filename)))
(defun tramp-sh-handle-set-file-times (filename &optional time)
(defun tramp-sh-handle-set-file-times (filename &optional time _flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(when (tramp-get-remote-touch v)
@ -2171,8 +2177,8 @@ the uid and gid from FILENAME."
v 'file-error
"Unknown operation `%s', must be `copy' or `rename'"
op))))
(localname1 (tramp-compat-file-local-name filename))
(localname2 (tramp-compat-file-local-name newname))
(localname1 (tramp-file-local-name filename))
(localname2 (tramp-file-local-name newname))
(prefix (file-remote-p (if t1 filename newname)))
cmd-result)
(when (and (eq op 'copy) (file-directory-p filename))
@ -2796,8 +2802,11 @@ the result will be a local, non-Tramp, file name."
;; We use BUFFER also as connection buffer during setup. Because of
;; this, its original contents must be saved, and restored once
;; connection has been setup.
;; The complete STDERR buffer is available only when the process has
;; terminated.
(defun tramp-sh-handle-make-process (&rest args)
"Like `make-process' for Tramp files."
"Like `make-process' for Tramp files.
STDERR can also be a file name."
(when args
(with-parsed-tramp-file-name (expand-file-name default-directory) nil
(let ((name (plist-get args :name))
@ -2829,14 +2838,23 @@ the result will be a local, non-Tramp, file name."
(signal 'wrong-type-argument (list #'functionp sentinel)))
(unless (or (null stderr) (bufferp stderr) (stringp stderr))
(signal 'wrong-type-argument (list #'stringp stderr)))
(when (and (stringp stderr) (tramp-tramp-file-p stderr)
(not (tramp-equal-remote default-directory stderr)))
(signal 'file-error (list "Wrong stderr" stderr)))
(let* ((buffer
(if buffer
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
(stderr (and stderr (get-buffer-create stderr)))
(tmpstderr (and stderr (tramp-make-tramp-temp-file v)))
;; STDERR can also be a file name.
(tmpstderr
(and stderr
(if (and (stringp stderr) (tramp-tramp-file-p stderr))
(tramp-unquote-file-local-name stderr)
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
(program (car command))
(args (cdr command))
;; When PROGRAM matches "*sh", and the first arg is
@ -2965,21 +2983,35 @@ the result will be a local, non-Tramp, file name."
(ignore-errors
(set-process-query-on-exit-flag p (null noquery))
(set-marker (process-mark p) (point)))
;; We must flush them here already; otherwise
;; `rename-file', `delete-file' or
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; Copy tmpstderr file.
(when (and (stringp stderr)
(not (tramp-tramp-file-p stderr)))
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(rename-file remote-tmpstderr stderr))))
;; Provide error buffer. This shows only
;; initial error messages; messages arriving
;; later on shall be inserted by `auto-revert'.
;; The temporary file will still be existing.
;; TODO: Write a sentinel, which deletes the
;; temporary file.
(when tmpstderr
;; We must flush them here already; otherwise
;; `insert-file-contents' will fail.
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")
;; later on will be inserted when the process is
;; deleted. The temporary file will exist until
;; the process is deleted.
(when (bufferp stderr)
(with-current-buffer stderr
(insert-file-contents
(tramp-make-tramp-file-name v tmpstderr) 'visit)
(auto-revert-mode)))
(insert-file-contents-literally remote-tmpstderr))
;; Delete tmpstderr file.
(add-function
:after (process-sentinel p)
(lambda (_proc _msg)
(when (file-exists-p remote-tmpstderr)
(with-current-buffer stderr
(insert-file-contents-literally
remote-tmpstderr nil nil nil 'replace))
(delete-file remote-tmpstderr)))))
;; Return process.
p)))
@ -2992,6 +3024,65 @@ the result will be a local, non-Tramp, file name."
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer"))))))))
(defun tramp-sh-get-signal-strings (vec)
"Strings to return by `process-file' in case of signals."
(with-tramp-connection-property
vec
(concat
"signal-strings-" (tramp-get-method-parameter vec 'tramp-remote-shell))
(let ((default-directory (tramp-make-tramp-file-name vec 'localname))
process-file-return-signal-string signals res result)
(setq signals
(append
'(0) (split-string (shell-command-to-string "kill -l") nil 'omit)))
;; Sanity check. Sometimes, the first entry is "0", although we
;; don't expect it. Remove it.
(when (and (stringp (cadr signals)) (string-equal "0" (cadr signals)))
(setcdr signals (cddr signals)))
;; Sanity check. "kill -l" shall have returned just the signal
;; names. Some shells don't, like the one in "docker alpine".
(let (signal-hook-function)
(condition-case nil
(dolist (sig (cdr signals))
(unless (string-match-p "^[[:alnum:]+-]+$" sig)
(error nil)))
(error (setq signals '(0)))))
(dotimes (i 128)
(push
(cond
;; Some predefined values, which aren't reported sometimes,
;; or would raise problems (all Stopped signals).
((= i 0) 0)
((string-equal (nth i signals) "HUP") "Hangup")
((string-equal (nth i signals) "INT") "Interrupt")
((string-equal (nth i signals) "QUIT") "Quit")
((string-equal (nth i signals) "STOP") "Stopped (signal)")
((string-equal (nth i signals) "TSTP") "Stopped")
((string-equal (nth i signals) "TTIN") "Stopped (tty input)")
((string-equal (nth i signals) "TTOU") "Stopped (tty output)")
(t (setq res
(if (null (nth i signals))
""
(tramp-send-command
vec
(format
"%s %s %s"
(tramp-get-method-parameter vec 'tramp-remote-shell)
(mapconcat
#'identity
(tramp-get-method-parameter vec 'tramp-remote-shell-args)
" ")
(tramp-shell-quote-argument (format "kill -%d $$" i))))
(with-current-buffer (tramp-get-connection-buffer vec)
(goto-char (point-min))
(buffer-substring (point-at-bol) (point-at-eol)))))
(if (string-equal res "")
(format "Signal %d" i)
res)))
result))
;; Due to Bug#41287, we cannot add this to the `dotimes' clause.
(reverse result))))
(defun tramp-sh-handle-process-file
(program &optional infile destination display &rest args)
"Like `process-file' for Tramp files."
@ -3028,7 +3119,7 @@ the result will be a local, non-Tramp, file name."
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (with-parsed-tramp-file-name infile nil localname))
(setq input (tramp-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input 'nohop))
@ -3059,8 +3150,7 @@ the result will be a local, non-Tramp, file name."
(setcar (cdr destination) (expand-file-name (cadr destination)))
(if (tramp-equal-remote default-directory (cadr destination))
;; stderr is on the same remote host.
(setq stderr (with-parsed-tramp-file-name
(cadr destination) nil localname))
(setq stderr (tramp-file-local-name (cadr destination)))
;; stderr must be copied to remote host. The temporary
;; file must be deleted after execution.
(setq stderr (tramp-make-tramp-temp-file v)
@ -3078,13 +3168,12 @@ the result will be a local, non-Tramp, file name."
;; directory.
(condition-case nil
(unwind-protect
(setq ret
(if (tramp-send-command-and-check
v (format "cd %s && %s"
(tramp-shell-quote-argument localname)
command)
t t)
0 1))
(setq ret (tramp-send-command-and-check
v (format
"cd %s && %s"
(tramp-shell-quote-argument localname) command)
t t t))
(unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
(when outbuf
(with-current-buffer outbuf
@ -3102,6 +3191,12 @@ the result will be a local, non-Tramp, file name."
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
;; Handle signals. `process-file-return-signal-string' exists
;; since Emacs 28.1.
(when (and (bound-and-true-p process-file-return-signal-string)
(natnump ret) (>= ret 128))
(setq ret (nth (- ret 128) (tramp-sh-get-signal-strings v))))
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))
@ -3122,7 +3217,7 @@ the result will be a local, non-Tramp, file name."
(append
(tramp-get-remote-path (tramp-dissect-file-name default-directory))
;; The equivalent to `exec-directory'.
`(,(tramp-compat-file-local-name default-directory))))
`(,(tramp-file-local-name (expand-file-name default-directory)))))
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
@ -3258,7 +3353,8 @@ the result will be a local, non-Tramp, file name."
;; If `append' is non-nil, we copy the file locally, and let
;; the native `write-region' implementation do the job.
(when append (copy-file filename tmpfile 'ok))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; We say `no-message' here because we don't want the
;; visited file modtime data to be clobbered from the temp
@ -3981,23 +4077,30 @@ whether it exists and if so, it is added to the environment
variable PATH."
(let ((command
(format
"PATH=%s; export PATH" (string-join (tramp-get-remote-path vec) ":")))
"PATH=%s && export PATH" (string-join (tramp-get-remote-path vec) ":")))
(pipe-buf
(or (with-tramp-connection-property vec "pipe-buf"
(tramp-send-command-and-read
vec "getconf PIPE_BUF / 2>/dev/null || echo nil" 'noerror))
4096))
tmpfile)
(with-tramp-connection-property vec "pipe-buf"
(tramp-send-command-and-read
vec "getconf PIPE_BUF / 2>/dev/null || echo 4096" 'noerror)))
tmpfile chunk chunksize)
(tramp-message vec 5 "Setting $PATH environment variable")
(if (< (length command) pipe-buf)
(tramp-send-command vec command)
;; Use a temporary file.
(setq tmpfile
(tramp-make-tramp-file-name vec (tramp-make-tramp-temp-file vec)))
(write-region command nil tmpfile)
(tramp-send-command
vec (format ". %s" (tramp-compat-file-local-name tmpfile)))
(delete-file tmpfile))))
;; Use a temporary file. We cannot use `write-region' because
;; setting the remote path happens in the early connection
;; handshake, and not all external tools are determined yet.
(setq command (concat command "\n")
tmpfile (tramp-make-tramp-temp-file vec))
(while (not (string-empty-p command))
(setq chunksize (min (length command) (/ pipe-buf 2))
chunk (substring command 0 chunksize)
command (substring command chunksize))
(tramp-send-command vec (format
"echo -n %s >>%s"
(tramp-shell-quote-argument chunk)
(tramp-shell-quote-argument tmpfile))))
(tramp-send-command vec (format ". %s" tmpfile))
(tramp-send-command vec (format "rm -f %s" tmpfile)))))
;; ------------------------------------------------------------
;; -- Communication with external shell --
@ -4069,54 +4172,54 @@ file exists and nonzero exit status otherwise."
(defun tramp-open-shell (vec shell)
"Open shell SHELL."
;; Find arguments for this shell.
(with-tramp-progress-reporter
vec 5 (format-message "Opening remote shell `%s'" shell)
;; Find arguments for this shell.
(let ((extra-args (tramp-get-sh-extra-args shell)))
;; doesn't know about and thus /bin/sh will display a strange
;; prompt. For example, if $PS1 has "${CWD}" in the value, then
;; ksh will display the current working directory but /bin/sh
;; will display a dollar sign. The following command line sets
;; $PS1 to a sane value, and works under Bourne-ish shells as
;; well as csh-like shells. We also unset the variable $ENV
;; because that is read by some sh implementations (eg, bash
;; when called as sh) on startup; this way, we avoid the startup
;; file clobbering $PS1. $PROMPT_COMMAND is another way to set
;; the prompt in /bin/bash, it must be discarded as well.
;; $HISTFILE is set according to `tramp-histfile-override'.
;; $TERM and $INSIDE_EMACS set here to ensure they have the
;; correct values when the shell starts, not just processes
;; run within the shell. (Which processes include our
;; initial probes to ensure the remote shell is usable.)
(tramp-send-command
vec (format
(eval-when-compile
(concat
"exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
"ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"))
tramp-terminal-type
emacs-version tramp-version ; INSIDE_EMACS
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
(tramp-shell-quote-argument tramp-histfile-override))
(if tramp-histfile-override
"HISTFILE='' HISTFILESIZE=0 HISTSIZE=0"
""))
(tramp-shell-quote-argument tramp-end-of-output)
shell (or extra-args ""))
t)
;; Check proper HISTFILE setting. We give up when not working.
(when (and (stringp tramp-histfile-override)
(file-name-directory tramp-histfile-override))
(tramp-barf-unless-okay
vec
(format
"(cd %s)"
(tramp-shell-quote-argument
(file-name-directory tramp-histfile-override)))
"`tramp-histfile-override' uses invalid file `%s'"
tramp-histfile-override)))
;; It is useful to set the prompt in the following command because
;; some people have a setting for $PS1 which /bin/sh doesn't know
;; about and thus /bin/sh will display a strange prompt. For
;; example, if $PS1 has "${CWD}" in the value, then ksh will
;; display the current working directory but /bin/sh will display
;; a dollar sign. The following command line sets $PS1 to a sane
;; value, and works under Bourne-ish shells as well as csh-like
;; shells. We also unset the variable $ENV because that is read
;; by some sh implementations (eg, bash when called as sh) on
;; startup; this way, we avoid the startup file clobbering $PS1.
;; $PROMPT_COMMAND is another way to set the prompt in /bin/bash,
;; it must be discarded as well. $HISTFILE is set according to
;; `tramp-histfile-override'. $TERM and $INSIDE_EMACS set here to
;; ensure they have the correct values when the shell starts, not
;; just processes run within the shell. (Which processes include
;; our initial probes to ensure the remote shell is usable.)
(tramp-send-command
vec (format
(eval-when-compile
(concat
"exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
"ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"))
tramp-terminal-type
emacs-version tramp-version ; INSIDE_EMACS
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
(tramp-shell-quote-argument tramp-histfile-override))
(if tramp-histfile-override
"HISTFILE='' HISTFILESIZE=0 HISTSIZE=0"
""))
(tramp-shell-quote-argument tramp-end-of-output)
shell (or (tramp-get-sh-extra-args shell) ""))
t)
;; Check proper HISTFILE setting. We give up when not working.
(when (and (stringp tramp-histfile-override)
(file-name-directory tramp-histfile-override))
(tramp-barf-unless-okay
vec
(format
"(cd %s)"
(tramp-shell-quote-argument
(file-name-directory tramp-histfile-override)))
"`tramp-histfile-override' uses invalid file `%s'"
tramp-histfile-override))
(tramp-set-connection-property
(tramp-get-connection-process vec) "remote-shell" shell)))
@ -4187,9 +4290,16 @@ process to set up. VEC specifies the connection."
(let ((tramp-end-of-output tramp-initial-end-of-output)
(case-fold-search t))
(tramp-open-shell vec (tramp-get-method-parameter vec 'tramp-remote-shell))
(tramp-message vec 5 "Setting up remote shell environment")
;; Disable line editing.
(tramp-send-command vec "set +o vi +o emacs" t)
;; Dump option settings in the traces.
(when (>= tramp-verbose 9)
(tramp-send-command vec "set -o" t))
;; Disable echo expansion.
(tramp-message vec 5 "Setting up remote shell environment")
(tramp-send-command
vec "stty -inlcr -onlcr -echo kill '^U' erase '^H'" t)
;; Check whether the echo has really been disabled. Some
@ -4259,8 +4369,6 @@ process to set up. VEC specifies the connection."
(tramp-message
vec 5 "Setting coding system to `%s' and `%s'" cs-decode cs-encode)))
(tramp-send-command vec "set +o vi +o emacs" t)
;; Check whether the remote host suffers from buggy
;; `send-process-string'. This is known for FreeBSD (see comment
;; in `send_process', file process.c). I've tested sending 624
@ -4383,7 +4491,7 @@ and end of region, and are expected to replace the region contents
with the encoded or decoded results, respectively.")
(defconst tramp-remote-coding-commands
`((b64 "base64" "base64 -d -i")
'((b64 "base64" "base64 -d -i")
;; "-i" is more robust with older base64 from GNU coreutils.
;; However, I don't know whether all base64 versions do supports
;; this option.
@ -4394,8 +4502,9 @@ with the encoded or decoded results, respectively.")
(b64 "recode data..base64" "recode base64..data")
(b64 tramp-perl-encode-with-module tramp-perl-decode-with-module)
(b64 tramp-perl-encode tramp-perl-decode)
;; This is painful slow, so we put it on the end.
(b64 tramp-awk-encode tramp-awk-decode ,tramp-awk-coding-test)
;; These are painfully slow, so we put them on the end.
(b64 tramp-hexdump-awk-encode tramp-awk-decode)
(b64 tramp-od-awk-encode tramp-awk-decode)
(uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout")
(uu "uuencode xxx" "uudecode -o -")
(uu "uuencode xxx" "uudecode -p")
@ -4421,6 +4530,8 @@ Perl or Shell implementation for this functionality. This
program will be transferred to the remote host, and it is
available as shell function with the same name. A \"%t\" format
specifier in the variable value denotes a temporary file.
\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the
respective `awk', `hexdump' and `od' commands.
The optional TEST command can be used for further tests, whether
ENCODING and DECODING are applicable.")
@ -4471,11 +4582,6 @@ Goes through the list `tramp-local-coding-commands' and
vec 5 "Checking remote test command `%s'" rem-test)
(unless (tramp-send-command-and-check vec rem-test t)
(throw 'wont-work-remote nil)))
;; Check if remote perl exists when necessary.
(when (and (symbolp rem-enc)
(string-match-p "perl" (symbol-name rem-enc))
(not (tramp-get-remote-perl vec)))
(throw 'wont-work-remote nil))
;; Check if remote encoding and decoding commands can be
;; called remotely with null input and output. This makes
;; sure there are no syntax errors and the command is really
@ -4485,10 +4591,36 @@ Goes through the list `tramp-local-coding-commands' and
;; redirecting "mimencode" output to /dev/null, then as root
;; it might change the permissions of /dev/null!
(unless (stringp rem-enc)
(let ((name (symbol-name rem-enc)))
(let ((name (symbol-name rem-enc))
(value (symbol-value rem-enc)))
;; Check if remote perl exists when necessary.
(and (string-match-p "perl" name)
(not (tramp-get-remote-perl vec))
(throw 'wont-work-remote nil))
;; Check if remote awk exists when necessary.
(and (string-match-p "\\(^\\|[^%]\\)%a" value)
(not (tramp-get-remote-awk vec))
(throw 'wont-work-remote nil))
;; Check if remote hexdump exists when necessary.
(and (string-match-p "\\(^\\|[^%]\\)%h" value)
(not (tramp-get-remote-hexdump vec))
(throw 'wont-work-remote nil))
;; Check if remote od exists when necessary.
(and (string-match-p "\\(^\\|[^%]\\)%o" value)
(not (tramp-get-remote-od vec))
(throw 'wont-work-remote nil))
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
(tramp-maybe-send-script vec (symbol-value rem-enc) name)
(when (string-match-p "\\(^\\|[^%]\\)%[aho]" value)
(setq value
(format-spec
value
(format-spec-make
?a (tramp-get-remote-awk vec)
?h (tramp-get-remote-hexdump vec)
?o (tramp-get-remote-od vec)))
value (replace-regexp-in-string "%" "%%" value)))
(tramp-maybe-send-script vec value name)
(setq rem-enc name)))
(tramp-message
vec 5
@ -4503,6 +4635,15 @@ Goes through the list `tramp-local-coding-commands' and
tmpfile)
(while (string-match "-" name)
(setq name (replace-match "_" nil t name)))
(when (string-match-p "\\(^\\|[^%]\\)%[aho]" value)
(setq value
(format-spec
value
(format-spec-make
?a (tramp-get-remote-awk vec)
?h (tramp-get-remote-hexdump vec)
?o (tramp-get-remote-od vec)))
value (replace-regexp-in-string "%" "%%" value)))
(when (string-match-p "\\(^\\|[^%]\\)%t" value)
(setq tmpfile
(make-temp-name
@ -4513,7 +4654,7 @@ Goes through the list `tramp-local-coding-commands' and
(format-spec
value
(format-spec-make
?t (tramp-compat-file-local-name tmpfile)))))
?t (tramp-file-local-name tmpfile)))))
(tramp-maybe-send-script vec value name)
(setq rem-dec name)))
(tramp-message
@ -4796,7 +4937,7 @@ If there is just some editing, retry it after 5 seconds."
vec 5 "Cannot timeout session, trying it again in %s seconds." 5)
(run-at-time 5 nil 'tramp-timeout-session vec))
(tramp-message
vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'localname))
vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
(tramp-cleanup-connection vec 'keep-debug)))
(defun tramp-maybe-open-connection (vec)
@ -5116,7 +5257,7 @@ function waits for output unless NOOUTPUT is set."
found)))
(defun tramp-send-command-and-check
(vec command &optional subshell dont-suppress-err)
(vec command &optional subshell dont-suppress-err exit-status)
"Run COMMAND and check its exit status.
Send `echo $?' along with the COMMAND for checking the exit status.
If COMMAND is nil, just send `echo $?'. Return t if the exit
@ -5124,7 +5265,9 @@ status is 0, and nil otherwise.
If the optional argument SUBSHELL is non-nil, the command is
executed in a subshell, ie surrounded by parentheses. If
DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null.
Optional argument EXIT-STATUS, if non-nil, triggers the return of
the exit status."
(tramp-send-command
vec
(concat (if subshell "( " "")
@ -5138,7 +5281,9 @@ DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
(prog1
(zerop (read (current-buffer)))
(if exit-status
(read (current-buffer))
(zerop (read (current-buffer))))
(let ((inhibit-read-only t))
(delete-region (match-beginning 0) (point-max))))))
@ -5171,7 +5316,10 @@ raises an error."
command marker (buffer-string))))))
;; Read the expression.
(condition-case nil
(prog1 (read (current-buffer))
(prog1
(let ((signal-hook-function
(unless noerror signal-hook-function)))
(read (current-buffer)))
;; Error handling.
(when (re-search-forward "\\S-" (point-at-eol) t)
(error nil)))
@ -5594,7 +5742,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
"%s -t %s %s"
result
(format-time-string "%Y%m%d%H%M.%S")
(tramp-compat-file-local-name tmpfile))))
(tramp-file-local-name tmpfile))))
(delete-file tmpfile))
result)))
@ -5769,6 +5917,47 @@ ID-FORMAT valid values are `string' and `integer'."
tramp-unknown-id-string)
(t res)))))
(defun tramp-get-remote-busybox (vec)
"Determine remote `busybox' command."
(with-tramp-connection-property vec "busybox"
(tramp-message vec 5 "Finding a suitable `busybox' command")
(tramp-find-executable vec "busybox" (tramp-get-remote-path vec))))
(defun tramp-get-remote-awk (vec)
"Determine remote `awk' command."
(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 " {} </dev/null"))
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 " </dev/null"))
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 </dev/null"))
command)))))
(defun tramp-get-env-with-u-option (vec)
"Check, whether the remote `env' command supports the -u option."
(with-tramp-connection-property vec "env-u-option"

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

@ -75,12 +75,23 @@
;;;###tramp-autoload
(defcustom tramp-smb-conf "/dev/null"
"Path of the smb.conf file.
If it is nil, no smb.conf will be added to the `tramp-smb-program'
"Path of the \"smb.conf\" file.
If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program'
call, letting the SMB client use the default one."
:group 'tramp
:type '(choice (const nil) (file :must-match t)))
;;;###tramp-autoload
(defcustom tramp-smb-options nil
"List of additional options.
They are added to the `tramp-smb-program' call via \"--option '...'\".
For example, if the deprecated SMB1 protocol shall be used, add to
this variable (\"client min protocol=NT1\") ."
:group 'tramp
:type '(repeat string)
:version "27.2")
(defvar tramp-smb-version nil
"Version string of the SMB client.")
@ -135,6 +146,7 @@ call, letting the SMB client use the default one."
"NT_STATUS_HOST_UNREACHABLE"
"NT_STATUS_IMAGE_ALREADY_LOADED"
"NT_STATUS_INVALID_LEVEL"
"NT_STATUS_INVALID_PARAMETER"
"NT_STATUS_INVALID_PARAMETER_MIX"
"NT_STATUS_IO_TIMEOUT"
"NT_STATUS_LOGON_FAILURE"
@ -461,7 +473,8 @@ pass to the OPERATION."
(expand-file-name
tramp-temp-name-prefix
(tramp-compat-temporary-file-directory))))
(args (list (concat "//" host "/" share) "-E")))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
@ -471,6 +484,10 @@ pass to the OPERATION."
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
(while options
(setq args
(append args `("--option" ,(format "%s" (car options))))
options (cdr options)))
(setq args
(if t1
;; Source is remote.
@ -760,7 +777,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(let* ((share (tramp-smb-get-share v))
(localname (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E")))
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
@ -770,6 +788,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
(while options
(setq args
(append args `("--option" ,(format "%s" (car options))))
options (cdr options)))
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
@ -1188,9 +1210,7 @@ component is used as the target of the symlink."
(let ((non-essential t))
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target))))))
(setq target (tramp-file-local-name (expand-file-name target)))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@ -1244,7 +1264,7 @@ component is used as the target of the symlink."
(setq infile (expand-file-name infile))
(if (tramp-equal-remote default-directory infile)
;; INFILE is on the same remote host.
(setq input (with-parsed-tramp-file-name infile nil localname))
(setq input (tramp-file-local-name infile))
;; INFILE must be copied to remote host.
(setq input (tramp-make-tramp-temp-file v)
tmpinput (tramp-make-tramp-file-name v input))
@ -1414,7 +1434,8 @@ component is used as the target of the symlink."
"\\\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E" "-S"
(replace-regexp-in-string
"\n" "," acl-string))))
"\n" "," acl-string)))
(options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
@ -1424,6 +1445,10 @@ component is used as the target of the symlink."
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
(while options
(setq args
(append args `("--option" ,(format "%s" (car options))))
options (cdr options)))
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
@ -1468,7 +1493,7 @@ component is used as the target of the symlink."
(tramp-flush-connection-property v "process-name")
(tramp-flush-connection-property v "process-buffer")))))))
(defun tramp-smb-handle-set-file-modes (filename mode)
(defun tramp-smb-handle-set-file-modes (filename mode &optional _flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(when (tramp-smb-get-cifs-capabilities v)
@ -1557,9 +1582,6 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(format "File %s exists; overwrite anyway? " filename)))))
(tramp-error v 'file-already-exists filename))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
(let ((curbuf (current-buffer))
(tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
@ -1579,6 +1601,10 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(tramp-error v 'file-error "Cannot write `%s'" filename))
(delete-file tmpfile)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-properties v localname)
(unless (equal curbuf (current-buffer))
(tramp-error
v 'file-error
@ -1949,6 +1975,7 @@ If ARGUMENT is non-nil, use it as argument for
(host (tramp-file-name-host vec))
(domain (tramp-file-name-domain vec))
(port (tramp-file-name-port vec))
(options tramp-smb-options)
args)
(cond
@ -1967,6 +1994,10 @@ If ARGUMENT is non-nil, use it as argument for
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
(while options
(setq args
(append args `("--option" ,(format "%s" (car options))))
options (cdr options)))
(when argument
(setq args (append args (list argument))))
@ -2132,7 +2163,5 @@ Removes smb prompt. Returns nil if an error message has appeared."
;;
;; * Try to remove the inclusion of dummy "" directory. Seems to be at
;; several places, especially in `tramp-smb-handle-insert-directory'.
;;
;; * Ignore case in file names.
;;; tramp-smb.el ends here

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

@ -265,10 +265,8 @@ absolute file names."
v 0 (format "%s %s to %s" msg-operation filename newname)
(unless (tramp-sudoedit-send-command
v sudoedit-operation
(tramp-compat-file-name-unquote
(tramp-compat-file-local-name filename))
(tramp-compat-file-name-unquote
(tramp-compat-file-local-name newname)))
(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))))
@ -466,7 +464,7 @@ the result will be a local, non-Tramp, file name."
(tramp-sudoedit-send-command
v "test" "-r" (tramp-compat-file-name-unquote localname)))))
(defun tramp-sudoedit-handle-set-file-modes (filename mode)
(defun tramp-sudoedit-handle-set-file-modes (filename mode &optional _flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@ -524,7 +522,7 @@ the result will be a local, non-Tramp, file name."
(string-to-number (match-string 2)))
(string-to-number (match-string 3)))))))))
(defun tramp-sudoedit-handle-set-file-times (filename &optional time)
(defun tramp-sudoedit-handle-set-file-times (filename &optional time _flag)
"Like `set-file-times' for Tramp files."
(with-parsed-tramp-file-name filename nil
(tramp-flush-file-properties v localname)
@ -615,9 +613,7 @@ component is used as the target of the symlink."
(let ((non-essential t))
(when (and (tramp-tramp-file-p target)
(tramp-file-name-equal-p v (tramp-dissect-file-name target)))
(setq target
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name target))))))
(setq target (tramp-file-local-name (expand-file-name target)))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p target)
@ -715,8 +711,7 @@ ID-FORMAT valid values are `string' and `integer'."
(format "%d:%d"
(or uid (tramp-sudoedit-get-remote-uid v 'integer))
(or gid (tramp-sudoedit-get-remote-gid v 'integer)))
(tramp-compat-file-name-unquote
(tramp-compat-file-local-name filename)))))
(tramp-unquote-file-local-name filename))))
(defun tramp-sudoedit-handle-write-region
(start end filename &optional append visit lockname mustbenew)

149
lisp/net/tramp.el
View file

@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
;; Version: 2.4.3
;; Version: 2.4.5-pre
;; Package-Requires: ((emacs "24.4"))
;; Package-Type: multi
;; URL: https://savannah.gnu.org/projects/tramp
@ -37,7 +37,7 @@
;; For more detailed instructions, please see the info file.
;;
;; Notes:
;; -----
;; ------
;;
;; Also see the todo list at the bottom of this file.
;;
@ -46,6 +46,7 @@
;;
;; There's a mailing list for this, as well. Its name is:
;; tramp-devel@gnu.org
;; You can use the Web to subscribe, under the following URL:
;; https://lists.gnu.org/mailman/listinfo/tramp-devel
;;
@ -1347,6 +1348,11 @@ of `process-file', `start-file-process', or `shell-command'."
(match-string (nth 4 tramp-file-name-structure) name))
(tramp-compat-file-local-name name)))
;; The localname can be quoted with "/:". Extract this.
(defun tramp-unquote-file-local-name (name)
"Return unquoted localname of NAME."
(tramp-compat-file-name-unquote (tramp-file-local-name name)))
(defun tramp-find-method (method user host)
"Return the right method string to use depending on USER and HOST.
This is METHOD, if non-nil. Otherwise, do a lookup in
@ -1592,7 +1598,7 @@ necessary only. This function will be used in file name completion."
tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host)
tramp-postfix-host-format))
(when localname localname)))
localname))
(defun tramp-get-buffer (vec &optional dont-create)
"Get the connection buffer to be used for VEC.
@ -1648,7 +1654,7 @@ version, the function does nothing."
"Set connection-local variables in the current buffer.
If connection-local variables are not supported by this Emacs
version, the function does nothing."
(when (file-remote-p default-directory)
(when (tramp-tramp-file-p default-directory)
;; `hack-connection-local-variables-apply' exists since Emacs 26.1.
(tramp-compat-funcall
'hack-connection-local-variables-apply
@ -2864,7 +2870,7 @@ User is always nil."
(let ((default-directory (tramp-compat-temporary-file-directory)))
(when (file-readable-p filename)
(with-temp-buffer
(insert-file-contents filename)
(insert-file-contents-literally filename)
(goto-char (point-min))
(cl-loop while (not (eobp)) collect (funcall function))))))
@ -3199,7 +3205,7 @@ User is always nil."
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
tmpfile)))
(defun tramp-handle-file-modes (filename)
(defun tramp-handle-file-modes (filename &optional _flag)
"Like `file-modes' for Tramp files."
;; Starting with Emacs 25.1, `when-let' can be used.
(let ((attrs (file-attributes (or (file-truename filename) filename))))
@ -3247,7 +3253,7 @@ User is always nil."
;; lower case letters. This avoids us to create a
;; temporary file.
(while (and (string-match-p
"[a-z]" (tramp-compat-file-local-name candidate))
"[a-z]" (tramp-file-local-name candidate))
(not (file-exists-p candidate)))
(setq candidate
(directory-file-name
@ -3257,8 +3263,7 @@ User is always nil."
;; to Emacs 26+ like `file-name-case-insensitive-p',
;; so there is no compatibility problem calling it.
(unless
(string-match-p
"[a-z]" (tramp-compat-file-local-name candidate))
(string-match-p "[a-z]" (tramp-file-local-name candidate))
(setq tmpfile
(let ((default-directory
(file-name-directory filename)))
@ -3271,7 +3276,7 @@ User is always nil."
(file-exists-p
(concat
(file-remote-p candidate)
(upcase (tramp-compat-file-local-name candidate))))
(upcase (tramp-file-local-name candidate))))
;; Cleanup.
(when tmpfile (delete-file tmpfile)))))))))))
@ -3413,7 +3418,7 @@ User is always nil."
(tramp-error
v1 'file-error
"Maximum number (%d) of symlinks exceeded" numchase-limit)))
(tramp-compat-file-local-name (directory-file-name result)))))))))
(tramp-file-local-name (directory-file-name result)))))))))
(defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
@ -3645,10 +3650,16 @@ support symbolic links."
(let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command))
(command (substring command 0 asynchronous))
current-buffer-p
(output-buffer-p output-buffer)
(output-buffer
(cond
((bufferp output-buffer) output-buffer)
((stringp output-buffer) (get-buffer-create output-buffer))
((bufferp output-buffer)
(setq current-buffer-p (eq (current-buffer) output-buffer))
output-buffer)
((stringp output-buffer)
(setq current-buffer-p
(eq (buffer-name (current-buffer)) output-buffer))
(get-buffer-create output-buffer))
(output-buffer
(setq current-buffer-p t)
(current-buffer))
@ -3660,13 +3671,19 @@ support symbolic links."
(cond
((bufferp error-buffer) error-buffer)
((stringp error-buffer) (get-buffer-create error-buffer))))
(error-file
(and error-buffer
(with-parsed-tramp-file-name default-directory nil
(tramp-make-tramp-file-name
v (tramp-make-tramp-temp-file v)))))
(bname (buffer-name output-buffer))
(p (get-buffer-process output-buffer))
(dir default-directory)
buffer)
;; The following code is taken from `shell-command', slightly
;; adapted. Shouldn't it be factored out?
(when p
(when (and (integerp asynchronous) p)
(cond
((eq async-shell-command-buffer 'confirm-kill-process)
;; If will kill a process, query first.
@ -3698,22 +3715,25 @@ support symbolic links."
(rename-uniquely))
(setq output-buffer (get-buffer-create bname)))))
(setq buffer (if (and (not asynchronous) error-buffer)
(with-parsed-tramp-file-name default-directory nil
(list output-buffer
(tramp-make-tramp-file-name
v (tramp-make-tramp-temp-file v))))
output-buffer))
(if current-buffer-p
(progn
(barf-if-buffer-read-only)
(push-mark nil t))
(unless output-buffer-p
(with-current-buffer output-buffer
(setq default-directory dir)))
(setq buffer (if error-file (list output-buffer error-file) output-buffer))
(with-current-buffer output-buffer
(when current-buffer-p
(barf-if-buffer-read-only)
(push-mark nil t))
;; `shell-command-save-pos-or-erase' has been introduced with
;; Emacs 27.1.
(if (fboundp 'shell-command-save-pos-or-erase)
(tramp-compat-funcall
'shell-command-save-pos-or-erase current-buffer-p)
(setq buffer-read-only nil)
(erase-buffer)))
(if (and (not current-buffer-p) (integerp asynchronous))
(if (integerp asynchronous)
(let ((tramp-remote-process-environment
;; `async-shell-command-width' has been introduced with
;; Emacs 27.1.
@ -3726,42 +3746,68 @@ support symbolic links."
;; Run the process.
(setq p (start-file-process-shell-command
(buffer-name output-buffer) buffer command))
;; Display output.
(with-current-buffer output-buffer
(display-buffer output-buffer '(nil (allow-no-window . t)))
(setq mode-line-process '(":%s"))
(shell-mode)
(set-process-sentinel p #'shell-command-sentinel)
(set-process-filter p #'comint-output-filter))))
;; Insert error messages if they were separated.
(when error-file
(with-current-buffer error-buffer
(insert-file-contents-literally error-file)))
(if (process-live-p p)
;; Display output.
(with-current-buffer output-buffer
(setq mode-line-process '(":%s"))
(unless (eq major-mode 'shell-mode)
(shell-mode))
(set-process-filter p #'comint-output-filter)
(set-process-sentinel p #'shell-command-sentinel)
(when error-file
(add-function
:after (process-sentinel p)
(lambda (_proc _string)
(with-current-buffer error-buffer
(insert-file-contents-literally
error-file nil nil nil 'replace))
(delete-file error-file))))
(display-buffer output-buffer '(nil (allow-no-window . t))))
(when error-file
(delete-file error-file)))))
(prog1
;; Run the process.
(process-file-shell-command command nil buffer nil)
;; Insert error messages if they were separated.
(when (listp buffer)
(when error-file
(with-current-buffer error-buffer
(insert-file-contents (cadr buffer)))
(delete-file (cadr buffer)))
(insert-file-contents-literally error-file))
(delete-file error-file))
(if current-buffer-p
;; This is like exchange-point-and-mark, but doesn't
;; activate the mark. It is cleaner to avoid activation,
;; even though the command loop would deactivate the mark
;; because we inserted text.
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point)
(current-buffer))))
(progn
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point)
(current-buffer))))
;; `shell-command-set-point-after-cmd' has been
;; introduced with Emacs 27.1.
(if (fboundp 'shell-command-set-point-after-cmd)
(tramp-compat-funcall
'shell-command-set-point-after-cmd)))
;; There's some output, display it.
(when (with-current-buffer output-buffer (> (point-max) (point-min)))
(display-message-or-buffer output-buffer)))))))
(defun tramp-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files."
"Like `start-file-process' for Tramp files.
BUFFER might be a list, in this case STDERR is separated."
;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only.
(tramp-file-name-handler
'make-process
:name name
:buffer buffer
:buffer (if (consp buffer) (car buffer) buffer)
:command (and program (cons program args))
;; `shell-command' adds an errfile to `buffer'.
:stderr (when (consp buffer) (cadr buffer))
:noquery nil
:file-handler t))
@ -4044,6 +4090,8 @@ The terminal type can be configured with `tramp-terminal-type'."
(defun tramp-action-process-alive (proc _vec)
"Check, whether a process has finished."
(unless (process-live-p proc)
;; There might be pending output.
(while (tramp-accept-process-output proc 0))
(throw 'tramp-action 'process-died)))
(defun tramp-action-out-of-band (proc vec)
@ -4362,7 +4410,7 @@ would yield t. On the other hand, the following check results in nil:
(tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\")
If both files are local, the function returns t."
(or (and (null (file-remote-p file1)) (null (file-remote-p file2)))
(or (and (null (tramp-tramp-file-p file1)) (null (tramp-tramp-file-p file2)))
(and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2)
(string-equal (file-remote-p file1) (file-remote-p file2)))))
@ -4632,7 +4680,7 @@ This handles also chrooted environments, which are not regarded as local."
(tramp-make-tramp-file-name
vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
(or (and (file-directory-p dir) (file-writable-p dir)
(tramp-compat-file-local-name dir))
(tramp-file-local-name dir))
(tramp-error vec 'file-error "Directory %s not accessible" dir))
dir)))
@ -4655,7 +4703,7 @@ Return the local name of the temporary file."
(set-file-modes result #o0700)))
;; Return the local part.
(with-parsed-tramp-file-name result nil localname)))
(tramp-file-local-name result)))
(defun tramp-delete-temp-file-function ()
"Remove temporary files related to current buffer."
@ -4682,7 +4730,7 @@ this file, if that variable is non-nil."
(let ((system-type
(if (and (stringp tramp-auto-save-directory)
(file-remote-p tramp-auto-save-directory))
(tramp-tramp-file-p tramp-auto-save-directory))
'not-windows
system-type))
(auto-save-file-name-transforms
@ -4824,7 +4872,12 @@ verbosity of 6."
"Read a password from user (compat function).
Consults the auth-source package.
Invokes `password-read' if available, `read-passwd' else."
(let* ((case-fold-search t)
(let* (;; If `auth-sources' contains "~/.authinfo.gpg", and
;; `exec-path' contains a relative file name like ".", it
;; could happen that the "gpg" command is not found. So we
;; adapt `default-directory'. (Bug#39389, Bug#39489)
(default-directory (tramp-compat-temporary-file-directory))
(case-fold-search t)
(key (tramp-make-tramp-file-name
;; In tramp-sh.el, we must use "password-vector" due to
;; multi-hop.
@ -4976,10 +5029,12 @@ name of a process or buffer, or nil to default to the current buffer."
(tramp-error proc 'error "Process %s is not active" proc)
(tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
;; This is for tramp-sh.el. Other backends do not support this (yet).
;; Not all "kill" implementations support process groups by
;; negative pid, so we try both variants.
(tramp-compat-funcall
'tramp-send-command
(process-get proc 'vector)
(format "kill -2 -%d" pid))
(format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid))
;; Wait, until the process has disappeared. If it doesn't,
;; fall back to the default implementation.
(while (tramp-accept-process-output proc 0))

6
lisp/net/trampver.el
View file

@ -39,7 +39,7 @@
(defvar inhibit-message)
;;;###tramp-autoload
(defconst tramp-version "2.4.3.27.1"
(defconst tramp-version "2.4.5-pre"
"This version of Tramp.")
;;;###tramp-autoload
@ -51,6 +51,7 @@
;; Suppress message from `emacs-repository-get-branch'. We must
;; also handle out-of-tree builds.
(let ((inhibit-message t)
(debug-on-error nil)
(dir (or (locate-dominating-file (locate-library "tramp") ".git")
source-directory)))
;; `emacs-repository-get-branch' has been introduced with Emacs 27.1.
@ -64,6 +65,7 @@
;; Suppress message from `emacs-repository-get-version'. We must
;; also handle out-of-tree builds.
(let ((inhibit-message t)
(debug-on-error nil)
(dir (or (locate-dominating-file (locate-library "tramp") ".git")
source-directory)))
(and (stringp dir) (file-directory-p dir)
@ -73,7 +75,7 @@
;; Check for Emacs version.
(let ((x (if (not (string-lessp emacs-version "24.4"))
"ok"
(format "Tramp 2.4.3.27.1 is not fit for %s"
(format "Tramp 2.4.5-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))

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

@ -50,6 +50,7 @@
(require 'vc-hg)
(declare-function tramp-find-executable "tramp-sh")
(declare-function tramp-get-remote-gid "tramp-sh")
(declare-function tramp-get-remote-path "tramp-sh")
(declare-function tramp-get-remote-perl "tramp-sh")
(declare-function tramp-get-remote-stat "tramp-sh")
@ -74,6 +75,9 @@
(defvar connection-local-profile-alist)
;; Needed for Emacs 26.
(defvar async-shell-command-width)
;; Needed for Emacs 27.
(defvar process-file-return-signal-string)
(defvar shell-command-dont-erase-buffer)
;; Beautify batch mode.
(when noninteractive
@ -2357,7 +2361,14 @@ This checks also `file-name-as-directory', `file-name-directory',
(write-region nil nil tmp-name 3))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foobaz"))))
(should (string-equal (buffer-string) "foobaz")))
(delete-file tmp-name)
(with-temp-buffer
(insert "foo")
(write-region nil nil tmp-name 'append))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "foo"))))
;; Write string.
(write-region "foo" nil tmp-name)
@ -2393,14 +2404,14 @@ This checks also `file-name-as-directory', `file-name-directory',
tramp--test-messages))))))))
;; Do not overwrite if excluded.
(cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))
(cl-letf (((symbol-function #'y-or-n-p) (lambda (_prompt) t))
;; Ange-FTP.
((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
;; `mustbenew' is passed to Tramp since Emacs 26.1.
(when (tramp--test-emacs26-p)
(should-error
(cl-letf (((symbol-function 'y-or-n-p) 'ignore)
(cl-letf (((symbol-function #'y-or-n-p) #'ignore)
;; Ange-FTP.
((symbol-function 'yes-or-no-p) 'ignore))
(write-region "foo" nil tmp-name nil nil nil 'mustbenew))
@ -3115,22 +3126,38 @@ This tests also `access-file', `file-readable-p',
(file-remote-p tmp-name1)
(replace-regexp-in-string
"/" "//" (file-remote-p tmp-name1 'localname))))
;; `file-ownership-preserved-p' is implemented only in tramp-sh.el.
(test-file-ownership-preserved-p (tramp--test-sh-p))
attr)
(unwind-protect
(progn
;; A sticky bit could damage the `file-ownership-preserved-p' test.
(when
(and test-file-ownership-preserved-p
(zerop (logand
#o1000
(file-modes tramp-test-temporary-file-directory))))
(write-region "foo" nil tmp-name1)
(setq test-file-ownership-preserved-p
(= (tramp-compat-file-attribute-group-id
(file-attributes tmp-name1))
(tramp-get-remote-gid
(tramp-dissect-file-name tmp-name1) 'integer)))
(delete-file tmp-name1))
(should-error
(access-file tmp-name1 "error")
:type tramp-file-missing)
;; `file-ownership-preserved-p' should return t for
;; non-existing files. It is implemented only in tramp-sh.el.
(when (tramp--test-sh-p)
;; non-existing files.
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 "error"))
(when (tramp--test-sh-p)
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
;; We do not test inodes and device numbers.
@ -3160,16 +3187,16 @@ This tests also `access-file', `file-readable-p',
(should (stringp (tramp-compat-file-attribute-group-id attr)))
(tramp--test-ignore-make-symbolic-link-error
(should-error
(access-file tmp-name2 "error")
:type tramp-file-missing)
(when (tramp--test-sh-p)
(should-error
(access-file tmp-name2 "error")
:type tramp-file-missing)
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
(should-not (access-file tmp-name2 "error"))
(when (tramp--test-sh-p)
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name2 'group)))
(setq attr (file-attributes tmp-name2))
(should
@ -3200,7 +3227,7 @@ This tests also `access-file', `file-readable-p',
(tramp-dissect-file-name tmp-name3))))
(delete-file tmp-name2))
(when (tramp--test-sh-p)
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(delete-file tmp-name1)
(make-directory tmp-name1)
@ -3208,7 +3235,7 @@ This tests also `access-file', `file-readable-p',
(should (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
(should-not (access-file tmp-name1 ""))
(when (tramp--test-sh-p)
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
(should (eq (tramp-compat-file-attribute-type attr) t)))
@ -3420,11 +3447,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:type 'file-already-exists))
(when (tramp--test-expensive-test)
;; A number means interactive case.
(cl-letf (((symbol-function 'yes-or-no-p) #'ignore))
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(make-symbolic-link tmp-name1 tmp-name2 0)
:type 'file-already-exists)))
(cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
(cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t)))
(make-symbolic-link tmp-name1 tmp-name2 0)
(should
(string-equal
@ -3496,11 +3523,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(add-name-to-file tmp-name1 tmp-name2)
:type 'file-already-exists)
;; A number means interactive case.
(cl-letf (((symbol-function 'yes-or-no-p) #'ignore))
(cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
(should-error
(add-name-to-file tmp-name1 tmp-name2 0)
:type 'file-already-exists))
(cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
(cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t)))
(add-name-to-file tmp-name1 tmp-name2 0)
(should (file-regular-p tmp-name2)))
(add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
@ -4126,6 +4153,28 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (zerop (process-file "true")))
(should-not (zerop (process-file "false")))
(should-not (zerop (process-file "binary-does-not-exist")))
;; Return exit code.
(should (= 42 (process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "exit 42")))
;; Return exit code in case the process is interrupted,
;; and there's no indication for a signal describing string.
(let (process-file-return-signal-string)
(should
(= (+ 128 2)
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "kill -2 $$"))))
;; Return string in case the process is interrupted and
;; there's an indication for a signal describing string.
(let ((process-file-return-signal-string t))
(should
(string-match
"Interrupt\\|Signal 2"
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "kill -2 $$"))))
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
@ -4181,7 +4230,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(setq proc (start-file-process "test1" (current-buffer) "cat"))
(should (processp proc))
(should (equal (process-status proc) 'run))
(process-send-string proc "foo")
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
@ -4224,7 +4273,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(set-process-filter
proc
(lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
(process-send-string proc "foo")
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
@ -4248,7 +4297,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name 'local quoted))
kill-buffer-query-functions proc)
(with-no-warnings (should-not (make-process)))
@ -4262,7 +4312,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
(process-send-string proc "foo")
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
@ -4278,13 +4328,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Simple process using a file.
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(setq proc
(with-no-warnings
(make-process
:name "test2" :buffer (current-buffer)
:command `("cat" ,(file-name-nondirectory tmp-name))
:command `("cat" ,(file-name-nondirectory tmp-name1))
:file-handler t)))
(should (processp proc))
;; Read output.
@ -4296,7 +4346,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors
(delete-process proc)
(delete-file tmp-name)))
(delete-file tmp-name1)))
;; Process filter.
(unwind-protect
@ -4311,7 +4361,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
(process-send-string proc "foo")
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
@ -4337,7 +4387,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
(process-send-string proc "foo")
(process-send-string proc "foo\n")
(process-send-eof proc)
(delete-process proc)
;; Read output.
@ -4345,36 +4395,67 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(while (accept-process-output proc 0 nil t)))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string. And a remote macOS sends
;; a slightly modified string.
(should (string-match "killed.*\n\\'" (buffer-string))))
;; a slightly modified string. On MS Windows,
;; `delete-process' sends an unknown signal.
(should
(string-match
(if (eq system-type 'windows-nt)
"unknown signal\n\\'" "killed.*\n\\'")
(buffer-string))))
;; Cleanup.
(ignore-errors (delete-process proc)))
;; Process with stderr. tramp-adb.el doesn't support it (yet).
(unless (tramp--test-adb-p)
(let ((stderr (generate-new-buffer "*stderr*")))
(unwind-protect
(with-temp-buffer
(setq proc
(with-no-warnings
(make-process
:name "test5" :buffer (current-buffer)
:command '("cat" "/")
:stderr stderr
:file-handler t)))
(should (processp proc))
;; Read stderr.
(with-current-buffer stderr
(with-timeout (10 (tramp--test-timeout-handler))
(while (= (point-min) (point-max))
(while (accept-process-output proc 0 nil t))))
(should
(string-match "^cat:.* Is a directory" (buffer-string)))))
;; Process with stderr buffer.
(let ((stderr (generate-new-buffer "*stderr*")))
(unwind-protect
(with-temp-buffer
(setq proc
(with-no-warnings
(make-process
:name "test5" :buffer (current-buffer)
:command '("cat" "/does-not-exist")
:stderr stderr
:file-handler t)))
(should (processp proc))
;; Read stderr.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
(delete-process proc)
(with-current-buffer stderr
(should
(string-match
"cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc))
(ignore-errors (kill-buffer stderr))))))))
;; Cleanup.
(ignore-errors (delete-process proc))
(ignore-errors (kill-buffer stderr))))
;; Process with stderr file.
(dolist (tmpfile `(,tmp-name1 ,tmp-name2))
(unwind-protect
(with-temp-buffer
(setq proc
(with-no-warnings
(make-process
:name "test6" :buffer (current-buffer)
:command '("cat" "/does-not-exist")
:stderr tmpfile
:file-handler t)))
(should (processp proc))
;; Read stderr.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc nil nil t)))
(delete-process proc)
(with-temp-buffer
(insert-file-contents tmpfile)
(should
(string-match
"cat:.* No such file or directory" (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-process proc))
(ignore-errors (delete-file tmpfile)))))))
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
@ -4388,10 +4469,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; order to establish the connection prior running an asynchronous
;; process.
(let ((default-directory (file-truename tramp-test-temporary-file-directory))
(delete-exited-processes t)
kill-buffer-query-functions proc)
(unwind-protect
(with-temp-buffer
(setq proc (start-file-process "test" (current-buffer) "sleep" "10"))
(setq proc (start-file-process-shell-command
"test" (current-buffer)
"trap 'echo boom; exit 1' 2; sleep 100"))
(should (processp proc))
(should (process-live-p proc))
(should (equal (process-status proc) 'run))
@ -4399,7 +4483,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (interrupt-process proc))
;; Let the process accept the interrupt.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc nil nil 0)))
(while (process-live-p proc)
(while (accept-process-output proc 0 nil t))))
(should-not (process-live-p proc))
;; An interrupted process cannot be interrupted, again.
(should-error
@ -4409,14 +4494,24 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc)))))
(defun tramp--test-async-shell-command
(command output-buffer &optional error-buffer input)
"Like `async-shell-command', reading the output.
INPUT, if non-nil, is a string sent to the process."
(async-shell-command command output-buffer error-buffer)
(let ((proc (get-buffer-process output-buffer))
(delete-exited-processes t))
(when (stringp input)
(process-send-string proc input))
(with-timeout
((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
(while (or (accept-process-output proc nil nil t) (process-live-p proc))))
(accept-process-output proc nil nil t)))
(defun tramp--test-shell-command-to-string-asynchronously (command)
"Like `shell-command-to-string', but for asynchronous processes."
(with-temp-buffer
(async-shell-command command (current-buffer))
(with-timeout
((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
(tramp--test-async-shell-command command (current-buffer))
(buffer-substring-no-properties (point-min) (point-max))))
(ert-deftest tramp-test32-shell-command ()
@ -4435,111 +4530,294 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(inhibit-message t)
kill-buffer-query-functions)
;; Test ordinary `shell-command'.
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(shell-command
(format "ls %s" (file-name-nondirectory tmp-name))
(current-buffer))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
(format "%s\n" (file-name-nondirectory tmp-name))
(buffer-string))))
(dolist (this-shell-command
'(;; Synchronously.
shell-command
;; Asynchronously.
tramp--test-async-shell-command))
;; Cleanup.
(ignore-errors (delete-file tmp-name)))
;; Test `shell-command' with error buffer.
(let ((stderr (generate-new-buffer "*stderr*")))
;; Test ordinary `{async-}shell-command'.
(unwind-protect
(with-temp-buffer
(shell-command "error" (current-buffer) stderr)
(should (= (point-min) (point-max)))
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(funcall
this-shell-command
(format "ls %s" (file-name-nondirectory tmp-name))
(current-buffer))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-match
"error:.+not found"
(with-current-buffer stderr (buffer-string)))))
(string-equal
(format "%s\n" (file-name-nondirectory tmp-name))
(buffer-string))))
;; Cleanup.
(ignore-errors (kill-buffer stderr))))
(ignore-errors (delete-file tmp-name)))
;; Test ordinary `async-shell-command'.
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(async-shell-command
(format "ls %s" (file-name-nondirectory tmp-name))
(current-buffer))
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
(should
(string-equal
(format "%s\n" (file-name-nondirectory tmp-name))
(buffer-string))))
;; Test `{async-}shell-command' with error buffer.
(let ((stderr (generate-new-buffer "*stderr*")))
(unwind-protect
(with-temp-buffer
(funcall
this-shell-command
"echo foo >&2; echo bar" (current-buffer) stderr)
(should (string-equal "bar\n" (buffer-string)))
;; Check stderr.
(with-current-buffer stderr
(should (string-equal "foo\n" (buffer-string)))))
;; Cleanup.
(ignore-errors (delete-file tmp-name)))
;; Cleanup.
(ignore-errors (kill-buffer stderr)))))
;; Test sending string to `async-shell-command'.
(unwind-protect
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(async-shell-command "read line; ls $line" (current-buffer))
(process-send-string
(get-buffer-process (current-buffer))
(tramp--test-async-shell-command
"read line; ls $line" (current-buffer) nil
;; String to be sent.
(format "%s\n" (file-name-nondirectory tmp-name)))
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output
(get-buffer-process (current-buffer)) nil nil t)))
;; `ls' could produce colorized output.
(goto-char (point-min))
(while
(re-search-forward tramp-display-escape-sequence-regexp nil t)
(replace-match "" nil nil))
;; We cannot use `string-equal', because tramp-adb.el
;; echoes also the sent string.
(should
(string-match
(format "\\`%s" (regexp-quote (file-name-nondirectory tmp-name)))
(string-equal
;; tramp-adb.el echoes, so we must add the string.
(if (tramp--test-adb-p)
(format
"%s\n%s\n"
(file-name-nondirectory tmp-name)
(file-name-nondirectory tmp-name))
(format "%s\n" (file-name-nondirectory tmp-name)))
(buffer-string))))
;; Cleanup.
(ignore-errors (delete-file tmp-name)))
(ignore-errors (delete-file tmp-name)))))
;; Test `async-shell-command-width'. Since Emacs 27.1.
(when (ignore-errors
(and (boundp 'async-shell-command-width)
(zerop (call-process "tput" nil nil nil "cols"))
(zerop (process-file "tput" nil nil nil "cols"))))
(let (async-shell-command-width)
(should
(string-equal
(format "%s\n" (car (process-lines "tput" "cols")))
(tramp--test-shell-command-to-string-asynchronously
"tput cols")))
(setq async-shell-command-width 1024)
(should
(string-equal
"1024\n"
(tramp--test-shell-command-to-string-asynchronously
"tput cols"))))))))
;; Test `async-shell-command-width'. It exists since Emacs 26.1,
;; but seems to work since Emacs 27.1 only.
(when (and (tramp--test-sh-p) (tramp--test-emacs27-p))
(let* ((async-shell-command-width 1024)
(default-directory tramp-test-temporary-file-directory)
(cols (ignore-errors
(read (tramp--test-shell-command-to-string-asynchronously
"tput cols")))))
(when (natnump cols)
(should (= cols async-shell-command-width))))))
;; This test is inspired by Bug#39067.
(ert-deftest tramp-test32-shell-command-dont-erase-buffer ()
"Check `shell-command-dont-erase-buffer'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly.
(skip-unless (tramp--test-emacs27-p))
;; We check both the local and remote case, in order to guarantee
;; that they behave similar.
(dolist (default-directory
`(,temporary-file-directory ,tramp-test-temporary-file-directory))
(let ((buffer (generate-new-buffer "foo"))
;; Suppress nasty messages.
(inhibit-message t)
point kill-buffer-query-functions)
(unwind-protect
(progn
;; Don't erase if buffer is the current one. Point is not moved.
(let (shell-command-dont-erase-buffer)
(with-temp-buffer
(insert "bar")
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(shell-command "echo baz" (current-buffer))
(should (string-equal "barbaz\n" (buffer-string)))
(should (= point (point)))
(should-not (= (point) (point-max)))))
;; Erase if the buffer is not current one. Point is not moved.
(let (shell-command-dont-erase-buffer)
(with-current-buffer buffer
(erase-buffer)
(insert "bar")
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(with-temp-buffer
(shell-command "echo baz" buffer))
(should (string-equal "baz\n" (buffer-string)))
(should (= point (point)))
(should-not (= (point) (point-max)))))
;; Erase if buffer is the current one, but
;; `shell-command-dont-erase-buffer' is set to `erase'.
;; There is no point to check point.
(let ((shell-command-dont-erase-buffer 'erase))
(with-temp-buffer
(insert "bar")
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(shell-command "echo baz" (current-buffer))
(should (string-equal "baz\n" (buffer-string)))
;; In the local case, point is not moved after the
;; inserted text.
(should (= (point)
(if (file-remote-p default-directory)
(point-max) (point-min))))))
;; Don't erase if the buffer is the current one and
;; `shell-command-dont-erase-buffer' is set to
;; `beg-last-out'. Check point.
(let ((shell-command-dont-erase-buffer 'beg-last-out))
(with-temp-buffer
(insert "bar")
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(shell-command "echo baz" (current-buffer))
(should (string-equal "barbaz\n" (buffer-string)))
;; There is still an error in Tramp.
(unless (file-remote-p default-directory)
(should (= point (point)))
(should-not (= (point) (point-max))))))
;; Don't erase if the buffer is not the current one and
;; `shell-command-dont-erase-buffer' is set to
;; `beg-last-out'. Check point.
(let ((shell-command-dont-erase-buffer 'beg-last-out))
(with-current-buffer buffer
(erase-buffer)
(insert "bar")
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(with-temp-buffer
(shell-command "echo baz" buffer))
(should (string-equal "barbaz\n" (buffer-string)))
;; There is still an error in Tramp.
(unless (file-remote-p default-directory)
(should (= point (point)))
(should-not (= (point) (point-max))))))
;; Don't erase if the buffer is the current one and
;; `shell-command-dont-erase-buffer' is set to
;; `end-last-out'. Check point.
(let ((shell-command-dont-erase-buffer 'end-last-out))
(with-temp-buffer
(insert "bar")
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(shell-command "echo baz" (current-buffer))
(should (string-equal "barbaz\n" (buffer-string)))
;; This does not work as expected in the local case.
;; Therefore, we negate the test for the time being.
(should-not
(funcall (if (file-remote-p default-directory) #'identity #'not)
(= point (point))))
(should
(funcall (if (file-remote-p default-directory) #'identity #'not)
(= (point) (point-max))))))
;; Don't erase if the buffer is not the current one and
;; `shell-command-dont-erase-buffer' is set to
;; `end-last-out'. Check point.
(let ((shell-command-dont-erase-buffer 'end-last-out))
(with-current-buffer buffer
(erase-buffer)
(insert "bar")
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(with-temp-buffer
(shell-command "echo baz" buffer))
(should (string-equal "barbaz\n" (buffer-string)))
;; There is still an error in Tramp.
(unless (file-remote-p default-directory)
(should-not (= point (point)))
(should (= (point) (point-max))))))
;; Don't erase if the buffer is the current one and
;; `shell-command-dont-erase-buffer' is set to
;; `save-point'. Check point.
(let ((shell-command-dont-erase-buffer 'save-point))
(with-temp-buffer
(insert "bar")
(goto-char (1- (point-max)))
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (1- (point-max))))
(shell-command "echo baz" (current-buffer))
(should (string-equal "babaz\nr" (buffer-string)))
;; There is still an error in Tramp.
(unless (file-remote-p default-directory)
(should (= point (point)))
(should-not (= (point) (point-max))))))
;; Don't erase if the buffer is not the current one and
;; `shell-command-dont-erase-buffer' is set to
;; `save-point'. Check point.
(let ((shell-command-dont-erase-buffer 'save-point))
(with-current-buffer buffer
(erase-buffer)
(insert "bar")
(goto-char (1- (point-max)))
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (1- (point-max))))
(with-temp-buffer
(shell-command "echo baz" buffer))
;; This does not work as expected. Therefore, we
;; use the "wrong" string.
(should (string-equal "barbaz\n" (buffer-string)))
;; There is still an error in Tramp.
(unless (file-remote-p default-directory)
(should (= point (point)))
(should-not (= (point) (point-max))))))
;; Don't erase if the buffer is the current one and
;; `shell-command-dont-erase-buffer' is set to a random
;; value. Check point.
(let ((shell-command-dont-erase-buffer 'random))
(with-temp-buffer
(insert "bar")
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(shell-command "echo baz" (current-buffer))
(should (string-equal "barbaz\n" (buffer-string)))
;; This does not work as expected in the local case.
;; Therefore, we negate the test for the time being.
(should-not
(funcall (if (file-remote-p default-directory) #'identity #'not)
(= point (point))))
(should
(funcall (if (file-remote-p default-directory) #'identity #'not)
(= (point) (point-max))))))
;; Don't erase if the buffer is not the current one and
;; `shell-command-dont-erase-buffer' is set to a random
;; value. Check point.
(let ((shell-command-dont-erase-buffer 'random))
(with-current-buffer buffer
(erase-buffer)
(insert "bar")
(setq point (point))
(should (string-equal "bar" (buffer-string)))
(should (= (point) (point-max)))
(with-temp-buffer
(shell-command "echo baz" buffer))
(should (string-equal "barbaz\n" (buffer-string)))
;; There is still an error in Tramp.
(unless (file-remote-p default-directory)
(should-not (= point (point)))
(should (= (point) (point-max)))))))
;; Cleanup.
(ignore-errors (kill-buffer buffer))))))
;; This test is inspired by Bug#23952.
(ert-deftest tramp-test33-environment-variables ()
@ -5753,7 +6031,7 @@ Use the `ls' command."
;; Since Emacs 27.1.
(skip-unless (fboundp 'file-system-info))
;; `file-system-info' exists since Emacs 27. We don't want to see
;; `file-system-info' exists since Emacs 27.1. We don't want to see
;; compiler warnings for older Emacsen.
(let ((fsi (with-no-warnings
(file-system-info tramp-test-temporary-file-directory))))
@ -6191,8 +6469,6 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file'
;; do not work properly for `nextcloud'.
;; * Fix `tramp-test29-start-file-process' and
;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?).
;; * Implement `tramp-test31-interrupt-process' for `adb'.
;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote
;; file name operation cannot run in the timer. Remove `:unstable' tag?