Subject: bug#54062: 29.0.50; [PATCH] Eshell should inform processes when a pipe is broken

From: Jim Porter <[email-masked]>
Date: Sun, 20 Feb 2022 12:17:08 -0800

On 2/19/2022 11:27 PM, Eli Zaretskii wrote:
>> Cc: [email-masked]
>> From: Jim Porter <[email-masked]>
>> Date: Sat, 19 Feb 2022 13:18:16 -0800
>>
>>> Many console programs catch SIGINT, though.
>>>
>>> Can't we terminate ("kill") the process instead?  Or maybe deleting
>>> the process object is enough?
>>
>> That might work; it would definitely be better than `interrupt-process'.
>> On the other hand, I think it would be nice to handle this case by
>> breaking the pipe if possible, since that would be closer to how it
>> works in regular shells, as I understand it.
> 
> I meant killing the process as fallback for when SIGPIPE is not
> supported.

Ok, I've updated the patch to do this, with a note about how the 
behavior isn't quite correct. The current patch should work in most 
real-world cases, but if someone runs into a bug with this, hopefully 
the comment will point them in the right direction.

Note: I've only attached the updated patch here; parts 1-3 didn't 
change, so they're the same as in my original message[1].

>> Do you mean using `delete-process'? That works differently from how I'm
>> imagining things. From reading the code, `delete-process' sends SIGKILL
>> to the process group, but that means that a process that wants to do
>> something special in response to SIGPIPE (or EPIPE, or ERROR_BROKEN_PIPE
>> on Win32) wouldn't be able to, since that's not the signal/error it
>> receives.
> 
> How else can you close the pipe without deleting the process?  How can
> Emacs have a process whose I/O channels aren't ready to be used?
> 
> I thought you were talking about a pipe process (make-pipe-process),
> in which case deleting it closes the pipe.  But you seem to mean
> something else, so now I'm not sure I understand.

By "pipe", I meant the pair of file descriptors created by the pipe 
function (technically, `emacs_pipe') inside `create_process'. In this 
case, the subprocess being created will get the write end of that pipe, 
while Emacs gets the read end. If Emacs closes the read end of the pipe, 
then the next time the subprocess tries to write to its end of the pipe, 
it will get an error (SIGPIPE, EPIPE, or ERROR_BROKEN_PIPE, depending on 
the situation).

That's the behavior that the subprocess would expect: if the pipe for 
its stdout fd is broken, the error should refer to that problem (e.g. 
via signalling SIGPIPE). Raising the error in a different way (e.g. via 
SIGKILL) isn't quite correct.

However, as you correctly state, this is a niche feature, and messing 
around with Emacs's process management shouldn't be done lightly. It 
would take a lot of testing to be sure my previous patch is right, 
especially since my understanding of Emacs's process.c is pretty 
rudimentary. As you suggested, I think this new implementation should be 
a reasonable fallback.

[1] https://lists.gnu.org/archive/html/bug-gnu-emacs/2022-02/msg01431.html
From 99e73733d17f103baf039cfaf059fc0c54064191 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Tue, 1 Feb 2022 19:16:00 -0800
Subject: [PATCH 4/4] 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(-)
 create mode 100644 test/lisp/eshell/esh-proc-tests.el

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 @@ eshell-virtual-targets
   :risky t
   :group 'eshell-io)
 
+(define-error 'eshell-pipe-broken "Pipe broken")
+
 ;;; Internal Variables:
 
 (defvar eshell-current-handles nil)
@@ -481,10 +483,12 @@ eshell-output-object-to-target
 		(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 @@ eshell-insertion-filter
 	      (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 @@ eshell-sentinel
                                   (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 @@ with-temp-eshell
          (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)
-- 
2.25.1