mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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:
parent
309d87c3aa
commit
8b3ad455be
1 changed files with 51 additions and 18 deletions
|
@ -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.
|
||||||
|
|
Loading…
Reference in a new issue