nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2012-06-16 16:13:12 +02:00
parent 73d9659697
commit dcee50c114
1 changed files with 23 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
guix/store.scm
View File

@ -46,6 +46,8 @@
add-to-store add-to-store
build-derivations build-derivations
current-build-output-port
%store-prefix %store-prefix
store-path? store-path?
derivation-path?)) derivation-path?))
@ -274,7 +276,15 @@
(process-stderr s) (process-stderr s)
s)))))))) s))))))))
(define current-build-output-port
;; The port where build output is sent.
(make-parameter (current-error-port)))
(define (process-stderr server) (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 (define p
(nix-server-socket server)) (nix-server-socket server))
@ -287,15 +297,16 @@
(let ((k (read-int p))) (let ((k (read-int p)))
(cond ((= k %stderr-write) (cond ((= k %stderr-write)
(read-string p)) (read-string p)
#f)
((= k %stderr-read) ((= k %stderr-read)
(let ((len (read-int p))) (let ((len (read-int p)))
(read-string p) ; FIXME: what to do? (read-string p) ; FIXME: what to do?
)) #f))
((= k %stderr-next) ((= k %stderr-next)
(let ((s (read-string p))) (let ((s (read-string p)))
(display s (current-error-port)) (display s (current-build-output-port))
s)) #f))
((= k %stderr-error) ((= k %stderr-error)
(let ((error (read-string p)) (let ((error (read-string p))
(status (if (>= (nix-server-minor-version server) 8) (status (if (>= (nix-server-minor-version server) 8)
@ -305,6 +316,7 @@
(message error) (message error)
(status status)))))) (status status))))))
((= k %stderr-last) ((= k %stderr-last)
;; The daemon is done (see `stopWork' in `nix-worker.cc'.)
#t) #t)
(else (else
(raise (condition (&nix-protocol-error (raise (condition (&nix-protocol-error
@ -343,7 +355,8 @@
(send use-build-hook?)) (send use-build-hook?))
(if (>= (nix-server-minor-version server) 4) (if (>= (nix-server-minor-version server) 4)
(send build-verbosity log-type print-build-trace)) (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 (define-syntax define-operation
(syntax-rules () (syntax-rules ()
@ -354,7 +367,9 @@
(write-int (operation-id name) s) (write-int (operation-id name) s)
(write-arg type arg 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)))))) (read-arg return s))))))
(define-operation (add-text-to-store (string name) (string text) (define-operation (add-text-to-store (string name) (string text)
@ -371,7 +386,8 @@
store-path) store-path)
(define-operation (build-derivations (string-list derivations)) (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) boolean)