services: guix-daemon: Fix authorization of multiple keys.

Previously, the 'unless (file-exists? "/etc/guix/acl")' guard would mean
that only the first key in the list would get registered since were were
generating one registration snippet per key.  This fixes that.

* gnu/services/base.scm (hydra-key-authorization): Change to be a
'for-each' loop iterating on #$KEYS.
This commit is contained in:
Ludovic Courtès 2018-12-05 16:16:05 +01:00
parent eeedb094ec
commit 970ebdae8c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 21 additions and 21 deletions

View File

@ -1499,26 +1499,27 @@ starting at FIRST-UID, and under GID."
1+ 1+
1)) 1))
(define (hydra-key-authorization key guix) (define (hydra-key-authorization keys guix)
"Return a gexp with code to register KEY, a file containing a 'guix archive' "Return a gexp with code to register KEYS, a list of files containing 'guix
public key, with GUIX." archive' public keys, with GUIX."
#~(unless (file-exists? "/etc/guix/acl") #~(unless (file-exists? "/etc/guix/acl")
(let ((pid (primitive-fork))) (for-each (lambda (key)
(case pid (let ((pid (primitive-fork)))
((0) (case pid
(let* ((key #$key) ((0)
(port (open-file key "r0b"))) (let* ((port (open-file key "r0b")))
(format #t "registering public key '~a'...~%" key) (format #t "registering public key '~a'...~%" key)
(close-port (current-input-port)) (close-port (current-input-port))
(dup port 0) (dup port 0)
(execl #$(file-append guix "/bin/guix") (execl #$(file-append guix "/bin/guix")
"guix" "archive" "--authorize") "guix" "archive" "--authorize")
(exit 1))) (primitive-exit 1)))
(else (else
(let ((status (cdr (waitpid pid)))) (let ((status (cdr (waitpid pid))))
(unless (zero? status) (unless (zero? status)
(format (current-error-port) "warning: \ (format (current-error-port) "warning: \
failed to register public key '~a': ~a~%" key status)))))))) failed to register public key '~a': ~a~%" key status)))))))
'(#$@keys))))
(define %default-authorized-guix-keys (define %default-authorized-guix-keys
;; List of authorized substitute keys. ;; List of authorized substitute keys.
@ -1632,8 +1633,7 @@ failed to register public key '~a': ~a~%" key status))))))))
;; Optionally authorize substitute server keys. ;; Optionally authorize substitute server keys.
(if authorize-key? (if authorize-key?
#~(begin (hydra-key-authorization keys guix)
#$@(map (cut hydra-key-authorization <> guix) keys))
#~#f)))) #~#f))))
(define* (references-file item #:optional (name "references")) (define* (references-file item #:optional (name "references"))