[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 65441a6: Add remote processes to Tramp sshfs method
|
From: |
Michael Albinus |
|
Subject: |
master 65441a6: Add remote processes to Tramp sshfs method |
|
Date: |
Thu, 11 Mar 2021 11:17:00 -0500 (EST) |
branch: master
commit 65441a6fab7a24d2433411119191002cb366c96d
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Add remote processes to Tramp sshfs method
* 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.
---
doc/misc/tramp.texi | 11 ++--
lisp/net/tramp-cache.el | 22 +++++---
lisp/net/tramp-sh.el | 128 ++++++++++++++++---------------------------
lisp/net/tramp-sshfs.el | 117 +++++++++++++++++++++++++++------------
lisp/net/tramp-sudoedit.el | 22 +++-----
lisp/net/tramp.el | 57 ++++++++++---------
test/lisp/net/tramp-tests.el | 68 +++++++++++------------
7 files changed, 226 insertions(+), 199 deletions(-)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 5958162..e5e15cd 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -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
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index c79a3a0..2fcb7b1 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -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."
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7f6ecc6..14abf55 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -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
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index feb64b8..ce9412c 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -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))))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index e181365..66737e6 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -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.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9f65608..da779d3 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -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)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index d9a8065..6565919 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -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)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 65441a6: Add remote processes to Tramp sshfs method,
Michael Albinus <=