diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs @@ -8,6 +8,7 @@ Packet( AsymmetricSessionKeyPacket, OnePassSignaturePacket, + SymmetricSessionKeyPacket, PublicKeyPacket, SecretKeyPacket, CompressedDataPacket, @@ -33,15 +34,11 @@ key_id, message, nested, - private_hash, - s2k_count, - s2k_hash_algorithm, - s2k_salt, - s2k_type, s2k_useage, + s2k, signature, signature_type, - symmetric_type, + symmetric_algorithm, timestamp, trailer, unhashed_subpackets, @@ -51,6 +48,8 @@ signaturePacket, Message(..), SignatureSubpacket(..), + S2K(..), + string2key, HashAlgorithm(..), KeyAlgorithm(..), SymmetricAlgorithm(..), @@ -59,29 +58,33 @@ MPI(..), find_key, fingerprint_material, - signatures_and_data, - signature_issuer + SignatureOver(..), + signatures, + signature_issuer, + public_key_fields, + secret_key_fields ) where import Numeric import Control.Monad import Control.Arrow import Control.Applicative +import Data.Monoid import Data.Bits import Data.Word import Data.Char -import Data.Maybe import Data.List import Data.OpenPGP.Internal +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LZ #ifdef CEREAL -import Data.Serialize +import Data.Serialize hiding (decode) import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as B (toString, fromString) #define BINARY_CLASS Serialize #else -import Data.Binary +import Data.Binary hiding (decode) import Data.Binary.Get import Data.Binary.Put import qualified Data.ByteString.Lazy as B @@ -119,6 +122,9 @@ toLazyBS :: B.ByteString -> LZ.ByteString toLazyBS = LZ.fromChunks . (:[]) + +lazyEncode :: (Serialize a) => a -> LZ.ByteString +lazyEncode = toLazyBS . encode #else getRemainingByteString :: Get B.ByteString getRemainingByteString = getRemainingLazyByteString @@ -141,6 +147,9 @@ decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString decompress = lazyDecompress + +lazyEncode :: (Binary a) => a -> LZ.ByteString +lazyEncode = encode #endif lazyCompress :: CompressionAlgorithm -> LZ.ByteString -> LZ.ByteString @@ -168,6 +177,10 @@ padBS :: Int -> B.ByteString -> B.ByteString padBS l s = B.replicate (fromIntegral l - B.length s) 0 `B.append` s +checksum :: B.ByteString -> Word16 +checksum = fromIntegral . + B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer) + data Packet = AsymmetricSessionKeyPacket { version::Word8, @@ -175,6 +188,7 @@ key_algorithm::KeyAlgorithm, encrypted_data::B.ByteString } | + -- ^ SignaturePacket { version::Word8, signature_type::Word8, @@ -186,6 +200,14 @@ signature::[MPI], trailer::B.ByteString } | + -- ^ + SymmetricSessionKeyPacket { + version::Word8, + symmetric_algorithm::SymmetricAlgorithm, + s2k::S2K, + encrypted_data::B.ByteString + } | + -- ^ OnePassSignaturePacket { version::Word8, signature_type::Word8, @@ -194,6 +216,7 @@ key_id::String, nested::Word8 } | + -- ^ PublicKeyPacket { version::Word8, timestamp::Word32, @@ -202,39 +225,41 @@ is_subkey::Bool, v3_days_of_validity::Maybe Word16 } | + -- ^ (also subkey) SecretKeyPacket { version::Word8, timestamp::Word32, key_algorithm::KeyAlgorithm, key::[(Char,MPI)], - s2k_useage::Word8, -- determines if the Maybes are Just or Nothing - symmetric_type::Maybe Word8, - s2k_type::Maybe Word8, - s2k_hash_algorithm::Maybe HashAlgorithm, - s2k_salt::Maybe Word64, - s2k_count::Maybe Word32, + s2k_useage::Word8, + s2k::S2K, -- ^ This is meaningless if symmetric_algorithm == Unencrypted + symmetric_algorithm::SymmetricAlgorithm, encrypted_data::B.ByteString, - private_hash::Maybe B.ByteString, -- the hash may be in the encrypted data is_subkey::Bool } | + -- ^ (also subkey) CompressedDataPacket { compression_algorithm::CompressionAlgorithm, message::Message } | - MarkerPacket | + -- ^ + MarkerPacket | -- ^ LiteralDataPacket { format::Char, filename::String, timestamp::Word32, content::B.ByteString } | - TrustPacket B.ByteString | - UserIDPacket String | + -- ^ + TrustPacket B.ByteString | -- ^ + UserIDPacket String | -- ^ EncryptedDataPacket { - version::Word8, -- 0 for old-skool no-MDC (tag 9) + version::Word8, encrypted_data::B.ByteString } | - ModificationDetectionCodePacket B.ByteString | + -- ^ + -- or when version is 0 + ModificationDetectionCodePacket B.ByteString | -- ^ UnsupportedPacket Word8 B.ByteString deriving (Show, Read, Eq) @@ -248,32 +273,31 @@ -- Use 5-octet lengths put (255 :: Word8) put (blen :: Word32) - putSomeByteString body + putSomeByteString body where blen :: (Num a) => a blen = fromIntegral $ B.length body (body, tag) = put_packet p get = do - (t, packet) <- get_packet_bytes + tag <- get + let (t, l) = + if (tag .&. 64) /= 0 then + (tag .&. 63, parse_new_length) + else + ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False) + packet <- uncurry get_packet_bytes =<< l localGet (parse_packet t) (B.concat packet) -get_packet_bytes :: Get (Word8, [B.ByteString]) -get_packet_bytes = do - tag <- get - let (t, l) = - if (tag .&. 64) /= 0 then - (tag .&. 63, fmap (first Just) parse_new_length) - else - ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False) - (len, partial) <- l +get_packet_bytes :: Maybe Word32 -> Bool -> Get [B.ByteString] +get_packet_bytes len partial = do -- This forces the whole packet to be consumed packet <- maybe getRemainingByteString (getSomeByteString . fromIntegral) len - if not partial then return (t, [packet]) else - (,) t <$> ((packet:) . snd) <$> get_packet_bytes + if not partial then return [packet] else + (packet:) <$> (uncurry get_packet_bytes =<< parse_new_length) -- http://tools.ietf.org/html/rfc4880#section-4.2.2 -parse_new_length :: Get (Word32, Bool) -parse_new_length = do +parse_new_length :: Get (Maybe Word32, Bool) +parse_new_length = fmap (first Just) $ do len <- fmap fromIntegral (get :: Get Word8) case len of -- One octet length @@ -323,7 +347,7 @@ secret_key_fields _ = undefined -- Nothing in the spec. Maybe empty (!) :: (Eq k) => [(k,v)] -> k -> v -(!) xs = fromJust . (`lookup` xs) +(!) xs k = let Just x = lookup k xs in x -- Need this seperate for trailer calculation signature_packet_start :: Packet -> B.ByteString @@ -375,7 +399,7 @@ put_packet (AsymmetricSessionKeyPacket version key_id key_algorithm dta) = (B.concat [ encode version, - encode (fst $ head $ readHex key_id :: Word64), + encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64), encode key_algorithm, dta ], 1) @@ -397,10 +421,12 @@ encode hash_head ] ++ map encode signature, 2) where - keyid = fst $ head $ readHex keyidS :: Word64 + keyid = fst $ head $ readHex $ takeFromEnd 16 keyidS :: Word64 Just (IssuerPacket keyidS) = find isIssuer unhashed_subpackets isIssuer (IssuerPacket {}) = True isIssuer _ = False +put_packet (SymmetricSessionKeyPacket version salgo s2k encd) = + (B.concat [encode version, encode salgo, encode s2k, encd], 3) put_packet (SignaturePacket { version = 4, unhashed_subpackets = unhashed_subpackets, hash_head = hash_head, @@ -423,40 +449,29 @@ (B.concat [ encode version, encode signature_type, encode hash_algorithm, encode key_algorithm, - encode (fst $ head $ readHex key_id :: Word64), + encode (fst $ head $ readHex $ takeFromEnd 16 key_id :: Word64), encode nested ], 4) put_packet (SecretKeyPacket { version = version, timestamp = timestamp, key_algorithm = algorithm, key = key, - s2k_useage = s2k_useage, - symmetric_type = symmetric_type, - s2k_type = s2k_type, - s2k_hash_algorithm = s2k_hash_algo, - s2k_salt = s2k_salt, - s2k_count = s2k_count, + s2k_useage = s2k_useage, s2k = s2k, + symmetric_algorithm = symmetric_algorithm, encrypted_data = encrypted_data, is_subkey = is_subkey }) = - (B.concat $ [p, encode s2k_useage] ++ - (if s2k_useage `elem` [255, 254] then - [encode $ fromJust symmetric_type, encode s2k_t, - encode $ fromJust s2k_hash_algo] ++ - (if s2k_t `elem` [1,3] then [encode $ fromJust s2k_salt] else []) ++ - if s2k_t == 3 then - [encode $ encode_s2k_count $ fromJust s2k_count] else [] - else []) ++ - (if s2k_useage > 0 then + (B.concat $ p : + (if s2k_useage `elem` [254,255] then + [encode s2k_useage, encode symmetric_algorithm, encode s2k] + else + [encode symmetric_algorithm] + ) ++ + (if symmetric_algorithm /= Unencrypted then + -- For V3 keys, the "encrypted data" has an unencrypted checksum + -- of the unencrypted MPIs on the end [encrypted_data] else s ++ - -- XXX: Checksum is part of encrypted_data for V4 ONLY - if s2k_useage == 254 then - [B.replicate 20 0] -- TODO SHA1 Checksum - else - [encode (fromIntegral $ - B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) - (0::Integer) (B.concat s) :: Word16)]), + [encode $ checksum $ B.concat s]), if is_subkey then 7 else 5) where - (Just s2k_t) = s2k_type p = fst (put_packet $ PublicKeyPacket version timestamp algorithm key False Nothing) s = map (encode . (key !)) (secret_key_fields algorithm) @@ -466,7 +481,7 @@ | v == 3 = final (B.concat $ [ B.singleton 3, encode timestamp, - encode (fromJust $ v3_days_of_validity p), + encode v3_days, encode algorithm ] ++ material) | v == 4 = @@ -474,6 +489,7 @@ B.singleton 4, encode timestamp, encode algorithm ] ++ material) where + Just v3_days = v3_days_of_validity p final x = (x, if is_subkey then 14 else 6) material = map (encode . (key !)) (public_key_fields algorithm) put_packet (CompressedDataPacket { compression_algorithm = algorithm, @@ -557,6 +573,12 @@ trailer = B.concat [encode version, encode signature_type, encode key_algorithm, encode hash_algorithm, encode (fromIntegral hashed_size :: Word16), hashed_data, B.pack [4, 0xff], encode ((6 + fromIntegral hashed_size) :: Word32)] } x -> fail $ "Unknown SignaturePacket version " ++ show x ++ "." +-- SymmetricSessionKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.3 +parse_packet 3 = SymmetricSessionKeyPacket + <$> (assertProp (==4) =<< get) + <*> get + <*> get + <*> getRemainingByteString -- OnePassSignaturePacket, http://tools.ietf.org/html/rfc4880#section-5.4 parse_packet 4 = do version <- get @@ -584,31 +606,24 @@ }) <- parse_packet 6 s2k_useage <- get :: Get Word8 let k = SecretKeyPacket version timestamp algorithm key s2k_useage - k' <- case s2k_useage of - _ | s2k_useage `elem` [255, 254] -> do - symmetric_type <- get - s2k_type <- get - s2k_hash_algorithm <- get - s2k_salt <- if s2k_type `elem` [1, 3] then get - else return undefined - s2k_count <- if s2k_type == 3 then fmap decode_s2k_count get else - return undefined - return (k (Just symmetric_type) (Just s2k_type) - (Just s2k_hash_algorithm) (Just s2k_salt) (Just s2k_count)) + (symmetric_algorithm, s2k) <- case () of + _ | s2k_useage `elem` [255, 254] -> (,) <$> get <*> get _ | s2k_useage > 0 -> -- s2k_useage is symmetric_type in this case - return (k (Just s2k_useage) Nothing Nothing Nothing Nothing) + (,) <$> localGet get (encode s2k_useage) <*> pure (SimpleS2K MD5) _ -> - return (k Nothing Nothing Nothing Nothing Nothing) - if s2k_useage > 0 then do { + return (Unencrypted, S2K 100 B.empty) + if symmetric_algorithm /= Unencrypted then do { encrypted <- getRemainingByteString; - return (k' encrypted Nothing False) + return (k s2k symmetric_algorithm encrypted False) } else do - key <- foldM (\m f -> do + skey <- foldM (\m f -> do mpi <- get :: Get MPI - return $ (f,mpi):m) key (secret_key_fields algorithm) - private_hash <- getRemainingByteString - return ((k' B.empty (Just private_hash) False) {key = key}) + return $ (f,mpi):m) [] (secret_key_fields algorithm) + chk <- get + when (checksum (B.concat $ map (encode . snd) skey) /= chk) $ + fail "Checksum verification failed for unencrypted secret key" + return ((k s2k symmetric_algorithm B.empty False) {key = key ++ skey}) -- PublicKeyPacket, http://tools.ietf.org/html/rfc4880#section-5.5.2 parse_packet 6 = do version <- get :: Get Word8 @@ -710,6 +725,48 @@ enum_from_word8 :: (Enum a) => Word8 -> a enum_from_word8 = toEnum . fromIntegral +data S2K = + SimpleS2K HashAlgorithm | + SaltedS2K HashAlgorithm Word64 | + IteratedSaltedS2K HashAlgorithm Word64 Word32 | + S2K Word8 B.ByteString + deriving (Show, Read, Eq) + +instance BINARY_CLASS S2K where + put (SimpleS2K halgo) = put (0::Word8) >> put halgo + put (SaltedS2K halgo salt) = put (1::Word8) >> put halgo >> put salt + put (IteratedSaltedS2K halgo salt count) = put (3::Word8) >> put halgo + >> put salt >> put (encode_s2k_count count) + put (S2K t body) = put t >> putSomeByteString body + + get = do + t <- get :: Get Word8 + case t of + 0 -> SimpleS2K <$> get + 1 -> SaltedS2K <$> get <*> get + 3 -> IteratedSaltedS2K <$> get <*> get <*> (decode_s2k_count <$> get) + _ -> S2K t <$> getRemainingByteString + +-- | Take a hash function and an 'S2K' value and generate the bytes +-- needed for creating a symmetric key. +-- +-- Return value is always infinite length. +-- Take the first n bytes you need for your keysize. +string2key :: (HashAlgorithm -> LZ.ByteString -> BS.ByteString) -> S2K -> LZ.ByteString -> LZ.ByteString +string2key hsh (SimpleS2K halgo) s = infiniHashes (hsh halgo) s +string2key hsh (SaltedS2K halgo salt) s = + infiniHashes (hsh halgo) (lazyEncode salt `LZ.append` s) +string2key hsh (IteratedSaltedS2K halgo salt count) s = + infiniHashes (hsh halgo) $ + LZ.take (max (fromIntegral count) (LZ.length s)) + (LZ.cycle $ lazyEncode salt `LZ.append` s) +string2key _ s2k _ = error $ "Unsupported S2K specifier: " ++ show s2k + +infiniHashes :: (LZ.ByteString -> BS.ByteString) -> LZ.ByteString -> LZ.ByteString +infiniHashes hsh s = LZ.fromChunks (hs 0) + where + hs c = hsh (LZ.replicate c 0 `LZ.append` s) : hs (c+1) + data HashAlgorithm = MD5 | SHA1 | RIPEMD160 | SHA256 | SHA384 | SHA512 | SHA224 | HashAlgorithm Word8 deriving (Show, Read, Eq) @@ -830,22 +887,77 @@ put = put . enum_to_word8 get = fmap enum_from_word8 get --- A message is encoded as a list that takes the entire file +-- | A message is encoded as a list that takes the entire file newtype Message = Message [Packet] deriving (Show, Read, Eq) instance BINARY_CLASS Message where put (Message xs) = mapM_ put xs get = fmap Message listUntilEnd --- | Extract all signature and data packets from a 'Message' -signatures_and_data :: Message -> ([Packet], [Packet]) -signatures_and_data (Message ((CompressedDataPacket {message = m}):_)) = - signatures_and_data m -signatures_and_data (Message lst) = - (filter isSignaturePacket lst, filter isDta lst) +instance Monoid Message where + mempty = Message [] + mappend (Message a) (Message b) = Message (a ++ b) + +-- | Data needed to verify a signature +data SignatureOver = + DataSignature {literal::Packet, signatures_over::[Packet]} | + KeySignature {topkey::Packet, signatures_over::[Packet]} | + SubkeySignature {topkey::Packet, subkey::Packet, signatures_over::[Packet]} | + CertificationSignature {topkey::Packet, user_id::Packet, signatures_over::[Packet]} + deriving (Show, Read, Eq) + +-- To get the signed-over bytes +instance BINARY_CLASS SignatureOver where + put (DataSignature (LiteralDataPacket {content = c}) _) = + putSomeByteString c + put (KeySignature k _) = mapM_ putSomeByteString (fingerprint_material k) + put (SubkeySignature k s _) = mapM_ (mapM_ putSomeByteString) + [fingerprint_material k, fingerprint_material s] + put (CertificationSignature k (UserIDPacket s) _) = + mapM_ (mapM_ putSomeByteString) [fingerprint_material k, [ + B.singleton 0xB4, + encode ((fromIntegral $ B.length bs) :: Word32), + bs + ]] + where + bs = B.fromString s + put x = fail $ "Malformed signature: " ++ show x + get = fail "Cannot meaningfully parse bytes to be signed over." + +-- | Extract signed objects from a well-formatted message +-- +-- Recurses into CompressedDataPacket +-- +-- +signatures :: Message -> [SignatureOver] +signatures (Message [CompressedDataPacket _ m]) = signatures m +signatures (Message ps) = + maybe (paired_sigs Nothing ps) (\p -> [DataSignature p sigs]) (find isDta ps) where + sigs = filter isSignaturePacket ps isDta (LiteralDataPacket {}) = True isDta _ = False +-- TODO: UserAttribute +paired_sigs :: Maybe Packet -> [Packet] -> [SignatureOver] +paired_sigs _ [] = [] +paired_sigs _ (p@(PublicKeyPacket {is_subkey = False}):ps) = + KeySignature p (takeWhile isSignaturePacket ps) : + paired_sigs (Just p) (dropWhile isSignaturePacket ps) +paired_sigs _ (p@(SecretKeyPacket {is_subkey = False}):ps) = + KeySignature p (takeWhile isSignaturePacket ps) : + paired_sigs (Just p) (dropWhile isSignaturePacket ps) +paired_sigs (Just k) (p@(PublicKeyPacket {is_subkey = True}):ps) = + SubkeySignature k p (takeWhile isSignaturePacket ps) : + paired_sigs (Just p) (dropWhile isSignaturePacket ps) +paired_sigs (Just k) (p@(SecretKeyPacket {is_subkey = True}):ps) = + SubkeySignature k p (takeWhile isSignaturePacket ps) : + paired_sigs (Just p) (dropWhile isSignaturePacket ps) +paired_sigs (Just k) (p@(UserIDPacket {}):ps) = + CertificationSignature k p (takeWhile isSignaturePacket ps) : + paired_sigs (Just p) (dropWhile isSignaturePacket ps) +paired_sigs k (_:ps) = paired_sigs k ps + +-- | newtype MPI = MPI Integer deriving (Show, Read, Eq, Ord) instance BINARY_CLASS MPI where put (MPI i) @@ -879,15 +991,15 @@ rest <- listUntilEnd return (next:rest) --- http://tools.ietf.org/html/rfc4880#section-5.2.3.1 +-- | data SignatureSubpacket = SignatureCreationTimePacket Word32 | - SignatureExpirationTimePacket Word32 | -- seconds after CreationTime + SignatureExpirationTimePacket Word32 | -- ^ seconds after CreationTime ExportableCertificationPacket Bool | TrustSignaturePacket {depth::Word8, trust::Word8} | RegularExpressionPacket String | RevocablePacket Bool | - KeyExpirationTimePacket Word32 | -- seconds after key CreationTime + KeyExpirationTimePacket Word32 | -- ^ seconds after key CreationTime PreferredSymmetricAlgorithmsPacket [SymmetricAlgorithm] | RevocationKeyPacket { sensitive::Bool, @@ -979,7 +1091,7 @@ fprb = padBS 20 $ B.drop 2 $ encode (MPI fpri) fpri = fst $ head $ readHex fpr put_signature_subpacket (IssuerPacket keyid) = - (encode (fst $ head $ readHex keyid :: Word64), 16) + (encode (fst $ head $ readHex $ takeFromEnd 16 keyid :: Word64), 16) put_signature_subpacket (NotationDataPacket human_readable name value) = (B.concat [ B.pack [flag1,0,0,0], @@ -1160,7 +1272,12 @@ isIssuer _ = False signature_issuer _ = Nothing -find_key :: (Packet -> String) -> Message -> String -> Maybe Packet +-- | Find a key with the given Fingerprint/KeyID +find_key :: + (Packet -> String) -- ^ Extract Fingerprint/KeyID from packet + -> Message -- ^ List of packets (some of which are keys) + -> String -- ^ Fingerprint/KeyID to search for + -> Maybe Packet find_key fpr (Message (x@(PublicKeyPacket {}):xs)) keyid = find_key' fpr x xs keyid find_key fpr (Message (x@(SecretKeyPacket {}):xs)) keyid = @@ -1174,10 +1291,24 @@ | thisid == keyid = Just x | otherwise = find_key fpr (Message xs) keyid where - thisid = reverse $ take (length keyid) (reverse (fpr x)) + thisid = takeFromEnd (length keyid) (fpr x) +takeFromEnd :: Int -> String -> String +takeFromEnd l = reverse . take l . reverse + -- | SignaturePacket smart constructor -signaturePacket :: Word8 -> Word8 -> KeyAlgorithm -> HashAlgorithm -> [SignatureSubpacket] -> [SignatureSubpacket] -> Word16 -> [MPI] -> Packet +-- +-- +signaturePacket :: + Word8 -- ^ Signature version (probably 4) + -> Word8 -- ^ Signature type + -> KeyAlgorithm + -> HashAlgorithm + -> [SignatureSubpacket] -- ^ Hashed subpackets (these get signed) + -> [SignatureSubpacket] -- ^ Unhashed subpackets (these do not get signed) + -> Word16 -- ^ Left 16 bits of the signed hash value + -> [MPI] -- ^ The raw MPIs of the signature + -> Packet signaturePacket version signature_type key_algorithm hash_algorithm hashed_subpackets unhashed_subpackets hash_head signature = let p = SignaturePacket { version = version, diff --git a/Data/OpenPGP/Arbitrary.hs b/Data/OpenPGP/Arbitrary.hs --- a/Data/OpenPGP/Arbitrary.hs +++ b/Data/OpenPGP/Arbitrary.hs @@ -1,15 +1,15 @@ +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-} module Data.OpenPGP.Arbitrary where import Data.OpenPGP +import Data.OpenPGP.Internal import Test.QuickCheck import Test.QuickCheck.Instances -import Numeric -import Data.Char import Data.Word instance Arbitrary Packet where arbitrary - = do x <- choose (0 :: Int, 12) + = do x <- choose (0 :: Int, 13) case x of 0 -> do x1 <- arbitrary x2 <- arbitrary @@ -35,17 +35,22 @@ x2 <- arbitrary x3 <- arbitrary x4 <- arbitrary + return (SymmetricSessionKeyPacket x1 x2 x3 x4) + 3 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + x4 <- arbitrary x5 <- arbitrary x6 <- arbitrary return (OnePassSignaturePacket x1 x2 x3 x4 x5 x6) - 3 -> do x1 <- arbitrary + 4 -> do x1 <- arbitrary x2 <- arbitrary x3 <- arbitrary x4 <- arbitrary x5 <- arbitrary x6 <- arbitrary return (PublicKeyPacket x1 x2 x3 x4 x5 x6) - 4 -> do x1 <- arbitrary + 5 -> do x1 <- arbitrary x2 <- arbitrary x3 <- arbitrary x4 <- arbitrary @@ -54,35 +59,50 @@ x7 <- arbitrary x8 <- arbitrary x9 <- arbitrary - x10 <- arbitrary - x11 <- arbitrary - x12 <- arbitrary - x13 <- arbitrary - return (SecretKeyPacket x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13) - 5 -> do x1 <- arbitrary + return (SecretKeyPacket x1 x2 x3 x4 x5 x6 x7 x8 x9) + 6 -> do x1 <- arbitrary x2 <- arbitrary return (CompressedDataPacket x1 x2) - 6 -> return MarkerPacket - 7 -> do x1 <- arbitrary + 7 -> return MarkerPacket + 8 -> do x1 <- arbitrary x2 <- arbitrary x3 <- arbitrary x4 <- arbitrary return (LiteralDataPacket x1 x2 x3 x4) - 8 -> do x1 <- arbitrary - return (TrustPacket x1) 9 -> do x1 <- arbitrary - return (UserIDPacket x1) + return (TrustPacket x1) 10 -> do x1 <- arbitrary + return (UserIDPacket x1) + 11 -> do x1 <- arbitrary x2 <- arbitrary return (EncryptedDataPacket x1 x2) - 11 -> do x1 <- arbitrary - return (ModificationDetectionCodePacket x1) 12 -> do x1 <- arbitrary + return (ModificationDetectionCodePacket x1) + 13 -> do x1 <- arbitrary x2 <- arbitrary return (UnsupportedPacket x1 x2) _ -> error "FATAL ERROR: Arbitrary instance, logic bug" +instance Arbitrary S2K where + arbitrary + = do x <- choose (0 :: Int, 3) + case x of + 0 -> do x1 <- arbitrary + return (SimpleS2K x1) + 1 -> do x1 <- arbitrary + x2 <- arbitrary + return (SaltedS2K x1 x2) + 2 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- fmap decode_s2k_count arbitrary + return (IteratedSaltedS2K x1 x2 x3) + 3 -> do x1 <- suchThat arbitrary (`notElem` [0,1,3]) + x2 <- arbitrary + return (S2K x1 x2) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + + instance Arbitrary HashAlgorithm where arbitrary = do x <- choose (0 :: Int, 7) @@ -165,6 +185,27 @@ arbitrary = do x1 <- arbitrary return (Message x1) + + +instance Arbitrary SignatureOver where + arbitrary + = do x <- choose (0 :: Int, 3) + case x of + 0 -> do x1 <- arbitrary + x2 <- arbitrary + return (DataSignature x1 x2) + 1 -> do x1 <- arbitrary + x2 <- arbitrary + return (KeySignature x1 x2) + 2 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + return (SubkeySignature x1 x2 x3) + 3 -> do x1 <- arbitrary + x2 <- arbitrary + x3 <- arbitrary + return (CertificationSignature x1 x2 x3) + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" instance Arbitrary MPI where diff --git a/README b/README --- a/README +++ b/README @@ -11,6 +11,9 @@ or +For dealing with ASCII armor, see + + It is intended that you use qualified imports with this library. > import qualified Data.OpenPGP as OpenPGP diff --git a/openpgp.cabal b/openpgp.cabal --- a/openpgp.cabal +++ b/openpgp.cabal @@ -1,5 +1,5 @@ name: openpgp -version: 0.5 +version: 0.6 cabal-version: >= 1.8 license: OtherLicense license-file: COPYING @@ -27,6 +27,9 @@ or . + For dealing with ASCII armor, see + + . It is intended that you use qualified imports with this library. . > import qualified Data.OpenPGP as OpenPGP @@ -117,6 +120,7 @@ tests/data/compressedsig.gpg, tests/data/compressedsig-zlib.gpg, tests/data/onepass_sig, + tests/data/symmetrically_encrypted, tests/data/pubring.gpg, tests/data/secring.gpg, tests/data/uncompressed-ops-dsa.gpg, diff --git a/tests/data/symmetrically_encrypted b/tests/data/symmetrically_encrypted new file mode 100644 Binary files /dev/null and b/tests/data/symmetrically_encrypted differ diff --git a/tests/suite.hs b/tests/suite.hs --- a/tests/suite.hs +++ b/tests/suite.hs @@ -44,6 +44,10 @@ prop_MPI_serialization_loop mpi = mpi == decode' (encode mpi) +prop_S2K_serialization_loop :: OpenPGP.S2K -> Bool +prop_S2K_serialization_loop s2k = + s2k == decode' (encode s2k) + prop_SignatureSubpacket_serialization_loop :: OpenPGP.SignatureSubpacket -> Bool prop_SignatureSubpacket_serialization_loop packet = packet == decode' (encode packet) @@ -137,10 +141,12 @@ testCase "compressedsig-zlib.gpg" (testSerialization "compressedsig-zlib.gpg"), testCase "compressedsig-bzip2.gpg" (testSerialization "compressedsig-bzip2.gpg"), testCase "onepass_sig" (testSerialization "onepass_sig"), + testCase "symmetrically_encrypted" (testSerialization "symmetrically_encrypted"), testCase "uncompressed-ops-dsa.gpg" (testSerialization "uncompressed-ops-dsa.gpg"), testCase "uncompressed-ops-dsa-sha384.txt.gpg" (testSerialization "uncompressed-ops-dsa-sha384.txt.gpg"), testCase "uncompressed-ops-rsa.gpg" (testSerialization "uncompressed-ops-rsa.gpg"), testProperty "MPI encode/decode" prop_MPI_serialization_loop, + testProperty "S2K encode/decode" prop_S2K_serialization_loop, testProperty "SignatureSubpacket encode/decode" prop_SignatureSubpacket_serialization_loop ], testGroup "S2K count" [