[bug#51440] [PATCH 06/10] services: secret-service: Turn into a Shepherd service.

[Ludovic Courtès]

* 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.
---
 gnu/build/secret-service.scm    | 17 ++++++++++++-
 gnu/services/virtualization.scm | 45 ++++++++++++++++++++++++---------
 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 @@ (define (send-files sock)
        (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 @@ (define (read-secrets port)
                    (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 bca5f56b87..e7d2a7b833 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -852,23 +852,44 @@ (define qemu-binfmt-service-type
 ;;; 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
-- 
2.33.0