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'.
This commit is contained in:
Ludovic Courtès
parent
43408e304f
commit
4459c7859c
@ -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)
|
||||
|
||||
@ -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 <ludo@gnu.org>"))))))
|
||||
|
||||
(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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user