diff options
author | Ludovic Courtès <ludo@gnu.org> | 2022-03-28 14:27:34 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2022-04-07 00:08:56 +0200 |
commit | 83121aa85a0237f81c9a3c1dd36f1206c1cae854 (patch) | |
tree | b21fd122e559795fc126fbd619afa545cc3fe05d | |
parent | 808b9e850491c7b1d867a5f1f4d5ee6f61f345d4 (diff) |
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'.
-rw-r--r-- | gnu/build/secret-service.scm | 42 |
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." |