summaryrefslogtreecommitdiff
path: root/Data
diff options
context:
space:
mode:
authorStephen Paul Weber <singpolyma@singpolyma.net>2012-08-06 10:46:40 -0500
committerStephen Paul Weber <singpolyma@singpolyma.net>2012-08-06 10:48:06 -0500
commita90fec088355aeb4f670b272dd62acc7369e07ef (patch)
tree95f0ef689cf35d04610c7a925b8625c13468d4a5 /Data
parentdcf4e3a203c4a93389e35c23b6fa5c79469a1dcf (diff)
Full roundtrip for v3 PublicKey
Added some examples to HUnit tests. Made Put work for v3 PublicKey Store validity as v3_days_of_validity (Maybe Word16) v4 Get learns some things from the v3 Get
Diffstat (limited to 'Data')
-rw-r--r--Data/OpenPGP.hs39
1 files changed, 26 insertions, 13 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index e6076fa..ce6ab90 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -24,6 +24,8 @@ module Data.OpenPGP (
24 hashed_subpackets, 24 hashed_subpackets,
25 hash_head, 25 hash_head,
26 key, 26 key,
27 is_subkey,
28 v3_days_of_validity,
27 key_algorithm, 29 key_algorithm,
28 key_id, 30 key_id,
29 message, 31 message,
@@ -173,7 +175,8 @@ data Packet =
173 timestamp::Word32, 175 timestamp::Word32,
174 key_algorithm::KeyAlgorithm, 176 key_algorithm::KeyAlgorithm,
175 key::[(Char,MPI)], 177 key::[(Char,MPI)],
176 is_subkey::Bool 178 is_subkey::Bool,
179 v3_days_of_validity::Maybe Word16
177 } | 180 } |
178 SecretKeyPacket { 181 SecretKeyPacket {
179 version::Word8, 182 version::Word8,
@@ -409,15 +412,25 @@ put_packet (SecretKeyPacket { version = version, timestamp = timestamp,
409 where 412 where
410 (Just s2k_t) = s2k_type 413 (Just s2k_t) = s2k_type
411 p = fst (put_packet $ 414 p = fst (put_packet $
412 PublicKeyPacket version timestamp algorithm key False 415 PublicKeyPacket version timestamp algorithm key False Nothing
413 :: (B.ByteString, Integer)) -- Supress warning 416 :: (B.ByteString, Integer)) -- Supress warning
414 s = map (encode . (key !)) (secret_key_fields algorithm) 417 s = map (encode . (key !)) (secret_key_fields algorithm)
415put_packet (PublicKeyPacket { version = 4, timestamp = timestamp, 418put_packet p@(PublicKeyPacket { version = v, timestamp = timestamp,
416 key_algorithm = algorithm, key = key, 419 key_algorithm = algorithm, key = key,
417 is_subkey = is_subkey }) = 420 is_subkey = is_subkey })
418 (B.concat $ [B.singleton 4, encode timestamp, encode algorithm] ++ 421 | v == 3 =
419 map (encode . (key !)) (public_key_fields algorithm), 422 final (B.concat $ [
420 if is_subkey then 14 else 6) 423 B.singleton 3, encode timestamp,
424 encode (fromJust $ v3_days_of_validity p),
425 encode algorithm
426 ] ++ material)
427 | v == 4 =
428 final (B.concat $ [
429 B.singleton 4, encode timestamp, encode algorithm
430 ] ++ material)
431 where
432 final x = (x, if is_subkey then 14 else 6)
433 material = map (encode . (key !)) (public_key_fields algorithm)
421put_packet (CompressedDataPacket { compression_algorithm = algorithm, 434put_packet (CompressedDataPacket { compression_algorithm = algorithm,
422 message = message }) = 435 message = message }) =
423 (B.append (encode algorithm) $ compress algorithm $ encode message, 8) 436 (B.append (encode algorithm) $ compress algorithm $ encode message, 8)
@@ -549,7 +562,7 @@ parse_packet 6 = do
549 case version of 562 case version of
550 3 -> do 563 3 -> do
551 timestamp <- get 564 timestamp <- get
552 _ <- get :: Get Word16 -- TODO: preserve days_of_validity somehow 565 days <- get
553 algorithm <- get 566 algorithm <- get
554 key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm) 567 key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
555 return PublicKeyPacket { 568 return PublicKeyPacket {
@@ -557,20 +570,20 @@ parse_packet 6 = do
557 timestamp = timestamp, 570 timestamp = timestamp,
558 key_algorithm = algorithm, 571 key_algorithm = algorithm,
559 key = key, 572 key = key,
560 is_subkey = False 573 is_subkey = False,
574 v3_days_of_validity = Just days
561 } 575 }
562 4 -> do 576 4 -> do
563 timestamp <- get 577 timestamp <- get
564 algorithm <- get 578 algorithm <- get
565 key <- mapM (\f -> do 579 key <- mapM (\f -> fmap ((,)f) get) (public_key_fields algorithm)
566 mpi <- get :: Get MPI
567 return (f, mpi)) (public_key_fields algorithm)
568 return PublicKeyPacket { 580 return PublicKeyPacket {
569 version = 4, 581 version = 4,
570 timestamp = timestamp, 582 timestamp = timestamp,
571 key_algorithm = algorithm, 583 key_algorithm = algorithm,
572 key = key, 584 key = key,
573 is_subkey = False 585 is_subkey = False,
586 v3_days_of_validity = Nothing
574 } 587 }
575 x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "." 588 x -> fail $ "Unsupported PublicKeyPacket version " ++ show x ++ "."
576-- Secret-SubKey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.4 589-- Secret-SubKey Packet, http://tools.ietf.org/html/rfc4880#section-5.5.1.4