mirror of
git://git.savannah.gnu.org/guix.git
synced 2023-12-14 03:33:07 +01:00
openpgp: Raise error conditions instead of calling 'error'.
* 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
parent
041dc3a9c0
commit
05d973eef2
1 changed files with 46 additions and 15 deletions
|
|
@ -31,6 +31,12 @@
|
|||
verify-openpgp-signature
|
||||
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-issuer-key-id
|
||||
openpgp-signature-issuer-fingerprint
|
||||
|
|
@ -119,6 +125,19 @@
|
|||
(define (unixtime 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.
|
||||
|
|
@ -312,7 +331,7 @@ hexadecimal format for fingerprints."
|
|||
(define HASH-SHA-512 10)
|
||||
(define HASH-SHA-224 11)
|
||||
|
||||
(define (openpgp-hash-algorithm id)
|
||||
(define (openpgp-hash-algorithm id signature-port)
|
||||
(cond ((= id HASH-MD5) 'md5)
|
||||
((= id HASH-SHA-1) 'sha1)
|
||||
((= id HASH-RIPE-MD160) 'rmd160)
|
||||
|
|
@ -320,7 +339,9 @@ hexadecimal format for fingerprints."
|
|||
((= id HASH-SHA-384) 'sha384)
|
||||
((= id HASH-SHA-512) 'sha512)
|
||||
((= 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-ZIP 1) ;deflate
|
||||
|
|
@ -455,7 +476,7 @@ hexadecimal format for fingerprints."
|
|||
((= tag PACKET-ONE-PASS-SIGNATURE)
|
||||
'one-pass-signature) ;TODO: implement
|
||||
(else
|
||||
(error 'get-data "Unsupported packet type" tag)))))
|
||||
(raise (condition (&openpgp-unrecognized-packet-error (port p))))))))
|
||||
|
||||
(define-record-type <openpgp-public-key>
|
||||
(make-openpgp-public-key version subkey? time value fingerprint)
|
||||
|
|
@ -509,7 +530,9 @@ signature."
|
|||
((string=? type "PGP SIGNATURE")
|
||||
(get-packet (open-bytevector-input-port data)))
|
||||
(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
|
||||
"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)
|
||||
(get-integers p u8 u8 u32 u64 u8 u8 u16)))
|
||||
(unless (= hmlen 5)
|
||||
(error "invalid signature packet"))
|
||||
(raise (condition
|
||||
(&openpgp-invalid-signature-error (port p)))))
|
||||
|
||||
(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)))
|
||||
(unless (port-eof? p)
|
||||
(print "Trailing data in signature: " (get-bytevector-all p)))
|
||||
(make-openpgp-signature version type
|
||||
(public-key-algorithm pkalg)
|
||||
(openpgp-hash-algorithm halg) hashl16
|
||||
(openpgp-hash-algorithm halg p) hashl16
|
||||
(list (integers->bytevector u8 type
|
||||
u32 ctime))
|
||||
;; Emulate hashed subpackets
|
||||
|
|
@ -651,7 +676,7 @@ FINGERPRINT, a bytevector."
|
|||
(get-bytevector-n p (get-u16 p)))
|
||||
((hashl16) (get-u16 p)))
|
||||
(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)))
|
||||
(unless (port-eof? p)
|
||||
(print "Trailing data in signature: " (get-bytevector-all p)))
|
||||
|
|
@ -670,8 +695,8 @@ FINGERPRINT, a bytevector."
|
|||
u8 #xff
|
||||
u32 (+ 6 subpacket-len))))
|
||||
(unhashed-subpackets
|
||||
(parse-subpackets unhashed-subpackets))
|
||||
(hashed-subpackets (parse-subpackets hashed-subpackets))
|
||||
(parse-subpackets unhashed-subpackets p))
|
||||
(hashed-subpackets (parse-subpackets hashed-subpackets p))
|
||||
(subpackets (append hashed-subpackets
|
||||
unhashed-subpackets))
|
||||
(issuer-key-id (assoc-ref subpackets 'issuer))
|
||||
|
|
@ -679,11 +704,14 @@ FINGERPRINT, a bytevector."
|
|||
'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))
|
||||
(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
|
||||
(public-key-algorithm pkalg)
|
||||
(openpgp-hash-algorithm halg)
|
||||
(openpgp-hash-algorithm halg p)
|
||||
hashl16
|
||||
append-data
|
||||
hashed-subpackets
|
||||
|
|
@ -694,7 +722,7 @@ FINGERPRINT, a bytevector."
|
|||
(print "Unsupported signature version: " version)
|
||||
'unsupported-signature-version))))
|
||||
|
||||
(define (parse-subpackets bv)
|
||||
(define (parse-subpackets bv signature-port)
|
||||
(define (parse tag data)
|
||||
(let ((type (fxbit-field tag 0 7))
|
||||
(critical? (fxbit-set? tag 7)))
|
||||
|
|
@ -740,7 +768,8 @@ FINGERPRINT, a bytevector."
|
|||
value)))))))
|
||||
((= type SUBPACKET-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)
|
||||
(cons 'preferred-compression-algorithms
|
||||
(map compression-algorithm (bytevector->u8-list data))))
|
||||
|
|
@ -785,7 +814,9 @@ FINGERPRINT, a bytevector."
|
|||
;; should be considered invalid.
|
||||
(print "Unknown subpacket type: " type)
|
||||
(if critical?
|
||||
(error "unrecognized critical signature subpacket" type)
|
||||
(raise (condition
|
||||
(&openpgp-unrecognized-packet-error
|
||||
(port signature-port))))
|
||||
(list 'unsupported-subpacket type data))))))
|
||||
|
||||
(let ((p (open-bytevector-input-port bv)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue