From 6ed606ed2a0fa27078bc16001e0a918cb305b96b Mon Sep 17 00:00:00 2001 From: Jim Porter 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 | 15 +++++--- test/lisp/eshell/esh-proc-tests.el | 45 ++++++++++++++++++++++++ test/lisp/eshell/eshell-tests-helpers.el | 9 +++-- 4 files changed, 70 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..86ae69978f 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -386,8 +386,11 @@ 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)) + (eshell-pipe-broken (signal-process proc 'SIGPIPE))) + (setcar (nthcdr 4 entry) nil)))))))))) (defun eshell-sentinel (proc string) "Generic sentinel for command processes. Reports only signals. @@ -416,8 +419,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 . + +;;; 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