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:
		
							parent
							
								
									43408e304f
								
							
						
					
					
						commit
						4459c7859c
					
				
					 2 changed files with 56 additions and 10 deletions
				
			
		| 
						 | 
					@ -33,6 +33,7 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
            openpgp-signature?
 | 
					            openpgp-signature?
 | 
				
			||||||
            openpgp-signature-issuer
 | 
					            openpgp-signature-issuer
 | 
				
			||||||
 | 
					            openpgp-signature-issuer-fingerprint
 | 
				
			||||||
            openpgp-signature-public-key-algorithm
 | 
					            openpgp-signature-public-key-algorithm
 | 
				
			||||||
            openpgp-signature-hash-algorithm
 | 
					            openpgp-signature-hash-algorithm
 | 
				
			||||||
            openpgp-signature-creation-time
 | 
					            openpgp-signature-creation-time
 | 
				
			||||||
| 
						 | 
					@ -345,7 +346,6 @@ hexadecimal format for fingerprints."
 | 
				
			||||||
  ;; 12 = Revocation Key
 | 
					  ;; 12 = Revocation Key
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define SUBPACKET-ISSUER 16)
 | 
					(define SUBPACKET-ISSUER 16)
 | 
				
			||||||
;; TODO: hashed SUBPACKET-ISSUER-FINGERPRINT-V4
 | 
					 | 
				
			||||||
(define SUBPACKET-NOTATION-DATA 20)
 | 
					(define SUBPACKET-NOTATION-DATA 20)
 | 
				
			||||||
(define SUBPACKET-PREFERRED-HASH-ALGORITHMS 21)
 | 
					(define SUBPACKET-PREFERRED-HASH-ALGORITHMS 21)
 | 
				
			||||||
(define SUBPACKET-PREFERRED-COMPRESSION-ALGORITHMS 22)
 | 
					(define SUBPACKET-PREFERRED-COMPRESSION-ALGORITHMS 22)
 | 
				
			||||||
| 
						 | 
					@ -358,8 +358,8 @@ hexadecimal format for fingerprints."
 | 
				
			||||||
(define SUBPACKET-REASON-FOR-REVOCATION 29)
 | 
					(define SUBPACKET-REASON-FOR-REVOCATION 29)
 | 
				
			||||||
(define SUBPACKET-FEATURES 30)
 | 
					(define SUBPACKET-FEATURES 30)
 | 
				
			||||||
  ;; 31 = Signature Target
 | 
					  ;; 31 = Signature Target
 | 
				
			||||||
 | 
					 | 
				
			||||||
