master 9df5e30800 4/4: Send SIGPIPE to external Eshell processes if their output target closes

[Lars Ingebrigtsen]

branch: master
commit 9df5e3080066341d78489f0b18eabeeccac76b0c
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Send SIGPIPE to external Eshell processes if their output target closes
    
    * lisp/eshell/esh-io.el (eshell-pipe-broken): New error.
    (eshell-output-object-to-target): Signal 'eshell-pipe-broken' if the
    target is an exited/signaled process.
    
    * lisp/eshell/esh-proc.el (eshell-insertion-filter): Handle
    'eshell-pipe-broken'.
    
    * test/lisp/eshell/esh-proc-tests.el: New test.
---
 lisp/eshell/esh-io.el                    | 12 ++++++---
 lisp/eshell/esh-proc.el                  | 31 +++++++++++++++++++---
 test/lisp/eshell/esh-proc-tests.el       | 45 ++++++++++++++++++++++++++++++++
 test/lisp/eshell/eshell-tests-helpers.el |  9 ++++---
 4 files changed, 86 insertions(+), 11 deletions(-)

diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index fc1124561a..3644c1a18b 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -150,6 +150,8 @@ not be added to this variable."
   :risky t
   :group 'eshell-io)
 
+(define-error 'eshell-pipe-broken "Pipe broken")
+
 ;;; Internal Variables:
 
 (defvar eshell-current-handles nil)
@@ -481,10 +483,12 @@ Returns what was actually sent, or nil if nothing was 
sent."
                (goto-char target))))))
 
    ((eshell-processp target)
-    (when (eq (process-status target) 'run)
-      (unless (stringp object)
-       (setq object (eshell-stringify object)))
-      (process-send-string target object)))
+    (unless (stringp object)
+      (setq object (eshell-stringify object)))
+    (condition-case nil
+        (process-send-string target object)
+      ;; If `process-send-string' raises an error, treat it as a broken pipe.
+      (error (signal 'eshell-pipe-broken target))))
 
    ((consp target)
     (apply (car target) object (cdr target))))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index bb2136c06c..ed37de85f7 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -386,8 +386,27 @@ output."
              (let ((data (nth 3 entry)))
                (setcar (nthcdr 3 entry) nil)
                (setcar (nthcdr 4 entry) t)
-               (eshell-output-object data nil (cadr entry))
-               (setcar (nthcdr 4 entry) nil)))))))))
+                (unwind-protect
+                    (condition-case nil
+                        (eshell-output-object data nil (cadr entry))
+                      ;; FIXME: We want to send SIGPIPE to the process
+                      ;; here.  However, remote processes don't
+                      ;; currently support that, and not all systems
+                      ;; have SIGPIPE in the first place (e.g. MS
+                      ;; Windows).  In these cases, just delete the
+                      ;; process; this is reasonably close to the
+                      ;; right behavior, since the default action for
+                      ;; SIGPIPE is to terminate the process.  For use
+                      ;; cases where SIGPIPE is truly needed, using an
+                      ;; external pipe operator (`*|') may work
+                      ;; instead (e.g. when working with remote
+                      ;; processes).
+                      (eshell-pipe-broken
+                       (if (or (process-get proc 'remote-pid)
+                               (eq system-type 'windows-nt))
+                           (delete-process proc)
+                         (signal-process proc 'SIGPIPE))))
+                  (setcar (nthcdr 4 entry) nil))))))))))
 
 (defun eshell-sentinel (proc string)
   "Generic sentinel for command processes.  Reports only signals.
@@ -416,8 +435,12 @@ PROC is the process that's exiting.  STRING is the exit 
message."
                                   (lambda ()
                                     (if (nth 4 entry)
                                         (run-at-time 0 nil finish-io)
-                                      (when str (eshell-output-object str nil 
handles))
-                                      (eshell-close-handles status 'nil 
handles)))))
+                                      (unwind-protect
+                                          (when str
+                                            (eshell-output-object
+                                             str nil handles))
+                                        (eshell-close-handles
+                                         status 'nil handles))))))
                           (funcall finish-io)))))
                (eshell-remove-process-entry entry))))
        (eshell-kill-process-function proc string)))))
diff --git a/test/lisp/eshell/esh-proc-tests.el 
b/test/lisp/eshell/esh-proc-tests.el
new file mode 100644
index 0000000000..e7ea6c00d6
--- /dev/null
+++ b/test/lisp/eshell/esh-proc-tests.el
@@ -0,0 +1,45 @@
+;;; esh-proc-tests.el --- esh-proc test suite  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'esh-mode)
+(require 'eshell)
+
+(require 'eshell-tests-helpers
+         (expand-file-name "eshell-tests-helpers"
+                           (file-name-directory (or load-file-name
+                                                    default-directory))))
+
+(ert-deftest esh-proc-test/sigpipe-exits-process ()
+  "Test that a SIGPIPE is properly sent to a process if a pipe closes"
+  (skip-unless (and (executable-find "sh")
+                    (executable-find "echo")
+                    (executable-find "sleep")))
+  (with-temp-eshell
+   (eshell-command-result-p
+    ;; The first command is like `yes' but slower.  This is to prevent
+    ;; it from taxing Emacs's process filter too much and causing a
+    ;; hang.
+    (concat "sh -c 'while true; do echo y; sleep 1; done' | "
+            "sh -c 'read NAME; echo ${NAME}'")
+    "y\n")
+   (eshell-wait-for-subprocess t)
+   (should (eq (process-list) nil))))
diff --git a/test/lisp/eshell/eshell-tests-helpers.el 
b/test/lisp/eshell/eshell-tests-helpers.el
index 33cdd60113..f944194a2b 100644
--- a/test/lisp/eshell/eshell-tests-helpers.el
+++ b/test/lisp/eshell/eshell-tests-helpers.el
@@ -50,15 +50,18 @@ See `eshell-wait-for-subprocess'.")
          (let (kill-buffer-query-functions)
            (kill-buffer eshell-buffer))))))
 
-(defun eshell-wait-for-subprocess ()
+(defun eshell-wait-for-subprocess (&optional all)
   "Wait until there is no interactive subprocess running in Eshell.
+If ALL is non-nil, wait until there are no Eshell subprocesses at
+all running.
+
 If this takes longer than `eshell-test--max-subprocess-time',
 raise an error."
   (let ((start (current-time)))
-    (while (eshell-interactive-process-p)
+    (while (if all eshell-process-list (eshell-interactive-process-p))
       (when (> (float-time (time-since start))
                eshell-test--max-subprocess-time)
-        (error "timed out waiting for subprocess"))
+        (error "timed out waiting for subprocess(es)"))
       (sit-for 0.1))))
 
 (defun eshell-insert-command (text &optional func)