summaryrefslogtreecommitdiff
path: root/guix/openpgp.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/openpgp.scm')
-rw-r--r--guix/openpgp.scm61
1 files changed, 46 insertions, 15 deletions
diff --git a/guix/openpgp.scm b/guix/openpgp.scm
index 2b2997dcd4..9370c8ada8 100644
--- a/guix/openpgp.scm
+++ b/guix/openpgp.scm
@@ -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)))