packages feed

openpgp-asciiarmor (empty) → 0.0

raw patch · 17 files changed

+498/−0 lines, 17 filesdep +HUnitdep +attoparsecdep +basesetup-changedbinary-added

Dependencies added: HUnit, attoparsec, base, base64-bytestring, bytestring, cereal, test-framework, test-framework-hunit

Files

+ Codec/Encryption/OpenPGP/ASCIIArmor.hs view
@@ -0,0 +1,15 @@+-- 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 (+   encode+ , decode+ , parseArmor+ , multipartMerge+) where++import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode)+import Codec.Encryption.OpenPGP.ASCIIArmor.Decode (decode, parseArmor)+import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge)
+ Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs view
@@ -0,0 +1,140 @@+{-# 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+) 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 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.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 (parse parseArmors bs)+    where+        go (Fail t c e) = Left (fromString e)+        go (Partial cont) = go (cont B.empty)+        go (Done _ r) = Right r++parseArmors :: Parser [Armor]+parseArmors = many parseArmor++parseArmor :: Parser Armor+parseArmor = do+    atype <- prefixed beginLine <?> "begin line"+    headers <- armorHeaders <?> "headers"+    blankishLine <?> "blank line"+    payload <- base64Data <?> "base64 data"+    endLine atype <?> "end line"+    return $ Armor atype headers 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 (B.pack firstnum) (B.pack secondnum)+        partsindef = ArmorSplitMessageIndefinite . B.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` x `B.append` BC8.singleton '/' `B.append` y+aType (ArmorSplitMessageIndefinite x) = BC8.pack "MESSAGE, PART " `B.append` x+aType (ArmorSignature) = BC8.pack "SIGNATURE"++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
+ Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs view
@@ -0,0 +1,59 @@+-- 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+) where++import Codec.Encryption.OpenPGP.ASCIIArmor.Types+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC8+import qualified Data.ByteString.Base64 as Base64+import Data.Digest.CRC24 (crc24)+import Data.Serialize (put)+import Data.Serialize.Put (runPut, putWord32be)+import Data.String (IsString, fromString)++encode :: [Armor] -> ByteString+encode = B.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++blankLine :: ByteString+blankLine = BC8.singleton '\n'++beginLine :: ArmorType -> ByteString+beginLine atype = BC8.pack "-----BEGIN PGP " `B.append` aType atype `B.append` BC8.pack "-----\n"++endLine :: ArmorType -> ByteString+endLine atype = BC8.pack "-----END PGP " `B.append` aType atype `B.append` BC8.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"++armorHeaders :: [(String, String)] -> ByteString+armorHeaders ahs = BC8.unlines . map armorHeader $ ahs+    where+        armorHeader :: (String, String) -> ByteString+        armorHeader (k, v) = BC8.pack k `B.append` BC8.pack ": " `B.append` BC8.pack v++armorData :: ByteString -> ByteString+armorData = BC8.unlines . wordWrap 64 . Base64.encode++wordWrap :: Int -> ByteString -> [ByteString]+wordWrap lw bs+    | B.null bs = []+    | lw < 1 || lw > 76 = wordWrap 76 bs+    | otherwise = B.take lw bs : wordWrap lw (B.drop lw bs)++armorChecksum :: ByteString -> ByteString+armorChecksum = BC8.cons '=' . armorData . B.tail . runPut . putWord32be . crc24
+ Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs view
@@ -0,0 +1,24 @@+-- 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 (ByteString)+import qualified Data.ByteString as B++multipartMerge :: [Armor] -> Armor+multipartMerge as = go as (Armor ArmorMessage [] B.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 `B.append` bs)+        go' (ArmorSplitMessageIndefinite _) hs bs (Armor _ ohs obs) = Armor ArmorMessage (ohs ++ hs) (obs `B.append` bs)+        go' _ _ _ state = state
+ Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs view
@@ -0,0 +1,23 @@+-- 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 (ByteString)++data Armor = Armor ArmorType [(String, String)] ByteString+   | ClearSigned [(String, String)] String Armor+    deriving (Show, Eq)++data ArmorType = ArmorMessage+               | ArmorPublicKeyBlock+               | ArmorPrivateKeyBlock+               | ArmorSplitMessage ByteString ByteString+               | ArmorSplitMessageIndefinite ByteString+               | ArmorSignature+    deriving (Show, Eq)
+ Data/Digest/CRC24.hs view
@@ -0,0 +1,25 @@+-- CRC24.hs: OpenPGP (RFC4880) CRC24 implementation+-- Copyright Ⓒ 2012  Clint Adams+-- This software is released under the terms of the ISC license.+-- (See the LICENSE file).++module Data.Digest.CRC24 (+  crc24+) where++import Data.Bits (shiftL, (.&.), xor)+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Word (Word8, Word32)++crc24_init :: Word32+crc24_init = 0xB704CE++crc24_poly :: Word32+crc24_poly = 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++crc24 :: ByteString -> Word32+crc24 bs = B.foldl crc24_update crc24_init bs
+ LICENSE view
@@ -0,0 +1,15 @@+Copyright Ⓒ 2012 Clint Adams <clint@debian.org>++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ openpgp-asciiarmor.cabal view
@@ -0,0 +1,55 @@+Name:                openpgp-asciiarmor+Version:             0.0+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 <clint@debian.org>+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/msg2.asc+  , tests/data/msg1.gpg+  , tests/data/msg2.pgp++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+  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
+ tests/data/msg1.asc view
@@ -0,0 +1,7 @@+-----BEGIN PGP MESSAGE-----+Version: OpenPrivacy 0.99++yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS+vBSFjNSiVHsuAA==+=njUN+-----END PGP MESSAGE-----
+ tests/data/msg1.gpg view

