From dcee50c1146a6698be3e88a36da5e890f829ff9d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 16 Jun 2012 16:13:12 +0200
Subject: store: Wait for the server to be done sending output.

* guix/store.scm (current-build-output-port): New variable.
  (process-stderr): Add docstring.  Always return #f, except upon
  %STDERR-LAST.  Upon %STDERR-NEXT, write to
  `current-build-output-port', not `current-error-port'.
  (set-build-options): Loop until `process-stderr' returns true.
  (define-operation): Likewise.
  (build-derivations): Update docstring to mention that it's
  synchronous.
---
 guix/store.scm | 30 +++++++++++++++++++++++-------
 1 file changed, 23 insertions(+), 7 deletions(-)

(limited to 'guix/store.scm')

diff --git a/guix/store.scm b/guix/store.scm
index 1e36657d05..e00282ad8a 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -46,6 +46,8 @@ (define-module (guix store)
             add-to-store
             build-derivations
 
+            current-build-output-port
+
             %store-prefix
             store-path?
             derivation-path?))
@@ -274,7 +276,15 @@ (define* (open-connection #:optional (file %default-socket-path))
                       (process-stderr s)
                       s))))))))
 
+(define current-build-output-port
+  ;; The port where build output is sent.
+  (make-parameter (current-error-port)))
+
 (define (process-stderr server)
+  "Read standard output and standard error from SERVER, writing it to
+CURRENT-BUILD-OUTPUT-PORT.  Return #t when SERVER is done sending data, and
+#f otherwise; in the latter case, the caller should call `process-stderr'
+again until #t is returned or an error is raised."
   (define p
     (nix-server-socket server))
 
@@ -287,15 +297,16 @@ (define %stderr-error #x63787470)
 
   (let ((k (read-int p)))
     (cond ((= k %stderr-write)
-           (read-string p))
+           (read-string p)
+           #f)
           ((= k %stderr-read)
            (let ((len (read-int p)))
              (read-string p)                      ; FIXME: what to do?
-             ))
+             #f))
           ((= k %stderr-next)
            (let ((s (read-string p)))
-             (display s (current-error-port))
-             s))
+             (display s (current-build-output-port))
+             #f))
           ((= k %stderr-error)
            (let ((error  (read-string p))
                  (status (if (>= (nix-server-minor-version server) 8)
@@ -305,6 +316,7 @@ (define %stderr-error #x63787470)
                                 (message error)
                                 (status  status))))))
           ((= k %stderr-last)
+           ;; The daemon is done (see `stopWork' in `nix-worker.cc'.)
            #t)
           (else
            (raise (condition (&nix-protocol-error
@@ -343,7 +355,8 @@ (define socket
         (send use-build-hook?))
     (if (>= (nix-server-minor-version server) 4)
         (send build-verbosity log-type print-build-trace))
-    (process-stderr server)))
+    (let loop ((done? (process-stderr server)))
+      (or done? (process-stderr server)))))
 
 (define-syntax define-operation
   (syntax-rules ()
@@ -354,7 +367,9 @@ (define (name server arg ...)
          (write-int (operation-id name) s)
          (write-arg type arg s)
          ...
-         (process-stderr server)
+         ;; Loop until the server is done sending error output.
+         (let loop ((done? (process-stderr server)))
+           (or done? (loop (process-stderr server))))
          (read-arg return s))))))
 
 (define-operation (add-text-to-store (string name) (string text)
@@ -371,7 +386,8 @@ (define-operation (add-to-store (string basename)
   store-path)
 
 (define-operation (build-derivations (string-list derivations))
-  "Build DERIVATIONS; return #t on success."
+  "Build DERIVATIONS, and return when the worker is done building them.
+Return #t on success."
   boolean)
 
 
-- 
cgit v1.2.3