summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-06-16 16:13:12 +0200
committerLudovic Courtès <ludo@gnu.org>2012-06-16 16:13:12 +0200
commitdcee50c1146a6698be3e88a36da5e890f829ff9d (patch)
treee0b95f074619c0300d7d47f41e3b160a6429087b /guix
parent73d96596978b6a6f338e5444719a36bffd3fa521 (diff)
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/store.scm30
1 files changed, 23 insertions, 7 deletions
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 @@
add-to-store
build-derivations
+ current-build-output-port
+
%store-prefix
store-path?
derivation-path?))
@@ -274,7 +276,15 @@
(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 @@
(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 @@
(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 @@
(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 @@
(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 @@
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)