diff options
| -rw-r--r-- | src/cuirass/base.scm | 17 |
1 files changed, 15 insertions, 2 deletions
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 1966ad6..7f4cc3c 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -36,6 +36,9 @@ #:use-module ((guix config) #:select (%state-directory)) #:use-module (git) #:use-module (ice-9 binary-ports) + #:use-module ((ice-9 suspendable-ports) + #:select (current-read-waiter + current-write-waiter)) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 popen) @@ -79,7 +82,12 @@ ;; currently closes in a 'dynamic-wind' handler, which means it would close ;; the store at each context switch. Remove this when the real 'with-store' ;; has been fixed. - (let ((store (open-connection))) + (let* ((store (open-connection)) + (socket (store-connection-socket store))) + ;; Mark SOCKET as non-blocking so Fibers can schedule the way it wants. + (let ((flags (fcntl socket F_GETFL))) + (fcntl socket F_SETFL (logior O_NONBLOCK flags))) + (unwind-protect ;; Always set #:keep-going? so we don't stop on the first build failure. ;; Set #:print-build-trace explicitly to make sure 'process-build-log' @@ -422,7 +430,12 @@ Essentially this procedure inverts the inversion-of-control that (lambda () (guard (c ((store-error? c) (atomic-box-set! result c))) - (parameterize ((current-build-output-port output)) + (parameterize ((current-build-output-port output) + + ;; STORE's socket is O_NONBLOCK but since we're + ;; not in a fiber, disable Fiber's handlers. + (current-read-waiter #f) + (current-write-waiter #f)) (let ((x (build-derivations store lst))) (atomic-box-set! result x)))) (close-port output)) |