From: Michael Albinus Date: Tue, 29 Mar 2022 17:36:28 +0000 (+0200) Subject: Handle process property `remote-command' in Tramp X-Git-Tag: emacs-29.0.90~1931^2~868 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=973608e35895a8f89a3abcac43dfaf89598b0c82;p=emacs.git 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'. --- diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 62bcf9c73b3..c527f3e8068 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 ce90943d9a6..ab20185d5ad 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 805be8270a4..3ab5e4d169a 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 bbc5499ae72..db6b0fc174d 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 580cfea1f85..4e5eed9d997 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 f34fdbdaf79..94ff12bab4d 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))