From 5b58c28b7e134e80a831d6849079b47f8d6abea7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 18 Aug 2016 16:33:01 +0200
Subject: [PATCH] services: guix: Add 'authorized-keys' configuration knob.

* gnu/services/base.scm (hydra-key-authorization): Add 'key' parameter
and honor it.
(%default-authorized-guix-keys): New variable.
(<guix-configuration>)[authorized-keys]: New field.
(guix-shepherd-service): Adjust 'match' clause accordingly.
(guix-activation): Adjust call to 'hydra-key-authorization'.
* doc/guix.texi (Base Services): Document 'authorized-keys'.
---
 doc/guix.texi         |  9 ++++++++-
 gnu/services/base.scm | 24 ++++++++++++++++--------
 2 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index c6b489eea5..533023854b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7680,9 +7680,16 @@ Name of the group for build user accounts.
 Number of build user accounts to create.
 
 @item @code{authorize-key?} (default: @code{#t})
-Whether to authorize the substitute key for @code{hydra.gnu.org}
+Whether to authorize the substitute keys listed in
+@code{authorized-keys}---by default that of @code{hydra.gnu.org}
 (@pxref{Substitutes}).
 
+@vindex %default-authorized-guix-keys
+@item @code{authorized-keys} (default: @var{%default-authorized-guix-keys})
+The list of authorized key files for archive imports, as a list of
+string-valued gexps (@pxref{Invoking guix archive}).  By default, it
+contains that of @code{hydra.gnu.org} (@pxref{Substitutes}).
+
 @item @code{use-substitutes?} (default: @code{#t})
 Whether to use substitutes.
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 218f3b3cf3..3b4c22f8a2 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -86,6 +86,7 @@
             syslog-service-type
             %default-syslog.conf
 
+            %default-authorized-guix-keys
             guix-configuration
             guix-configuration?
             guix-service
@@ -1003,15 +1004,14 @@ starting at FIRST-UID, and under GID."
           1+
           1))
 
-(define (hydra-key-authorization guix)
-  "Return a gexp with code to register the hydra.gnu.org public key with
-GUIX."
+(define (hydra-key-authorization key guix)
+  "Return a gexp with code to register KEY, a file containing a 'guix archive'
+public key, with GUIX."
   #~(unless (file-exists? "/etc/guix/acl")
       (let ((pid (primitive-fork)))
         (case pid
           ((0)
-           (let* ((key  (string-append #$guix
-                                       "/share/guix/hydra.gnu.org.pub"))
+           (let* ((key  #$key)
                   (port (open-file key "r0b")))
              (format #t "registering public key '~a'...~%" key)
              (close-port (current-input-port))
@@ -1025,6 +1025,10 @@ GUIX."
                (format (current-error-port) "warning: \
 failed to register hydra.gnu.org public key: ~a~%" status))))))))
 
+(define %default-authorized-guix-keys
+  ;; List of authorized substitute keys.
+  (list #~(string-append #$guix "/share/guix/hydra.gnu.org.pub")))
+
 (define-record-type* <guix-configuration>
   guix-configuration make-guix-configuration
   guix-configuration?
@@ -1036,6 +1040,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
                     (default 10))
   (authorize-key?   guix-configuration-authorize-key? ;Boolean
                     (default #t))
+  (authorized-keys  guix-configuration-authorized-keys ;list of gexps
+                    (default %default-authorized-guix-keys))
   (use-substitutes? guix-configuration-use-substitutes? ;Boolean
                     (default #t))
   (substitute-urls  guix-configuration-substitute-urls ;list of strings
@@ -1053,7 +1059,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
 (define (guix-shepherd-service config)
   "Return a <shepherd-service> for the Guix daemon service with CONFIG."
   (match config
-    (($ <guix-configuration> guix build-group build-accounts authorize-key?
+    (($ <guix-configuration> guix build-group build-accounts
+                             authorize-key? keys
                              use-substitutes? substitute-urls extra-options
                              lsof lsh)
      (list (shepherd-service
@@ -1093,14 +1100,15 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
 (define (guix-activation config)
   "Return the activation gexp for CONFIG."
   (match config
-    (($ <guix-configuration> guix build-group build-accounts authorize-key?)
+    (($ <guix-configuration> guix build-group build-accounts authorize-key? keys)
      ;; Assume that the store has BUILD-GROUP as its group.  We could
      ;; otherwise call 'chown' here, but the problem is that on a COW unionfs,
      ;; chown leads to an entire copy of the tree, which is a bad idea.
 
      ;; Optionally authorize hydra.gnu.org's key.
      (if authorize-key?
-         (hydra-key-authorization guix)
+         #~(begin
+             #$@(map (cut hydra-key-authorization <> guix) keys))
          #~#f))))
 
 (define guix-service-type