aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/build/secret-service.scm17
-rw-r--r--gnu/services/virtualization.scm45
2 files changed, 49 insertions, 13 deletions
diff --git a/gnu/build/secret-service.scm b/gnu/build/secret-service.scm
index 46dcf1b9c3..4e183e11e8 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 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -111,6 +111,15 @@ wait for at most HANDSHAKE-TIMEOUT seconds for handshake to complete. Return
(close-port sock)
#f))))
+(define (delete-file* file)
+ "Ensure FILE does not exist."
+ (catch 'system-error
+ (lambda ()
+ (delete-file file))
+ (lambda args
+ (unless (= ENOENT (system-error-errno args))
+ (apply throw args)))))
+
(define (secret-service-receive-secrets port)
"Listen to local PORT and wait for a secret service client to send secrets.
Write them to the file system. Return the list of files installed on success,
@@ -170,6 +179,12 @@ and #f otherwise."
(log "installing file '~a' (~a bytes)...~%"
file size)
(mkdir-p (dirname file))
+
+ ;; It could be that FILE already exists, for instance
+ ;; because it has been created by a service's activation
+ ;; snippet (e.g., SSH host keys). Delete it.
+ (delete-file* file)
+
(call-with-output-file file
(lambda (output)
(dump port output size)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index 4222bb4353..66ae1a1565 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -898,23 +898,44 @@ specified, the QEMU default path is used."))
;;; Secrets for guest VMs.
;;;
-(define (secret-service-activation port)
- "Return an activation snippet that fetches sensitive material at local PORT,
+(define (secret-service-shepherd-services port)
+ "Return a Shepherd service that fetches sensitive material at local PORT,
over TCP. Reboot upon failure."
- (with-imported-modules '((gnu build secret-service)
- (guix build utils))
- #~(begin
- (use-modules (gnu build secret-service))
- (let ((sent (secret-service-receive-secrets #$port)))
- (unless sent
- (sleep 3)
- (reboot))))))
+ ;; This is a Shepherd service, rather than an activation snippet, to make
+ ;; sure it is started once 'networking' is up so it can accept incoming
+ ;; connections.
+ (list
+ (shepherd-service
+ (documentation "Fetch secrets from the host at startup time.")
+ (provision '(secret-service-client))
+ (requirement '(loopback networking))
+ (modules '((gnu build secret-service)
+ (guix build utils)))
+ (start (with-imported-modules '((gnu build secret-service)
+ (guix build utils))
+ #~(lambda ()
+ ;; Since shepherd's output port goes to /dev/log, write this
+ ;; message to stderr so it's visible on the Mach console.
+ (format (current-error-port)
+ "receiving secrets from the host...~%")
+ (force-output (current-error-port))
+
+ (let ((sent (secret-service-receive-secrets #$port)))
+ (unless sent
+ (sleep 3)
+ (reboot))))))
+ (stop #~(const #f)))))
(define secret-service-type
(service-type
(name 'secret-service)
- (extensions (list (service-extension activation-service-type
- secret-service-activation)))
+ (extensions (list (service-extension shepherd-root-service-type
+ secret-service-shepherd-services)
+
+ ;; Make every Shepherd service depend on
+ ;; 'secret-service-client'.
+ (service-extension user-processes-service-type
+ (const '(secret-service-client)))))
(description
"This service fetches secret key and other sensitive material over TCP at
boot time. This service is meant to be used by virtual machines (VMs) that