[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/12: openpgp: Add 'lookup-key-by-fingerprint'.
From: |
guix-commits |
Subject: |
05/12: openpgp: Add 'lookup-key-by-fingerprint'. |
Date: |
Fri, 1 May 2020 12:46:17 -0400 (EDT) |
civodul pushed a commit to branch wip-openpgp
in repository guix.
commit fbbe09567cc28c6ba343c3e495bcd2b6bf4e066b
Author: Ludovic Courtès <address@hidden>
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 d9f8a41..e4fa2da 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)
@@ -924,14 +925,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 '())))
@@ -940,7 +959,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)
@@ -951,15 +970,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)
@@ -969,13 +988,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 <address@hidden>"))))))
+ (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))))))))
(test-equal "get-openpgp-detached-signature/ascii"
(list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)
- branch wip-openpgp created (now 8916c2f), guix-commits, 2020/05/01
- 01/12: Add '.guix-authorizations'., guix-commits, 2020/05/01
- 02/12: DRAFT Add (guix openpgp)., guix-commits, 2020/05/01
- 04/12: openpgp: Store the issuer key id and fingerprint in <openpgp-signature>., guix-commits, 2020/05/01
- 03/12: openpgp: Decode the issuer-fingerprint signature subpacket., guix-commits, 2020/05/01
- 05/12: openpgp: Add 'lookup-key-by-fingerprint'.,
guix-commits <=
- 07/12: openpgp: 'lookup-key-by-{id, fingerprint}' return the key first., guix-commits, 2020/05/01
- 09/12: git-authenticate: Use (guix openpgp)., guix-commits, 2020/05/01
- 06/12: openpgp: 'verify-openpgp-signature' looks up by fingerprint when possible., guix-commits, 2020/05/01
- 08/12: openpgp: Add 'string->openpgp-packet'., guix-commits, 2020/05/01
- 11/12: git-authenticate: Load the list of authorized keys from the tree., guix-commits, 2020/05/01
- 10/12: .guix-authorizations: Augment., guix-commits, 2020/05/01
- 12/12: git-authenticate: Load the keyring from the repository., guix-commits, 2020/05/01