openpgp-asciiarmor-0.1/0000755000000000000000000000000011746365547013361 5ustar0000000000000000openpgp-asciiarmor-0.1/openpgp-asciiarmor.cabal0000644000000000000000000000366011746365547020151 0ustar0000000000000000Name: openpgp-asciiarmor Version: 0.1 Synopsis: OpenPGP (RFC4880) ASCII Armor codec Description: OpenPGP (RFC4880) ASCII Armor codec Homepage: http://floss.scru.org/openpgp-asciiarmor License: OtherLicense License-file: LICENSE Author: Clint Adams Maintainer: Clint Adams Copyright: 2012, Clint Adams Category: Codec, Data Build-type: Simple Extra-source-files: tests/suite.hs , tests/data/msg1.asc , tests/data/msg1a.asc , tests/data/msg1b.asc , tests/data/msg1c.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 Library Exposed-modules: Codec.Encryption.OpenPGP.ASCIIArmor , Codec.Encryption.OpenPGP.ASCIIArmor.Decode , Codec.Encryption.OpenPGP.ASCIIArmor.Encode , 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 , bytestring , cereal default-language: Haskell98 Test-Suite tests type: exitcode-stdio-1.0 main-is: tests/suite.hs Build-depends: attoparsec , base > 4 && < 5 , base64-bytestring , bytestring , cereal , HUnit , test-framework , test-framework-hunit default-language: Haskell98 source-repository head type: git location: git://git.debian.org/users/clint/openpgp-asciiarmor.git openpgp-asciiarmor-0.1/Setup.hs0000644000000000000000000000005611746365547015016 0ustar0000000000000000import Distribution.Simple main = defaultMain openpgp-asciiarmor-0.1/LICENSE0000644000000000000000000000135411746365547014371 0ustar0000000000000000Copyright Ⓒ 2012 Clint Adams Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. openpgp-asciiarmor-0.1/tests/0000755000000000000000000000000011746365547014523 5ustar0000000000000000openpgp-asciiarmor-0.1/tests/suite.hs0000644000000000000000000001217011746365547016211 0ustar0000000000000000import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.HUnit import Test.HUnit 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) testCRC24 :: ByteString -> Word32 -> Assertion testCRC24 bs crc = assertEqual "crc24" crc (crc24 bs) testArmorDecode :: FilePath -> [FilePath] -> Assertion testArmorDecode fp targets = do 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 getPayload (Armor _ _ pl) = pl testArmorMultipartDecode :: FilePath -> FilePath -> Assertion testArmorMultipartDecode 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 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 -> 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) , testCase "CRC24: Haskell" (testCRC24 (BC8.pack "Haskell") 15612750) , testCase "CRC24: hOpenPGP and friends" (testCRC24 (BC8.pack "hOpenPGP and friends") 11940960) ] , testGroup "ASCII armor" [ 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") ] ] main = defaultMain tests openpgp-asciiarmor-0.1/tests/data/0000755000000000000000000000000011746365547015434 5ustar0000000000000000openpgp-asciiarmor-0.1/tests/data/msg4.sig0000644000000000000000000000103711746365547017013 0ustar0000000000000000O4  \oUG72`gA+nYXv]Iv~Z!OÁ+&*9%BCvբNbX* 6r8g 8k\h֣Ƃqb921(SL*YxUE #ݾXNvj%Gfp[˻7p7ƤѝGPUnxj,a: P`W> zJ (cN#iGtct[QmRaQ[?)%١ÎV|Q$p5&1d%3')o`kwLb6 v@kys,*NkuD`! 4Pu)ݍ"N!J@)=#[9]ͅ]N{amz&il5T80Hu(׵Ԣ {Ћo|7i|ͦ דE,ĠڀGHl)蝂||_sr 094_{#zH)쁣openpgp-asciiarmor-0.1/tests/data/msg4.asc0000644000000000000000000000150411746365547016776 0ustar0000000000000000-----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----- openpgp-asciiarmor-0.1/tests/data/msg40000644000000000000000000000003711746365547016231 0ustar0000000000000000This message is detach-signed. openpgp-asciiarmor-0.1/tests/data/msg3.sig0000644000000000000000000000103711746365547017012 0ustar0000000000000000Oz  \oUpـvx꫆j b!MmY LL S |#$]'lWQ .$?D:PT/&ߐNca VxGnm驦d ÜHՅ5Ǎ]VȕK8OQmAHםV)'z?W89wu|!o7_ҵz@8#1vBv?6Y$6z[Wu-aOtt^eƺy`ҚJwsK (V)௨0! ףҴzF?topenpgp-asciiarmor-0.1/tests/data/msg3.asc0000644000000000000000000000214711746365547017001 0ustar0000000000000000-----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----- openpgp-asciiarmor-0.1/tests/data/msg30000644000000000000000000000036711746365547016236 0ustar0000000000000000This 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. openpgp-asciiarmor-0.1/tests/data/msg2.pgp0000644000000000000000000000017611746365547017020 0ustar0000000000000000y&b,MPӮ_QvR4Fdjqmbum)ov>̅Ne™3Py9;ѐEcW5F< 4lD46s;Ak 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 :: B.ByteString -> Word32 crc24 bs = crc24Lazy . BL.fromChunks $ [bs] crc24Lazy :: ByteString -> Word32 crc24Lazy = BL.foldl crc24Update crc24Init openpgp-asciiarmor-0.1/Codec/0000755000000000000000000000000011746365547014376 5ustar0000000000000000openpgp-asciiarmor-0.1/Codec/Encryption/0000755000000000000000000000000011746365547016530 5ustar0000000000000000openpgp-asciiarmor-0.1/Codec/Encryption/OpenPGP/0000755000000000000000000000000011746365547020000 5ustar0000000000000000openpgp-asciiarmor-0.1/Codec/Encryption/OpenPGP/ASCIIArmor.hs0000644000000000000000000000104511746365547022165 0ustar0000000000000000-- ASCIIArmor.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 ( decode , decodeLazy , encode , encodeLazy , parseArmor , multipartMerge ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, decodeLazy, parseArmor) import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode, encodeLazy) import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge) openpgp-asciiarmor-0.1/Codec/Encryption/OpenPGP/ASCIIArmor/0000755000000000000000000000000011746365547021631 5ustar0000000000000000openpgp-asciiarmor-0.1/Codec/Encryption/OpenPGP/ASCIIArmor/Utils.hs0000644000000000000000000000146111746365547023267 0ustar0000000000000000-- 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 openpgp-asciiarmor-0.1/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs0000644000000000000000000000175311746365547024154 0ustar0000000000000000-- ASCIIArmor/Multipart.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.Multipart ( multipartMerge ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL multipartMerge :: [Armor] -> Armor 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' :: ArmorType -> [(String,String)] -> ByteString -> Armor -> Armor 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 openpgp-asciiarmor-0.1/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs0000644000000000000000000000134511746365547023274 0ustar0000000000000000-- ASCIIArmor/Decode.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.Types ( Armor(..) , ArmorType(..) ) where import Data.ByteString.Lazy (ByteString) data Armor = Armor ArmorType [(String, String)] ByteString | ClearSigned [(String, String)] ByteString Armor deriving (Show, Eq) data ArmorType = ArmorMessage | ArmorPublicKeyBlock | ArmorPrivateKeyBlock | ArmorSplitMessage ByteString ByteString | ArmorSplitMessageIndefinite ByteString | ArmorSignature deriving (Show, Eq) openpgp-asciiarmor-0.1/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs0000644000000000000000000000614311746365547023366 0ustar0000000000000000-- ASCIIArmor/Encode.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.Encode ( encode , encodeLazy ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types 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 (crc24Lazy) import Data.Serialize (put) import Data.Serialize.Put (runPutLazy, putWord32be) import Data.String (IsString, fromString) 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 `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 = BLC8.singleton '\n' beginLine :: ArmorType -> ByteString beginLine atype = BLC8.pack "-----BEGIN PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" endLine :: ArmorType -> ByteString endLine atype = BLC8.pack "-----END PGP " `BL.append` aType atype `BL.append` BLC8.pack "-----\n" aType :: ArmorType -> ByteString 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 = BLC8.unlines . map armorHeader $ ahs where armorHeader :: (String, String) -> ByteString armorHeader (k, v) = BLC8.pack k `BL.append` BLC8.pack ": " `BL.append` BLC8.pack v armorData :: ByteString -> ByteString armorData = BLC8.unlines . wordWrap 64 . BL.fromChunks . return . Base64.encode . B.concat . BL.toChunks wordWrap :: Int -> ByteString -> [ByteString] wordWrap lw bs | BL.null bs = [] | lw < 1 || lw > 76 = wordWrap 76 bs | otherwise = BL.take (fromIntegral lw) bs : wordWrap lw (BL.drop (fromIntegral lw) bs) armorChecksum :: ByteString -> ByteString 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 openpgp-asciiarmor-0.1/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs0000644000000000000000000001541211746365547023353 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- ASCIIArmor/Decode.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.Decode ( parseArmor , decode , decodeLazy ) where import Codec.Encryption.OpenPGP.ASCIIArmor.Types 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) import Data.Serialize (get) import Data.Serialize.Get (Get, runGet, getWord8) import Data.Serialize.Put (runPut, putWord32be) import Data.String (IsString, fromString) import Data.Word (Word32) decode :: IsString e => ByteString -> Either e [Armor] decode bs = go (AS.parse parseArmors bs) where 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 = 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 (BL.fromChunks [payload]) beginLine :: Parser ArmorType beginLine = do string "-----BEGIN PGP " "leading minus-hyphens" atype <- pubkey <|> privkey <|> parts <|> message <|> signature string "-----" "trailing minus-hyphens" many (satisfy (inClass " \t")) "whitespace" lineEnding "line ending" return atype where message = string "MESSAGE" *> return ArmorMessage pubkey = string "PUBLIC KEY BLOCK" *> return ArmorPublicKeyBlock privkey = string "PRIVATE KEY BLOCK" *> return ArmorPrivateKeyBlock signature = string "SIGNATURE" *> return ArmorSignature parts = string "MESSAGE, PART " *> (partsdef <|> partsindef) partsdef = do firstnum <- num word8 (fromIntegral . fromEnum $ '/') secondnum <- num return $ ArmorSplitMessage (BL.pack firstnum) (BL.pack secondnum) partsindef = ArmorSplitMessageIndefinite . BL.pack <$> num num = many1 (satisfy isDigit_w8) "number" lineEnding :: Parser ByteString lineEnding = string "\n" <|> string "\r\n" armorHeaders :: Parser [(String, String)] armorHeaders = many armorHeader armorHeader :: Parser (String, String) armorHeader = do key <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) string ": " val <- many1 (satisfy (notInClass "\n\r")) lineEnding return (w8sToString key, w8sToString val) where w8sToString = BC8.unpack . B.pack blankishLine :: Parser ByteString blankishLine = many (satisfy (inClass " \t")) *> lineEnding endLine :: ArmorType -> Parser ByteString endLine atype = do string $ "-----END PGP " `B.append` aType atype `B.append` "-----" lineEnding 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 " `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 cksum <- checksumLine let payload = B.concat ls let ourcksum = crc24 payload case runGet d24 cksum of Left err -> fail err Right theircksum -> if theircksum == ourcksum then return payload else fail ("CRC24 mismatch: " ++ show (B.unpack cksum) ++ "/" ++ show theircksum ++ " vs. " ++ show ourcksum) where base64Line :: Parser ByteString base64Line = do b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) pad <- many (word8 (fromIntegral . fromEnum $ '=')) lineEnding let line = B.pack b64 `B.append` B.pack pad case Base64.decode line of Left err -> fail err Right bs -> return bs checksumLine :: Parser ByteString checksumLine = do word8 (fromIntegral . fromEnum $ '=') b64 <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")) lineEnding let line = B.pack b64 case Base64.decode line of Left err -> fail err Right bs -> return bs d24 :: Get Word32 d24 = do a <- getWord8 b <- getWord8 c <- getWord8 return $ shiftL (fromIntegral a :: Word32) 16 + shiftL (fromIntegral b :: Word32) 8 + (fromIntegral c :: Word32) 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")))