futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

openpgp: Raise error conditions instead of calling 'error'.

Browse Source 
* guix/openpgp.scm (&openpgp-error, &openpgp-unrecognized-packet-error)
(&openpgp-invalid-signature-error): New error conditions.
(openpgp-hash-algorithm): Add 'signature-port' parameter.  Raise an
error condition instead of calling 'error'.
(parse-subpackets): Likewise.
(get-data): Raise instead of calling 'error'.
(get-openpgp-detached-signature/ascii): Likewise.
(get-signature): Likewise.
This commit is contained in:
Ludovic Courtès 2020-05-02 23:44:00 +02:00
parent 041dc3a9c0
commit 05d973eef2
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 46 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
guix/openpgp.scm
View File

@ -31,6 +31,12 @@
verify-openpgp-signature verify-openpgp-signature
port-ascii-armored? port-ascii-armored?
openpgp-error?
openpgp-unrecognized-packet-error?
openpgp-unrecognized-packet-error-port
openpgp-invalid-signature-error?
openpgp-invalid-signature-error-port
openpgp-signature? openpgp-signature?
openpgp-signature-issuer-key-id openpgp-signature-issuer-key-id
openpgp-signature-issuer-fingerprint openpgp-signature-issuer-fingerprint
@ -119,6 +125,19 @@
(define (unixtime n) (define (unixtime n)
(time-monotonic->date (make-time 'time-monotonic 0 n))) (time-monotonic->date (make-time 'time-monotonic 0 n)))
;; Root of the error hierarchy.
(define-condition-type &openpgp-error &error
openpgp-error?)
;; Error raised when reading an unsupported or unrecognized packet tag.
(define-condition-type &openpgp-unrecognized-packet-error &openpgp-error
openpgp-unrecognized-packet-error?
(port openpgp-unrecognized-packet-error-port))
;; Error raised when reading an invalid signature packet.
(define-condition-type &openpgp-invalid-signature-error &openpgp-error
(port openpgp-invalid-signature-error-port))
;;; ;;;
;;; Bitwise I/O. ;;; Bitwise I/O.
@ -312,7 +331,7 @@ hexadecimal format for fingerprints."
(define HASH-SHA-512 10) (define HASH-SHA-512 10)
(define HASH-SHA-224 11) (define HASH-SHA-224 11)
(define (openpgp-hash-algorithm id) (define (openpgp-hash-algorithm id signature-port)
(cond ((= id HASH-MD5) 'md5) (cond ((= id HASH-MD5) 'md5)
((= id HASH-SHA-1) 'sha1) ((= id HASH-SHA-1) 'sha1)
((= id HASH-RIPE-MD160) 'rmd160) ((= id HASH-RIPE-MD160) 'rmd160)
@ -320,7 +339,9 @@ hexadecimal format for fingerprints."
((= id HASH-SHA-384) 'sha384) ((= id HASH-SHA-384) 'sha384)
((= id HASH-SHA-512) 'sha512) ((= id HASH-SHA-512) 'sha512)
((= id HASH-SHA-224) 'sha224) ((= id HASH-SHA-224) 'sha224)
(else (error "unknown hash algorithm" id)))) (else
(raise (condition
(&openpgp-invalid-signature-error (port signature-port)))))))
(define COMPRESSION-UNCOMPRESSED 0) (define COMPRESSION-UNCOMPRESSED 0)
(define COMPRESSION-ZIP 1) ;deflate (define COMPRESSION-ZIP 1) ;deflate
@ -455,7 +476,7 @@ hexadecimal format for fingerprints."
((= tag PACKET-ONE-PASS-SIGNATURE) ((= tag PACKET-ONE-PASS-SIGNATURE)
'one-pass-signature) ;TODO: implement 'one-pass-signature) ;TODO: implement
(else (else
(error 'get-data "Unsupported packet type" tag))))) (raise (condition (&openpgp-unrecognized-packet-error (port p))))))))
(define-record-type <openpgp-public-key> (define-record-type <openpgp-public-key>
(make-openpgp-public-key version subkey? time value fingerprint) (make-openpgp-public-key version subkey? time value fingerprint)
@ -509,7 +530,9 @@ signature."
((string=? type "PGP SIGNATURE") ((string=? type "PGP SIGNATURE")
(get-packet (open-bytevector-input-port data))) (get-packet (open-bytevector-input-port data)))
(else (else
(error "expected PGP SIGNATURE" type))))) (print "expected PGP SIGNATURE" type)
(raise (condition
(&openpgp-invalid-signature-error (port port))))))))
(define (hash-algorithm-name algorithm) ;XXX: should be in Guile-Gcrypt (define (hash-algorithm-name algorithm) ;XXX: should be in Guile-Gcrypt
"Return the name of ALGORITHM, a 'hash-algorithm' integer, as a symbol." "Return the name of ALGORITHM, a 'hash-algorithm' integer, as a symbol."
@ -626,15 +649,17 @@ FINGERPRINT, a bytevector."
(let-values (((hmlen type ctime keyid pkalg halg hashl16) (let-values (((hmlen type ctime keyid pkalg halg hashl16)
(get-integers p u8 u8 u32 u64 u8 u8 u16))) (get-integers p u8 u8 u32 u64 u8 u8 u16)))
(unless (= hmlen 5) (unless (= hmlen 5)
(error "invalid signature packet")) (raise (condition
(&openpgp-invalid-signature-error (port p)))))
(print "Signature type: " type " creation time: " (unixtime ctime)) (print "Signature type: " type " creation time: " (unixtime ctime))
(print "Hash algorithm: " (openpgp-hash-algorithm halg)) (print "Hash algorithm: " (openpgp-hash-algorithm halg p))
(let ((value (get-sig p pkalg))) (let ((value (get-sig p pkalg)))
(unless (port-eof? p) (unless (port-eof? p)
(print "Trailing data in signature: " (get-bytevector-all p))) (print "Trailing data in signature: " (get-bytevector-all p)))
(make-openpgp-signature version type (make-openpgp-signature version type
(public-key-algorithm pkalg) (public-key-algorithm pkalg)
(openpgp-hash-algorithm halg) hashl16 (openpgp-hash-algorithm halg p) hashl16
(list (integers->bytevector u8 type (list (integers->bytevector u8 type
u32 ctime)) u32 ctime))
;; Emulate hashed subpackets ;; Emulate hashed subpackets
@ -651,7 +676,7 @@ FINGERPRINT, a bytevector."
(get-bytevector-n p (get-u16 p))) (get-bytevector-n p (get-u16 p)))
((hashl16) (get-u16 p))) ((hashl16) (get-u16 p)))
(print "Signature type: " type) (print "Signature type: " type)
(print "Hash algorithm: " (openpgp-hash-algorithm halg)) (print "Hash algorithm: " (openpgp-hash-algorithm halg p))
(let ((value (get-sig p pkalg))) (let ((value (get-sig p pkalg)))
(unless (port-eof? p) (unless (port-eof? p)
(print "Trailing data in signature: " (get-bytevector-all p))) (print "Trailing data in signature: " (get-bytevector-all p)))
@ -670,8 +695,8 @@ FINGERPRINT, a bytevector."
u8 #xff u8 #xff
u32 (+ 6 subpacket-len)))) u32 (+ 6 subpacket-len))))
(unhashed-subpackets (unhashed-subpackets
(parse-subpackets unhashed-subpackets)) (parse-subpackets unhashed-subpackets p))
(hashed-subpackets (parse-subpackets hashed-subpackets)) (hashed-subpackets (parse-subpackets hashed-subpackets p))
(subpackets (append hashed-subpackets (subpackets (append hashed-subpackets
unhashed-subpackets)) unhashed-subpackets))
(issuer-key-id (assoc-ref subpackets 'issuer)) (issuer-key-id (assoc-ref subpackets 'issuer))
@ -679,11 +704,14 @@ FINGERPRINT, a bytevector."
'issuer-fingerprint))) 'issuer-fingerprint)))
(unless (or (not issuer) (not issuer-key-id) (unless (or (not issuer) (not issuer-key-id)
(key-id-matches-fingerprint? issuer-key-id issuer)) (key-id-matches-fingerprint? issuer-key-id issuer))
(error "issuer key id does not match fingerprint" issuer)) (print "issuer key id does not match fingerprint"
issuer-key-id issuer)
(raise (condition
(&openpgp-invalid-signature-error (port p)))))
(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 p)
hashl16 hashl16
append-data append-data
hashed-subpackets hashed-subpackets
@ -694,7 +722,7 @@ FINGERPRINT, a bytevector."
(print "Unsupported signature version: " version) (print "Unsupported signature version: " version)
'unsupported-signature-version)))) 'unsupported-signature-version))))
(define (parse-subpackets bv) (define (parse-subpackets bv signature-port)
(define (parse tag data) (define (parse tag data)
(let ((type (fxbit-field tag 0 7)) (let ((type (fxbit-field tag 0 7))
(critical? (fxbit-set? tag 7))) (critical? (fxbit-set? tag 7)))
@ -740,7 +768,8 @@ FINGERPRINT, a bytevector."
value))))))) value)))))))
((= type SUBPACKET-PREFERRED-HASH-ALGORITHMS) ((= type SUBPACKET-PREFERRED-HASH-ALGORITHMS)
(cons 'preferred-hash-algorithms (cons 'preferred-hash-algorithms
(map openpgp-hash-algorithm (bytevector->u8-list data)))) (map (cut openpgp-hash-algorithm <> signature-port)
(bytevector->u8-list data))))
((= type SUBPACKET-PREFERRED-COMPRESSION-ALGORITHMS) ((= type SUBPACKET-PREFERRED-COMPRESSION-ALGORITHMS)
(cons 'preferred-compression-algorithms (cons 'preferred-compression-algorithms
(map compression-algorithm (bytevector->u8-list data)))) (map compression-algorithm (bytevector->u8-list data))))
@ -785,7 +814,9 @@ FINGERPRINT, a bytevector."
;; should be considered invalid. ;; should be considered invalid.
(print "Unknown subpacket type: " type) (print "Unknown subpacket type: " type)
(if critical? (if critical?
(error "unrecognized critical signature subpacket" type) (raise (condition
(&openpgp-unrecognized-packet-error
(port signature-port))))
(list 'unsupported-subpacket type data)))))) (list 'unsupported-subpacket type data))))))
(let ((p (open-bytevector-input-port bv))) (let ((p (open-bytevector-input-port bv)))