[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 973608e358: Handle process property `remote-command' in Tramp
|
From: |
Michael Albinus |
|
Subject: |
master 973608e358: Handle process property `remote-command' in Tramp |
|
Date: |
Tue, 29 Mar 2022 13:36:43 -0400 (EDT) |
branch: master
commit 973608e35895a8f89a3abcac43dfaf89598b0c82
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Handle process property `remote-command' in Tramp
* doc/misc/tramp.texi (Remote processes): New subsection "Process
properties of asynchronous remote processes".
* lisp/net/tramp.el (tramp-handle-make-process):
* lisp/net/tramp-adb.el (tramp-adb-handle-make-process):
* lisp/net/tramp-smb.el (tramp-smb-handle-start-file-process):
* lisp/net/tramp-sh.el (tramp-sh-handle-make-process)
Set `remote-command' process property.
(tramp-scp-direct-remote-copying): Rename connection property.
* test/lisp/net/tramp-tests.el (tramp-test29-start-file-process)
(tramp-test30-make-process, tramp-test31-interrupt-process)
(tramp--test-async-shell-command): Check process property
`remote-command'.
---
doc/misc/tramp.texi | 29 ++++++++++++
lisp/net/tramp-adb.el | 4 ++
lisp/net/tramp-sh.el | 7 ++-
lisp/net/tramp-smb.el | 10 +++-
lisp/net/tramp.el | 3 ++
test/lisp/net/tramp-tests.el | 109 +++++++++++++++++++++++++++----------------
6 files changed, 120 insertions(+), 42 deletions(-)
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 62bcf9c73b..c527f3e806 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -2913,6 +2913,7 @@ 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
@cindex android shell setup for ssh
@@ -4019,6 +4020,34 @@ using the @code{:connection-type} keyword. If this
keyword is not
used, the value of @code{process-connection-type} is applied instead.
+@subsection Process properties of asynchronous remote processes
+@cindex Asynchronous remote processes
+
+When available, @value{tramp} adds process properties to process
+objects of asynchronous properties. However, it is not guaranteed
+that all these properties are set.
+
+@itemize
+@item @code{remote-tty}
+
+This is the name of the terminal a @var{process} uses on the remote
+host, i.e., it reads and writes on.
+
+@item @code{remote-pid}
+
+The process id of the command executed on the remote host. This is
+used when sending signals remotely.
+
+@item @code{remote-command}
+
+The remote command which has been invoked via @code{make-process} or
+@code{start-file-process}, a list of strings (program and its
+arguments). This does not show the additional shell sugar
+@value{tramp} makes around the commands, in order to see this you must
+inspect @value{tramp} @ref{Traces and Profiles, traces}.
+@end itemize
+
+
@anchor{Improving performance of asynchronous remote processes}
@subsection Improving performance of asynchronous remote processes
@cindex Asynchronous remote processes
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index ce90943d9a..ab20185d5a 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -973,6 +973,7 @@ implementation will be used."
(tramp-make-tramp-temp-file v))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (orig-command command)
(program (car command))
(args (cdr command))
(command
@@ -1030,6 +1031,9 @@ implementation will be used."
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
;; Set query flag and process marker for
;; this process. We ignore errors, because
;; the process could have finished already.
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 805be8270a..3ab5e4d169 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2856,6 +2856,7 @@ implementation will be used."
stderr (tramp-make-tramp-temp-name v)))))
(remote-tmpstderr
(and tmpstderr (tramp-make-tramp-file-name v tmpstderr)))
+ (orig-command command)
(program (car command))
(args (cdr command))
;; When PROGRAM matches "*sh", and the first arg is
@@ -3012,6 +3013,9 @@ implementation will be used."
(set-process-sentinel p sentinel))
(when filter
(set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property
+ p "remote-command" orig-command)
;; Set query flag and process marker for this
;; process. We ignore errors, because the
;; process could have finished already.
@@ -4877,7 +4881,8 @@ Goes through the list `tramp-inline-compress-commands'."
"\\(illegal\\|unknown\\) option -- R" nil 'noerror)))))
;; Check, that RemoteCommand is not used.
- (with-tramp-connection-property (tramp-get-process vec1)
"remote-command"
+ (with-tramp-connection-property
+ (tramp-get-process vec1) "ssh-remote-command"
(let ((command `("ssh" "-G" ,(tramp-file-name-host vec1))))
(with-temp-buffer
(tramp-call-process
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index bbc5499ae7..db6b0fc174 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1544,7 +1544,8 @@ component is used as the target of the symlink."
(command (string-join (cons program args) " "))
(bmp (and (buffer-live-p buffer) (buffer-modified-p buffer)))
(name1 name)
- (i 0))
+ (i 0)
+ p)
(unwind-protect
(save-excursion
(save-restriction
@@ -1567,8 +1568,13 @@ component is used as the target of the symlink."
host (file-name-directory localname))))
(tramp-message v 6 "(%s); exit" command)
(tramp-send-string v command)))
+ (setq p (tramp-get-connection-process v))
+ (when program
+ (process-put p 'remote-command (cons program args))
+ (tramp-set-connection-property
+ p "remote-command" (cons program args)))
;; Return value.
- (tramp-get-connection-process v)))
+ p))
;; Save exit.
(with-current-buffer (tramp-get-connection-buffer v)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 580cfea1f8..4e5eed9d99 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4316,6 +4316,7 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(get-buffer-create buffer)
;; BUFFER can be nil. We use a temporary buffer.
(generate-new-buffer tramp-temp-buffer-name)))
+ (orig-command command)
(env (mapcar
(lambda (elt)
(when (tramp-compat-string-search "=" elt) elt))
@@ -4391,6 +4392,8 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
;; t. See Bug#51177.
(when filter
(set-process-filter p filter))
+ (process-put p 'remote-command orig-command)
+ (tramp-set-connection-property p "remote-command" orig-command)
(tramp-message v 6 "%s" (string-join (process-command p) " "))
p))))))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index f34fdbdaf7..94ff12bab4 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4540,14 +4540,17 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
- kill-buffer-query-functions proc)
+ kill-buffer-query-functions command proc)
;; Simple process.
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process "test1" (current-buffer) "cat"))
+ (setq command '("cat")
+ proc
+ (apply #'start-file-process "test1" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
@@ -4564,11 +4567,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
- (setq proc
- (start-file-process
- "test2" (current-buffer)
- "cat" (file-name-nondirectory tmp-name)))
+ (setq command `("cat" ,(file-name-nondirectory tmp-name))
+ proc
+ (apply #'start-file-process "test2" (current-buffer) command))
(should (processp proc))
+ (should (equal (process-get proc 'remote-command) command))
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
@@ -4583,9 +4586,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; Process filter.
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process "test3" (current-buffer) "cat"))
+ (setq command '("cat")
+ proc
+ (apply #'start-file-process "test3" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(set-process-filter
proc
(lambda (p s) (with-current-buffer (process-buffer p) (insert s))))
@@ -4604,9 +4610,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(unless (tramp--test-sshfs-p)
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process "test3" (current-buffer) "cat"))
+ (setq command '("cat")
+ proc
+ (apply #'start-file-process "test4" (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(set-process-filter proc t)
(process-send-string proc "foo\n")
(process-send-eof proc)
@@ -4632,12 +4641,14 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(dolist (process-connection-type '(nil pipe t pty))
(unwind-protect
(with-temp-buffer
- (setq proc
- (start-file-process
- (format "test4-%s" process-connection-type)
- (current-buffer) "hexdump" "-v" "-e" "/1 \"%02X\n\""))
+ (setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ proc
+ (apply #'start-file-process
+ (format "test5-%s" process-connection-type)
+ (current-buffer) command))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
;; Read output.
@@ -4665,12 +4676,13 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; It works only for tramp-sh.el, and not direct async processes.
(if (or (not (tramp--test-sh-p)) (tramp-direct-async-process-p))
(should-error
- (start-file-process "test5" (current-buffer) nil)
+ (start-file-process "test6" (current-buffer) nil)
:type 'wrong-type-argument)
- (setq proc (start-file-process "test5" (current-buffer) nil))
+ (setq proc (start-file-process "test6" (current-buffer) nil))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should-not (process-get proc 'remote-command))
;; On MS Windows, `process-tty-name' returns nil.
(unless (tramp--test-windows-nt-p)
(should (stringp (process-tty-name proc))))))
@@ -4724,19 +4736,21 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((default-directory tramp-test-temporary-file-directory)
(tmp-name (tramp--test-make-temp-name nil quoted))
- kill-buffer-query-functions proc)
+ kill-buffer-query-functions command proc)
(with-no-warnings (should-not (make-process)))
;; Simple process.
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat")
+ proc
(with-no-warnings
(make-process
- :name "test1" :buffer (current-buffer) :command '("cat")
+ :name "test1" :buffer (current-buffer) :command command
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
@@ -4753,13 +4767,14 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
- (setq proc
+ (setq command `("cat" ,(file-name-nondirectory tmp-name))
+ proc
(with-no-warnings
(make-process
- :name "test2" :buffer (current-buffer)
- :command `("cat" ,(file-name-nondirectory tmp-name))
+ :name "test2" :buffer (current-buffer) :command command
:file-handler t)))
(should (processp proc))
+ (should (equal (process-get proc 'remote-command) command))
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (< (- (point-max) (point-min)) (length "foo"))
@@ -4774,16 +4789,18 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; Process filter.
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat")
+ proc
(with-no-warnings
(make-process
- :name "test3" :buffer (current-buffer) :command '("cat")
+ :name "test3" :buffer (current-buffer) :command command
:filter
(lambda (p s)
(with-current-buffer (process-buffer p) (insert s)))
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output.
@@ -4799,14 +4816,16 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(unless (tramp--test-sshfs-p)
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat")
+ proc
(with-no-warnings
(make-process
- :name "test3" :buffer (current-buffer) :command '("cat")
+ :name "test4" :buffer (current-buffer) :command command
:filter t
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
;; Read output. There shouldn't be any.
@@ -4822,16 +4841,18 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; Process sentinel.
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat")
+ proc
(with-no-warnings
(make-process
- :name "test4" :buffer (current-buffer) :command '("cat")
+ :name "test5" :buffer (current-buffer) :command command
:sentinel
(lambda (p s)
(with-current-buffer (process-buffer p) (insert s)))
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\n")
(process-send-eof proc)
(delete-process proc)
@@ -4850,14 +4871,15 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(let ((stderr (generate-new-buffer "*stderr*")))
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat" "/does-not-exist")
+ proc
(with-no-warnings
(make-process
- :name "test5" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
+ :name "test6" :buffer (current-buffer) :command
command
:stderr stderr
:file-handler t)))
(should (processp proc))
+ (should (equal (process-get proc 'remote-command) command))
;; Read output.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc 0 nil t)))
@@ -4881,14 +4903,15 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(unless (tramp-direct-async-process-p)
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("cat" "/does-not-exist")
+ proc
(with-no-warnings
(make-process
- :name "test6" :buffer (current-buffer)
- :command '("cat" "/does-not-exist")
+ :name "test7" :buffer (current-buffer) :command command
:stderr tmp-name
:file-handler t)))
(should (processp proc))
+ (should (equal (process-get proc 'remote-command) command))
;; Read stderr.
(with-timeout (10 (tramp--test-timeout-handler))
(while (accept-process-output proc nil nil t)))
@@ -4919,18 +4942,20 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(unless connection-type '(nil pipe t pty)))
(unwind-protect
(with-temp-buffer
- (setq proc
+ (setq command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ proc
(with-no-warnings
(make-process
:name
- (format "test7-%s-%s"
+ (format "test8-%s-%s"
connection-type process-connection-type)
:buffer (current-buffer)
:connection-type connection-type
- :command '("hexdump" "-v" "-e" "/1 \"%02X\n\"")
+ :command command
:file-handler t)))
(should (processp proc))
(should (equal (process-status proc) 'run))
+ (should (equal (process-get proc 'remote-command) command))
(process-send-string proc "foo\r\n")
(process-send-eof proc)
;; Read output.
@@ -4970,16 +4995,19 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; process.
(let ((default-directory (file-truename tramp-test-temporary-file-directory))
(delete-exited-processes t)
- kill-buffer-query-functions proc)
+ kill-buffer-query-functions command proc)
(unwind-protect
(with-temp-buffer
- (setq proc (start-file-process-shell-command
- "test" (current-buffer)
- "trap 'echo boom; exit 1' 2; sleep 100"))
+ (setq command "trap 'echo boom; exit 1' 2; sleep 100"
+ proc (start-file-process-shell-command
+ "test" (current-buffer) command))
(should (processp proc))
(should (process-live-p proc))
(should (equal (process-status proc) 'run))
(should (numberp (process-get proc 'remote-pid)))
+ (should (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command))))
(should (interrupt-process proc))
;; Let the process accept the interrupt.
(with-timeout (10 (tramp--test-timeout-handler))
@@ -5000,6 +5028,9 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
INPUT, if non-nil, is a string sent to the process."
(let ((proc (async-shell-command command output-buffer error-buffer))
(delete-exited-processes t))
+ (should (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command))))
(cl-letf (((symbol-function #'shell-command-sentinel) #'ignore))
(when (stringp input)
(process-send-string proc input))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 973608e358: Handle process property `remote-command' in Tramp,
Michael Albinus <=