ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: guix: Pre-compute the default ACL.

Browse source 
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
1 changed files with 51 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

69
gnu/services/base.scm
View file

@ -43,6 +43,7 @@ (define-module (gnu services base)
#: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 @@ (define-module (gnu services base)
#: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 @@ (define* (guix-build-accounts count #:key
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.