me
/
guix
Archived
1
0
Fork 0
Code

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'.
master
Ludovic Courtès 2022-03-28 14:27:34 +02:00
parent 808b9e8504
commit 83121aa85a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
gnu/build/secret-service.scm
View File

@ -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."