branch master updated: Use a non-blocking socket for store communication.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 3879094  Use a non-blocking socket for store communication.
3879094 is described below

commit 387909454c835c994414aa740a2d33d288064158
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Oct 27 18:55:54 2020 +0100

    Use a non-blocking socket for store communication.
    
    Set the store socket as non-blocking so that fibers communicating with the
    store don't get blocked as described here: 
https://issues.guix.gnu.org/43565.
    
    * src/cuirass/base.scm (with-store): Set the store socket as non-blocking.
    (build-derivations&): Unset current-read-waiter and current-write-waiter.
---
 src/cuirass/base.scm | 17 +++++++++++++++--
 1 file 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))