diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor.hs b/Codec/Encryption/OpenPGP/ASCIIArmor.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor.hs @@ -4,12 +4,14 @@ -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor ( - encode - , decode + decode + , decodeLazy + , encode + , encodeLazy , parseArmor , multipartMerge ) where -import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode) -import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, parseArmor) +import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, decodeLazy, parseArmor) +import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode, encodeLazy) import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge) diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs @@ -7,16 +7,21 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( parseArmor , decode + , decodeLazy ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types -import Control.Applicative (many, (<|>), (<$>), Alternative, (*>)) -import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (), parse, IResult(..)) +import Codec.Encryption.OpenPGP.ASCIIArmor.Utils +import Control.Applicative (many, (<|>), (<$>), Alternative, (<*), (<*>), (*>), optional) +import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, ()) +import qualified Data.Attoparsec.ByteString as AS +import qualified Data.Attoparsec.ByteString.Lazy as AL import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) import Data.Attoparsec.Combinator (manyTill) import Data.Bits (shiftL) import Data.ByteString (ByteString) import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Base64 as Base64 import Data.Digest.CRC24 (crc24) @@ -27,23 +32,42 @@ import Data.Word (Word32) decode :: IsString e => ByteString -> Either e [Armor] -decode bs = go (parse parseArmors bs) +decode bs = go (AS.parse parseArmors bs) where - go (Fail t c e) = Left (fromString e) - go (Partial cont) = go (cont B.empty) - go (Done _ r) = Right r + go (AS.Fail t c e) = Left (fromString e) + go (AS.Partial cont) = go (cont B.empty) + go (AS.Done _ r) = Right r +decodeLazy :: IsString e => BL.ByteString -> Either e [Armor] +decodeLazy bs = go (AL.parse parseArmors bs) + where + go (AL.Fail t c e) = Left (fromString e) + go (AL.Done _ r) = Right r + parseArmors :: Parser [Armor] parseArmors = many parseArmor parseArmor :: Parser Armor -parseArmor = do - atype <- prefixed beginLine "begin line" +parseArmor = prefixed (clearsigned <|> armor) "armor" + +clearsigned :: Parser Armor +clearsigned = do + string "-----BEGIN PGP SIGNED MESSAGE-----" "clearsign header" + lineEnding "line ending" + headers <- armorHeaders "clearsign headers" + blankishLine "blank line" + cleartext <- dashEscapedCleartext + sig <- armor + return $ ClearSigned headers (BL.fromChunks [cleartext]) sig + +armor :: Parser Armor +armor = do + atype <- beginLine "begin line" headers <- armorHeaders "headers" blankishLine "blank line" payload <- base64Data "base64 data" endLine atype "end line" - return $ Armor atype headers payload + return $ Armor atype headers (BL.fromChunks [payload]) beginLine :: Parser ArmorType beginLine = do @@ -63,8 +87,8 @@ firstnum <- num word8 (fromIntegral . fromEnum $ '/') secondnum <- num - return $ ArmorSplitMessage (B.pack firstnum) (B.pack secondnum) - partsindef = ArmorSplitMessageIndefinite . B.pack <$> num + return $ ArmorSplitMessage (BL.pack firstnum) (BL.pack secondnum) + partsindef = ArmorSplitMessageIndefinite . BL.pack <$> num num = many1 (satisfy isDigit_w8) "number" lineEnding :: Parser ByteString @@ -84,7 +108,7 @@ w8sToString = BC8.unpack . B.pack blankishLine :: Parser ByteString -blankishLine = many (satisfy (inClass " \t")) >> lineEnding +blankishLine = many (satisfy (inClass " \t")) *> lineEnding endLine :: ArmorType -> Parser ByteString endLine atype = do @@ -95,10 +119,13 @@ aType (ArmorMessage) = BC8.pack "MESSAGE" aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" -aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` x `B.append` BC8.singleton '/' `B.append` y -aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` x +aType (ArmorSplitMessage x y) = BC8.pack "MESSAGE, PART " `B.append` l2s x `B.append` BC8.singleton '/' `B.append` l2s y +aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` l2s x aType (ArmorSignature) = BC8.pack "SIGNATURE" +l2s :: BL.ByteString -> ByteString +l2s = B.concat . BL.toChunks + base64Data :: Parser ByteString base64Data = do ls <- many1 base64Line @@ -138,3 +165,13 @@ prefixed :: Parser a -> Parser a prefixed end = end <|> anyChar *> prefixed end + +dashEscapedCleartext :: Parser ByteString +dashEscapedCleartext = do + ls <- many1 ((deLine <|> unescapedLine) <* lineEnding) + return $ crlfUnlines ls + where + deLine :: Parser ByteString + deLine = B.pack <$> (string "- " *> many (satisfy (notInClass "\n\r"))) + unescapedLine :: Parser ByteString + unescapedLine = maybe B.empty B.pack <$> optional ((:) <$> satisfy (notInClass "-\n\r") <*> many (satisfy (notInClass "\n\r"))) diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs @@ -5,55 +5,71 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( encode + , encodeLazy ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types -import Data.ByteString (ByteString) +import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC8 +import qualified Data.ByteString.Lazy.Char8 as BLC8 import qualified Data.ByteString.Base64 as Base64 -import Data.Digest.CRC24 (crc24) +import Data.Digest.CRC24 (crc24Lazy) import Data.Serialize (put) -import Data.Serialize.Put (runPut, putWord32be) +import Data.Serialize.Put (runPutLazy, putWord32be) import Data.String (IsString, fromString) -encode :: [Armor] -> ByteString -encode = B.concat . map armor +encode :: [Armor] -> B.ByteString +encode = B.concat . BL.toChunks . encodeLazy +encodeLazy :: [Armor] -> ByteString +encodeLazy = BL.concat . map armor + armor :: Armor -> ByteString -armor (Armor atype ahs bs) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData bs `B.append` armorChecksum bs `B.append` endLine atype +armor (Armor atype ahs bs) = beginLine atype `BL.append` armorHeaders ahs `BL.append` blankLine `BL.append` armorData bs `BL.append` armorChecksum bs `BL.append` endLine atype +armor (ClearSigned chs ctxt csig) = BLC8.pack "-----BEGIN PGP SIGNED MESSAGE-----\n" `BL.append` armorHeaders chs `BL.append` blankLine `BL.append` dashEscape ctxt `BL.append` armor csig blankLine :: ByteString -blankLine = BC8.singleton '\n' +blankLine = BLC8.singleton '\n' beginLine :: ArmorType -> ByteString -beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" +beginLine atype = BLC8.pack "-----BEGIN PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" endLine :: ArmorType -> ByteString -endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.pack "-----\n" +endLine atype = BLC8.pack "-----END PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" aType :: ArmorType -> ByteString -aType (ArmorMessage) = BC8.pack "MESSAGE" -aType (ArmorPublicKeyBlock) = BC8.pack "PUBLIC KEY BLOCK" -aType (ArmorPrivateKeyBlock) = BC8.pack "PRIVATE KEY BLOCK" -aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y -aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x -aType (ArmorSignature) = BC8.pack "SIGNATURE" +aType (ArmorMessage) = BLC8.pack "MESSAGE" +aType (ArmorPublicKeyBlock) = BLC8.pack "PUBLIC KEY BLOCK" +aType (ArmorPrivateKeyBlock) = BLC8.pack "PRIVATE KEY BLOCK" +aType (ArmorSplitMessage x y) = BLC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ show y +aType (ArmorSplitMessageIndefinite x) = BLC8.pack $ "MESSAGE, PART " ++ show x +aType (ArmorSignature) = BLC8.pack "SIGNATURE" armorHeaders :: [(String, String)] -> ByteString -armorHeaders ahs = BC8.unlines . map armorHeader $ ahs +armorHeaders ahs = BLC8.unlines . map armorHeader $ ahs where armorHeader :: (String, String) -> ByteString - armorHeader (k, v) = BC8.pack k `B.append` BC8.pack ": " `B.append` BC8.pack v + armorHeader (k, v) = BLC8.pack k `BL.append` BLC8.pack ": " `BL.append` BLC8.pack v armorData :: ByteString -> ByteString -armorData = BC8.unlines . wordWrap 64 . Base64.encode +armorData = BLC8.unlines . wordWrap 64 . BL.fromChunks . return . Base64.encode . B.concat . BL.toChunks wordWrap :: Int -> ByteString -> [ByteString] wordWrap lw bs - | B.null bs = [] + | BL.null bs = [] | lw < 1 || lw > 76 = wordWrap 76 bs - | otherwise = B.take lw bs : wordWrap lw (B.drop lw bs) + | otherwise = BL.take (fromIntegral lw) bs : wordWrap lw (BL.drop (fromIntegral lw) bs) armorChecksum :: ByteString -> ByteString -armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24 +armorChecksum = BLC8.cons '=' . armorData . BL.tail . runPutLazy . putWord32be . crc24Lazy + +dashEscape :: ByteString -> ByteString +dashEscape = BLC8.unlines . map escapeLine . BLC8.lines + where + escapeLine :: ByteString -> ByteString + escapeLine l + | BLC8.singleton '-' `BL.isPrefixOf` l = BLC8.pack "- " `BL.append` l + | BLC8.pack "From " `BL.isPrefixOf` l = BLC8.pack "- " `BL.append` l + | otherwise = l diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs @@ -9,16 +9,16 @@ import Codec.Encryption.OpenPGP.ASCIIArmor.Types -import Data.ByteString (ByteString) -import qualified Data.ByteString as B +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BL multipartMerge :: [Armor] -> Armor -multipartMerge as = go as (Armor ArmorMessage [] B.empty) +multipartMerge as = go as (Armor ArmorMessage [] BL.empty) where go :: [Armor] -> Armor -> Armor go [] state = state - go ((Armor at hs bs):as) state = go as (go' at hs bs state) + go (Armor at hs bs:as) state = go as (go' at hs bs state) go' :: ArmorType -> [(String,String)] -> ByteString -> Armor -> Armor - go' (ArmorSplitMessage _ _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `B.append` bs) - go' (ArmorSplitMessageIndefinite _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `B.append` bs) + go' (ArmorSplitMessage _ _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `BL.append` bs) + go' (ArmorSplitMessageIndefinite _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `BL.append` bs) go' _ _ _ state = state diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs @@ -8,10 +8,10 @@ , ArmorType(..) ) where -import Data.ByteString (ByteString) +import Data.ByteString.Lazy (ByteString) data Armor = Armor ArmorType [(String, String)] ByteString - | ClearSigned [(String, String)] String Armor + | ClearSigned [(String, String)] ByteString Armor deriving (Show, Eq) data ArmorType = ArmorMessage diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs new file mode 100644 --- /dev/null +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs @@ -0,0 +1,24 @@ +-- ASCIIArmor/Utils.hs: OpenPGP (RFC4880) ASCII armor implementation +-- Copyright Ⓒ 2012 Clint Adams +-- This software is released under the terms of the ISC license. +-- (See the LICENSE file). + +module Codec.Encryption.OpenPGP.ASCIIArmor.Utils ( + crlfUnlines + , crlfUnlinesLazy +) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC8 +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BLC8 +import Data.List (intersperse) + +crlfUnlines :: [ByteString] -> ByteString +crlfUnlines [] = B.empty +crlfUnlines ss = B.concat $ intersperse (BC8.pack "\r\n") ss + +crlfUnlinesLazy :: [BL.ByteString] -> BL.ByteString +crlfUnlinesLazy [] = BL.empty +crlfUnlinesLazy ss = BL.concat $ intersperse (BLC8.pack "\r\n") ss diff --git a/Data/Digest/CRC24.hs b/Data/Digest/CRC24.hs --- a/Data/Digest/CRC24.hs +++ b/Data/Digest/CRC24.hs @@ -4,22 +4,27 @@ -- (See the LICENSE file). module Data.Digest.CRC24 ( - crc24 + crc24 + , crc24Lazy ) where import Data.Bits (shiftL, (.&.), xor) -import Data.ByteString (ByteString) +import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL import Data.Word (Word8, Word32) -crc24_init :: Word32 -crc24_init = 0xB704CE +crc24Init :: Word32 +crc24Init = 0xB704CE -crc24_poly :: Word32 -crc24_poly = 0x1864CFB +crc24Poly :: Word32 +crc24Poly = 0x1864CFB -crc24_update :: Word32 -> Word8 -> Word32 -crc24_update c b = (last . take 9 $ iterate (\x -> if (shiftL x 1) .&. 0x1000000 == 0x1000000 then shiftL x 1 `xor` crc24_poly else shiftL x 1) (c `xor` shiftL (fromIntegral b) 16)) .&. 0xFFFFFF +crc24Update :: Word32 -> Word8 -> Word32 +crc24Update c b = (last . take 9 $ iterate (\x -> if shiftL x 1 .&. 0x1000000 == 0x1000000 then shiftL x 1 `xor` crc24Poly else shiftL x 1) (c `xor` shiftL (fromIntegral b) 16)) .&. 0xFFFFFF -crc24 :: ByteString -> Word32 -crc24 bs = B.foldl crc24_update crc24_init bs +crc24 :: B.ByteString -> Word32 +crc24 bs = crc24Lazy . BL.fromChunks $ [bs] + +crc24Lazy :: ByteString -> Word32 +crc24Lazy = BL.foldl crc24Update crc24Init diff --git a/openpgp-asciiarmor.cabal b/openpgp-asciiarmor.cabal --- a/openpgp-asciiarmor.cabal +++ b/openpgp-asciiarmor.cabal @@ -1,5 +1,5 @@ Name: openpgp-asciiarmor -Version: 0.0 +Version: 0.1 Synopsis: OpenPGP (RFC4880) ASCII Armor codec Description: OpenPGP (RFC4880) ASCII Armor codec Homepage: http://floss.scru.org/openpgp-asciiarmor @@ -15,9 +15,15 @@ , tests/data/msg1a.asc , tests/data/msg1b.asc , tests/data/msg1c.asc - , tests/data/msg2.asc , tests/data/msg1.gpg + , tests/data/msg2.asc , tests/data/msg2.pgp + , tests/data/msg3 + , tests/data/msg3.asc + , tests/data/msg3.sig + , tests/data/msg4 + , tests/data/msg4.asc + , tests/data/msg4.sig Cabal-version: >= 1.10 @@ -29,6 +35,7 @@ , Codec.Encryption.OpenPGP.ASCIIArmor.Types Other-Modules: Data.Digest.CRC24 , Codec.Encryption.OpenPGP.ASCIIArmor.Multipart + , Codec.Encryption.OpenPGP.ASCIIArmor.Utils Build-depends: attoparsec , base > 4 && < 5 , base64-bytestring diff --git a/tests/data/msg3 b/tests/data/msg3 new file mode 100644 --- /dev/null +++ b/tests/data/msg3 @@ -0,0 +1,9 @@ +This is a message that will be clearsigned. + +From RFC4880, we know that some of these lines should be +dash-escaped. + +-Lines starting with a minus-hyphen MUST be escaped. +- Lines starting with "From" SHOULD be escaped. + +Other lines MAY be escaped. diff --git a/tests/data/msg3.asc b/tests/data/msg3.asc new file mode 100644 --- /dev/null +++ b/tests/data/msg3.asc @@ -0,0 +1,29 @@ +-----BEGIN PGP SIGNED MESSAGE----- +Hash: SHA1 + +This is a message that will be clearsigned. + +- From RFC4880, we know that some of these lines should be +dash-escaped. + +- -Lines starting with a minus-hyphen MUST be escaped. +- - Lines starting with "From" SHOULD be escaped. + +Other lines MAY be escaped. +-----BEGIN PGP SIGNATURE----- +Version: OpenPrivacy 0.99 + +iQIcBAEBAgAGBQJPmXqrAAoJEN/7iwtcb1WCG3AQAJ6TBeX12YDI1f/AdtV46quG +augJYpYZvBbKESGXue1Nv22a7uH4h8LgWRsaEQxMBUwJvlMJfNkjEMAkXQbkj/Og +J+78bAGMV1GtC5MuwPr8E+M8Z/uHhbzj3fWuUask0Q057u655YIEdlnY4OcZv9jW +hT+/2kNcC8aw9+kg0I175XNxwBhRXoRKX6dhyAkRSnz7yuQtGXH7kQJAt7TOxxAb +dud+u5IJixDPebG+NONPfuW5VB8erByW6UPIy4BQBnaxflSD8qJXxCDMWNzOBlYG +whKXDmlcVgy3J7ghSh2zcFcZhM30Ng49t6k57HOXR9XnI5dskY45yns2nD4kt58/ +7anmscGGj0S3pzoUuFAdVIEvziYDhISs35CmTmNh4r4LVuh4R+Zurt3mbe8O6amm +ZOWZzPsEDX/13B/DnL//70jVhTXUBqDj6MeNj5XHXVbIlfmIyeVLOIXiT/+u1FFt ++0ERqwFI152GGJJWlikn5bR6P89Xz+04OeTBdxV1fCGt+hlvN6e5X9K15P16QDiq +4COHMZyIyHbtQr92BIj0P46WNsNZJDaoegHl6xtbq60eV3W+LRvgHNphjE+mdIp0 +EV5lBqDGupGYpHkPjZBg0pqASs0Xd3P7SwkoVimtH7mXCPrL4K+o6X8IwsfEMCGY +Ddej4NK0eolGoz/1sKB0 +=ZShm +-----END PGP SIGNATURE----- diff --git a/tests/data/msg3.sig b/tests/data/msg3.sig new file mode 100644 Binary files /dev/null and b/tests/data/msg3.sig differ diff --git a/tests/data/msg4 b/tests/data/msg4 new file mode 100644 --- /dev/null +++ b/tests/data/msg4 @@ -0,0 +1,1 @@ +This message is detach-signed. diff --git a/tests/data/msg4.asc b/tests/data/msg4.asc new file mode 100644 --- /dev/null +++ b/tests/data/msg4.asc @@ -0,0 +1,17 @@ +-----BEGIN PGP SIGNATURE----- +Version: GnuPG v1.4.12 (GNU/Linux) + +iQIcBAABAgAGBQJPmZE0AAoJEN/7iwtcb1WC6EcQAK+NpDfsgTJgq+5nhZLZQcDC ++b+8K5eDn+Z/btFZz1h2mF3Y+MpJdgG5fvSSHsYRWiGuT8OBK5wm3vSYnSr8BeA5 +JUJDdhasF7LVosb0ToNiWLbtj9D9iiqmCaPW56Y2u3Ktv5Y4nOAWZw31OGv21B1c +ptYVv2iy1qPGgnHxYgM5ib37hzKlkTEGKFNMpfYqsMBZyXiKuLpVhEWelawMnCPJ +3b7loOhYvR1Odmolg0dmcFsay7s3uXC/nze+xqTM0Z1HnMxQVW54aixhOoajDO6V +p7OUUN5g/PBXHvx/gh7gPqgRCazo93rHSgoP//AoEuljrU4W9iNpCEcE5HTdYx0b +xh10WxWE4VHI8BVt5qhSzPe8BmFRWz+g9CmsJdmhw45W8XxRJMJwoTWzGPcmHTFk +JTOgJ9/MKcBvYGsBd0wGYq82DbDPdtwGgh5Aa3nz1dxzLCq7qIhOa3VEYKAhCjTx +UHWnKZrdjSKz8U4D6CECyxlK5UApPc4jWzn3XYCX8s2F84YW7htduE57Yf60bXom +aefIbDWef1Q4MOUV10h1gyjXtdSiIHvJ0ItvGKmRiXztjhq6+azYN+4RaXzpF5/N +pqG/DNeTouzMRSzEoLTQ2oBHB8VIbCnP6J2Ck3wPfJZfc6FyCv0gMPQ5pTToll97 +6toTAyOHl3pI/inp7IGj +=TJqj +-----END PGP SIGNATURE----- diff --git a/tests/data/msg4.sig b/tests/data/msg4.sig new file mode 100644 Binary files /dev/null and b/tests/data/msg4.sig differ diff --git a/tests/suite.hs b/tests/suite.hs --- a/tests/suite.hs +++ b/tests/suite.hs @@ -3,12 +3,15 @@ import Test.HUnit -import Codec.Encryption.OpenPGP.ASCIIArmor (encode, decode, multipartMerge) +import Codec.Encryption.OpenPGP.ASCIIArmor (decode, decodeLazy, encode, encodeLazy, multipartMerge) import Codec.Encryption.OpenPGP.ASCIIArmor.Types +import Codec.Encryption.OpenPGP.ASCIIArmor.Utils import Data.ByteString (ByteString) import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC8 +import qualified Data.ByteString.Lazy.Char8 as BLC8 import Data.Digest.CRC24 (crc24) import Data.Word (Word32) @@ -17,9 +20,9 @@ testArmorDecode :: FilePath -> [FilePath] -> Assertion testArmorDecode fp targets = do - bs <- B.readFile $ "tests/data/" ++ fp - tbss <- mapM (\target -> B.readFile $ "tests/data/" ++ target) targets - case decode bs of + bs <- BL.readFile $ "tests/data/" ++ fp + tbss <- mapM (\target -> BL.readFile $ "tests/data/" ++ target) targets + case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right as -> assertEqual ("for " ++ fp) tbss (map getPayload as) where @@ -27,20 +30,59 @@ testArmorMultipartDecode :: FilePath -> FilePath -> Assertion testArmorMultipartDecode fp target = do - bs <- B.readFile $ "tests/data/" ++ fp - tbs <- B.readFile $ "tests/data/" ++ target - case decode bs of + bs <- BL.readFile $ "tests/data/" ++ fp + tbs <- BL.readFile $ "tests/data/" ++ target + case decodeLazy bs of Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp Right as -> assertEqual ("for " ++ fp) tbs (getPayload (multipartMerge as)) where getPayload (Armor _ _ pl) = pl +testClearsignedDecodeBody :: FilePath -> FilePath -> Assertion +testClearsignedDecodeBody fp target = do + bs <- BL.readFile $ "tests/data/" ++ fp + tbs <- BL.readFile $ "tests/data/" ++ target + case decodeLazy bs of + Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp + Right [a] -> assertEqual ("for " ++ fp) (convertEndings tbs) (getBody a) + where + getBody (ClearSigned _ txt _) = txt + convertEndings = crlfUnlinesLazy . BLC8.lines + +testClearsignedDecodeSig :: FilePath -> FilePath -> Assertion +testClearsignedDecodeSig fp target = do + bs <- BL.readFile $ "tests/data/" ++ fp + tbs <- BL.readFile $ "tests/data/" ++ target + case decodeLazy bs of + Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp + Right [a] -> assertEqual ("for " ++ fp) tbs (getSig a) + where + getSig (ClearSigned _ _ (Armor _ _ sig)) = sig + testArmorEncode :: [FilePath] -> FilePath -> Assertion testArmorEncode fps target = do - bss <- mapM (\fp -> B.readFile $ "tests/data/" ++ fp) fps - tbs <- B.readFile $ "tests/data/" ++ target - assertEqual ("literaldata") (encode (map (\bs -> Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs) bss)) tbs + bss <- mapM (\fp -> BL.readFile $ "tests/data/" ++ fp) fps + tbs <- BL.readFile $ "tests/data/" ++ target + assertEqual ("literaldata") tbs (encodeLazy (map (\bs -> Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs) bss)) +testClearsignedEncode :: FilePath -> FilePath -> FilePath -> Assertion +testClearsignedEncode ftxt fsig ftarget = do + txt <- BL.readFile $ "tests/data/" ++ ftxt + sig <- BL.readFile $ "tests/data/" ++ fsig + target <- BL.readFile $ "tests/data/" ++ ftarget + assertEqual ("clearsigned encode") target (encodeLazy [ClearSigned [("Hash","SHA1")] txt (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] sig)]) + +testStrictDecode :: FilePath -> Assertion +testStrictDecode fp = do + bs <- BL.readFile $ "tests/data/" ++ fp + assertEqual ("strict decode") (decodeLazy bs :: Either String [Armor]) (decode (B.concat . BL.toChunks $ bs) :: Either String [Armor]) + +testStrictEncode :: FilePath -> Assertion +testStrictEncode fp = do + bs <- BL.readFile $ "tests/data/" ++ fp + let fakearmors = [Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs, ClearSigned [("Hash","SHA1")] bs (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] bs)] + assertEqual ("strict encode") (encodeLazy fakearmors) (BL.fromChunks [(encode fakearmors)]) + tests = [ testGroup "CRC24" [ testCase "CRC24: A" (testCRC24 (BC8.pack "A") 16680698) @@ -51,9 +93,15 @@ testCase "Decode sample armor" (testArmorDecode "msg1.asc" ["msg1.gpg"]) , testCase "Decode sample armor with cruft" (testArmorDecode "msg1a.asc" ["msg1.gpg"]) , testCase "Decode multiple sample armors" (testArmorDecode "msg1b.asc" ["msg1.gpg","msg1.gpg","msg1.gpg"]) + , testCase "Decode detached signature" (testArmorDecode "msg4.asc" ["msg4.sig"]) , testCase "Decode multi-part armor" (testArmorMultipartDecode "msg2.asc" "msg2.pgp") + , testCase "Decode body of clear-signed" (testClearsignedDecodeBody "msg3.asc" "msg3") + , testCase "Decode sig of clear-signed" (testClearsignedDecodeSig "msg3.asc" "msg3.sig") , testCase "Encode sample armor" (testArmorEncode ["msg1.gpg"] "msg1.asc") , testCase "Encode multiple sample armors" (testArmorEncode ["msg1.gpg","msg1.gpg","msg1.gpg"] "msg1c.asc") + , testCase "Encode clear-signed sig" (testClearsignedEncode "msg3" "msg3.sig" "msg3.asc") + , testCase "Decode from strict ByteString" (testStrictDecode "msg1.asc") + , testCase "Encode to strict ByteString" (testStrictEncode "msg1.gpg") ] ]