From f3bb959c9baba18a3575db969eaa4eecf5a9a21a Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Thu, 21 Oct 2021 01:12:48 -0700
Subject: HANDLE-FORK-REQUEST: immediately begin reading from out & err pipes

Previously we waited for waitpid(2) to return before reading from the pipes.
If either pipe filled up before the child process exited, we would deadlock.

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
---
 consfigurator.asd |  1 +
 debian/changelog  |  4 ++--
 debian/control    |  2 ++
 src/image.lisp    | 38 ++++++++++++++++++++++++--------------
 4 files changed, 29 insertions(+), 16 deletions(-)

diff --git a/consfigurator.asd b/consfigurator.asd
index e071285..1539b9b 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -9,6 +9,7 @@
                #:alexandria
                #:babel
                #:babel-streams
+               #:bordeaux-threads
                #:cl-ppcre
                #:cl-heredoc
                #:cl-interpol
diff --git a/debian/changelog b/debian/changelog
index a0d19e1..a40a3df 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,7 +1,7 @@
-consfigurator (0.11.1-1) UNRELEASED; urgency=medium
+consfigurator (0.12.0-1) UNRELEASED; urgency=medium
 
   * New upstream release.
-  * Add dep and build-dep on libacl1-dev.
+  * Add deps and build-deps on cl-bordeaux-threads and libacl1-dev.
 
  -- Sean Whitton <spwhitton@spwhitton.name>  Thu, 21 Oct 2021 13:25:09 -0700
 
diff --git a/debian/control b/debian/control
index 061072a..e678a3c 100644
--- a/debian/control
+++ b/debian/control
@@ -6,6 +6,7 @@ Build-Depends:
  cl-alexandria,
  cl-anaphora,
  cl-babel,
+ cl-bordeaux-threads,
  cl-cffi,
  cl-osicat,
  cl-heredoc,
@@ -35,6 +36,7 @@ Depends:
  cl-alexandria,
  cl-anaphora,
  cl-babel,
+ cl-bordeaux-threads,
  cl-cffi,
  cl-osicat,
  cl-heredoc,
diff --git a/src/image.lisp b/src/image.lisp
index aa1a4b2..bde16a1 100644
--- a/src/image.lisp
+++ b/src/image.lisp
@@ -264,20 +264,30 @@ already running from FILENAME."
                 (eval-input)
                 (with-fork-control (eval-input)))))))
     (unwind-protect
-         (with-open-file (out out :element-type 'character)
-           (with-open-file (err err :element-type 'character)
-             (let ((status (nth-value 1 (nix:waitpid child))))
-               (unless (nix:WIFEXITED status)
-                 (failed-change
-                  "~&Grandchild process did not exit normally, status #x~(~4,'0X~)."
-                  status))
-               (with-open-file (output output :direction :output
-                                              :if-exists :append
-                                              :element-type 'character)
-                 (write-to-mkfifo (list (slurp-stream-string out)
-                                        (slurp-stream-string err)
-                                        (nix:WEXITSTATUS status))
-                                  output)))))
+         (let* (outbuf
+                (out-reader
+                  (bt:make-thread
+                   (lambda ()
+                     (setq outbuf
+                           (read-file-string out :element-type 'character)))))
+                errbuf
+                (err-reader
+                  (bt:make-thread
+                   (lambda ()
+                     (setq errbuf
+                           (read-file-string err :element-type 'character)))))
+                (status (nth-value 1 (nix:waitpid child))))
+           (unless (nix:WIFEXITED status)
+             (failed-change
+              "~&Grandchild process did not exit normally, status #x~(~4,'0X~)."
+              status))
+           (bt:join-thread out-reader)
+           (bt:join-thread err-reader)
+           (with-open-file (output output :direction :output
+                                          :if-exists :append
+                                          :element-type 'character)
+             (write-to-mkfifo
+              (list outbuf errbuf (nix:WEXITSTATUS status)) output)))
       (delete-file out) (delete-file err))))
 
 (defclass asdf-requirements ()
-- 
cgit v1.2.3