Archived
1
0
Fork 0

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.
This commit is contained in:
Ludovic Courtès 2020-09-27 17:21:16 +02:00
parent 1edb7c7eec
commit 4d047853da
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -75,7 +75,8 @@ local PORT. If connect fails, sleep 1s and retry RETRY times."
(define (secret-service-receive-secrets port) (define (secret-service-receive-secrets port)
"Listen to local PORT and wait for a secret service client to send secrets. "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) (define (wait-for-client port)
;; Wait for a TCP connection on PORT. Note: We cannot use the ;; 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) (format (current-error-port)
"secret service: waiting for secrets on port ~a...~%" "secret service: waiting for secrets on port ~a...~%"
port) port)
(match (accept sock) (match (select (list sock) '() '() 60)
((client . address) (((_) () ())
(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) (format (current-error-port)
"secret service: client connection from ~a~%" "secret service: did not receive any secrets; time out~%")
(inet-ntop (sockaddr:fam address) #f))))
(sockaddr:addr address)))
(close-port sock)
client))))
;; TODO: Remove when (@ (guix build utils) dump-port) has a 'size' ;; TODO: Remove when (@ (guix build utils) dump-port) has a 'size'
;; parameter. ;; parameter.
@ -128,15 +135,17 @@ installing file '~a' (~a bytes)...~%"
(lambda (output) (lambda (output)
(dump port output size) (dump port output size)
(chmod file mode)))) (chmod file mode))))
files sizes modes)) files sizes modes)
files)
(_ (_
(format (current-error-port) (format (current-error-port)
"secret service: invalid secrets received~%") "secret service: invalid secrets received~%")
#f))) #f)))
(let* ((port (wait-for-client port)) (let* ((port (wait-for-client port))
(result (read-secrets port))) (result (and=> port read-secrets)))
(close-port port) (when port
(close-port port))
result)) result))
;;; secret-service.scm ends here ;;; secret-service.scm ends here