aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-04-30 15:43:19 +0200
committerLudovic Courtès <ludo@gnu.org>2020-05-04 09:56:13 +0200
commitbd8126558dc7a022d7853d803d7134ffa1b7bc52 (patch)
tree4eefdfc92ddf9ff6db9f8b122dfe09e50dc06d80
parentb45fa0a123bec8d023e5520dfb381bfc73313929 (diff)
downloadguix-bd8126558dc7a022d7853d803d7134ffa1b7bc52.tar.gz
guix-bd8126558dc7a022d7853d803d7134ffa1b7bc52.zip
openpgp: 'lookup-key-by-{id,fingerprint}' return the key first.
Previously, 'lookup-key-by-{id,fingerprint}' would always return the list of packets where the primary key is first. Thus, the caller would need to use 'find' to actually find the requested key. * guix/openpgp.scm (keyring-insert): Always add KEY to PACKETS. (lookup-key-by-id, lookup-key-by-fingerprint): Change to return the key as the first value. (verify-openpgp-signature): Remove now unneeded call to 'find'. * tests/openpgp.scm ("get-openpgp-keyring"): Adjust accordingly.
-rw-r--r--guix/openpgp.scm43
-rw-r--r--tests/openpgp.scm22
2 files changed, 30 insertions, 35 deletions
diff --git a/guix/openpgp.scm b/guix/openpgp.scm
index a871eb1a16..987660fa29 100644
--- a/guix/openpgp.scm
+++ b/guix/openpgp.scm
@@ -566,21 +566,12 @@ the issuer's OpenPGP public key extracted from KEYRING."
(if (= (openpgp-signature-type sig) SIGNATURE-BINARY)
(let* ((id (openpgp-signature-issuer-key-id sig))
(fingerprint (openpgp-signature-issuer-fingerprint sig))
- (key-data (if fingerprint
+ (key (if fingerprint
(lookup-key-by-fingerprint keyring fingerprint)
(lookup-key-by-id keyring id))))
- ;; Find the primary key or subkey that made the signature.
- (let ((key (find (lambda (k)
- (and (openpgp-public-key? k)
- (if fingerprint
- (bytevector=?
- (openpgp-public-key-fingerprint k)
- fingerprint)
- (= (openpgp-public-key-id k) id))))
- key-data)))
- (if key
- (check key sig)
- (values 'missing-key (or fingerprint id)))))
+ (if key
+ (check key sig)
+ (values 'missing-key (or fingerprint id))))
(values 'unsupported-signature sig)))
(define (key-id-matches-fingerprint? key-id fingerprint)
@@ -925,29 +916,33 @@ FINGERPRINT, a bytevector."
(ids openpgp-keyring-ids) ;vhash mapping key id to packets
(fingerprints openpgp-keyring-fingerprints)) ;mapping fingerprint to packets
-(define* (keyring-insert key keyring #:optional (packets (list key)))
+(define* (keyring-insert key keyring #:optional (packets '()))
"Insert the KEY/PACKETS association into KEYRING and return the resulting
keyring. PACKETS typically contains KEY, an <openpgp-public-key>, alongside
with additional <openpgp-public-key> records for sub-keys, <openpgp-user-id>
records, and so on."
- (openpgp-keyring (vhash-consv (openpgp-public-key-id key) packets
+ (openpgp-keyring (vhash-consv (openpgp-public-key-id key)
+ (cons key packets)
(openpgp-keyring-ids keyring))
- (vhash-cons (openpgp-public-key-fingerprint key) packets
+ (vhash-cons (openpgp-public-key-fingerprint key)
+ (cons key packets)
(openpgp-keyring-fingerprints keyring))))
(define (lookup-key-by-id keyring id)
- "Return a list of packets for the key with ID in KEYRING, or #f if ID could
-not be found. ID must be the 64-bit key ID of the key, an integer."
+ "Return two values: the first key with ID in KEYRING, and a list of
+associated packets (user IDs, signatures, etc.). Return #f and the empty list
+of ID was not found. ID must be the 64-bit key ID of the key, an integer."
(match (vhash-assv id (openpgp-keyring-ids keyring))
- ((_ . lst) lst)
- (#f '())))
+ ((_ key packets ...) (values key packets))
+ (#f (values #f '()))))
(define (lookup-key-by-fingerprint keyring fingerprint)
- "Return a list of packets for the key with FINGERPRINT in KEYRING, or #f if
-FINGERPRINT could not be found. FINGERPRINT must be a bytevector."
+ "Return two values: the key with FINGERPRINT in KEYRING, and a list of
+associated packets (user IDs, signatures, etc.). Return #f and the empty list
+of FINGERPRINT was not found. FINGERPRINT must be a bytevector."
(match (vhash-assoc fingerprint (openpgp-keyring-fingerprints keyring))
- ((_ . lst) lst)
- (#f '())))
+ ((_ key packets ...) (values key packets))
+ (#f (values #f '()))))
;; Reads a keyring from the binary input port p. It must not be
;; ASCII armored.
diff --git a/tests/openpgp.scm b/tests/openpgp.scm
index cc5e6cbcf7..a85fe6a6cb 100644
--- a/tests/openpgp.scm
+++ b/tests/openpgp.scm
@@ -160,17 +160,17 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
(keyring (get-openpgp-keyring
(open-bytevector-input-port
(call-with-input-file key read-radix-64)))))
- (match (lookup-key-by-id keyring %civodul-key-id)
- (((? openpgp-public-key? primary) packets ...)
- (let ((fingerprint (openpgp-public-key-fingerprint primary)))
- (and (= (openpgp-public-key-id primary) %civodul-key-id)
- (not (openpgp-public-key-subkey? primary))
- (string=? (openpgp-format-fingerprint fingerprint)
- %civodul-fingerprint)
- (string=? (openpgp-user-id-value (find openpgp-user-id? packets))
- "Ludovic Courtès <ludo@gnu.org>")
- (equal? (lookup-key-by-id keyring %civodul-key-id)
- (lookup-key-by-fingerprint keyring fingerprint))))))))
+ (let-values (((primary packets)
+ (lookup-key-by-id keyring %civodul-key-id)))
+ (let ((fingerprint (openpgp-public-key-fingerprint primary)))
+ (and (= (openpgp-public-key-id primary) %civodul-key-id)
+ (not (openpgp-public-key-subkey? primary))
+ (string=? (openpgp-format-fingerprint fingerprint)
+ %civodul-fingerprint)
+ (string=? (openpgp-user-id-value (find openpgp-user-id? packets))
+ "Ludovic Courtès <ludo@gnu.org>")
+ (eq? (lookup-key-by-fingerprint keyring fingerprint)
+ primary))))))
(test-equal "get-openpgp-detached-signature/ascii"
(list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)