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.
This commit is contained in:
Jim Porter 2022-02-01 19:16:00 -08:00 committed by Lars Ingebrigtsen
parent 76429f4d17
commit 9df5e30800
4 changed files with 86 additions and 11 deletions

View file

@ -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))))

View file

@ -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)))))

View file

@ -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))))

View file

@ -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)