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 62bcf9c73b3920777276f32df025f7e49ae6e757..c527f3e8068fecc920a49c8ae104ad98ecdc49f8 100644 (file)
--- 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 ce90943d9a682def0c337d6409489b167537a2ac..ab20185d5ade5e7e5f7df1096c2ce1c27295e1c7 100644 (file)
--- 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 805be8270a4bdcfde29aa8fffd321649f1f38b7a..3ab5e4d169afe1db00caa51cdb4502e615879fb0 100644 (file)
--- 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 bbc5499ae7281a73c421f0458e717f37cdbf6cb8..db6b0fc174d34071e9d0cecede3ff51fae01464a 100644 (file)
--- 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 580cfea1f85d5d3837d1ff6707a01675fd3d88ca..4e5eed9d997c7912e8277c84fa2ff846d20d4019 100644 (file)
--- 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 f34fdbdaf7924c3dd30f9aee7691d8d47733d6b1..94ff12bab4d335612ac37a0e8f669e1f54107910 100644 (file)
--- 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))