services: secret-service: Turn into a Shepherd service.

* gnu/services/virtualization.scm (secret-service-activation): Remove.
(secret-service-shepherd-services): New procedure.
(secret-service-type)[extensions]: Remove ACTIVATION-SERVICE-TYPE
extension.  Add SHEPHERD-ROOT-SERVICE-TYPE and
USER-PROCESSES-SERVICE-TYPE extensions.
* gnu/build/secret-service.scm (delete-file*): New procedure.
(secret-service-receive-secrets): Use it.
This commit is contained in:
Ludovic Courtès 2021-10-25 08:33:04 +02:00
parent 0cc742b261
commit 39e3b4b7ce
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 49 additions and 13 deletions

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -111,6 +111,15 @@ (define (send-files sock)
(close-port sock) (close-port sock)
#f)))) #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) (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. Return the list of files installed on success, Write them to the file system. Return the list of files installed on success,
@ -170,6 +179,12 @@ (define (read-secrets port)
(log "installing file '~a' (~a bytes)...~%" (log "installing file '~a' (~a bytes)...~%"
file size) file size)
(mkdir-p (dirname file)) (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 (call-with-output-file file
(lambda (output) (lambda (output)
(dump port output size) (dump port output size)

View file

@ -898,23 +898,44 @@ (define qemu-guest-agent-service-type
;;; Secrets for guest VMs. ;;; Secrets for guest VMs.
;;; ;;;
(define (secret-service-activation port) (define (secret-service-shepherd-services port)
"Return an activation snippet that fetches sensitive material at local PORT, "Return a Shepherd service that fetches sensitive material at local PORT,
over TCP. Reboot upon failure." over TCP. Reboot upon failure."
(with-imported-modules '((gnu build secret-service) ;; This is a Shepherd service, rather than an activation snippet, to make
(guix build utils)) ;; sure it is started once 'networking' is up so it can accept incoming
#~(begin ;; connections.
(use-modules (gnu build secret-service)) (list
(let ((sent (secret-service-receive-secrets #$port))) (shepherd-service
(unless sent (documentation "Fetch secrets from the host at startup time.")
(sleep 3) (provision '(secret-service-client))
(reboot)))))) (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 (define secret-service-type
(service-type (service-type
(name 'secret-service) (name 'secret-service)
(extensions (list (service-extension activation-service-type (extensions (list (service-extension shepherd-root-service-type
secret-service-activation))) secret-service-shepherd-services)
;; Make every Shepherd service depend on
;; 'secret-service-client'.
(service-extension user-processes-service-type
(const '(secret-service-client)))))
(description (description
"This service fetches secret key and other sensitive material over TCP at "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 boot time. This service is meant to be used by virtual machines (VMs) that