* 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.
@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
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
@example
@group
echo $INSIDE_EMACS
-@result{} 26.2,tramp:2.3.4
+@result{} 27.1,tramp:2.4.3
@end group
@end example
@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
@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}
@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}.
@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
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
(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
@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
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}
@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
(require 'tramp)
+(defvar process-file-return-signal-string)
+
;;;###tramp-autoload
(defcustom tramp-adb-program "adb"
"Name of the Android Debug Bridge program."
(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))
(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
(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)
(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.
(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)
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."
(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))
(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)
;; 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
(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))
;; 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
(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
(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
(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))))
(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.
(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)
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))))))
(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)))
(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.
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)
;; 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))
(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
(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.")
(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)))
\f
;; File name primitives.
(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."
(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)
(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)
(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)))
,(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.
(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)
;;;###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
"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\"
}
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+/\"
}
"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
(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)
(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.
(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)
(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."
;; 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)
(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)
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))
;; 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))
(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
(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)))
(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."
(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))
(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)
;; 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
(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))
(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."
;; 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
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 --
(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)))
(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
(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
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.
(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")
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.")
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
;; 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
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
(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
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)
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
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 "( " "")
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))))))
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)))
"%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)))
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"
;;;###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.")
"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"
(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)))
(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.
(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)))
(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)
(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)
(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))
"\\\\" "/" (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)))
(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)
(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)
(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))
(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
(host (tramp-file-name-host vec))
(domain (tramp-file-name-domain vec))
(port (tramp-file-name-port vec))
+ (options tramp-smb-options)
args)
(cond
(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))))
;;
;; * 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
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))))
(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)
(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)
(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)
(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)
;; 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
;; For more detailed instructions, please see the info file.
;;
;; Notes:
-;; -----
+;; ------
;;
;; Also see the todo list at the bottom of this file.
;;
;;
;; 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
;;
(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
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.
"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
(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))))))
(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))))
;; 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
;; 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)))
(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)))))))))))
(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."
(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))
(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.
(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.
;; 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))
(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)
(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)))))
(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)))
(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."
(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
"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.
(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))
(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
;; 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.
;; 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)
;; 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)))
(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")
(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
(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)
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))
(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.
(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
(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)
(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)))
: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
(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)
(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))
(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))
(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))
(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)))
: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))
;; 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.
;; Cleanup.
(ignore-errors
(delete-process proc)
- (delete-file tmp-name)))
+ (delete-file tmp-name1)))
;; Process filter.
(unwind-protect
: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))
: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.
(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
+ ;; 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))))
+
+ ;; 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
- (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)))))
+ (insert-file-contents tmpfile)
+ (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 (delete-file tmpfile)))))))
(ert-deftest tramp-test31-interrupt-process ()
"Check `interrupt-process'."
;; 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))
(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
;; 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 ()
(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'.
+ ;; 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 (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
- (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))
+ (tramp--test-async-shell-command
+ "read line; ls $line" (current-buffer) nil
+ ;; String to be sent.
+ (format "%s\n" (file-name-nondirectory tmp-name)))
(should
(string-equal
- (format "%s\n" (file-name-nondirectory tmp-name))
+ ;; 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 sending string to `async-shell-command'.
+ ;; 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
- (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))
- (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)))
- (buffer-string))))
+ (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 (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"))))))))
+ (ignore-errors (kill-buffer buffer))))))
;; This test is inspired by Bug#23952.
(ert-deftest tramp-test33-environment-variables ()
;; 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))))
;; * 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?
projects / emacs.git / commitdiff