civodul pushed a commit to branch wip-openpgp
in repository guix.
commit 65e804f1c133d04e47a736e9d08187b448736076
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Sun Apr 26 23:20:26 2020 +0200
openpgp: Add 'lookup-key-by-fingerprint'.
* guix/openpgp.scm (<openpgp-keyring>)[table]: Rename to...
[ids]: ... this.
[fingerprints]: New field.
(keyring-insert, lookup-key-by-fingerprint): New procedures.
(%empty-keyring): Adjust.
(get-openpgp-keyring): Manipulate KEYRING instead of its vhash, use
'keyring-insert'.
* tests/openpgp.scm ("get-openpgp-keyring"): Test
'lookup-key-by-fingerprint'.
---
guix/openpgp.scm | 43 +++++++++++++++++++++++++++++++------------
tests/openpgp.scm | 16 +++++++++-------
2 files changed, 40 insertions(+), 19 deletions(-)
diff --git a/guix/openpgp.scm b/guix/openpgp.scm
index 442ad8a..1fb91c5 100644
--- a/guix/openpgp.scm
+++ b/guix/openpgp.scm
@@ -52,6 +52,7 @@
openpgp-keyring?
%empty-keyring
lookup-key-by-id
+ lookup-key-by-fingerprint
get-openpgp-keyring
read-radix-64)
@@ -909,14 +910,32 @@ FINGERPRINT, a bytevector."
;;; Keyring management
(define-record-type <openpgp-keyring>
- (openpgp-keyring table)
+ (openpgp-keyring ids fingerprints)
openpgp-keyring?
- (table openpgp-keyring-table)) ;vhash mapping key id to packets
+ (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)))
+ "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-ids keyring))
+ (vhash-cons (openpgp-public-key-fingerprint 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."
- (match (vhash-assv id (openpgp-keyring-table keyring))
+ (match (vhash-assv id (openpgp-keyring-ids keyring))
+ ((_ . lst) lst)
+ (#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."
+ (match (vhash-assoc fingerprint (openpgp-keyring-fingerprints keyring))
((_ . lst) lst)
(#f '())))
@@ -925,7 +944,7 @@ not be found. ID must be the 64-bit key ID of the key, an
integer."
(define %empty-keyring
;; The empty keyring.
- (openpgp-keyring vlist-null))
+ (openpgp-keyring vlist-null vlist-null))
(define* (get-openpgp-keyring port
#:optional (keyring %empty-keyring)
@@ -936,15 +955,15 @@ complements KEYRING. LIMIT is the maximum number of keys
to read, or -1 if
there is no limit."
(let lp ((pkt (get-packet port))
(limit limit)
- (keyring (openpgp-keyring-table keyring)))
+ (keyring keyring))
(print "#;key " pkt)
(cond ((or (zero? limit) (eof-object? pkt))
- (openpgp-keyring keyring))
+ keyring)
((openpgp-public-key-primary? pkt)
;; Read signatures, user id's, subkeys
- (let lp* ((pkt (get-packet port))
+ (let lp* ((pkt (get-packet port))
(pkts (list pkt))
- (key-ids (list (openpgp-public-key-id pkt))))
+ (keys (list pkt)))
(print "#;keydata " pkt)
(cond ((or (eof-object? pkt)
(eq? pkt 'unsupported-public-key-version)
@@ -954,13 +973,13 @@ there is no limit."
;; packets.
(lp pkt
(- limit 1)
- (fold (cute vhash-consv <> (reverse pkts) <>)
- keyring key-ids)))
+ (fold (cute keyring-insert <> <> (reverse pkts))
+ keyring keys)))
((openpgp-public-key? pkt) ;subkey
(lp* (get-packet port) (cons pkt pkts)
- (cons (openpgp-public-key-id pkt) key-ids)))
+ (cons pkt keys)))
(else
- (lp* (get-packet port) (cons pkt pkts) key-ids)))))
+ (lp* (get-packet port) (cons pkt pkts) keys)))))
(else
;; Skip until there's a primary key. Ignore errors...
(lp (get-packet port) limit keyring)))))
diff --git a/tests/openpgp.scm b/tests/openpgp.scm
index 1709167..eac2e88 100644
--- a/tests/openpgp.scm
+++ b/tests/openpgp.scm
@@ -162,13 +162,15 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
(call-with-input-file key read-radix-64)))))
(match (lookup-key-by-id keyring %civodul-key-id)
(((? openpgp-public-key? primary) packets ...)
- (and (= (openpgp-public-key-id primary) %civodul-key-id)
- (not (openpgp-public-key-subkey? primary))
- (string=? (openpgp-format-fingerprint
- (openpgp-public-key-fingerprint primary))
- %civodul-fingerprint)
- (string=? (openpgp-user-id-value (find openpgp-user-id? packets))
- "Ludovic Courtès <l...@gnu.org>"))))))
+ (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 <l...@gnu.org>")
+ (equal? (lookup-key-by-id keyring %civodul-key-id)
+ (lookup-key-by-fingerprint keyring fingerprint))))))))
(test-equal "get-openpgp-detached-signature/ascii"
(list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)
