summaryrefslogtreecommitdiff
path: root/gnu/services/base.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-03-10 23:39:14 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-10 23:41:33 +0100
commit8b3ad455be7e8ace35a2eaebf7fffbb611280852 (patch)
tree6c6732f2e7e3c06fde56418bfad6013e8aa89626 /gnu/services/base.scm
parent309d87c3aa8df1a0784efa903f63d0d9b95cace6 (diff)
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.
Diffstat (limited to 'gnu/services/base.scm')
-rw-r--r--gnu/services/base.scm69
1 files changed, 51 insertions, 18 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index fffb7b301b..67df4d1379 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -43,6 +43,7 @@
#:select (canonical-package glibc glibc-utf8-locales))
#:use-module (gnu packages bash)
#:use-module (gnu packages package-management)
+ #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
#:use-module (gnu packages linux)
#:use-module (gnu packages terminals)
#:use-module ((gnu build file-systems)
@@ -50,6 +51,7 @@
#:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix modules)
+ #:use-module ((guix self) #:select (make-config.scm))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
@@ -1502,27 +1504,58 @@ GID."
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)
"Return a gexp with code to register KEYS, a list of files containing 'guix
archive' public keys, with GUIX."
- #~(unless (file-exists? "/etc/guix/acl")
- (for-each (lambda (key)
- (let ((pid (primitive-fork)))
- (case pid
- ((0)
- (let* ((port (open-file key "r0b")))
- (format #t "registering public key '~a'...~%" key)
- (close-port (current-input-port))
- (dup port 0)
- (execl #$(file-append guix "/bin/guix")
- "guix" "archive" "--authorize")
- (primitive-exit 1)))
- (else
- (let ((status (cdr (waitpid pid))))
- (unless (zero? status)
- (format (current-error-port) "warning: \
-failed to register public key '~a': ~a~%" key status)))))))
- '(#$@keys))))
+ (define aaa
+ ;; XXX: Terrible hack to work around <https://bugs.gnu.org/15602>: this
+ ;; forces (guix config) and (guix utils) to be loaded upfront, so that
+ ;; their run-time symbols are defined.
+ (scheme-file "aaa.scm"
+ #~(define-module (guix aaa)
+ #:use-module (guix config)
+ #:use-module (guix memoization))))
+
+ (define default-acl
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules `(((guix config) => ,(make-config.scm))
+ ((guix aaa) => ,aaa)
+ ,@(source-module-closure '((guix pki))
+ #:select? not-config?))
+ (computed-file "acl"
+ #~(begin
+ (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
;; List of authorized substitute keys.