diff options
| author | Michael Albinus | 2024-05-25 17:23:30 +0200 |
|---|---|---|
| committer | Michael Albinus | 2024-05-25 17:23:30 +0200 |
| commit | 91509d5d2a2dc818830cff63f13d6efcb229dc0c (patch) | |
| tree | 3e1a8e148117c1227894cddd634526d5468e1729 /lisp | |
| parent | 129c6778e640f8ae9ba0eba9ad9ce81b4bf2328e (diff) | |
| download | emacs-91509d5d2a2dc818830cff63f13d6efcb229dc0c.tar.gz emacs-91509d5d2a2dc818830cff63f13d6efcb229dc0c.zip | |
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.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/net/tramp-androidsu.el | 4 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 8 | ||||
| -rw-r--r-- | lisp/simple.el | 5 |
3 files changed, 12 insertions, 5 deletions
diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index 95b852d2068..b2f0bab650d 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el | |||
| @@ -385,6 +385,8 @@ FUNCTION." | |||
| 385 | ;; Generate a command to start the process using `su' with | 385 | ;; Generate a command to start the process using `su' with |
| 386 | ;; suitable options for specifying the mount namespace and | 386 | ;; suitable options for specifying the mount namespace and |
| 387 | ;; suchlike. | 387 | ;; suchlike. |
| 388 | ;; Suppress `internal-default-process-sentinel', which is | ||
| 389 | ;; set when :sentinel is nil. (Bug#71049) | ||
| 388 | (setq | 390 | (setq |
| 389 | p (let ((android-use-exec-loader nil)) | 391 | p (let ((android-use-exec-loader nil)) |
| 390 | (make-process | 392 | (make-process |
| @@ -407,7 +409,7 @@ FUNCTION." | |||
| 407 | :coding coding | 409 | :coding coding |
| 408 | :noquery noquery | 410 | :noquery noquery |
| 409 | :connection-type connection-type | 411 | :connection-type connection-type |
| 410 | :sentinel sentinel | 412 | :sentinel (or sentinel #'ignore) |
| 411 | :stderr stderr))) | 413 | :stderr stderr))) |
| 412 | ;; Set filter. Prior Emacs 29.1, it doesn't work reliably | 414 | ;; Set filter. Prior Emacs 29.1, it doesn't work reliably |
| 413 | ;; to provide it as `make-process' argument when filter is | 415 | ;; to provide it as `make-process' argument when filter is |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 18116229337..9385b023392 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -5011,9 +5011,9 @@ should be set conmnection-local.") | |||
| 5011 | (string-join command) (tramp-get-remote-pipe-buf v))) | 5011 | (string-join command) (tramp-get-remote-pipe-buf v))) |
| 5012 | (signal 'error (cons "Command too long:" command))) | 5012 | (signal 'error (cons "Command too long:" command))) |
| 5013 | 5013 | ||
| 5014 | ;; Replace `login-args' place holders. Split ControlMaster | ||
| 5015 | ;; options. | ||
| 5016 | (setq | 5014 | (setq |
| 5015 | ;; Replace `login-args' place holders. Split ControlMaster | ||
| 5016 | ;; options. | ||
| 5017 | login-args | 5017 | login-args |
| 5018 | (append | 5018 | (append |
| 5019 | (flatten-tree (tramp-get-method-parameter v 'tramp-async-args)) | 5019 | (flatten-tree (tramp-get-method-parameter v 'tramp-async-args)) |
| @@ -5025,11 +5025,13 @@ should be set conmnection-local.") | |||
| 5025 | ?h (or host "") ?u (or user "") ?p (or port "") | 5025 | ?h (or host "") ?u (or user "") ?p (or port "") |
| 5026 | ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) | 5026 | ?c (format-spec (or options "") (format-spec-make ?t tmpfile)) |
| 5027 | ?d (or device "") ?a (or pta "") ?l "")))) | 5027 | ?d (or device "") ?a (or pta "") ?l "")))) |
| 5028 | ;; Suppress `internal-default-process-sentinel', which is | ||
| 5029 | ;; set when :sentinel is nil. (Bug#71049) | ||
| 5028 | p (make-process | 5030 | p (make-process |
| 5029 | :name name :buffer buffer | 5031 | :name name :buffer buffer |
| 5030 | :command (append `(,login-program) login-args command) | 5032 | :command (append `(,login-program) login-args command) |
| 5031 | :coding coding :noquery noquery :connection-type connection-type | 5033 | :coding coding :noquery noquery :connection-type connection-type |
| 5032 | :sentinel sentinel :stderr stderr)) | 5034 | :sentinel (or sentinel #'ignore) :stderr stderr)) |
| 5033 | ;; Set filter. Prior Emacs 29.1, it doesn't work reliably | 5035 | ;; Set filter. Prior Emacs 29.1, it doesn't work reliably |
| 5034 | ;; to provide it as `make-process' argument when filter is | 5036 | ;; to provide it as `make-process' argument when filter is |
| 5035 | ;; t. See Bug#51177. | 5037 | ;; t. See Bug#51177. |
diff --git a/lisp/simple.el b/lisp/simple.el index 5177905ee1b..ae8a824cb54 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -4863,11 +4863,14 @@ and are used only if a pop-up buffer is displayed." | |||
| 4863 | ;; We have a sentinel to prevent insertion of a termination message | 4863 | ;; We have a sentinel to prevent insertion of a termination message |
| 4864 | ;; in the buffer itself, and to set the point in the buffer when | 4864 | ;; in the buffer itself, and to set the point in the buffer when |
| 4865 | ;; `shell-command-dont-erase-buffer' is non-nil. | 4865 | ;; `shell-command-dont-erase-buffer' is non-nil. |
| 4866 | ;; For remote shells, `process-command' does not serve the proper shell | ||
| 4867 | ;; command. We use process property `remote-command' instead. (Bug#71049) | ||
| 4866 | (defun shell-command-sentinel (process signal) | 4868 | (defun shell-command-sentinel (process signal) |
| 4867 | (when (memq (process-status process) '(exit signal)) | 4869 | (when (memq (process-status process) '(exit signal)) |
| 4868 | (shell-command-set-point-after-cmd (process-buffer process)) | 4870 | (shell-command-set-point-after-cmd (process-buffer process)) |
| 4869 | (message "%s: %s." | 4871 | (message "%s: %s." |
| 4870 | (car (cdr (cdr (process-command process)))) | 4872 | (car (cdr (cdr (or (process-get process 'remote-command) |
| 4873 | (process-command process))))) | ||
| 4871 | (substring signal 0 -1)))) | 4874 | (substring signal 0 -1)))) |
| 4872 | 4875 | ||
| 4873 | (defun shell-command-on-region (start end command | 4876 | (defun shell-command-on-region (start end command |