07/15: openpgp: 'lookup-key-by-{id, fingerprint}' return the key first.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit bd8126558dc7a022d7853d803d7134ffa1b7bc52
Author: Ludovic Courtès <address@hidden>
AuthorDate: Thu Apr 30 15:43:19 2020 +0200

    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.
---
 guix/openpgp.scm  | 43 +++++++++++++++++++------------------------
 tests/openpgp.scm | 22 +++++++++++-----------
 2 files changed, 30 insertions(+), 35 deletions(-)

diff --git a/guix/openpgp.scm b/guix/openpgp.scm
index a871eb1..987660f 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 cc5e6cb..a85fe6a 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 <address@hidden>")
-              (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 <address@hidden>")
+             (eq? (lookup-key-by-fingerprint keyring fingerprint)
+                  primary))))))
 
 (test-equal "get-openpgp-detached-signature/ascii"
   (list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)