me
/
guix
Archived
1
0
Fork 0
Code

authenticate: Cache the ACL and key pairs. 

In practice we're always using the same key pair,
/etc/guix/signing-key.{pub,sec}.  Keeping them in cache allows us to
avoid redundant I/O and parsing when signing multiple store items in a
row.

* guix/scripts/authenticate.scm (load-key-pair): New procedure.
(sign-with-key): Remove 'key-file' parameter and add 'public-key' and
'secret-key'.  Adjust accordingly.
(validate-signature): Add 'acl' parameter and pass it to
'authorized-key?'.
(guix-authenticate)[call-with-reply]: New procedure.
[with-reply]: New macro.
Call 'current-acl' upfront and cache its result.  Add 'key-pairs' as an
argument to 'loop' and use it as a cache of key pairs.
master
Ludovic Courtès 2020-09-11 14:35:07 +02:00
parent 64cf660f87
commit 7d516c17da
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 64 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
guix/scripts/authenticate.scm
View File

@ -25,10 +25,12 @@
#:use-module (guix diagnostics) #:use-module (guix diagnostics)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (srfi srfi-71)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports) #:use-module (ice-9 binary-ports)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 vlist)
#:export (guix-authenticate)) #:export (guix-authenticate))
;;; Commentary: ;;; Commentary:
@ -43,32 +45,40 @@
;; Read a gcrypt sexp from a port and return it. ;; Read a gcrypt sexp from a port and return it.
(compose string->canonical-sexp read-string)) (compose string->canonical-sexp read-string))
(define (sign-with-key key-file sha256) (define (load-key-pair key-file)
"Sign the hash SHA256 (a bytevector) with KEY-FILE, and return the signature "Load the key pair whose secret key lives at KEY-FILE. Return a pair of
as a canonical sexp that includes both the hash and the actual signature." canonical sexps representing those keys."
(let* ((secret-key (call-with-input-file key-file read-canonical-sexp)) (catch 'system-error
(public-key (if (string-suffix? ".sec" key-file) (lambda ()
(call-with-input-file (let* ((secret-key (call-with-input-file key-file read-canonical-sexp))
(public-key (call-with-input-file
(string-append (string-drop-right key-file 4) (string-append (string-drop-right key-file 4)
".pub") ".pub")
read-canonical-sexp) read-canonical-sexp)))
(raise (cons public-key secret-key)))
(formatted-message (lambda args
(G_ "cannot find public key for secret key '~a'~%") (let ((errno (system-error-errno args)))
key-file)))) (raise
(data (bytevector->hash-data sha256 (formatted-message
#:key-type (key-type public-key))) (G_ "failed to load key pair at '~a': ~a~%")
(signature (signature-sexp data secret-key public-key))) key-file (strerror errno)))))))
signature))
(define (validate-signature signature) (define (sign-with-key public-key secret-key sha256)
"Sign the hash SHA256 (a bytevector) with SECRET-KEY (a canonical sexp), and
return the signature as a canonical sexp that includes SHA256, PUBLIC-KEY, and
the actual signature."
(let ((data (bytevector->hash-data sha256
#:key-type (key-type public-key))))
(signature-sexp data secret-key public-key)))
(define (validate-signature signature acl)
"Validate SIGNATURE, a canonical sexp. Check whether its public key is "Validate SIGNATURE, a canonical sexp. Check whether its public key is
authorized, verify the signature, and return the signed data (a bytevector) authorized in ACL, verify the signature, and return the signed data (a
upon success." bytevector) upon success."
(let* ((subject (signature-subject signature)) (let* ((subject (signature-subject signature))
(data (signature-signed-data signature))) (data (signature-signed-data signature)))
(if (and data subject) (if (and data subject)
(if (authorized-key? subject) (if (authorized-key? subject acl)
(if (valid-signature? signature) (if (valid-signature? signature)
(hash-data->bytevector data) ; success (hash-data->bytevector data) ; success
(raise (raise
@ -145,6 +155,19 @@ by colon, followed by the given number of characters."
(put-bytevector (current-output-port) bv) (put-bytevector (current-output-port) bv)
(force-output (current-output-port)))) (force-output (current-output-port))))
(define (call-with-reply thunk)
;; Send a reply for the result of THUNK or for any exception raised during
;; its execution.
(guard (c ((formatted-message? c)
(send-reply (reply-code command-failed)
(apply format #f
(G_ (formatted-message-string c))
(formatted-message-arguments c)))))
(send-reply (reply-code success) (thunk))))
(define-syntax-rule (with-reply exp ...)
(call-with-reply (lambda () exp ...)))
;; Signature sexps written to stdout may contain binary data, so force ;; Signature sexps written to stdout may contain binary data, so force
;; ISO-8859-1 encoding so that things are not mangled. See ;; ISO-8859-1 encoding so that things are not mangled. See
;; <http://bugs.gnu.org/17312> for details. ;; <http://bugs.gnu.org/17312> for details.
@ -162,31 +185,38 @@ Sign data or verify signatures. This tool is meant to be used internally by
(("--version") (("--version")
(show-version-and-exit "guix authenticate")) (show-version-and-exit "guix authenticate"))
(() (()
(let loop () (let ((acl (current-acl)))
(guard (c ((formatted-message? c) (let loop ((key-pairs vlist-null))
(send-reply (reply-code command-failed)
(apply format #f
(G_ (formatted-message-string c))
(formatted-message-arguments c)))))
;; Read a request on standard input and reply. ;; Read a request on standard input and reply.
(match (read-command (current-input-port)) (match (read-command (current-input-port))
(("sign" signing-key (= base16-string->bytevector hash)) (("sign" signing-key (= base16-string->bytevector hash))
(let ((signature (sign-with-key signing-key hash))) (let* ((key-pairs keys
(send-reply (reply-code success) (match (vhash-assoc signing-key key-pairs)
(canonical-sexp->string signature)))) ((_ . keys)
(values key-pairs keys))
(#f
(let ((keys (load-key-pair signing-key)))
(values (vhash-cons signing-key keys
key-pairs)
keys))))))
(with-reply (canonical-sexp->string
(match keys
((public . secret)
(sign-with-key public secret hash)))))
(loop key-pairs)))
(("verify" signature) (("verify" signature)
(send-reply (reply-code success) (with-reply (bytevector->base16-string
(bytevector->base16-string
(validate-signature (validate-signature
(string->canonical-sexp signature))))) (string->canonical-sexp signature)
acl)))
(loop key-pairs))
(() (()
(exit 0)) (exit 0))
(commands (commands
(warning (G_ "~s: invalid command; ignoring~%") commands) (warning (G_ "~s: invalid command; ignoring~%") commands)
(send-reply (reply-code command-not-found) (send-reply (reply-code command-not-found)
"invalid command")))) "invalid command")
(loop key-pairs))))))
(loop)))
(_ (_
(leave (G_ "wrong arguments~%")))))) (leave (G_ "wrong arguments~%"))))))