From 4d047853da76dc5fa5dd50ecb750c861342ef47b Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 27 Sep 2020 17:21:16 +0200
Subject: secret-service: Add a timeout when waiting for a client.

* gnu/build/secret-service.scm (secret-service-receive-secrets)
[wait-for-client]: Call 'select' with a 60s timeout before 'accept'.
Return #f upon timeout.
[read-secrets]: Return FILES on success.
Adjust caller of 'wait-for-client' to handle #f.
---
 gnu/build/secret-service.scm | 33 +++++++++++++++++++++------------
 1 file changed, 21 insertions(+), 12 deletions(-)

(limited to 'gnu')

diff --git a/gnu/build/secret-service.scm b/gnu/build/secret-service.scm
index aafb1684b5..40c24abf09 100644
--- a/gnu/build/secret-service.scm
+++ b/gnu/build/secret-service.scm
@@ -75,7 +75,8 @@ local PORT.  If connect fails, sleep 1s and retry RETRY times."
 
 (define (secret-service-receive-secrets port)
   "Listen to local PORT and wait for a secret service client to send secrets.
-Write them to the file system."
+Write them to the file system.  Return the list of files installed on success,
+and #f otherwise."
 
   (define (wait-for-client port)
     ;; Wait for a TCP connection on PORT.  Note: We cannot use the
@@ -87,14 +88,20 @@ Write them to the file system."
       (format (current-error-port)
               "secret service: waiting for secrets on port ~a...~%"
               port)
-      (match (accept sock)
-        ((client . address)
+      (match (select (list sock) '() '() 60)
+        (((_) () ())
+         (match (accept sock)
+           ((client . address)
+            (format (current-error-port)
+                    "secret service: client connection from ~a~%"
+                    (inet-ntop (sockaddr:fam address)
+                               (sockaddr:addr address)))
+            (close-port sock)
+            client)))
+        ((() () ())
          (format (current-error-port)
-                 "secret service: client connection from ~a~%"
-                 (inet-ntop (sockaddr:fam address)
-                            (sockaddr:addr address)))
-         (close-port sock)
-         client))))
+                 "secret service: did not receive any secrets; time out~%")
+         #f))))
 
   ;; TODO: Remove when (@ (guix build utils) dump-port) has a 'size'
   ;; parameter.
@@ -128,15 +135,17 @@ installing file '~a' (~a bytes)...~%"
                      (lambda (output)
                        (dump port output size)
                        (chmod file mode))))
-                 files sizes modes))
+                 files sizes modes)
+       files)
       (_
        (format (current-error-port)
                "secret service: invalid secrets received~%")
        #f)))
 
-  (let* ((port (wait-for-client port))
-         (result (read-secrets port)))
-    (close-port port)
+  (let* ((port   (wait-for-client port))
+         (result (and=> port read-secrets)))
+    (when port
+      (close-port port))
     result))
 
 ;;; secret-service.scm ends here
-- 
cgit v1.2.3