Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Fri, 11 Sep 2020 14:42:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
Message #17 received at 43340 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 43340 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 5/5] authenticate: Cache the ACL and key pairs. Date: Fri, 11 Sep 2020 16:51:54 +0200
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 'current-acl' upfront and cache its result.
Add 'key-pairs' as an argument to 'loop' and use it as a cache of key
pairs.
---
guix/scripts/authenticate.scm | 108 +++++++++++++++++++++-------------
1 file changed, 66 insertions(+), 42 deletions(-)
diff --git a/guix/scripts/authenticate.scm b/guix/scripts/authenticate.scm
index 34737481d5..95005641c4 100644
--- a/guix/scripts/authenticate.scm
+++ b/guix/scripts/authenticate.scm
@@ -24,10 +24,12 @@
#:use-module (guix diagnostics)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (srfi srfi-71)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
+ #:use-module (ice-9 vlist)
#:export (guix-authenticate))
;;; Commentary:
@@ -42,32 +44,40 @@
;; Read a gcrypt sexp from a port and return it.
(compose string->canonical-sexp read-string))
-(define (sign-with-key key-file sha256)
- "Sign the hash SHA256 (a bytevector) with KEY-FILE, and return the signature
-as a canonical sexp that includes both the hash and the actual signature."
- (let* ((secret-key (call-with-input-file key-file read-canonical-sexp))
- (public-key (if (string-suffix? ".sec" key-file)
- (call-with-input-file
+(define (load-key-pair key-file)
+ "Load the key pair whose secret key lives at KEY-FILE. Return a pair of
+canonical sexps representing those keys."
+ (catch 'system-error
+ (lambda ()
+ (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)
".pub")
- read-canonical-sexp)
- (raise
- (formatted-message
- (G_ "cannot find public key for secret key '~a'~%")
- key-file))))
- (data (bytevector->hash-data sha256
- #:key-type (key-type public-key)))
- (signature (signature-sexp data secret-key public-key)))
- signature))
+ read-canonical-sexp)))
+ (cons public-key secret-key)))
+ (lambda args
+ (let ((errno (system-error-errno args)))
+ (raise
+ (formatted-message
+ (G_ "failed to load key pair at '~a': ~a~%")
+ key-file (strerror errno)))))))
-(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
-authorized, verify the signature, and return the signed data (a bytevector)
-upon success."
+authorized in ACL, verify the signature, and return the signed data (a
+bytevector) upon success."
(let* ((subject (signature-subject signature))
(data (signature-signed-data signature)))
(if (and data subject)
- (if (authorized-key? subject)
+ (if (authorized-key? subject acl)
(if (valid-signature? signature)
(hash-data->bytevector data) ; success
(raise
@@ -145,29 +155,43 @@ be used internally by 'guix-daemon'.\n")))
(("--version")
(show-version-and-exit "guix authenticate"))
(()
- (let loop ()
- (guard (c ((formatted-message? c)
- (send-reply 500
- (apply format #f
- (G_ (formatted-message-string c))
- (formatted-message-arguments c)))))
- ;; Read a request on standard input and reply.
- (match (read-command (current-input-port))
- (("sign" signing-key (= base16-string->bytevector hash))
- (let ((signature (sign-with-key signing-key hash)))
- (send-reply 0 (canonical-sexp->string signature))))
- (("verify" signature)
- (send-reply 0
- (bytevector->base16-string
- (validate-signature
- (string->canonical-sexp signature)))))
- (()
- (exit 0))
- (commands
- (warning (G_ "~s: invalid command; ignoring~%") commands)
- (send-reply 404 "invalid command"))))
-
- (loop)))
+ (let ((acl (current-acl)))
+ (let loop ((key-pairs vlist-null))
+ (guard (c ((formatted-message? c)
+ (send-reply 500
+ (apply format #f
+ (G_ (formatted-message-string c))
+ (formatted-message-arguments c)))))
+ ;; Read a request on standard input and reply.
+ (match (read-command (current-input-port))
+ (("sign" signing-key (= base16-string->bytevector hash))
+ (let* ((key-pairs keys
+ (match (vhash-assoc signing-key key-pairs)
+ ((_ . keys)
+ (values key-pairs keys))
+ (#f
+ (let ((keys (load-key-pair signing-key)))
+ (values (vhash-cons signing-key keys
+ key-pairs)
+ keys)))))
+ (signature (match keys
+ ((public . secret)
+ (sign-with-key public secret hash)))))
+ (send-reply 0 (canonical-sexp->string signature))
+ (loop key-pairs)))
+ (("verify" signature)
+ (send-reply 0
+ (bytevector->base16-string
+ (validate-signature
+ (string->canonical-sexp signature)
+ acl)))
+ (loop key-pairs))
+ (()
+ (exit 0))
+ (commands
+ (warning (G_ "~s: invalid command; ignoring~%") commands)
+ (send-reply 404 "invalid command")
+ (loop key-pairs)))))))
(_
(leave (G_ "wrong arguments~%"))))))
--
2.28.0
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.