From 43408e304ffb1149f35cb539b40d673d567c9116 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 2 Jan 2020 00:03:58 +0100 Subject: Add (guix openpgp). * guix/openpgp.scm, tests/openpgp.scm, tests/civodul.key, tests/dsa.key, tests/ed25519.key, tests/rsa.key, tests/ed25519.sec: New files. * Makefile.am (MODULES): Add guix/openpgp.scm. (SCM_TESTS): Add tests/openpgp.scm. (EXTRA_DIST): Add tests/*.key and tests/ed25519.sec. --- tests/openpgp.scm | 248 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 248 insertions(+) create mode 100644 tests/openpgp.scm (limited to 'tests/openpgp.scm') diff --git a/tests/openpgp.scm b/tests/openpgp.scm new file mode 100644 index 0000000000..8a3c7bbeb7 --- /dev/null +++ b/tests/openpgp.scm @@ -0,0 +1,248 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (tests-openpgp) + #:use-module (guix openpgp) + #:use-module (gcrypt hash) + #:use-module (gcrypt pk-crypto) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-64) + #:use-module (srfi srfi-71)) + +(define %radix-64-sample + ;; Example of Radix-64 encoding from Section 6.6 of RFC4880. + "\ +-----BEGIN PGP MESSAGE----- +Version: OpenPrivacy 0.99 + +yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS +vBSFjNSiVHsuAA== +=njUN +-----END PGP MESSAGE-----\n") + +(define %radix-64-sample/crc-mismatch + ;; This time with a wrong CRC24 value. + "\ +-----BEGIN PGP MESSAGE----- + +yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS +vBSFjNSiVHsuAA== +=AAAA +-----END PGP MESSAGE-----\n") + +(define %civodul-fingerprint + "3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5") + +(define %civodul-key-id #x090B11993D9AEBB5) ;civodul.key + +;; Test keys. They were generated in a container along these lines: +;; guix environment -CP --ad-hoc gnupg pinentry +;; then, within the container: +;; mkdir ~/.gnupg +;; echo pinentry-program ~/.guix-profile/bin/pinentry-tty > ~/.gnupg/gpg-agent.conf +;; gpg --quick-gen-key '' rsa +;; or similar. +(define %rsa-key-id #xAE25DA2A70DEED59) ;rsa.key +(define %dsa-key-id #x587918047BE8BD2C) ;dsa.key +(define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.key + + +;;; The following are detached signatures created commands like: +;;; echo 'Hello!' | gpg -sba --digest-algo sha512 +;;; They are detached (no PACKET-ONE-PASS-SIGNATURE) and uncompressed. + +(define %hello-signature/rsa + ;; Signature of the ASCII string "Hello!\n". + "\ +-----BEGIN PGP SIGNATURE----- + +iQEzBAABCAAdFiEEOF+Gz8hrZlpcFl5rriXaKnDe7VkFAl4SRF0ACgkQriXaKnDe +7VlIyQf/TU5rGUK42/C1ULoWvvm25Mjwh6xxoPPkuBxvos8bE6yKr/vJZePU3aSE +mjbVFcO7DioxHMqLd49j803bUtdllJVU18ex9MkKbKjapkgEGkJsuTTzqyONprgk +7xtZGBWuxkP1M6hJICJkA3Ys+sTdKalux/pzr5OWAe+gxytTF/vr/EyJzdmBxbJv +/fhd1SeVIXSw4c5gf2Wcvcgfy4N5CiLaUb7j4646KBTvDvmUMcDZ+vmKqC/XdQeQ +PrjArGKt40ErVd98fwvNHZnw7VQMx0A3nL3joL5g7/RckDOUb4mqKoqLsLd0wPHP +y32DiDUY9s3sy5OMzX4Y49em8vxvlg== +=ASEm +-----END PGP SIGNATURE-----") + + +(define %hello-signature/dsa + "\ +-----BEGIN PGP SIGNATURE----- + +iHUEABEIAB0WIQQohKmAQiMwpPM92X9YeRgEe+i9LAUCXhJFpQAKCRBYeRgEe+i9 +LDAaAQC0lXPQepvZBANAUtRLMZuOwL9NQPkfhIwUXtLEBBzyFQD/So8DcybXpRBi +JKOiyAQQjMs/GJ6qMEQpRAhyyJRAock= +=iAEc +-----END PGP SIGNATURE-----") + + +(define %hello-signature/ed25519/sha256 ;digest-algo: sha256 + "\ +-----BEGIN PGP SIGNATURE----- + +iHUEABYIAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRADAAKCRB3H0nL+q4H +LUImAP9/foaSjPFC/MSr52LNV5ROSL9haea4jPpUP+N6ViFGowEA+AE/xpXPIqsz +R6CdxMevURuqUpqQ7rHeiMmdUepeewU= +=tLXy +-----END PGP SIGNATURE-----") + +(define %hello-signature/ed25519/sha512 ;digest-algo: sha512 + "\ +-----BEGIN PGP SIGNATURE----- + +iHUEABYKAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRAGgAKCRB3H0nL+q4H +LTeKAP0S8LiiosJXOARlYNdhfGw9j26lHrbwJh5CORGlaqqIJAEAoMYcmtNa2b6O +inlEwB/KQM88O9RwA8xH7X5a0rodOw4= +=68r/ +-----END PGP SIGNATURE-----") + +(define %hello-signature/ed25519/sha1 ;digest-algo: sha1 + "\ +-----BEGIN PGP SIGNATURE----- + +iHUEABYCAB0WIQRE0x4hr3E4+bYyKAp3H0nL+q4HLQUCXqRALQAKCRB3H0nL+q4H +LdhEAQCfkdYhIVRa43oTNw9EL/TDFGQjXSHNRFVU0ktjkWbkQwEAjIXhvj2sqy79 +Pz7oopeN72xgggYUNT37ezqN3MeCqw0= +=AE4G +-----END PGP SIGNATURE-----") + + +(test-begin "openpgp") + +(test-equal "read-radix-64" + '(#t "PGP MESSAGE") + (let-values (((data type) + (call-with-input-string %radix-64-sample read-radix-64))) + (list (bytevector? data) type))) + +(test-equal "read-radix-64, CRC mismatch" + '(#f "PGP MESSAGE") + (call-with-values + (lambda () + (call-with-input-string %radix-64-sample/crc-mismatch + read-radix-64)) + list)) + +(test-assert "get-openpgp-keyring" + (let* ((key (search-path %load-path "tests/civodul.key")) + (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 ...) + (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 ")))))) + +(test-equal "get-openpgp-detached-signature/ascii" + (list `(,%dsa-key-id dsa sha256) + `(,%rsa-key-id rsa sha256) + `(,%ed25519-key-id eddsa sha256) + `(,%ed25519-key-id eddsa sha512) + `(,%ed25519-key-id eddsa sha1)) + (map (lambda (str) + (let ((signature (get-openpgp-detached-signature/ascii + (open-input-string str)))) + (list (openpgp-signature-issuer signature) + (openpgp-signature-public-key-algorithm signature) + (openpgp-signature-hash-algorithm signature)))) + (list %hello-signature/dsa + %hello-signature/rsa + %hello-signature/ed25519/sha256 + %hello-signature/ed25519/sha512 + %hello-signature/ed25519/sha1))) + +(test-equal "verify-openpgp-signature, missing key" + `(missing-key ,%rsa-key-id) + (let* ((keyring (get-openpgp-keyring (%make-void-port "r"))) + (signature (get-openpgp-packet + (open-bytevector-input-port + (call-with-input-string %hello-signature/rsa + read-radix-64))))) + (let-values (((status key) + (verify-openpgp-signature signature keyring + (open-input-string "Hello!\n")))) + (list status key)))) + +(test-equal "verify-openpgp-signature, good signatures" + `((good-signature ,%rsa-key-id) + (good-signature ,%dsa-key-id) + (good-signature ,%ed25519-key-id) + (good-signature ,%ed25519-key-id) + (good-signature ,%ed25519-key-id)) + (map (lambda (key signature) + (let* ((key (search-path %load-path key)) + (keyring (get-openpgp-keyring + (open-bytevector-input-port + (call-with-input-file key read-radix-64)))) + (signature (get-openpgp-packet + (open-bytevector-input-port + (call-with-input-string signature + read-radix-64))))) + (let-values (((status key) + (verify-openpgp-signature signature keyring + (open-input-string "Hello!\n")))) + (list status (openpgp-public-key-id key))))) + (list "tests/rsa.key" "tests/dsa.key" + "tests/ed25519.key" "tests/ed25519.key" "tests/ed25519.key") + (list %hello-signature/rsa %hello-signature/dsa + %hello-signature/ed25519/sha256 + %hello-signature/ed25519/sha512 + %hello-signature/ed25519/sha1))) + +(test-equal "verify-openpgp-signature, bad signature" + `((bad-signature ,%rsa-key-id) + (bad-signature ,%dsa-key-id) + (bad-signature ,%ed25519-key-id) + (bad-signature ,%ed25519-key-id) + (bad-signature ,%ed25519-key-id)) + (let ((keyring (fold (lambda (key keyring) + (let ((key (search-path %load-path key))) + (get-openpgp-keyring + (open-bytevector-input-port + (call-with-input-file key read-radix-64)) + keyring))) + %empty-keyring + '("tests/rsa.key" "tests/dsa.key" + "tests/ed25519.key" "tests/ed25519.key" + "tests/ed25519.key")))) + (map (lambda (signature) + (let ((signature (get-openpgp-packet + (open-bytevector-input-port + (call-with-input-string signature + read-radix-64))))) + (let-values (((status key) + (verify-openpgp-signature signature keyring + (open-input-string "What?!")))) + (list status (openpgp-public-key-id key))))) + (list %hello-signature/rsa %hello-signature/dsa + %hello-signature/ed25519/sha256 + %hello-signature/ed25519/sha512 + %hello-signature/ed25519/sha1)))) + +(test-end "openpgp") -- cgit 1.4.1 From 4459c7859c286ab54fa3a9901c8a17591b04c516 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 25 Apr 2020 23:23:51 +0200 Subject: openpgp: Decode the issuer-fingerprint signature subpacket. * guix/openpgp.scm (SUBPACKET-ISSUER-FINGERPRINT): New variable. (openpgp-signature-issuer-fingerprint): New procedure. (key-id-matches-fingerprint?): New procedure. (get-signature): Look for the 'issuer and 'issuer-fingerprint subpackets. Ensure the issuer key ID matches the fingerprint when both are available. (parse-subpackets): Handle SUBPACKET-ISSUER-FINGERPRINT. * tests/openpgp.scm (%rsa-key-fingerprint) (%dsa-key-fingerprint, %ed25519-key-fingerprint): New variables. * tests/openpgp.scm ("get-openpgp-detached-signature/ascii"): Check the result of 'openpgp-signature-issuer-fingerprint'. --- guix/openpgp.scm | 44 +++++++++++++++++++++++++++++++++++++++----- tests/openpgp.scm | 22 +++++++++++++++++----- 2 files changed, 56 insertions(+), 10 deletions(-) (limited to 'tests/openpgp.scm') diff --git a/guix/openpgp.scm b/guix/openpgp.scm index bfdbe4b61b..77a75373df 100644 --- a/guix/openpgp.scm +++ b/guix/openpgp.scm @@ -33,6 +33,7 @@ openpgp-signature? openpgp-signature-issuer + openpgp-signature-issuer-fingerprint openpgp-signature-public-key-algorithm openpgp-signature-hash-algorithm openpgp-signature-creation-time @@ -345,7 +346,6 @@ hexadecimal format for fingerprints." ;; 12 = Revocation Key (define SUBPACKET-ISSUER 16) -;; TODO: hashed SUBPACKET-ISSUER-FINGERPRINT-V4 (define SUBPACKET-NOTATION-DATA 20) (define SUBPACKET-PREFERRED-HASH-ALGORITHMS 21) (define SUBPACKET-PREFERRED-COMPRESSION-ALGORITHMS 22) @@ -358,8 +358,8 @@ hexadecimal format for fingerprints." (define SUBPACKET-REASON-FOR-REVOCATION 29) (define SUBPACKET-FEATURES 30) ;; 31 = Signature Target - (define SUBPACKET-EMBEDDED-SIGNATURE 32) +(define SUBPACKET-ISSUER-FINGERPRINT 33) ;defined in RFC4880bis (define SIGNATURE-BINARY #x00) (define SIGNATURE-TEXT #x01) @@ -486,6 +486,13 @@ hexadecimal format for fingerprints." ;; XXX: is the issuer always in the unhashed subpackets? (else #f))) +(define (openpgp-signature-issuer-fingerprint sig) + "When it's available, return the fingerprint, a bytevector, or the issuer of +SIG. Otherwise, return #f." + (or (assoc-ref (openpgp-signature-hashed-subpackets sig) 'issuer-fingerprint) + (assoc-ref (openpgp-signature-unhashed-subpackets sig) + 'issuer-fingerprint))) + (define (openpgp-signature-creation-time sig) (cond ((assq 'signature-ctime (openpgp-signature-hashed-subpackets sig)) => (lambda (x) (unixtime (cdr x)))) @@ -578,6 +585,14 @@ the issuer's OpenPGP public key extracted from KEYRING." (values 'missing-key issuer)))) (values 'unsupported-signature sig))) +(define (key-id-matches-fingerprint? key-id fingerprint) + "Return true if KEY-ID, a number, corresponds to the low 8 bytes of +FINGERPRINT, a bytevector." + (let* ((len (bytevector-length fingerprint)) + (low (make-bytevector 8))) + (bytevector-copy! fingerprint (- len 8) low 0 8) + (= (bytevector->uint low) key-id))) + (define (get-signature p) (define (->hex n) (string-hex-pad (number->string n 16))) @@ -662,14 +677,26 @@ the issuer's OpenPGP public key extracted from KEYRING." ;; Errata ID: 2214. (integers->bytevector u8 #x04 u8 #xff - u32 (+ 6 subpacket-len))))) + u32 (+ 6 subpacket-len)))) + (unhashed-subpackets + (parse-subpackets unhashed-subpackets)) + (hashed-subpackets (parse-subpackets hashed-subpackets)) + (subpackets (append hashed-subpackets + unhashed-subpackets)) + (issuer-key-id (assoc-ref subpackets 'issuer)) + (issuer (assoc-ref subpackets + 'issuer-fingerprint))) + (unless (or (not issuer) (not issuer-key-id) + (key-id-matches-fingerprint? issuer-key-id issuer)) + (error "issuer key id does not match fingerprint" issuer)) + (make-openpgp-signature version type (public-key-algorithm pkalg) (openpgp-hash-algorithm halg) hashl16 append-data - (parse-subpackets hashed-subpackets) - (parse-subpackets unhashed-subpackets) + hashed-subpackets + unhashed-subpackets value))))) (else (print "Unsupported signature version: " version) @@ -701,6 +728,13 @@ the issuer's OpenPGP public key extracted from KEYRING." ((= type SUBPACKET-ISSUER) (cons 'issuer (bytevector-u64-ref data 0 (endianness big)))) + ((= type SUBPACKET-ISSUER-FINGERPRINT) ;v4+ only, RFC4880bis + (cons 'issuer-fingerprint + (let* ((version (bytevector-u8-ref data 0)) + (len (match version (4 20) (5 32)) ) + (fingerprint (make-bytevector len))) + (bytevector-copy! data 1 fingerprint 0 len) + fingerprint))) ((= type SUBPACKET-NOTATION-DATA) (let ((p (open-bytevector-input-port data))) (let-values (((f1 nlen vlen) diff --git a/tests/openpgp.scm b/tests/openpgp.scm index 8a3c7bbeb7..20d65171fd 100644 --- a/tests/openpgp.scm +++ b/tests/openpgp.scm @@ -18,6 +18,7 @@ (define-module (tests-openpgp) #:use-module (guix openpgp) + #:use-module (gcrypt base16) #:use-module (gcrypt hash) #:use-module (gcrypt pk-crypto) #:use-module (ice-9 binary-ports) @@ -65,6 +66,16 @@ vBSFjNSiVHsuAA== (define %dsa-key-id #x587918047BE8BD2C) ;dsa.key (define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.key +(define %rsa-key-fingerprint + (base16-string->bytevector + (string-downcase "385F86CFC86B665A5C165E6BAE25DA2A70DEED59"))) +(define %dsa-key-fingerprint + (base16-string->bytevector + (string-downcase "2884A980422330A4F33DD97F587918047BE8BD2C"))) +(define %ed25519-key-fingerprint + (base16-string->bytevector + (string-downcase "44D31E21AF7138F9B632280A771F49CBFAAE072D"))) + ;;; The following are detached signatures created commands like: ;;; echo 'Hello!' | gpg -sba --digest-algo sha512 @@ -160,15 +171,16 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0= "Ludovic Courtès ")))))) (test-equal "get-openpgp-detached-signature/ascii" - (list `(,%dsa-key-id dsa sha256) - `(,%rsa-key-id rsa sha256) - `(,%ed25519-key-id eddsa sha256) - `(,%ed25519-key-id eddsa sha512) - `(,%ed25519-key-id eddsa sha1)) + (list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256) + `(,%rsa-key-id ,%rsa-key-fingerprint rsa sha256) + `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha256) + `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha512) + `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha1)) (map (lambda (str) (let ((signature (get-openpgp-detached-signature/ascii (open-input-string str)))) (list (openpgp-signature-issuer signature) + (openpgp-signature-issuer-fingerprint signature) (openpgp-signature-public-key-algorithm signature) (openpgp-signature-hash-algorithm signature)))) (list %hello-signature/dsa -- cgit 1.4.1 From 7b2b3a13cc2d9b043f37b2e7ba0f147c08de8fad Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 26 Apr 2020 16:03:46 +0200 Subject: openpgp: Store the issuer key id and fingerprint in . * guix/openpgp.scm ()[issuer, issuer-fingerprint]: New fields. (openpgp-signature-issuer, openpgp-signature-issuer-fingerprint): Remove. (verify-openpgp-signature): Use 'openpgp-signature-issuer-key-id'. (get-signature): Initialize 'issuer' and 'issuer-fingerprint'. * tests/openpgp.scm ("get-openpgp-detached-signature/ascii"): Adjust accordingly. --- guix/openpgp.scm | 28 ++++++++++------------------ tests/openpgp.scm | 2 +- 2 files changed, 11 insertions(+), 19 deletions(-) (limited to 'tests/openpgp.scm') diff --git a/guix/openpgp.scm b/guix/openpgp.scm index 77a75373df..3b11998c11 100644 --- a/guix/openpgp.scm +++ b/guix/openpgp.scm @@ -32,7 +32,7 @@ port-ascii-armored? openpgp-signature? - openpgp-signature-issuer + openpgp-signature-issuer-key-id openpgp-signature-issuer-fingerprint openpgp-signature-public-key-algorithm openpgp-signature-hash-algorithm @@ -469,7 +469,7 @@ hexadecimal format for fingerprints." (define-record-type (make-openpgp-signature version type pk-algorithm hash-algorithm hashl16 append-data hashed-subpackets unhashed-subpackets - value) + value issuer issuer-fingerprint) openpgp-signature? (version openpgp-signature-version) (type openpgp-signature-type) @@ -479,19 +479,9 @@ hexadecimal format for fingerprints." (append-data openpgp-signature-append-data) ;append to data when hashing (hashed-subpackets openpgp-signature-hashed-subpackets) (unhashed-subpackets openpgp-signature-unhashed-subpackets) - (value openpgp-signature-value)) - -(define (openpgp-signature-issuer sig) - (cond ((assq 'issuer (openpgp-signature-unhashed-subpackets sig)) => cdr) - ;; XXX: is the issuer always in the unhashed subpackets? - (else #f))) - -(define (openpgp-signature-issuer-fingerprint sig) - "When it's available, return the fingerprint, a bytevector, or the issuer of -SIG. Otherwise, return #f." - (or (assoc-ref (openpgp-signature-hashed-subpackets sig) 'issuer-fingerprint) - (assoc-ref (openpgp-signature-unhashed-subpackets sig) - 'issuer-fingerprint))) + (value openpgp-signature-value) + (issuer openpgp-signature-issuer-key-id) ;integer | #f + (issuer-fingerprint openpgp-signature-issuer-fingerprint)) ;bytevector | #f (define (openpgp-signature-creation-time sig) (cond ((assq 'signature-ctime (openpgp-signature-hashed-subpackets sig)) @@ -573,7 +563,7 @@ the issuer's OpenPGP public key extracted from KEYRING." ;; TODO: Support SIGNATURE-TEXT. (if (= (openpgp-signature-type sig) SIGNATURE-BINARY) - (let* ((issuer (openpgp-signature-issuer sig)) + (let* ((issuer (openpgp-signature-issuer-key-id sig)) (key-data (lookup-key-by-id keyring issuer))) ;; Find the primary key or subkey that made the signature. (let ((key (find (lambda (k) @@ -651,7 +641,8 @@ FINGERPRINT, a bytevector." (list (cons 'signature-ctime ctime)) ;; Unhashed subpackets (list (cons 'issuer keyid)) - value)))) + value + keyid #f)))) ((4) (let*-values (((type pkalg halg) (get-integers p u8 u8 u8)) ((hashed-subpackets) @@ -697,7 +688,8 @@ FINGERPRINT, a bytevector." append-data hashed-subpackets unhashed-subpackets - value))))) + value + issuer-key-id issuer))))) (else (print "Unsupported signature version: " version) 'unsupported-signature-version)))) diff --git a/tests/openpgp.scm b/tests/openpgp.scm index 20d65171fd..1709167859 100644 --- a/tests/openpgp.scm +++ b/tests/openpgp.scm @@ -179,7 +179,7 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0= (map (lambda (str) (let ((signature (get-openpgp-detached-signature/ascii (open-input-string str)))) - (list (openpgp-signature-issuer signature) + (list (openpgp-signature-issuer-key-id signature) (openpgp-signature-issuer-fingerprint signature) (openpgp-signature-public-key-algorithm signature) (openpgp-signature-hash-algorithm signature)))) -- cgit 1.4.1 From efe1f0122c61b8932671d07419f0200c170a994e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 26 Apr 2020 23:20:26 +0200 Subject: openpgp: Add 'lookup-key-by-fingerprint'. * guix/openpgp.scm ()[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(-) (limited to 'tests/openpgp.scm') diff --git a/guix/openpgp.scm b/guix/openpgp.scm index 3b11998c11..8479f8a168 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) @@ -912,14 +913,32 @@ FINGERPRINT, a bytevector." ;;; Keyring management (define-record-type - (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 , alongside +with additional records for sub-keys, +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 '()))) @@ -928,7 +947,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) @@ -939,15 +958,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) @@ -957,13 +976,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 1709167859..eac2e88f74 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 ")))))) + (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 ") + (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) -- cgit 1.4.1 From b45fa0a123bec8d023e5520dfb381bfc73313929 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 26 Apr 2020 23:27:36 +0200 Subject: openpgp: 'verify-openpgp-signature' looks up by fingerprint when possible. * guix/openpgp.scm (verify-openpgp-signature): Use 'lookup-key-by-fingerprint' when SIG contains a fingerprint. Honor FINGERPRINT in the 'find' predicate. Upon missing-key, return FINGERPRINT if available. * tests/openpgp.scm ("verify-openpgp-signature, missing key"): Adjust expected value accordingly. --- guix/openpgp.scm | 15 +++++++++++---- tests/openpgp.scm | 2 +- 2 files changed, 12 insertions(+), 5 deletions(-) (limited to 'tests/openpgp.scm') diff --git a/guix/openpgp.scm b/guix/openpgp.scm index 8479f8a168..a871eb1a16 100644 --- a/guix/openpgp.scm +++ b/guix/openpgp.scm @@ -564,16 +564,23 @@ the issuer's OpenPGP public key extracted from KEYRING." ;; TODO: Support SIGNATURE-TEXT. (if (= (openpgp-signature-type sig) SIGNATURE-BINARY) - (let* ((issuer (openpgp-signature-issuer-key-id sig)) - (key-data (lookup-key-by-id keyring issuer))) + (let* ((id (openpgp-signature-issuer-key-id sig)) + (fingerprint (openpgp-signature-issuer-fingerprint sig)) + (key-data (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) - (= (openpgp-public-key-id k) issuer))) + (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 issuer)))) + (values 'missing-key (or fingerprint id))))) (values 'unsupported-signature sig))) (define (key-id-matches-fingerprint? key-id fingerprint) diff --git a/tests/openpgp.scm b/tests/openpgp.scm index eac2e88f74..cc5e6cbcf7 100644 --- a/tests/openpgp.scm +++ b/tests/openpgp.scm @@ -192,7 +192,7 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0= %hello-signature/ed25519/sha1))) (test-equal "verify-openpgp-signature, missing key" - `(missing-key ,%rsa-key-id) + `(missing-key ,%rsa-key-fingerprint) (let* ((keyring (get-openpgp-keyring (%make-void-port "r"))) (signature (get-openpgp-packet (open-bytevector-input-port -- cgit 1.4.1 From bd8126558dc7a022d7853d803d7134ffa1b7bc52 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 30 Apr 2020 15:43:19 +0200 Subject: 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(-) (limited to 'tests/openpgp.scm') 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 , alongside with additional records for sub-keys, 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 ") - (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 ") + (eq? (lookup-key-by-fingerprint keyring fingerprint) + primary)))))) (test-equal "get-openpgp-detached-signature/ascii" (list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256) -- cgit 1.4.1 From b835e158d51c873a99367afd27f3d57cfe92e10e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 30 Apr 2020 15:56:54 +0200 Subject: openpgp: Add 'string->openpgp-packet'. * guix/openpgp.scm (string->openpgp-packet): New procedure. * tests/openpgp.scm ("verify-openpgp-signature, missing key") ("verify-openpgp-signature, good signatures") ("verify-openpgp-signature, bad signature"): Use it. --- guix/openpgp.scm | 9 ++++++++- tests/openpgp.scm | 15 +++------------ 2 files changed, 11 insertions(+), 13 deletions(-) (limited to 'tests/openpgp.scm') diff --git a/guix/openpgp.scm b/guix/openpgp.scm index 987660fa29..2b2997dcd4 100644 --- a/guix/openpgp.scm +++ b/guix/openpgp.scm @@ -55,7 +55,8 @@ lookup-key-by-fingerprint get-openpgp-keyring - read-radix-64) + read-radix-64 + string->openpgp-packet) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) @@ -1067,3 +1068,9 @@ end-of-file object if the Radix-64 sequence was truncated." (values #f kind))) (loop (cons str lines)))))))) (values #f #f)))) + +(define (string->openpgp-packet str) + "Read STR, an ASCII-armored OpenPGP packet, and return the corresponding +OpenPGP record." + (get-packet + (open-bytevector-input-port (call-with-input-string str read-radix-64)))) diff --git a/tests/openpgp.scm b/tests/openpgp.scm index a85fe6a6cb..0beab6f88b 100644 --- a/tests/openpgp.scm +++ b/tests/openpgp.scm @@ -194,10 +194,7 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0= (test-equal "verify-openpgp-signature, missing key" `(missing-key ,%rsa-key-fingerprint) (let* ((keyring (get-openpgp-keyring (%make-void-port "r"))) - (signature (get-openpgp-packet - (open-bytevector-input-port - (call-with-input-string %hello-signature/rsa - read-radix-64))))) + (signature (string->openpgp-packet %hello-signature/rsa))) (let-values (((status key) (verify-openpgp-signature signature keyring (open-input-string "Hello!\n")))) @@ -214,10 +211,7 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0= (keyring (get-openpgp-keyring (open-bytevector-input-port (call-with-input-file key read-radix-64)))) - (signature (get-openpgp-packet - (open-bytevector-input-port - (call-with-input-string signature - read-radix-64))))) + (signature (string->openpgp-packet signature))) (let-values (((status key) (verify-openpgp-signature signature keyring (open-input-string "Hello!\n")))) @@ -246,10 +240,7 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0= "tests/ed25519.key" "tests/ed25519.key" "tests/ed25519.key")))) (map (lambda (signature) - (let ((signature (get-openpgp-packet - (open-bytevector-input-port - (call-with-input-string signature - read-radix-64))))) + (let ((signature (string->openpgp-packet signature))) (let-values (((status key) (verify-openpgp-signature signature keyring (open-input-string "What?!")))) -- cgit 1.4.1