ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

openpgp: Add 'lookup-key-by-fingerprint'.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2020-04-26 23:20:26 +02:00
parent 7b2b3a13cc
commit efe1f0122c
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 40 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
guix/openpgp.scm
View file

@ -52,6 +52,7 @@ (define-module (guix openpgp)
openpgp-keyring? openpgp-keyring?
%empty-keyring %empty-keyring
lookup-key-by-id lookup-key-by-id
lookup-key-by-fingerprint
get-openpgp-keyring get-openpgp-keyring
read-radix-64) read-radix-64)
@ -912,14 +913,32 @@ (define (get-user-attribute p len)
;;; Keyring management ;;; Keyring management
(define-record-type <openpgp-keyring> (define-record-type <openpgp-keyring>
(openpgp-keyring table) (openpgp-keyring ids fingerprints)
openpgp-keyring? 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) (define (lookup-key-by-id keyring id)
"Return a list of packets for the key with ID in KEYRING, or #f if ID could "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." 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) ((_ . lst) lst)
(#f '()))) (#f '())))
@ -928,7 +947,7 @@ (define (lookup-key-by-id keyring id)
(define %empty-keyring (define %empty-keyring
;; The empty keyring. ;; The empty keyring.
(openpgp-keyring vlist-null)) (openpgp-keyring vlist-null vlist-null))
(define* (get-openpgp-keyring port (define* (get-openpgp-keyring port
#:optional (keyring %empty-keyring) #:optional (keyring %empty-keyring)
@ -939,15 +958,15 @@ (define* (get-openpgp-keyring port
there is no limit." there is no limit."
(let lp ((pkt (get-packet port)) (let lp ((pkt (get-packet port))
(limit limit) (limit limit)
(keyring (openpgp-keyring-table keyring))) (keyring keyring))
(print "#;key " pkt) (print "#;key " pkt)
(cond ((or (zero? limit) (eof-object? pkt)) (cond ((or (zero? limit) (eof-object? pkt))
(openpgp-keyring keyring)) keyring)
((openpgp-public-key-primary? pkt) ((openpgp-public-key-primary? pkt)
;; Read signatures, user id's, subkeys ;; Read signatures, user id's, subkeys
(let lp* ((pkt (get-packet port)) (let lp* ((pkt (get-packet port))
(pkts (list pkt)) (pkts (list pkt))
(key-ids (list (openpgp-public-key-id pkt)))) (keys (list pkt)))
(print "#;keydata " pkt) (print "#;keydata " pkt)
(cond ((or (eof-object? pkt) (cond ((or (eof-object? pkt)
(eq? pkt 'unsupported-public-key-version) (eq? pkt 'unsupported-public-key-version)
@ -957,13 +976,13 @@ (define* (get-openpgp-keyring port
;; packets. ;; packets.
(lp pkt (lp pkt
(- limit 1) (- limit 1)
(fold (cute vhash-consv <> (reverse pkts) <>) (fold (cute keyring-insert <> <> (reverse pkts))
keyring key-ids))) keyring keys)))
((openpgp-public-key? pkt) ;subkey ((openpgp-public-key? pkt) ;subkey
(lp* (get-packet port) (cons pkt pkts) (lp* (get-packet port) (cons pkt pkts)
(cons (openpgp-public-key-id pkt) key-ids))) (cons pkt keys)))
(else (else
(lp* (get-packet port) (cons pkt pkts) key-ids))))) (lp* (get-packet port) (cons pkt pkts) keys)))))
(else (else
;; Skip until there's a primary key. Ignore errors... ;; Skip until there's a primary key. Ignore errors...
(lp (get-packet port) limit keyring))))) (lp (get-packet port) limit keyring)))))

16
tests/openpgp.scm
View file

@ -162,13 +162,15 @@ (define %hello-signature/ed25519/sha1 ;digest-algo: sha1
(call-with-input-file key read-radix-64))))) (call-with-input-file key read-radix-64)))))
(match (lookup-key-by-id keyring %civodul-key-id) (match (lookup-key-by-id keyring %civodul-key-id)
(((? openpgp-public-key? primary) packets ...) (((? openpgp-public-key? primary) packets ...)
(and (= (openpgp-public-key-id primary) %civodul-key-id) (let ((fingerprint (openpgp-public-key-fingerprint primary)))
(not (openpgp-public-key-subkey? primary)) (and (= (openpgp-public-key-id primary) %civodul-key-id)
(string=? (openpgp-format-fingerprint (not (openpgp-public-key-subkey? primary))
(openpgp-public-key-fingerprint primary)) (string=? (openpgp-format-fingerprint fingerprint)
%civodul-fingerprint) %civodul-fingerprint)
(string=? (openpgp-user-id-value (find openpgp-user-id? packets)) (string=? (openpgp-user-id-value (find openpgp-user-id? packets))
"Ludovic Courtès <ludo@gnu.org>")))))) "Ludovic Courtès <ludo@gnu.org>")
(equal? (lookup-key-by-id keyring %civodul-key-id)
(lookup-key-by-fingerprint keyring fingerprint))))))))
(test-equal "get-openpgp-detached-signature/ascii" (test-equal "get-openpgp-detached-signature/ascii"
(list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256) (list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)