binary file changed (absent → 58 bytes)

+ tests/data/msg1a.asc view
@@ -0,0 +1,11 @@+This file contains an ASCII-armored PGP message enclosed between++-----BEGIN PGP MESSAGE-----+Version: OpenPrivacy 0.99++yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS+vBSFjNSiVHsuAA==+=njUN+-----END PGP MESSAGE-----++two lines of arbitrary text.
+ tests/data/msg1b.asc view
@@ -0,0 +1,28 @@+This file contains three ASCII-armored PGP messages interspersed++-----BEGIN PGP MESSAGE-----+Version: OpenPrivacy 0.99++yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS+vBSFjNSiVHsuAA==+=njUN+-----END PGP MESSAGE-----+-----BEGIN PGP MESSAGE-----+Version: OpenPrivacy 0.99++yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS+vBSFjNSiVHsuAA==+=njUN+-----END PGP MESSAGE-----++with arbitrary text.++-----BEGIN PGP MESSAGE-----+Version: OpenPrivacy 0.99++yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS+vBSFjNSiVHsuAA==+=njUN+-----END PGP MESSAGE-----++All three messages are identical.
+ tests/data/msg1c.asc view
@@ -0,0 +1,21 @@+-----BEGIN PGP MESSAGE-----+Version: OpenPrivacy 0.99++yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS+vBSFjNSiVHsuAA==+=njUN+-----END PGP MESSAGE-----+-----BEGIN PGP MESSAGE-----+Version: OpenPrivacy 0.99++yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS+vBSFjNSiVHsuAA==+=njUN+-----END PGP MESSAGE-----+-----BEGIN PGP MESSAGE-----+Version: OpenPrivacy 0.99++yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS+vBSFjNSiVHsuAA==+=njUN+-----END PGP MESSAGE-----
+ tests/data/msg2.asc view
@@ -0,0 +1,13 @@+-----BEGIN PGP MESSAGE, PART 01/02-----+Version: ClosedPrivacy 0.99++pgAAAHnw/J+O5ibiYizWTVDTrl/FUe926aD7lhNS+qjFNASGRmSSvWqWyubVcW0Z+YnVtKfpv03Y+zIUQv+TATmWcwpkzhQ9QeTk70ZBFFmNXsuM12dTQGkY8IDRsmUT9+=H7u4+-----END PGP MESSAGE, PART 01/02-----++-----BEGIN PGP MESSAGE, PART 02/02-----++m+f4GTQ2FwJzO0GeazzBV4ywKLqSnCQVFBNKhDnw+=hLwC+-----END PGP MESSAGE, PART 02/02-----
+ tests/data/msg2.pgp view

binary file changed (absent → 126 bytes)

+ tests/suite.hs view
@@ -0,0 +1,60 @@+import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.HUnit++import Test.HUnit++import Codec.Encryption.OpenPGP.ASCIIArmor (encode, decode, multipartMerge)+import Codec.Encryption.OpenPGP.ASCIIArmor.Types++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC8+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 <- B.readFile $ "tests/data/" ++ fp+    tbss <- mapM (\target -> B.readFile $ "tests/data/" ++ target) targets+    case decode 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 <- B.readFile $ "tests/data/" ++ fp+    tbs <- B.readFile $ "tests/data/" ++ target+    case decode bs of+        Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp+        Right as -> assertEqual ("for " ++ fp) tbs (getPayload (multipartMerge as))+    where+        getPayload (Armor _ _ pl) = pl++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++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 multi-part armor" (testArmorMultipartDecode "msg2.asc" "msg2.pgp")+    , testCase "Encode sample armor" (testArmorEncode ["msg1.gpg"] "msg1.asc")+    , testCase "Encode multiple sample armors" (testArmorEncode ["msg1.gpg","msg1.gpg","msg1.gpg"] "msg1c.asc")+    ]+ ]++main = defaultMain tests