~ruther/guix-local

39e3b4b7cee175a3c1f37329744c582528d55f5d — Ludovic Courtès 4 years ago 0cc742b
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.
2 files changed, 49 insertions(+), 13 deletions(-)

M gnu/build/secret-service.scm
M gnu/services/virtualization.scm
M gnu/build/secret-service.scm => gnu/build/secret-service.scm +16 -1
@@ 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)

M gnu/services/virtualization.scm => gnu/services/virtualization.scm +33 -12
@@ 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