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

Add remote processes to Tramp sshfs method

Browse source 
* doc/misc/tramp.texi (FUSE setup): Method sshfs supports also
remote processes.

* lisp/net/tramp-cache.el (tramp-get-file-property)
(tramp-set-file-property): Move setting of
`tramp-cache-unload-hook' out of function.

* lisp/net/tramp.el (tramp-expand-args): New defun.
(tramp-handle-make-process):
* lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
(tramp-maybe-open-connection):
* lisp/net/tramp-sshfs.el (tramp-sshfs-maybe-open-connection):
* lisp/net/tramp-sudoedit.el (tramp-sudoedit-send-command): Use it.

* lisp/net/tramp-sshfs.el (tramp-methods) <sshfs>:
Adapt `tramp-mount-args'.  Add `tramp-login-args',
`tramp-direct-async', `tramp-remote-shell',
`tramp-remote-shell-login' and `tramp-remote-shell-args'.
(tramp-connection-properties): Set "direct-async-process" fir sshfs.
(tramp-sshfs-file-name-handler-alist): Add `exec-path',
`make-process', `process-file', `set-file-modes', `shell-command',
`start-file-process', `tramp-get-remote-gid',
`tramp-get-remote-uid' and `tramp-set-file-uid-gid'.
(tramp-sshfs-handle-exec-path, tramp-sshfs-handle-process-file)
(tramp-sshfs-handle-set-file-modes): New defuns.

* test/lisp/net/tramp-tests.el (tramp-test20-file-modes)
(tramp-test28-process-file, tramp-test29-start-file-process)
(tramp-test30-make-process, tramp-test32-shell-command)
(tramp-test32-shell-command-dont-erase-buffer)
(tramp-test34-explicit-shell-file-name, tramp-test35-exec-path)
(tramp-test43-asynchronous-requests): Run also for tramp-sshfs.
(tramp--test-shell-file-name): New defun.
(tramp-test28-process-file)
(tramp-test34-explicit-shell-file-name)
(tramp-test43-asynchronous-requests): Use it.
(tramp-test40-special-characters-with-stat)
(tramp-test40-special-characters-with-perl)
(tramp-test40-special-characters-with-ls)
(tramp-test41-utf8-with-stat, tramp-test41-utf8-with-perl)
(tramp-test41-utf8-with-ls): Remove superfluous skip.
This commit is contained in:
Michael Albinus 2021-03-11 17:16:50 +01:00
parent 62610da8c4
commit 65441a6fab
7 changed files with 226 additions and 199 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
doc/misc/tramp.texi
View file

@ -2648,11 +2648,14 @@ visibility of files.
@subsection @option{sshfs} setup
@cindex sshfs setup
The method @option{sshfs} declares only the mount arguments, passed to
the @command{sshfs} command. This is a list of list of strings, and
can be overwritten by the connection property @t{"mount-args"},
@xref{Predefined connection information}.
The method @option{sshfs} declares the mount arguments in the variable
@code{tramp-methods}, passed to the @command{sshfs} command. This is
a list of list of strings, and can be overwritten by the connection
property @t{"mount-args"}, @xref{Predefined connection information}.
Additionally. it declares also the arguments for running remote
processes, using the @command{ssh} command. These don't need to be
changed.
@node Android shell setup
@section Android shell setup hints

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