(define SUBPACKET-EMBEDDED-SIGNATURE 32)
 | 
					(define SUBPACKET-EMBEDDED-SIGNATURE 32)
 | 
				
			||||||
 | 
					(define SUBPACKET-ISSUER-FINGERPRINT 33)          ;defined in RFC4880bis
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define SIGNATURE-BINARY #x00)
 | 
					(define SIGNATURE-BINARY #x00)
 | 
				
			||||||
(define SIGNATURE-TEXT #x01)
 | 
					(define SIGNATURE-TEXT #x01)
 | 
				
			||||||
| 
						 | 
					@ -486,6 +486,13 @@ hexadecimal format for fingerprints."
 | 
				
			||||||
        ;; XXX: is the issuer always in the unhashed subpackets?
 | 
					        ;; XXX: is the issuer always in the unhashed subpackets?
 | 
				
			||||||
        (else #f)))
 | 
					        (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)
 | 
					(define (openpgp-signature-creation-time sig)
 | 
				
			||||||
  (cond ((assq 'signature-ctime (openpgp-signature-hashed-subpackets sig))
 | 
					  (cond ((assq 'signature-ctime (openpgp-signature-hashed-subpackets sig))
 | 
				
			||||||
         => (lambda (x) (unixtime (cdr x))))
 | 
					         => (lambda (x) (unixtime (cdr x))))
 | 
				
			||||||
| 
						 | 
					@ -578,6 +585,14 @@ the issuer's OpenPGP public key extracted from KEYRING."
 | 
				
			||||||
              (values 'missing-key issuer))))
 | 
					              (values 'missing-key issuer))))
 | 
				
			||||||
      (values 'unsupported-signature sig)))
 | 
					      (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 (get-signature p)
 | 
				
			||||||
  (define (->hex n)
 | 
					  (define (->hex n)
 | 
				
			||||||
    (string-hex-pad (number->string n 16)))
 | 
					    (string-hex-pad (number->string n 16)))
 | 
				
			||||||
| 
						 | 
					@ -662,14 +677,26 @@ the issuer's OpenPGP public key extracted from KEYRING."
 | 
				
			||||||
                    ;; Errata ID: 2214.
 | 
					                    ;; Errata ID: 2214.
 | 
				
			||||||
                    (integers->bytevector u8 #x04
 | 
					                    (integers->bytevector u8 #x04
 | 
				
			||||||
                                          u8 #xff
 | 
					                                          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
 | 
					             (make-openpgp-signature version type
 | 
				
			||||||
                                     (public-key-algorithm pkalg)
 | 
					                                     (public-key-algorithm pkalg)
 | 
				
			||||||
                                     (openpgp-hash-algorithm halg)
 | 
					                                     (openpgp-hash-algorithm halg)
 | 
				
			||||||
                                     hashl16
 | 
					                                     hashl16
 | 
				
			||||||
                                     append-data
 | 
					                                     append-data
 | 
				
			||||||
                                     (parse-subpackets hashed-subpackets)
 | 
					                                     hashed-subpackets
 | 
				
			||||||
                                     (parse-subpackets unhashed-subpackets)
 | 
					                                     unhashed-subpackets
 | 
				
			||||||
                                     value)))))
 | 
					                                     value)))))
 | 
				
			||||||
      (else
 | 
					      (else
 | 
				
			||||||
       (print "Unsupported signature version: " version)
 | 
					       (print "Unsupported signature version: " version)
 | 
				
			||||||
| 
						 | 
					@ -701,6 +728,13 @@ the issuer's OpenPGP public key extracted from KEYRING."
 | 
				
			||||||
       ((= type SUBPACKET-ISSUER)
 | 
					       ((= type SUBPACKET-ISSUER)
 | 
				
			||||||
        (cons 'issuer
 | 
					        (cons 'issuer
 | 
				
			||||||
              (bytevector-u64-ref data 0 (endianness big))))
 | 
					              (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)
 | 
					       ((= type SUBPACKET-NOTATION-DATA)
 | 
				
			||||||
        (let ((p (open-bytevector-input-port data)))
 | 
					        (let ((p (open-bytevector-input-port data)))
 | 
				
			||||||
          (let-values (((f1 nlen vlen)
 | 
					          (let-values (((f1 nlen vlen)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -18,6 +18,7 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-module (tests-openpgp)
 | 
					(define-module (tests-openpgp)
 | 
				
			||||||
  #:use-module (guix openpgp)
 | 
					  #:use-module (guix openpgp)
 | 
				
			||||||
 | 
					  #:use-module (gcrypt base16)
 | 
				
			||||||
  #:use-module (gcrypt hash)
 | 
					  #:use-module (gcrypt hash)
 | 
				
			||||||
  #:use-module (gcrypt pk-crypto)
 | 
					  #:use-module (gcrypt pk-crypto)
 | 
				
			||||||
  #:use-module (ice-9 binary-ports)
 | 
					  #:use-module (ice-9 binary-ports)
 | 
				
			||||||
| 
						 | 
					@ -65,6 +66,16 @@ vBSFjNSiVHsuAA==
 | 
				
			||||||
(define %dsa-key-id      #x587918047BE8BD2C)      ;dsa.key
 | 
					(define %dsa-key-id      #x587918047BE8BD2C)      ;dsa.key
 | 
				
			||||||
(define %ed25519-key-id  #x771F49CBFAAE072D)      ;ed25519.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:
 | 
					;;; The following are detached signatures created commands like:
 | 
				
			||||||
;;;    echo 'Hello!' | gpg -sba --digest-algo sha512
 | 
					;;;    echo 'Hello!' | gpg -sba --digest-algo sha512
 | 
				
			||||||
| 
						 | 
					@ -160,15 +171,16 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
 | 
				
			||||||
                      "Ludovic Courtès <ludo@gnu.org>"))))))
 | 
					                      "Ludovic Courtès <ludo@gnu.org>"))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(test-equal "get-openpgp-detached-signature/ascii"
 | 
					(test-equal "get-openpgp-detached-signature/ascii"
 | 
				
			||||||
  (list `(,%dsa-key-id dsa sha256)
 | 
					  (list `(,%dsa-key-id ,%dsa-key-fingerprint dsa sha256)
 | 
				
			||||||
        `(,%rsa-key-id rsa sha256)
 | 
					        `(,%rsa-key-id ,%rsa-key-fingerprint rsa sha256)
 | 
				
			||||||
        `(,%ed25519-key-id eddsa sha256)
 | 
					        `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha256)
 | 
				
			||||||
        `(,%ed25519-key-id eddsa sha512)
 | 
					        `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha512)
 | 
				
			||||||
        `(,%ed25519-key-id eddsa sha1))
 | 
					        `(,%ed25519-key-id ,%ed25519-key-fingerprint eddsa sha1))
 | 
				
			||||||
  (map (lambda (str)
 | 
					  (map (lambda (str)
 | 
				
			||||||
         (let ((signature (get-openpgp-detached-signature/ascii
 | 
					         (let ((signature (get-openpgp-detached-signature/ascii
 | 
				
			||||||
                           (open-input-string str))))
 | 
					                           (open-input-string str))))
 | 
				
			||||||
           (list (openpgp-signature-issuer signature)
 | 
					           (list (openpgp-signature-issuer signature)
 | 
				
			||||||
 | 
					                 (openpgp-signature-issuer-fingerprint signature)
 | 
				
			||||||
                 (openpgp-signature-public-key-algorithm signature)
 | 
					                 (openpgp-signature-public-key-algorithm signature)
 | 
				
			||||||
                 (openpgp-signature-hash-algorithm signature))))
 | 
					                 (openpgp-signature-hash-algorithm signature))))
 | 
				
			||||||
       (list %hello-signature/dsa
 | 
					       (list %hello-signature/dsa
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue