diff options
author | Clint Adams <clint@debian.org> | 2012-04-25 19:10:27 -0400 |
---|---|---|
committer | Clint Adams <clint@debian.org> | 2012-04-25 19:10:27 -0400 |
commit | f06c3f713f99c9ea09a76728ffce2c6e1c957070 (patch) | |
tree | 647c5c500b0713ff73533988944eef3bb4ca1bf8 | |
parent | 5ed645493e10190f7cddd753bb058e8487037549 (diff) |
Handle decoding multiple ASCII armor messages from a single bytestream.
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor.hs | 4 | ||||
-rw-r--r-- | Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 26 | ||||
-rw-r--r-- | openpgp-asciiarmor.cabal | 2 | ||||
-rw-r--r-- | tests/data/msg1a.asc | 11 | ||||
-rw-r--r-- | tests/data/msg1b.asc | 28 | ||||
-rw-r--r-- | tests/suite.hs | 18 |
6 files changed, 71 insertions, 18 deletions
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor.hs b/Codec/Encryption/OpenPGP/ASCIIArmor.hs index 74c8c69..075a481 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor.hs | |||
@@ -5,9 +5,9 @@ | |||
5 | 5 | ||
6 | module Codec.Encryption.OpenPGP.ASCIIArmor ( | 6 | module Codec.Encryption.OpenPGP.ASCIIArmor ( |
7 | armor | 7 | armor |
8 | , decodeArmor | 8 | , decode |
9 | , parseArmor | 9 | , parseArmor |
10 | ) where | 10 | ) where |
11 | 11 | ||
12 | import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (armor) | 12 | import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (armor) |
13 | import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decodeArmor, parseArmor) | 13 | import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, parseArmor) |
diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index 8c2a8a3..e69087c 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | |||
@@ -6,13 +6,14 @@ | |||
6 | 6 | ||
7 | module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( | 7 | module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( |
8 | parseArmor | 8 | parseArmor |
9 | , decodeArmor | 9 | , decode |
10 | ) where | 10 | ) where |
11 | 11 | ||
12 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | 12 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types |
13 | import Control.Applicative (many, (<|>), (<$>)) | 13 | import Control.Applicative (many, (<|>), (<$>), Alternative, (*>)) |
14 | import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>), parse, IResult(..)) | 14 | import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (<?>), parse, IResult(..)) |
15 | import Data.Attoparsec.ByteString.Char8 (isDigit_w8) | 15 | import Data.Attoparsec.ByteString.Char8 (isDigit_w8, anyChar) |
16 | import Data.Attoparsec.Combinator (manyTill) | ||
16 | import Data.Bits (shiftL) | 17 | import Data.Bits (shiftL) |
17 | import Data.ByteString (ByteString) | 18 | import Data.ByteString (ByteString) |
18 | import qualified Data.ByteString as B | 19 | import qualified Data.ByteString as B |
@@ -25,15 +26,19 @@ import Data.Serialize.Put (runPut, putWord32be) | |||
25 | import Data.String (IsString, fromString) | 26 | import Data.String (IsString, fromString) |
26 | import Data.Word (Word32) | 27 | import Data.Word (Word32) |
27 | 28 | ||
28 | decodeArmor :: (Integral a, Read a, Show a, IsString e) => ByteString -> Either e (Armor a) | 29 | decode :: (Integral a, Read a, Show a, IsString e) => ByteString -> Either e ([Armor a]) |
29 | decodeArmor bs = case parse parseArmor bs of | 30 | decode bs = go (parse parseArmors bs) |
30 | Fail t c e -> Left (fromString e) | 31 | where |
31 | Partial _ -> Left (fromString "what") | 32 | go (Fail t c e) = Left (fromString e) |
32 | Done _ r -> Right r | 33 | go (Partial cont) = go (cont B.empty) |
34 | go (Done _ r) = Right r | ||
35 | |||
36 | parseArmors :: (Integral a, Read a, Show a) => Parser ([Armor a]) | ||
37 | parseArmors = many parseArmor | ||
33 | 38 | ||
34 | parseArmor :: (Integral a, Read a, Show a) => Parser (Armor a) | 39 | parseArmor :: (Integral a, Read a, Show a) => Parser (Armor a) |
35 | parseArmor = do | 40 | parseArmor = do |
36 | atype <- beginLine <?> "begin line" | 41 | atype <- prefixed beginLine <?> "begin line" |
37 | headers <- armorHeaders <?> "headers" | 42 | headers <- armorHeaders <?> "headers" |
38 | blankishLine <?> "blank line" | 43 | blankishLine <?> "blank line" |
39 | payload <- base64Data <?> "base64 data" | 44 | payload <- base64Data <?> "base64 data" |
@@ -126,3 +131,6 @@ d24 = do | |||
126 | b <- getWord8 | 131 | b <- getWord8 |
127 | c <- getWord8 | 132 | c <- getWord8 |
128 | return $ shiftL (fromIntegral a :: Word32) 16 + shiftL (fromIntegral b :: Word32) 8 + (fromIntegral c :: Word32) | 133 | return $ shiftL (fromIntegral a :: Word32) 16 + shiftL (fromIntegral b :: Word32) 8 + (fromIntegral c :: Word32) |
134 | |||
135 | prefixed :: Parser a -> Parser a | ||
136 | prefixed end = end <|> anyChar *> prefixed end | ||
diff --git a/openpgp-asciiarmor.cabal b/openpgp-asciiarmor.cabal index 4b7e25d..ff2289a 100644 --- a/openpgp-asciiarmor.cabal +++ b/openpgp-asciiarmor.cabal | |||
@@ -12,6 +12,8 @@ Category: Codec, Data | |||
12 | Build-type: Simple | 12 | Build-type: Simple |
13 | Extra-source-files: tests/suite.hs | 13 | Extra-source-files: tests/suite.hs |
14 | , tests/data/msg1.asc | 14 | , tests/data/msg1.asc |
15 | , tests/data/msg1a.asc | ||
16 | , tests/data/msg1b.asc | ||
15 | , tests/data/msg1.gpg | 17 | , tests/data/msg1.gpg |
16 | 18 | ||
17 | Cabal-version: >= 1.10 | 19 | Cabal-version: >= 1.10 |
diff --git a/tests/data/msg1a.asc b/tests/data/msg1a.asc new file mode 100644 index 0000000..64dc079 --- /dev/null +++ b/tests/data/msg1a.asc | |||
@@ -0,0 +1,11 @@ | |||
1 | This file contains an ASCII-armored PGP message enclosed between | ||
2 | |||
3 | -----BEGIN PGP MESSAGE----- | ||
4 | Version: OpenPrivacy 0.99 | ||
5 | |||
6 | yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS | ||
7 | vBSFjNSiVHsuAA== | ||
8 | =njUN | ||
9 | -----END PGP MESSAGE----- | ||
10 | |||
11 | two lines of arbitrary text. | ||
diff --git a/tests/data/msg1b.asc b/tests/data/msg1b.asc new file mode 100644 index 0000000..1176420 --- /dev/null +++ b/tests/data/msg1b.asc | |||
@@ -0,0 +1,28 @@ | |||
1 | This file contains three ASCII-armored PGP messages interspersed | ||
2 | |||
3 | -----BEGIN PGP MESSAGE----- | ||
4 | Version: OpenPrivacy 0.99 | ||
5 | |||
6 | yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS | ||
7 | vBSFjNSiVHsuAA== | ||
8 | =njUN | ||
9 | -----END PGP MESSAGE----- | ||
10 | -----BEGIN PGP MESSAGE----- | ||
11 | Version: OpenPrivacy 0.99 | ||
12 | |||
13 | yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS | ||
14 | vBSFjNSiVHsuAA== | ||
15 | =njUN | ||
16 | -----END PGP MESSAGE----- | ||
17 | |||
18 | with arbitrary text. | ||
19 | |||
20 | -----BEGIN PGP MESSAGE----- | ||
21 | Version: OpenPrivacy 0.99 | ||
22 | |||
23 | yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS | ||
24 | vBSFjNSiVHsuAA== | ||
25 | =njUN | ||
26 | -----END PGP MESSAGE----- | ||
27 | |||
28 | All three messages are identical. | ||
diff --git a/tests/suite.hs b/tests/suite.hs index 272295a..45a2fb2 100644 --- a/tests/suite.hs +++ b/tests/suite.hs | |||
@@ -3,7 +3,7 @@ import Test.Framework.Providers.HUnit | |||
3 | 3 | ||
4 | import Test.HUnit | 4 | import Test.HUnit |
5 | 5 | ||
6 | import Codec.Encryption.OpenPGP.ASCIIArmor (armor, decodeArmor) | 6 | import Codec.Encryption.OpenPGP.ASCIIArmor (armor, decode) |
7 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types | 7 | import Codec.Encryption.OpenPGP.ASCIIArmor.Types |
8 | 8 | ||
9 | import Data.ByteString (ByteString) | 9 | import Data.ByteString (ByteString) |
@@ -15,13 +15,15 @@ import Data.Word (Word32) | |||
15 | testCRC24 :: ByteString -> Word32 -> Assertion | 15 | testCRC24 :: ByteString -> Word32 -> Assertion |
16 | testCRC24 bs crc = assertEqual "crc24" crc (crc24 bs) | 16 | testCRC24 bs crc = assertEqual "crc24" crc (crc24 bs) |
17 | 17 | ||
18 | testArmorDecode :: FilePath -> FilePath -> Assertion | 18 | testArmorDecode :: FilePath -> [FilePath] -> Assertion |
19 | testArmorDecode fp target = do | 19 | testArmorDecode fp targets = do |
20 | bs <- B.readFile $ "tests/data/" ++ fp | 20 | bs <- B.readFile $ "tests/data/" ++ fp |
21 | tbs <- B.readFile $ "tests/data/" ++ target | 21 | tbss <- mapM (\target -> B.readFile $ "tests/data/" ++ target) targets |
22 | case decodeArmor bs of | 22 | case decode bs of |
23 | Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp | 23 | Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp |
24 | Right (Armor at hdrs pl) -> do assertEqual ("for " ++ fp) tbs pl | 24 | Right as -> do assertEqual ("for " ++ fp) tbss (map getPayload as) |
25 | where | ||
26 | getPayload (Armor _ _ pl) = pl | ||
25 | 27 | ||
26 | testArmorEncode :: FilePath -> FilePath -> Assertion | 28 | testArmorEncode :: FilePath -> FilePath -> Assertion |
27 | testArmorEncode fp target = do | 29 | testArmorEncode fp target = do |
@@ -36,7 +38,9 @@ tests = [ | |||
36 | , testCase "CRC24: hOpenPGP and friends" (testCRC24 (BC8.pack "hOpenPGP and friends") 11940960) | 38 | , testCase "CRC24: hOpenPGP and friends" (testCRC24 (BC8.pack "hOpenPGP and friends") 11940960) |
37 | ] | 39 | ] |
38 | , testGroup "ASCII armor" [ | 40 | , testGroup "ASCII armor" [ |
39 | testCase "Decode sample armor" (testArmorDecode "msg1.asc" "msg1.gpg") | 41 | testCase "Decode sample armor" (testArmorDecode "msg1.asc" ["msg1.gpg"]) |
42 | , testCase "Decode sample armor with cruft" (testArmorDecode "msg1a.asc" ["msg1.gpg"]) | ||
43 | , testCase "Decode multiple sample armors" (testArmorDecode "msg1b.asc" ["msg1.gpg","msg1.gpg","msg1.gpg"]) | ||
40 | , testCase "Encode sample armor" (testArmorEncode "msg1.gpg" "msg1.asc") | 44 | , testCase "Encode sample armor" (testArmorEncode "msg1.gpg" "msg1.asc") |
41 | ] | 45 | ] |
42 | ] | 46 | ] |