Make Tramp's async processes more robust

* lisp/simple.el (shell-command-sentinel): Check process property
`remote-command' first.

* lisp/net/tramp.el (tramp-handle-make-process):
* lisp/net/tramp-androidsu.el (tramp-androidsu-handle-make-process):
Set sentinel `ignore'.  (Bug#71049)

* test/lisp/net/tramp-tests.el
(tramp--test-deftest-direct-async-process): Don't suppress
internal sentinel.
(tramp-test32-shell-commanddirect-async): Don't tag it :unstable.

(cherry picked from commit 91509d5d2a2dc818830cff63f13d6efcb229dc0c)

diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el
index 95b852d20683f35e529c10879011b83ad4fa95f1..b2f0bab650d91010a1c672b34be881c9857ec62e 100644 (file)
--- a/lisp/net/tramp-androidsu.el
+++ b/lisp/net/tramp-androidsu.el
@@ -385,6 +385,8 @@ FUNCTION."
           ;; Generate a command to start the process using `su' with
           ;; suitable options for specifying the mount namespace and
           ;; suchlike.
+         ;; Suppress `internal-default-process-sentinel', which is
+         ;; set when :sentinel is nil.  (Bug#71049)
          (setq
           p (let ((android-use-exec-loader nil))
                (make-process
@@ -407,7 +409,7 @@ FUNCTION."
                :coding coding
                 :noquery noquery
                 :connection-type connection-type
-               :sentinel sentinel
+               :sentinel (or sentinel #'ignore)
                 :stderr stderr)))
          ;; Set filter.  Prior Emacs 29.1, it doesn't work reliably
          ;; to provide it as `make-process' argument when filter is

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3e80bb4b8ebc6b65f87c712f49d4f2badb5c1d0a..63f1b39c458b52f88a44813f65648350ba34a2af 100644 (file)
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5001,9 +5001,9 @@ should be set conmnection-local.")
                      (string-join command) (tramp-get-remote-pipe-buf v)))
            (signal 'error (cons "Command too long:" command)))
 
-         ;; Replace `login-args' place holders.  Split ControlMaster
-         ;; options.
          (setq
+          ;; Replace `login-args' place holders.  Split ControlMaster
+          ;; options.
           login-args
           (append
            (flatten-tree (tramp-get-method-parameter v 'tramp-async-args))
@@ -5015,11 +5015,13 @@ should be set conmnection-local.")
               ?h (or host "") ?u (or user "") ?p (or port "")
               ?c (format-spec (or options "") (format-spec-make ?t tmpfile))
               ?d (or device "") ?a (or pta "") ?l ""))))
+          ;; Suppress `internal-default-process-sentinel', which is
+          ;; set when :sentinel is nil.  (Bug#71049)
           p (make-process
              :name name :buffer buffer
              :command (append `(,login-program) login-args command)
              :coding coding :noquery noquery :connection-type connection-type
-             :sentinel sentinel :stderr stderr))
+             :sentinel (or sentinel #'ignore) :stderr stderr))
          ;; Set filter.  Prior Emacs 29.1, it doesn't work reliably
          ;; to provide it as `make-process' argument when filter is
          ;; t.  See Bug#51177.

diff --git a/lisp/simple.el b/lisp/simple.el
index 34ca26392aa70fa3bc69ce4febb13c186513a2ed..6757ecce8013743c39ba23768854becb44101594 100644 (file)
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4913,11 +4913,14 @@ and are used only if a pop-up buffer is displayed."
 ;; We have a sentinel to prevent insertion of a termination message
 ;; in the buffer itself, and to set the point in the buffer when
 ;; `shell-command-dont-erase-buffer' is non-nil.
+;; For remote shells, `process-command' does not serve the proper shell
+;; command.  We use process property `remote-command' instead.  (Bug#71049)
 (defun shell-command-sentinel (process signal)
   (when (memq (process-status process) '(exit signal))
     (shell-command-set-point-after-cmd (process-buffer process))
     (message "%s: %s."
-             (car (cdr (cdr (process-command process))))
+             (car (cdr (cdr (or (process-get process 'remote-command)
+                                (process-command process)))))
              (substring signal 0 -1))))
 
 (defun shell-command-on-region (start end command

diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 6932bbdc4fecfa05f38a03bf2855cb8bb7a05589..474bb4c350cdd60016dfe80f65bca6ba164e9863 100644 (file)
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -5081,10 +5081,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
        ;; We do expect an established connection already,
        ;; `file-truename' does it by side-effect.  Suppress
        ;; `tramp--test-enabled', in order to keep the connection.
-       ;; Suppress "Process ... finished" messages.
-       (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp-compat-always)
-                ((symbol-function #'internal-default-process-sentinel)
-                 #'ignore))
+       (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp-compat-always))
         (file-truename ert-remote-temporary-file-directory)
         (funcall (ert-test-body ert-test))))))
 
@@ -5627,7 +5624,7 @@ INPUT, if non-nil, is a string sent to the process."
       (when (natnump cols)
        (should (= cols async-shell-command-width))))))
 
-(tramp--test-deftest-direct-async-process tramp-test32-shell-command 'unstable)
+(tramp--test-deftest-direct-async-process tramp-test32-shell-command)
 
 ;; This test is inspired by Bug#39067.
 (ert-deftest tramp-test32-shell-command-dont-erase-buffer ()