Allow child processes to continue after EPIPE

This ensures that if the child process closed its stdin and Emacs tries
to write to it, the process can still do any remaining work and exit
normally.  In practice, this can occur with commands like "head(1)"
(bug#79079).

* src/fileio.c (file_for_stream): New function, extracted from...
(Fset_binary_mode): ... here.
(Ffile__close_stream): New function.

* src/process.c (send_process): When encountering EPIPE, only close the
fd for the pipe to the child process's stdin.

* lisp/eshell/esh-io.el (eshell-output-object-to-target): Don't check
for process liveness anymore.

* test/src/process-tests.el (process-tests/broken-pipe): New function.
(process-tests/broken-pipe/pipe, process-tests/broken-pipe/pty)
(process-tests/broken-pipe/pipe-stdin)
(process-tests/broken-pipe/pty-stdin): New tests.

* etc/NEWS: Announce this change.

1 files changed, 63 insertions, 0 deletions

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