diff options
author | Stephen Paul Weber <singpolyma@singpolyma.net> | 2012-08-06 10:22:47 -0500 |
---|---|---|
committer | Stephen Paul Weber <singpolyma@singpolyma.net> | 2012-08-06 10:22:47 -0500 |
commit | dcf4e3a203c4a93389e35c23b6fa5c79469a1dcf (patch) | |
tree | 62dc80bfa2329b79ee7cde5693b3f0aec41ddab2 /Data | |
parent | 5c851e7727ee261c498d6128805b9705f3f677f1 (diff) |
Put v2/3 signatures as well
Add trailer calculation for v2/3
Add code to put these packets back out
Change Arbitrary instance to allow for these kinds of signatures
Tests pass
Diffstat (limited to 'Data')
-rw-r--r-- | Data/OpenPGP.hs | 41 |
1 files changed, 39 insertions, 2 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 5e735d0..e6076fa 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs | |||
@@ -65,6 +65,7 @@ import Data.Bits | |||
65 | import Data.Word | 65 | import Data.Word |
66 | import Data.Char | 66 | import Data.Char |
67 | import Data.Maybe | 67 | import Data.Maybe |
68 | import Data.List | ||
68 | import Data.OpenPGP.Internal | 69 | import Data.OpenPGP.Internal |
69 | import qualified Data.ByteString.Lazy as LZ | 70 | import qualified Data.ByteString.Lazy as LZ |
70 | 71 | ||
@@ -308,15 +309,51 @@ signature_packet_start x = | |||
308 | 309 | ||
309 | -- The trailer is just the top of the body plus some crap | 310 | -- The trailer is just the top of the body plus some crap |
310 | calculate_signature_trailer :: Packet -> B.ByteString | 311 | calculate_signature_trailer :: Packet -> B.ByteString |
311 | calculate_signature_trailer p = | 312 | calculate_signature_trailer (SignaturePacket { version = v, |
313 | signature_type = signature_type, | ||
314 | unhashed_subpackets = unhashed_subpackets | ||
315 | }) | v `elem` [2,3] = | ||
316 | B.concat [ | ||
317 | encode signature_type, | ||
318 | encode creation_time | ||
319 | ] | ||
320 | where | ||
321 | Just (SignatureCreationTimePacket creation_time) = find isCreation unhashed_subpackets | ||
322 | isCreation (SignatureCreationTimePacket {}) = True | ||
323 | isCreation _ = False | ||
324 | calculate_signature_trailer p@(SignaturePacket {version = 4}) = | ||
312 | B.concat [ | 325 | B.concat [ |
313 | signature_packet_start p, | 326 | signature_packet_start p, |
314 | encode (0x04 :: Word8), | 327 | encode (0x04 :: Word8), |
315 | encode (0xff :: Word8), | 328 | encode (0xff :: Word8), |
316 | encode (fromIntegral (B.length $ signature_packet_start p) :: Word32) | 329 | encode (fromIntegral (B.length $ signature_packet_start p) :: Word32) |
317 | ] | 330 | ] |
331 | calculate_signature_trailer x = | ||
332 | error ("Trying to calculate signature trailer for: " ++ show x) | ||
318 | 333 | ||
319 | put_packet :: (Num a) => Packet -> (B.ByteString, a) | 334 | put_packet :: (Num a) => Packet -> (B.ByteString, a) |
335 | put_packet (SignaturePacket { version = v, | ||
336 | unhashed_subpackets = unhashed_subpackets, | ||
337 | key_algorithm = key_algorithm, | ||
338 | hash_algorithm = hash_algorithm, | ||
339 | hash_head = hash_head, | ||
340 | signature = signature, | ||
341 | trailer = trailer }) | v `elem` [2,3] = | ||
342 | -- TODO: Assert that there are no subpackets we cannot encode? | ||
343 | (B.concat $ [ | ||
344 | B.singleton v, | ||
345 | B.singleton 0x05, | ||
346 | trailer, -- signature_type and creation_time | ||
347 | encode keyid, | ||
348 | encode key_algorithm, | ||
349 | encode hash_algorithm, | ||
350 | encode hash_head | ||
351 | ] ++ map encode signature, 2) | ||
352 | where | ||
353 | keyid = fst $ head $ readHex keyidS :: Word64 | ||
354 | Just (IssuerPacket keyidS) = find isIssuer unhashed_subpackets | ||
355 | isIssuer (IssuerPacket {}) = True | ||
356 | isIssuer _ = False | ||
320 | put_packet (SignaturePacket { version = 4, | 357 | put_packet (SignaturePacket { version = 4, |
321 | unhashed_subpackets = unhashed_subpackets, | 358 | unhashed_subpackets = unhashed_subpackets, |
322 | hash_head = hash_head, | 359 | hash_head = hash_head, |
@@ -407,7 +444,7 @@ parse_packet 2 = do | |||
407 | _ <- fmap (assertProp (==5)) (get :: Get Word8) | 444 | _ <- fmap (assertProp (==5)) (get :: Get Word8) |
408 | signature_type <- get | 445 | signature_type <- get |
409 | creation_time <- get :: Get Word32 | 446 | creation_time <- get :: Get Word32 |
410 | key_id <- get :: Get Word64 | 447 | keyid <- get :: Get Word64 |
411 | key_algorithm <- get | 448 | key_algorithm <- get |
412 | hash_algorithm <- get | 449 | hash_algorithm <- get |
413 | hash_head <- get | 450 | hash_head <- get |