@ -162,17 +162,20 @@ Return DEFAULT if not set."
(tramp-message
key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
file property value remote-file-name-inhibit-cache cache-used cached-at)
;; For analysis purposes, count the number of getting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
(val (or (and (boundp var) (numberp (symbol-value var))
(symbol-value var))
(progn
(add-hook 'tramp-cache-unload-hook
(lambda () (makunbound var)))
0))))
0)))
(set var (1+ val))))
value))
(add-hook 'tramp-cache-unload-hook
(lambda ()
(dolist (var (all-completions "tramp-cache-get-count-" obarray))
(unintern var obarray))))
;;;###tramp-autoload
(defun tramp-set-file-property (key file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of KEY.
@ -187,17 +190,20 @@ Return VALUE."
;; We put the timestamp there.
(puthash property (cons (current-time) value) hash)
(tramp-message key 8 "%s %s %s" file property value)
;; For analysis purposes, count the number of setting this file attribute.
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
(val (or (and (boundp var) (numberp (symbol-value var))
(symbol-value var))
(progn
(add-hook 'tramp-cache-unload-hook
(lambda () (makunbound var)))
0))))
0)))
(set var (1+ val))))
value))
(add-hook 'tramp-cache-unload-hook
(lambda ()
(dolist (var (all-completions "tramp-cache-set-count-" obarray))
(unintern var obarray))))
;;;###tramp-autoload
(defun tramp-flush-file-property (key file property)
"Remove PROPERTY of FILE in the cache context of KEY."

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

@ -2370,53 +2370,29 @@ The method used must be an out-of-band method."
(setq listener (number-to-string (+ 50000 (random 10000))))))
;; Compose copy command.
(setq host (or host "")
user (or user "")
port (or port "")
spec (format-spec-make
?t (tramp-get-connection-property
(tramp-get-connection-process v) "temp-file" ""))
options (format-spec (tramp-ssh-controlmaster-options v) spec)
spec (format-spec-make
?h host ?u user ?p port ?r listener ?c options
?k (if keep-date " " "")
(setq options
(format-spec
(tramp-ssh-controlmaster-options v)
(format-spec-make
?t (tramp-get-connection-property
(tramp-get-connection-process v) "temp-file" "")))
spec (list
?h (or host "") ?u (or user "") ?p (or port "")
?r listener ?c options ?k (if keep-date " " "")
?n (concat "2>" (tramp-get-remote-null-device v)))
copy-program (tramp-get-method-parameter v 'tramp-copy-program)
copy-keep-date (tramp-get-method-parameter
v 'tramp-copy-keep-date)
copy-args
(delete
;; " " has either been a replacement of "%k" (when
;; keep-date argument is non-nil), or a replacement
;; for the whole keep-date sublist.
" "
(dolist
(x (tramp-get-method-parameter v 'tramp-copy-args) copy-args)
(setq copy-args
(append
copy-args
(let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
(unless (member "" y) y))))))
copy-env
(delq
nil
(mapcar
(lambda (x)
(setq x (mapcar (lambda (y) (format-spec y spec)) x))
(unless (member "" x) (string-join x " ")))
(tramp-get-method-parameter v 'tramp-copy-env)))
;; " " has either been a replacement of "%k" (when
;; keep-date argument is non-nil), or a replacement for
;; the whole keep-date sublist.
(delete " " (apply #'tramp-expand-args v 'tramp-copy-args spec))
copy-env (apply #'tramp-expand-args v 'tramp-copy-env spec)
remote-copy-program
(tramp-get-method-parameter v 'tramp-remote-copy-program))
(dolist (x (tramp-get-method-parameter v 'tramp-remote-copy-args))
(setq remote-copy-args
(append
remote-copy-args
(let ((y (mapcar (lambda (z) (format-spec z spec)) x)))
(unless (member "" y) y)))))
(tramp-get-method-parameter v 'tramp-remote-copy-program)
remote-copy-args
(apply #'tramp-expand-args v 'tramp-remote-copy-args spec))
;; Check for local copy program.
(unless (executable-find copy-program)
@ -2462,10 +2438,11 @@ The method used must be an out-of-band method."
v "process-name" (buffer-name (current-buffer)))
(tramp-set-connection-property
v "process-buffer" (current-buffer))
(while copy-env
(when copy-env
(tramp-message
orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env))
(setenv (pop copy-env) (pop copy-env)))
orig-vec 6 "%s=\"%s\""
(car copy-env) (string-join (cdr copy-env) " "))
(setenv (car copy-env) (string-join (cdr copy-env) " ")))
(setq
copy-args
(append
@ -5049,19 +5026,17 @@ connection if a previous connection has died for some reason."
(l-domain (tramp-file-name-domain hop))
(l-host (tramp-file-name-host hop))
(l-port (tramp-file-name-port hop))
(login-program
(tramp-get-method-parameter hop 'tramp-login-program))
(login-args
(tramp-get-method-parameter hop 'tramp-login-args))
(remote-shell
(tramp-get-method-parameter hop 'tramp-remote-shell))
(extra-args (tramp-get-sh-extra-args remote-shell))
(async-args
(tramp-get-method-parameter hop 'tramp-async-args))
(tramp-compat-flatten-tree
(tramp-get-method-parameter hop 'tramp-async-args)))
(connection-timeout
(tramp-get-method-parameter
hop 'tramp-connection-timeout))
(command login-program)
(command
(tramp-get-method-parameter hop 'tramp-login-program))
;; We don't create the temporary file. In
;; fact, it is just a prefix for the
;; ControlPath option of ssh; the real
@ -5075,11 +5050,7 @@ connection if a previous connection has died for some reason."
(with-tramp-connection-property
(tramp-get-process vec) "temp-file"
(tramp-compat-make-temp-name)))
spec r-shell)
;; Add arguments for asynchronous processes.
(when (and process-name async-args)
(setq login-args (append async-args login-args)))
r-shell)
;; Check, whether there is a restricted shell.
(dolist (elt tramp-restricted-shell-hosts-alist)
@ -5104,31 +5075,28 @@ connection if a previous connection has died for some reason."
;; Replace `login-args' place holders.
(setq
l-host (or l-host "")
l-user (or l-user "")
l-port (or l-port "")
spec (format-spec-make ?t tmpfile)
options (format-spec options spec)
spec (format-spec-make
?h l-host ?u l-user ?p l-port ?c options
?l (concat remote-shell " " extra-args " -i"))
command
(concat
;; We do not want to see the trailing local
;; prompt in `start-file-process'.
(unless r-shell "exec ")
command " "
(mapconcat
(lambda (x)
(setq x (mapcar (lambda (y) (format-spec y spec)) x))
(unless (member "" x) (string-join x " ")))
login-args " ")
;; Local shell could be a Windows COMSPEC. It
;; doesn't know the ";" syntax, but we must exit
;; always for `start-file-process'. It could
;; also be a restricted shell, which does not
;; allow "exec".
(when r-shell " && exit || exit")))
(mapconcat
#'identity
(append
;; We do not want to see the trailing local
;; prompt in `start-file-process'.
(unless r-shell '("exec"))
`(,command)
;; Add arguments for asynchronous processes.
(when process-name async-args)
(tramp-expand-args
hop 'tramp-login-args
?h (or l-host "") ?u (or l-user "") ?p (or l-port "")
?c (format-spec options (format-spec-make ?t tmpfile))
?l (concat remote-shell " " extra-args " -i"))
;; Local shell could be a Windows COMSPEC. It
;; doesn't know the ";" syntax, but we must
;; exit always for `start-file-process'. It
;; could also be a restricted shell, which does
;; not allow "exec".
(when r-shell '("&&" "exit" "||" "exit")))
" "))
;; Send the command.
(tramp-message vec 3 "Sending command `%s'" command)
@ -5469,7 +5437,7 @@ Nonexistent directories are removed from spec."
(progn
(tramp-message
vec 3
"`getconf PATH' not successful, using default value \"%s\"."
"`getconf PATH' not successful, using default value \"%s\"."
"/bin:/usr/bin")
"/bin:/usr/bin"))))
(own-remote-path

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

@ -51,9 +51,19 @@
(tramp--with-startup
(add-to-list 'tramp-methods
`(,tramp-sshfs-method
(tramp-mount-args
(("-p" "%p")
("-o" "idmap=user,reconnect")))))
(tramp-mount-args (("-C") ("-p" "%p")
("-o" "idmap=user,reconnect")))
;; These are for remote processes.
(tramp-login-program "ssh")
(tramp-login-args (("-q")("-l" "%u") ("-p" "%p")
("-e" "none") ("%h") ("%l")))
(tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))))
(add-to-list 'tramp-connection-properties
`(,(format "/%s:" tramp-sshfs-method) "direct-async-process" t))
(tramp-set-completion-function
tramp-sshfs-method tramp-completion-function-alist-ssh))
@ -76,7 +86,7 @@
. tramp-handle-directory-files-and-attributes)
(dired-compress-file . ignore)
(dired-uncache . tramp-handle-dired-uncache)
;; (exec-path . ignore)
(exec-path . tramp-sshfs-handle-exec-path)
(expand-file-name . tramp-handle-expand-file-name)
(file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
(file-acl . ignore)
@ -117,22 +127,22 @@
(make-directory . tramp-fuse-handle-make-directory)
(make-directory-internal . ignore)
(make-nearby-temp-file . tramp-handle-make-nearby-temp-file)
;; (make-process . ignore)
(make-process . tramp-handle-make-process)
(make-symbolic-link . tramp-handle-make-symbolic-link)
;; (process-file . ignore)
(process-file . tramp-sshfs-handle-process-file)
(rename-file . tramp-sshfs-handle-rename-file)
(set-file-acl . ignore)
(set-file-modes . ignore)
(set-file-modes . tramp-sshfs-handle-set-file-modes)
(set-file-selinux-context . ignore)
(set-file-times . ignore)
(set-visited-file-modtime . tramp-handle-set-visited-file-modtime)
;; (shell-command . ignore)
;; (start-file-process . ignore)
(shell-command . tramp-handle-shell-command)
(start-file-process . tramp-handle-start-file-process)
(substitute-in-file-name . tramp-handle-substitute-in-file-name)
(temporary-file-directory . tramp-handle-temporary-file-directory)
;; (tramp-get-remote-gid . ignore)
;; (tramp-get-remote-uid . ignore)
;; (tramp-set-file-uid-gid . ignore)
(tramp-get-remote-gid . ignore)
(tramp-get-remote-uid . ignore)
(tramp-set-file-uid-gid . ignore)
(unhandled-file-name-directory . ignore)
(vc-registered . ignore)
(verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
@ -185,6 +195,22 @@ arguments to pass to the OPERATION."
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-properties v localname)))))
(defun tramp-sshfs-handle-exec-path ()
"Like `exec-path' for Tramp files."
(append
(with-parsed-tramp-file-name default-directory nil
(with-tramp-connection-property (tramp-get-process v) "remote-path"
(with-temp-buffer
(process-file "getconf" nil t nil "PATH")
(split-string
(progn
;; Read the expression.
(goto-char (point-min))
(buffer-substring (point) (point-at-eol)))
":" 'omit))))
;; The equivalent to `exec-directory'.
`(,(tramp-file-local-name (expand-file-name default-directory)))))
(defun tramp-sshfs-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
;;`file-system-info' exists since Emacs 27.1.
@ -199,6 +225,34 @@ arguments to pass to the OPERATION."
(when visit (setq buffer-file-name filename))
(cons (expand-file-name filename) (cdr result))))
(defun tramp-sshfs-handle-process-file
(program &optional infile destination display &rest args)
"Like `process-file' for Tramp files."
;; The implementation is not complete yet.
(when (and (numberp destination) (zerop destination))
(error "Implementation does not handle immediate return"))
(with-parsed-tramp-file-name default-directory nil
(let ((command
(format
"cd %s && exec %s"
localname
(mapconcat #'tramp-shell-quote-argument (cons program args) " "))))
(unwind-protect
(apply
#'tramp-call-process
v (tramp-get-method-parameter v 'tramp-login-program)
infile destination display
(tramp-expand-args
v 'tramp-login-args
?h (or (tramp-file-name-host v) "")
?u (or (tramp-file-name-user v) "")
?p (or (tramp-file-name-port v) "")
?l command))
(unless process-file-side-effects
(tramp-flush-directory-properties v ""))))))
(defun tramp-sshfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
"Like `rename-file' for Tramp files."
@ -217,6 +271,13 @@ arguments to pass to the OPERATION."
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-properties v localname))))
(defun tramp-sshfs-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
(with-parsed-tramp-file-name filename nil
(unless (and (eq flag 'nofollow) (file-symlink-p filename))
(tramp-flush-file-properties v localname)
(set-file-modes (tramp-fuse-local-file-name filename) mode flag))))
(defun tramp-sshfs-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
@ -269,28 +330,16 @@ connection if a previous connection has died for some reason."
(unless
(or (tramp-fuse-mounted-p vec)
(let* ((port (or (tramp-file-name-port vec) ""))
(spec (format-spec-make ?p port))
mount-args
(mount-args
(dolist
(x
(tramp-get-method-parameter vec 'tramp-mount-args)
mount-args)
(setq mount-args
(append
mount-args
(let ((y (mapcar
(lambda (z) (format-spec z spec))
x)))
(unless (member "" y) y)))))))
(with-temp-buffer
(zerop
(apply
#'tramp-call-process
vec tramp-sshfs-program nil t nil
(tramp-fuse-mount-spec vec)
(tramp-fuse-mount-point vec) mount-args))))
(with-temp-buffer
(zerop
(apply
#'tramp-call-process
vec tramp-sshfs-program nil t nil
(tramp-fuse-mount-spec vec)
(tramp-fuse-mount-point vec)
(tramp-expand-args
vec 'tramp-mount-args
?p (or (tramp-file-name-port vec) "")))))
(tramp-error
vec 'file-error "Error mounting %s" (tramp-fuse-mount-spec vec))))

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

@ -791,22 +791,16 @@ in case of error, t otherwise."
(tramp-sudoedit-maybe-open-connection vec)
(with-current-buffer (tramp-get-connection-buffer vec)
(erase-buffer)
(let* ((login (tramp-get-method-parameter vec 'tramp-sudo-login))
(host (or (tramp-file-name-host vec) ""))
(user (or (tramp-file-name-user vec) ""))
(spec (format-spec-make ?h host ?u user))
(args (append
(tramp-compat-flatten-tree
(mapcar
(lambda (x)
(setq x (mapcar (lambda (y) (format-spec y spec)) x))
(unless (member "" x) x))
login))
(tramp-compat-flatten-tree (delq nil args))))
(delete-exited-processes t)
(let* ((delete-exited-processes t)
(process-connection-type tramp-process-connection-type)
(p (apply #'start-process
(tramp-get-connection-name vec) (current-buffer) args))
(tramp-get-connection-name vec) (current-buffer)
(append
(tramp-expand-args
vec 'tramp-sudo-login
?h (or (tramp-file-name-host vec) "")
?u (or (tramp-file-name-user vec) ""))
(tramp-compat-flatten-tree args))))
;; We suppress the messages `Waiting for prompts from remote shell'.
(tramp-verbose (if (= tramp-verbose 3) 2 tramp-verbose))
;; We do not want to save the password.

57
lisp/net/tramp.el
View file

@ -3765,6 +3765,22 @@ User is always nil."
;; Result.
target-alist))
(defun tramp-expand-args (vec parameter &rest spec-list)
"Expand login arguments as given by PARAMETER in `tramp-methods'.
PARAMETER is a symbol like `tramp-login-args', denoting a list of
list of strings from `tramp-methods', containing %-sequences for
substitution. SPEC-LIST is a list of char/value pairs used for
`format-spec-make'."
(let ((args (tramp-get-method-parameter vec parameter))
(spec (apply 'format-spec-make spec-list)))
;; Expand format spec.
(tramp-compat-flatten-tree
(mapcar
(lambda (x)
(setq x (mapcar (lambda (y) (format-spec y spec)) x))
(unless (member "" x) x))
args))))
(defun tramp-direct-async-process-p (&rest args)
"Whether direct async `make-process' can be called."
(let ((v (tramp-dissect-file-name default-directory))
@ -3846,14 +3862,11 @@ It does not support `:stderr'."
(append `("cd" ,localname "&&" "(" "env") env `(,command ")"))))
;; Check for `tramp-sh-file-name-handler', because something
;; is different between tramp-adb.el and tramp-sh.el.
;; is different between tramp-sh.el, and tramp-adb.el or
;; tramp-sshfs.el.
(let* ((sh-file-name-handler-p (tramp-sh-file-name-handler-p v))
(login-program
(tramp-get-method-parameter v 'tramp-login-program))
(login-args
(tramp-get-method-parameter v 'tramp-login-args))
(async-args
(tramp-get-method-parameter v 'tramp-async-args))
;; We don't create the temporary file. In fact, it
;; is just a prefix for the ControlPath option of
;; ssh; the real temporary file has another name, and
@ -3871,29 +3884,23 @@ It does not support `:stderr'."
(when sh-file-name-handler-p
(tramp-compat-funcall
'tramp-ssh-controlmaster-options v)))
spec p)
login-args p)
;; Replace `login-args' place holders.
;; Replace `login-args' place holders. Split
;; ControlMaster options.
(setq
spec (format-spec-make ?t tmpfile)
options (format-spec (or options "") spec)
spec (format-spec-make
?h (or host "") ?u (or user "") ?p (or port "")
?c options ?l "")
;; Add arguments for asynchronous processes.
login-args (append async-args login-args)
;; Expand format spec.
login-args
(tramp-compat-flatten-tree
(mapcar
(lambda (x)
(setq x (mapcar (lambda (y) (format-spec y spec)) x))
(unless (member "" x) x))
login-args))
;; Split ControlMaster options.
login-args
(tramp-compat-flatten-tree
(mapcar (lambda (x) (split-string x " ")) login-args))
(append
(tramp-compat-flatten-tree
(tramp-get-method-parameter v 'tramp-async-args))
(tramp-compat-flatten-tree
(mapcar
(lambda (x) (split-string x " "))
(tramp-expand-args
v 'tramp-login-args
?h (or host "") ?u (or user "") ?p (or port "")
?c (format-spec (or options "") (format-spec-make ?t tmpfile))
?l ""))))
p (make-process
:name name :buffer buffer
:command (append `(,login-program) login-args command)

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

@ -3537,7 +3537,7 @@ They might differ only in time attributes or directory size."
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled))
(skip-unless
(or (tramp--test-sh-p) (tramp--test-sudoedit-p)
(or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p)
;; Not all tramp-gvfs.el methods support changing the file mode.
(and
(tramp--test-gvfs-p)
@ -4368,11 +4368,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
(delete-file tmp-name))))))
(defun tramp--test-shell-file-name ()
"Return default remote shell.."
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
(ert-deftest tramp-test28-process-file ()
"Check `process-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@ -4389,25 +4393,27 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(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")
(tramp--test-shell-file-name)
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 $$"))))
(unless (tramp--test-sshfs-p)
(let (process-file-return-signal-string)
(should
(= (+ 128 2)
(process-file
(tramp--test-shell-file-name)
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-p
"Interrupt\\|Signal 2"
(process-file
(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
nil nil nil "-c" "kill -2 $$"))))
(unless (tramp--test-sshfs-p)
(let ((process-file-return-signal-string t))
(should
(string-match-p
"Interrupt\\|Signal 2"
(process-file
(tramp--test-shell-file-name)
nil nil nil "-c" "kill -2 $$")))))
(with-temp-buffer
(write-region "foo" nil tmp-name)
@ -4451,7 +4457,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Check `start-file-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@ -4571,7 +4577,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
"Check `make-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; `make-process' supports file name handlers since Emacs 27.
(skip-unless (tramp--test-emacs27-p))
@ -4799,7 +4805,7 @@ INPUT, if non-nil, is a string sent to the process."
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
(tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
@ -4898,7 +4904,7 @@ INPUT, if non-nil, is a string sent to the process."
:tags '(:expensive-test :unstable)
(skip-unless (tramp--test-enabled))
(skip-unless nil)
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly.
(skip-unless (tramp--test-emacs27-p))
@ -5223,7 +5229,7 @@ Use direct async.")
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
(tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
@ -5245,8 +5251,7 @@ Use direct async.")
(with-no-warnings
(connection-local-set-profile-variables
'remote-sh
`((explicit-shell-file-name
. ,(if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
`((explicit-shell-file-name . ,(tramp--test-shell-file-name))
(explicit-sh-args . ("-c" "echo foo"))))
(connection-local-set-profiles
`(:application tramp
@ -5280,7 +5285,7 @@ Use direct async.")
(ert-deftest tramp-test35-exec-path ()
"Check `exec-path' and `executable-find'."
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
;; Since Emacs 27.1.
(skip-unless (fboundp 'exec-path))
@ -6120,7 +6125,6 @@ Use the `stat' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@ -6140,7 +6144,6 @@ Use the `perl' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@ -6163,7 +6166,6 @@ Use the `ls' command."
(skip-unless (tramp--test-sh-p))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@ -6249,7 +6251,6 @@ Use the `stat' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-stat v)))
@ -6273,7 +6274,6 @@ Use the `perl' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
;; We cannot use `tramp-test-vec', because this fails during compilation.
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(skip-unless (tramp-get-remote-perl v)))
@ -6300,7 +6300,6 @@ Use the `ls' command."
(skip-unless (not (tramp--test-windows-nt-and-pscp-psftp-p)))
(skip-unless (not (tramp--test-ksh-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (or (tramp--test-emacs26-p) (not (tramp--test-rclone-p))))
(let ((tramp-connection-properties
(append
@ -6341,6 +6340,7 @@ Use the `ls' command."
"Set \"process-name\" and \"process-buffer\" connection properties.
The values are derived from PROC. Run BODY.
This is needed in timer functions as well as process filters and sentinels."
;; FIXME: For tramp-sshfs.el, `processp' does not work.
(declare (indent 1) (debug (processp body)))
`(let* ((v (tramp-get-connection-property ,proc "vector" nil))
(pname (tramp-get-connection-property v "process-name" nil))
@ -6380,7 +6380,7 @@ process sentinels. They shall not disturb each other."
;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for
;; remote processes in Emacs. That doesn't work for tramp-adb.el.
(skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p))
(tramp--test-sh-p)))
(tramp--test-sh-p) (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-crypt-p)))
(skip-unless (not (tramp--test-docker-p)))
(skip-unless (not (tramp--test-windows-nt-p)))
@ -6390,7 +6390,7 @@ process sentinels. They shall not disturb each other."
(define-key special-event-map [sigusr1] #'tramp--test-timeout-handler)
(let* (;; For the watchdog.
(default-directory (expand-file-name temporary-file-directory))
(shell-file-name (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh"))
(shell-file-name (tramp--test-shell-file-name))
;; It doesn't work on w32 systems.
(watchdog
(start-process-shell-command
@ -6765,8 +6765,8 @@ If INTERACTIVE is non-nil, the tests are run interactively."
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
;; * Implement `tramp-test31-interrupt-process' for `adb' and for
;; direct async processes.
;; * Implement `tramp-test31-interrupt-process' for `adb', `sshfs' and
;; for direct async processes.
(provide 'tramp-tests)