aboutsummaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-03-28 14:27:34 +0200
committerLudovic Courtès <ludo@gnu.org>2022-04-07 00:08:56 +0200
commit83121aa85a0237f81c9a3c1dd36f1206c1cae854 (patch)
treeb21fd122e559795fc126fbd619afa545cc3fe05d /gnu/build
parent808b9e850491c7b1d867a5f1f4d5ee6f61f345d4 (diff)
downloadguix-83121aa85a0237f81c9a3c1dd36f1206c1cae854.tar.gz
guix-83121aa85a0237f81c9a3c1dd36f1206c1cae854.zip
secret-service: Abstract 'wait-for-readable-fd'.
* gnu/build/secret-service.scm (wait-for-readable-fd): New procedure. (secret-service-send-secrets): Use it instead of 'select'.
Diffstat (limited to 'gnu/build')
-rw-r--r--gnu/build/secret-service.scm42
1 files changed, 24 insertions, 18 deletions
diff --git a/gnu/build/secret-service.scm b/gnu/build/secret-service.scm
index 4e183e11e8..621c4447dc 100644
--- a/gnu/build/secret-service.scm
+++ b/gnu/build/secret-service.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -47,6 +47,13 @@
;; to syslog.
#'(format (current-output-port) fmt args ...))))))
+(define (wait-for-readable-fd port timeout)
+ "Wait until PORT has data available for reading or TIMEOUT has expired.
+Return #t in the former case and #f in the latter case."
+ (match (select (list port) '() '() timeout)
+ (((_) () ()) #t)
+ ((() () ()) #f)))
+
(define* (secret-service-send-secrets port secret-root
#:key (retry 60)
(handshake-timeout 120))
@@ -93,23 +100,22 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
;; Wait for "hello" message from the server. This is the only way to know
;; that we're really connected to the server inside the guest.
- (match (select (list sock) '() '() handshake-timeout)
- (((_) () ())
- (match (read sock)
- (('secret-service-server ('version version ...))
- (log "sending files from ~s...~%" secret-root)
- (send-files sock)
- (log "done sending files to port ~a~%" port)
- (close-port sock)
- secret-root)
- (x
- (log "invalid handshake ~s~%" x)
- (close-port sock)
- #f)))
- ((() () ()) ;timeout
- (log "timeout while sending files to ~a~%" port)
- (close-port sock)
- #f))))
+ (if (wait-for-readable-fd sock handshake-timeout)
+ (match (read sock)
+ (('secret-service-server ('version version ...))
+ (log "sending files from ~s...~%" secret-root)
+ (send-files sock)
+ (log "done sending files to port ~a~%" port)
+ (close-port sock)
+ secret-root)
+ (x
+ (log "invalid handshake ~s~%" x)
+ (close-port sock)
+ #f))
+ (begin ;timeout
+ (log "timeout while sending files to ~a~%" port)
+ (close-port sock)
+ #f))))
(define (delete-file* file)
"Ensure FILE does not exist."