services: guix: Pre-compute the default ACL.

This makes the first boot slightly faster.

* gnu/services/base.scm (not-config?): New procedure.
(hydra-key-authorization): Rewrite to pre-compute the default ACL, and
pre-compute it using (guix pki) directly.
This commit is contained in:
Ludovic Courtès 2019-03-10 23:39:14 +01:00
parent 309d87c3aa
commit 8b3ad455be
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -43,6 +43,7 @@ (define-module (gnu services base)
#:select (canonical-package glibc glibc-utf8-locales)) #:select (canonical-package glibc glibc-utf8-locales))
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages terminals) #:use-module (gnu packages terminals)
#:use-module ((gnu build file-systems) #:use-module ((gnu build file-systems)
@ -50,6 +51,7 @@ (define-module (gnu services base)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix modules) #:use-module (guix modules)
#:use-module ((guix self) #:select (make-config.scm))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -1502,27 +1504,58 @@ (define* (guix-build-accounts count #:key
1+ 1+
1)) 1))
(define not-config?
;; Select (guix …) and (gnu …) modules, except (guix config).
(match-lambda
(('guix 'config) #f)
(('guix rest ...) #t)
(('gnu rest ...) #t)
(rest #f)))
(define (hydra-key-authorization keys guix) (define (hydra-key-authorization keys guix)
"Return a gexp with code to register KEYS, a list of files containing 'guix "Return a gexp with code to register KEYS, a list of files containing 'guix
archive' public keys, with GUIX." archive' public keys, with GUIX."
#~(unless (file-exists? "/etc/guix/acl") (define aaa
(for-each (lambda (key) ;; XXX: Terrible hack to work around <https://bugs.gnu.org/15602>: this
(let ((pid (primitive-fork))) ;; forces (guix config) and (guix utils) to be loaded upfront, so that
(case pid ;; their run-time symbols are defined.
((0) (scheme-file "aaa.scm"
(let* ((port (open-file key "r0b"))) #~(define-module (guix aaa)
(format #t "registering public key '~a'...~%" key) #:use-module (guix config)
(close-port (current-input-port)) #:use-module (guix memoization))))
(dup port 0)
(execl #$(file-append guix "/bin/guix") (define default-acl
"guix" "archive" "--authorize") (with-extensions (list guile-gcrypt)
(primitive-exit 1))) (with-imported-modules `(((guix config) => ,(make-config.scm))
(else ((guix aaa) => ,aaa)
(let ((status (cdr (waitpid pid)))) ,@(source-module-closure '((guix pki))
(unless (zero? status) #:select? not-config?))
(format (current-error-port) "warning: \ (computed-file "acl"
failed to register public key '~a': ~a~%" key status))))))) #~(begin
'(#$@keys)))) (use-modules (guix pki)
(gcrypt pk-crypto)
(ice-9 rdelim))
(define keys
(map (lambda (file)
(call-with-input-file file
(compose string->canonical-sexp
read-string)))
'(#$@keys)))
(call-with-output-file #$output
(lambda (port)
(write-acl (public-keys->acl keys)
port))))))))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
(unless (file-exists? "/etc/guix/acl")
(mkdir-p "/etc/guix")
(copy-file #+default-acl "/etc/guix/acl")
(chmod "/etc/guix/acl" #o600)))))
(define %default-authorized-guix-keys (define %default-authorized-guix-keys
;; List of authorized substitute keys. ;; List of authorized substitute keys.