[Ludovic Courtès]

branch: main
commit bd6e05cefdcded316e590df535a718bdf609ab3a
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Fri Mar 21 16:16:24 2025 +0100

    utils: Add ‘non-blocking-port’.
    
    * src/cuirass/store.scm (non-blocking-port): Move to…
    * src/cuirass/utils.scm (non-blocking-port): … here.  New procedure.
---
 src/cuirass/store.scm | 11 ++---------
 src/cuirass/utils.scm |  8 ++++++++
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/cuirass/store.scm b/src/cuirass/store.scm
index 86e0fdf..a5a770e 100644
--- a/src/cuirass/store.scm
+++ b/src/cuirass/store.scm
@@ -24,6 +24,7 @@
   #:use-module ((guix config) #:select (%state-directory))
   #:autoload   (guix serialization) (nar-error? nar-error-file)
   #:autoload   (cuirass logging) (log-info log-warning log-error)
+  #:autoload   (cuirass utils) (non-blocking-port)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 match)
@@ -31,8 +32,7 @@
   #:use-module (ice-9 threads)
   #:use-module ((fibers) #:select (sleep))
   #:autoload   (fibers channels) (make-channel put-message get-message)
-  #:export (non-blocking-port
-            with-store/non-blocking
+  #:export (with-store/non-blocking
             process-build-log
             ensure-path/retry
             build-derivations&
@@ -100,13 +100,6 @@ any."
   "Return true if PORT is blocking--i.e., lacking O_NONBLOCK."
   (zero? (logand O_NONBLOCK (fcntl port F_GETFL))))
 
-(define (non-blocking-port port)
-  "Make PORT non-blocking and return it."
-  (let ((flags (fcntl port F_GETFL)))
-    (when (zero? (logand O_NONBLOCK flags))
-      (fcntl port F_SETFL (logior O_NONBLOCK flags)))
-    port))
-
 (define (ensure-non-blocking-store-connection store)
   "Mark the file descriptor that backs STORE, a <store-connection>, as
 O_NONBLOCK."
diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index b06f451..204988c 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -59,6 +59,7 @@
             with-timing-check
             gather-user-privileges
             open-unix-listening-socket
+            non-blocking-port
 
             atomic-box-fetch-and-increment!
             atomic-box-fetch-and-decrement!
@@ -334,6 +335,13 @@ its parent directory if needed and make it #o700."
     (listen sock 64)
     sock))
 
+(define (non-blocking-port port)
+  "Make PORT non-blocking and return it."
+  (let ((flags (fcntl port F_GETFL)))
+    (when (zero? (logand O_NONBLOCK flags))
+      (fcntl port F_SETFL (logior O_NONBLOCK flags)))
+    port))
+
 
 ;;;
 ;;; Atomic procedures.