guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 9de6ed0a7eb8e1b7ac1d1ce9c725667336308ecd
Author: Ludovic Courtès <[email protected]>
AuthorDate: Fri Sep 12 16:26:43 2025 +0200
services: secret-service: Fiberize ‘secret-service-send-secrets’.
The previous code was tentatively written to run either in a Fibers context
or
in a non-Fibers context. Drop the non-Fibers code since this always runs
within ‘shepherd’, which is fiberized.
* gnu/build/secret-service.scm (with-modules): Remove.
(wait-for-readable-fd): Rewrite using regular Fibers operations.
(secret-service-send-secrets): Use ‘SOCK_NONBLOCK’. Simplify ‘sleep’
binding.
Change-Id: Ic05d0bc54e6d2df89b6602bc716402067c845792
---
gnu/build/secret-service.scm | 67 +++++++++++++-------------------------------
1 file changed, 19 insertions(+), 48 deletions(-)
diff --git a/gnu/build/secret-service.scm b/gnu/build/secret-service.scm
index 0226c64032..615dd3535e 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-2023 Ludovic Courtès <[email protected]>
+;;; Copyright © 2020-2023, 2025 Ludovic Courtès <[email protected]>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]>
;;;
;;; This file is part of GNU Guix.
@@ -18,8 +18,12 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build secret-service)
+ #:autoload (fibers io-wakeup) (wait-until-port-readable-operation)
+ #:autoload (fibers operations) (perform-operation
+ choice-operation
+ wrap-operation)
+ #:autoload (fibers timers) (sleep-operation)
#:use-module (guix build utils)
-
#:use-module (srfi srfi-26)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
@@ -33,6 +37,9 @@
;;;
;;; Utility procedures for copying secrets into a VM.
;;;
+;;; Note: This code runs within the 'shepherd' process, hence the use of
+;;; Fibers.
+;;;
;;; Code:
(define-syntax log
@@ -47,51 +54,15 @@
;; to syslog.
#'(format (current-output-port) fmt args ...))))))
-(define-syntax with-modules
- (syntax-rules ()
- "Dynamically load the given MODULEs at run time, making the chosen
-bindings available within the lexical scope of BODY."
- ((_ ((module #:select (bindings ...)) rest ...) body ...)
- (let* ((iface (resolve-interface 'module))
- (bindings (module-ref iface 'bindings))
- ...)
- (with-modules (rest ...) body ...)))
- ((_ () body ...)
- (begin body ...))))
-
(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 (resolve-module '(fibers) #f #:ensure #f) ;using Fibers?
- (#f
- (log "blocking on socket...~%")
- (match (select (list port) '() '() timeout)
- (((_) () ()) #t)
- ((() () ()) #f)))
- (fibers
- ;; We're running on the Shepherd 0.9+ with Fibers. Arrange to make a
- ;; non-blocking wait so that other fibers can be scheduled in while we
- ;; wait for PORT.
- (with-modules (((fibers) #:select (spawn-fiber sleep))
- ((fibers channels)
- #:select (make-channel put-message get-message)))
- ;; Make PORT non-blocking.
- (let ((flags (fcntl port F_GETFL)))
- (fcntl port F_SETFL (logior O_NONBLOCK flags)))
-
- (let ((channel (make-channel)))
- (spawn-fiber
- (lambda ()
- (sleep timeout) ;suspends the fiber
- (put-message channel 'timeout)))
- (spawn-fiber
- (lambda ()
- (lookahead-u8 port) ;suspends the fiber
- (put-message channel 'readable)))
- (log "suspending fiber on socket...~%")
- (match (get-message channel)
- ('readable #t)
- ('timeout #f)))))))
+ (perform-operation
+ (choice-operation
+ (wrap-operation (wait-until-port-readable-operation port)
+ (const #t))
+ (wrap-operation (sleep-operation timeout)
+ (const #f)))))
(define (socket-address->string address)
"Return a human-readable representation of ADDRESS, an object as returned by
@@ -135,10 +106,10 @@ HANDSHAKE-TIMEOUT seconds for handshake to complete.
Return #f on failure."
(log "sending secrets to ~a~%" (socket-address->string address))
- (let ((sock (socket AF_INET (logior SOCK_CLOEXEC SOCK_STREAM) 0))
- (sleep (if (resolve-module '(fibers) #f)
- (module-ref (resolve-interface '(fibers)) 'sleep)
- sleep)))
+ (let ((sock (socket AF_INET
+ (logior SOCK_CLOEXEC SOCK_NONBLOCK SOCK_STREAM)
+ 0))
+ (sleep (module-ref (resolve-interface '(fibers)) 'sleep)))
;; Connect to QEMU on the forwarded port. The 'connect' call succeeds as
;; soon as QEMU is ready, even if there's no server listening on the
;; forward port inside the guest.
