diff --git a/etc/NEWS b/etc/NEWS index 795ac6f5c3d..e6fd8a7f747 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -30,6 +30,13 @@ applies, and please also update docstrings as needed. * Changes in Emacs 32.1 +--- +** Emacs no longer kills child processes after EPIPE. +Previously, Emacs would immediately kill a child process and set its +exit status to 256 if sending input to that process returned EPIPE. +Now when this happens, Emacs closes the file descriptor to write to the +child process, but allows it to continue execution as normal. + * Editing Changes in Emacs 32.1 diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index ea7dbb2e122..395a641aed6 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -741,18 +741,14 @@ Returns what was actually sent, or nil if nothing was sent.") "Output OBJECT to the process TARGET." (unless (stringp object) (setq object (eshell-stringify object))) - (condition-case err + (condition-case _ (process-send-string target object) (error - ;; If `process-send-string' raises an error and the process has - ;; finished, treat it as a broken pipe. Otherwise, just re-raise - ;; the signal. NOTE: When running Emacs in batch mode - ;; (e.g. during regression tests), Emacs can abort due to SIGPIPE - ;; here. Maybe `process-send-string' should handle SIGPIPE even - ;; in batch mode (bug#66186). - (if (process-live-p target) - (signal err) - (signal 'eshell-pipe-broken (list target))))) + ;; NOTE: When running Emacs in batch mode (e.g. during regression + ;; tests), Emacs can abort due to SIGPIPE here. Maybe + ;; `process-send-string' should handle SIGPIPE even in batch mode + ;; (bug#66186). + (signal 'eshell-pipe-broken (list target)))) object) (cl-defmethod eshell-output-object-to-target (object diff --git a/src/fileio.c b/src/fileio.c index eb64b59fcf2..e6a6670ff9d 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6572,6 +6572,19 @@ before any other event (mouse or keypress) is handled. */) } +static FILE * +file_for_stream (Lisp_Object stream) +{ + if (EQ (stream, Qstdin)) + return stdin; + else if (EQ (stream, Qstdout)) + return stdout; + else if (EQ (stream, Qstderr)) + return stderr; + else + xsignal2 (Qerror, build_string ("unsupported stream"), stream); +} + DEFUN ("set-binary-mode", Fset_binary_mode, Sset_binary_mode, 2, 2, 0, doc: /* Switch STREAM to binary I/O mode or text I/O mode. STREAM can be one of the symbols `stdin', `stdout', or `stderr'. @@ -6593,18 +6606,9 @@ On Posix systems, this function always returns non-nil, and has no effect except for flushing STREAM's data. */) (Lisp_Object stream, Lisp_Object mode) { - FILE *fp = NULL; - int binmode; - CHECK_SYMBOL (stream); - if (EQ (stream, Qstdin)) - fp = stdin; - else if (EQ (stream, Qstdout)) - fp = stdout; - else if (EQ (stream, Qstderr)) - fp = stderr; - else - xsignal2 (Qerror, build_string ("unsupported stream"), stream); + FILE *fp = file_for_stream (stream); + int binmode; binmode = NILP (mode) ? O_TEXT : O_BINARY; if (fp != stdin) @@ -6612,6 +6616,22 @@ effect except for flushing STREAM's data. */) return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil; } + +DEFUN ("file--close-stream", Ffile__close_stream, + Sfile__close_stream, 1, 1, 0, + doc: /* Close the standard STREAM of the Emacs process. +STREAM can be one of the symbols `stdin', `stdout', or `stderr'. + +This function is primarily intended for testing process machinery within +Emacs. */) + (Lisp_Object stream) +{ + CHECK_SYMBOL (stream); + FILE *fp = file_for_stream (stream); + fclose (fp); + return Qnil; +} + #ifndef DOS_NT @@ -7047,6 +7067,7 @@ This includes interactive calls to `delete-file' and defsubr (&Snext_read_file_uses_dialog_p); defsubr (&Sset_binary_mode); + defsubr (&Sfile__close_stream); #ifndef DOS_NT defsubr (&Sfile_system_info); diff --git a/src/process.c b/src/process.c index d46be48821f..9ea2b66533b 100644 --- a/src/process.c +++ b/src/process.c @@ -6922,10 +6922,8 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len, } else if (errno == EPIPE) { - p->raw_status_new = 0; - pset_status (p, list2 (Qexit, make_fixnum (256))); - p->tick = ++process_tick; - deactivate_process (proc); + close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]); + p->outfd = -1; error ("Process %s no longer connected to pipe; closed it", SDATA (p->name)); } diff --git a/test/src/process-tests.el b/test/src/process-tests.el index e854d3d3b87..1b1a9dfb07f 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -1054,6 +1054,69 @@ Return nil if FILENAME doesn't exist." (process-exit-status proc) events)))))) +(defun process-tests/broken-pipe (connection-type) + "Test handling of broken pipes; see bug#79079. +This test runs a shell script that reads a line of text and closes +stdin. We send two lines of text to the script; the second should +signal an error indicating that the pipe has been closed. The script +should also run to completion, printing out the line of text it read." + (with-temp-buffer + (let ((saw-error nil) + (proc (make-process + :name "test" :buffer (current-buffer) + :command `(,(expand-file-name invocation-name + invocation-directory) + "-Q" "--batch" "--eval" + ,(prin1-to-string + '(let ((line (read-string ""))) + (file--close-stream 'stdin) + (message "closed stream") + (sit-for 1) + (message "%s" line)))) + :connection-type 'pipe))) + (process-send-string proc "hello\n") + (while (not (string-prefix-p "closed stream\n" (buffer-string))) + (accept-process-output)) + (condition-case err + (process-send-string proc "extra\n") + (error + (setq saw-error t) + (should (string-match + (rx bos "Process test" (? "<" (+ digit) ">") + " no longer connected to pipe; closed it" + eos) + (error-message-string err))))) + (unless saw-error + (ert-fail "Expected error from `process-send-string'")) + ;; Wait for the process to finish, and check results. + (while (eq (process-status proc) 'run) + (accept-process-output)) + (accept-process-output) + (should (eq (process-status proc) 'exit)) + (should (eq (process-exit-status proc) 0)) + (should (string-match + (rx bos "closed stream\nhello\n\nProcess test" + (? "<" (+ digit) ">") " finished\n" eos) + (buffer-string)))))) + +;; These tests only works when running Emacs interactively, since we +;; don't catch SIGPIPE in batch mode. TODO: Fixing bug#66186 would +;; probably allow running these tests in batch mode. +(when (not noninteractive) + (ert-deftest process-tests/broken-pipe/pipe () + (process-tests/broken-pipe 'pipe)) + + ;; Emacs doesn't support PTYs on MS-Windows. + (unless (memq system-type '(ms-dos windows-nt)) + (ert-deftest process-tests/broken-pipe/pty () + (process-tests/broken-pipe 'pty)) + + (ert-deftest process-tests/broken-pipe/pipe-stdin () + (process-tests/broken-pipe '(pipe . pty))) + + (ert-deftest process-tests/broken-pipe/pty-stdin () + (process-tests/broken-pipe '(pty . pipe))))) + (ert-deftest process-num-processors () "Sanity checks for num-processors." (should (equal (num-processors) (num-processors)))