From 5ed645493e10190f7cddd753bb058e8487037549 Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Wed, 25 Apr 2012 16:38:48 -0400 Subject: Separate ASCII armor codec into its own package, change license to ISC, and change API toward Stephen Paul Weber's proposal. --- Codec/Encryption/OpenPGP/ASCIIArmor.hs | 2 +- Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs | 17 +++++---- Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs | 25 ++++++------- Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs | 23 ++++++++++++ Data/Digest/CRC24.hs | 2 +- LICENSE | 30 +++++++--------- openpgp-asciiarmor.cabal | 49 ++++++++++++++++++++++++++ tests/data/msg1.asc | 7 ++++ tests/data/msg1.gpg | Bin 0 -> 58 bytes tests/suite.hs | 44 +++++++++++++++++++++++ 10 files changed, 157 insertions(+), 42 deletions(-) create mode 100644 Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs create mode 100644 openpgp-asciiarmor.cabal create mode 100644 tests/data/msg1.asc create mode 100644 tests/data/msg1.gpg create mode 100644 tests/suite.hs diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor.hs b/Codec/Encryption/OpenPGP/ASCIIArmor.hs index 62440ae..74c8c69 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor.hs @@ -1,6 +1,6 @@ -- ASCIIArmor.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright Ⓒ 2012 Clint Adams --- This software is released under the terms of the Expat (MIT) license. +-- This software is released under the terms of the ISC license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor ( diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs index 64f7236..8c2a8a3 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} -- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright Ⓒ 2012 Clint Adams --- This software is released under the terms of the Expat (MIT) license. +-- This software is released under the terms of the ISC license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( @@ -9,8 +9,7 @@ module Codec.Encryption.OpenPGP.ASCIIArmor.Decode ( , decodeArmor ) where -import Codec.Encryption.OpenPGP.Serialize () -import Codec.Encryption.OpenPGP.Types +import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Control.Applicative (many, (<|>), (<$>)) import Data.Attoparsec.ByteString (Parser, many1, string, inClass, notInClass, satisfy, word8, (), parse, IResult(..)) import Data.Attoparsec.ByteString.Char8 (isDigit_w8) @@ -39,9 +38,7 @@ parseArmor = do blankishLine "blank line" payload <- base64Data "base64 data" endLine atype "end line" - case runGet get payload of - Left err -> fail err - Right packets -> return $ Armor atype headers (unBlock packets) + return $ Armor atype headers payload beginLine :: (Integral a, Read a, Show a) => Parser (ArmorType a) beginLine = do @@ -64,16 +61,18 @@ beginLine = do lineEnding :: Parser ByteString lineEnding = string "\n" <|> string "\r\n" -armorHeaders :: Parser [ArmorHeader] +armorHeaders :: Parser [(String, String)] armorHeaders = many armorHeader -armorHeader :: Parser ArmorHeader +armorHeader :: Parser (String, String) armorHeader = do key <- many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")) string ": " val <- many1 (satisfy (notInClass "\n\r")) lineEnding - return (B.pack key, B.pack val) + return (w8sToString key, w8sToString val) + where + w8sToString = BC8.unpack . B.pack blankishLine :: Parser ByteString blankishLine = many (satisfy (inClass " \t")) >> lineEnding diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs index c9c9641..8853be3 100644 --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs @@ -1,14 +1,13 @@ -- ASCIIArmor/Encode.hs: OpenPGP (RFC4880) ASCII armor implementation -- Copyright Ⓒ 2012 Clint Adams --- This software is released under the terms of the Expat (MIT) license. +-- This software is released under the terms of the ISC license. -- (See the LICENSE file). module Codec.Encryption.OpenPGP.ASCIIArmor.Encode ( armor ) where -import Codec.Encryption.OpenPGP.Serialize () -import Codec.Encryption.OpenPGP.Types +import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC8 @@ -19,7 +18,7 @@ import Data.Serialize.Put (runPut, putWord32be) import Data.String (IsString, fromString) armor :: (Integral a, Show a) => Armor a -> ByteString -armor (Armor atype ahs ps) = beginLine atype `B.append` armorHeaders ahs `B.append` blankLine `B.append` armorData (opgpStream ps) `B.append` armorChecksum (opgpStream ps) `B.append` endLine atype +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' @@ -38,22 +37,20 @@ aType (ArmorSplitMessage x y) = BC8.pack $ "MESSAGE, PART " ++ show x ++ "/" ++ aType (ArmorSplitMessageIndefinite x) = BC8.pack $ "MESSAGE, PART " ++ show x aType (ArmorSignature) = BC8.pack "SIGNATURE" -armorHeaders :: [ArmorHeader] -> ByteString +armorHeaders :: [(String, String)] -> ByteString armorHeaders ahs = BC8.unlines . map armorHeader $ ahs where - armorHeader :: ArmorHeader -> ByteString - armorHeader (k, v) = k `B.append` BC8.pack ": " `B.append` v - -opgpStream :: [Packet] -> ByteString -opgpStream = runPut . put . Block + 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 . wrap76 . Base64.encode +armorData = BC8.unlines . wordWrap 64 . Base64.encode -wrap76 :: ByteString -> [ByteString] -wrap76 bs +wordWrap :: Int -> ByteString -> [ByteString] +wordWrap lw bs | B.null bs = [] - | otherwise = B.take 76 bs : wrap76 (B.drop 76 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 diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs new file mode 100644 index 0000000..8c7ef6f --- /dev/null +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs @@ -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 a = Armor (ArmorType a) [(String, String)] ByteString + | ClearSigned [(String, String)] String (Armor a) + deriving (Show, Eq) + +data ArmorType a = ArmorMessage + | ArmorPublicKeyBlock + | ArmorPrivateKeyBlock + | ArmorSplitMessage a a + | ArmorSplitMessageIndefinite a + | ArmorSignature + deriving (Show, Eq) diff --git a/Data/Digest/CRC24.hs b/Data/Digest/CRC24.hs index 5c8c27c..4637834 100644 --- a/Data/Digest/CRC24.hs +++ b/Data/Digest/CRC24.hs @@ -1,6 +1,6 @@ -- CRC24.hs: OpenPGP (RFC4880) CRC24 implementation -- Copyright Ⓒ 2012 Clint Adams --- This software is released under the terms of the Expat (MIT) license. +-- This software is released under the terms of the ISC license. -- (See the LICENSE file). module Data.Digest.CRC24 ( diff --git a/LICENSE b/LICENSE index 02691d7..db7a166 100644 --- a/LICENSE +++ b/LICENSE @@ -1,19 +1,15 @@ -Copyright Ⓒ 2012 Clint Adams +Copyright Ⓒ 2012 Clint Adams -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies -of the Software, and to permit persons to whom the Software is furnished to do -so, subject to the following conditions: +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 above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. +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. diff --git a/openpgp-asciiarmor.cabal b/openpgp-asciiarmor.cabal new file mode 100644 index 0000000..4b7e25d --- /dev/null +++ b/openpgp-asciiarmor.cabal @@ -0,0 +1,49 @@ +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 +Copyright: 2012, Clint Adams +Category: Codec, Data +Build-type: Simple +Extra-source-files: tests/suite.hs + , tests/data/msg1.asc + , tests/data/msg1.gpg + +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 + 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 diff --git a/tests/data/msg1.asc b/tests/data/msg1.asc new file mode 100644 index 0000000..832d3bb --- /dev/null +++ b/tests/data/msg1.asc @@ -0,0 +1,7 @@ +-----BEGIN PGP MESSAGE----- +Version: OpenPrivacy 0.99 + +yDgBO22WxBHv7O8X7O/jygAEzol56iUKiXmV+XmpCtmpqQUKiQrFqclFqUDBovzS +vBSFjNSiVHsuAA== +=njUN +-----END PGP MESSAGE----- diff --git a/tests/data/msg1.gpg b/tests/data/msg1.gpg new file mode 100644 index 0000000..ddb79ea Binary files /dev/null and b/tests/data/msg1.gpg differ diff --git a/tests/suite.hs b/tests/suite.hs new file mode 100644 index 0000000..272295a --- /dev/null +++ b/tests/suite.hs @@ -0,0 +1,44 @@ +import Test.Framework (defaultMain, testGroup) +import Test.Framework.Providers.HUnit + +import Test.HUnit + +import Codec.Encryption.OpenPGP.ASCIIArmor (armor, decodeArmor) +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 target = do + bs <- B.readFile $ "tests/data/" ++ fp + tbs <- B.readFile $ "tests/data/" ++ target + case decodeArmor bs of + Left e -> assertFailure $ "Decode failed (" ++ e ++ ") on " ++ fp + Right (Armor at hdrs pl) -> do assertEqual ("for " ++ fp) tbs pl + +testArmorEncode :: FilePath -> FilePath -> Assertion +testArmorEncode fp target = do + bs <- B.readFile $ "tests/data/" ++ fp + tbs <- B.readFile $ "tests/data/" ++ target + assertEqual ("literaldata") (armor (Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs)) 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 "Encode sample armor" (testArmorEncode "msg1.gpg" "msg1.asc") + ] + ] + +main = defaultMain tests -- cgit v1.2.3