pem 0.1.2 → 0.2.0
raw patch · 4 files changed
+133/−52 lines, 4 filesdep +HUnitdep +test-framework-hunitdep −attoparsecdep −cerealdep ~base64-bytestring
Dependencies added: HUnit, test-framework-hunit
Dependencies removed: attoparsec, cereal
Dependency ranges changed: base64-bytestring
Files
- Data/PEM/Parser.hs +61/−29
- Data/PEM/Writer.hs +16/−18
- Tests/pem.hs +53/−2
- pem.cabal +3/−3
Data/PEM/Parser.hs view
@@ -13,47 +13,79 @@ -- and a binary content encoded in base64. -- module Data.PEM.Parser- ( pemParser- , pemParseBS+ ( pemParseBS , pemParseLBS ) where -import Control.Applicative-import Data.Attoparsec-import qualified Data.Attoparsec.Lazy as AttoLazy-import Data.Attoparsec.Char8 (space)--import Data.PEM.Types-+import Data.Either (partitionEithers) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Base64 as Base64+import qualified Data.ByteString.Lazy.Char8 as LC+import qualified Data.ByteString.Base64.Lazy as Base64 -import Prelude hiding (takeWhile)-import Data.Serialize.Builder-import Data.Monoid+import Data.PEM.Types +parseOnePEM :: [L.ByteString] -> Either (Maybe String) (PEM, [L.ByteString])+parseOnePEM = findPem+ where beginMarker = "-----BEGIN "+ endMarker = "-----END "++ findPem [] = Left Nothing+ findPem (l:ls) = case beginMarker `prefixEat` l of+ Nothing -> findPem ls+ Just n -> getPemName getPemHeaders n ls+ getPemName next n ls =+ let (name, r) = L.break (== 0x2d) n in+ case r of+ "-----" -> next (LC.unpack name) ls+ _ -> Left $ Just "invalid PEM delimiter found"++ getPemHeaders name lbs =+ case getPemHeaderLoop lbs of+ Left err -> Left err+ Right (hdrs, lbs2) -> getPemContent name hdrs [] lbs2+ where getPemHeaderLoop [] = Left $ Just "invalid PEM: no more content in header context"+ getPemHeaderLoop (r:rs) = -- FIXME doesn't properly parse headers yet+ Right ([], r:rs)++ getPemContent name hdrs contentLines lbs =+ case lbs of+ [] -> Left $ Just "invalid PEM: no end marker found"+ (l:ls) -> case endMarker `prefixEat` l of+ Nothing ->+ let content = Base64.decodeLenient l+ in getPemContent name hdrs (content : contentLines) ls+ Just n -> getPemName (finalizePem name hdrs contentLines) n ls+ finalizePem name hdrs contentLines nameEnd lbs+ | nameEnd /= name = Left $ Just "invalid PEM: end name doesn't match start name"+ | otherwise =+ let pem = PEM { pemName = name+ , pemHeader = hdrs+ , pemContent = toSBS $ L.concat $ reverse contentLines }+ in Right (pem, lbs)++ toSBS = BC.concat . L.toChunks++ prefixEat prefix x =+ let (x1, x2) = L.splitAt (L.length prefix) x+ in if x1 == prefix then Just x2 else Nothing+ -- | parser to get PEM sections-pemParser :: Parser [PEM]-pemParser = many contextSection- where- beginMarker = string "-----BEGIN " >> return ()- endMarker = string "-----END " >> return ()- skipLine = skipWhile (/= 0xa) >> space >> return ()- eatLine = takeWhile (/= 0xa) <* space- contextSection = manyTill skipLine beginMarker *> section- section = do- -- begin marker has already been eaten by contextSection- name <- takeWhile (/= 0x2d) <* (string "-----" *> space)- l <- manyTill eatLine endMarker- let content = toByteString $ mconcat $ map (fromByteString . Base64.decodeLenient) l- return $ PEM { pemName = BC.unpack name, pemHeader = [], pemContent = content }+pemParse :: [L.ByteString] -> [Either String PEM]+pemParse l+ | null l = []+ | otherwise = case parseOnePEM l of+ Left Nothing -> []+ Left (Just err) -> [Left err]+ Right (p, remaining) -> Right p : pemParse remaining -- | parse a PEM content using a strict bytestring pemParseBS :: ByteString -> Either String [PEM]-pemParseBS = parseOnly pemParser+pemParseBS b = pemParseLBS $ L.fromChunks [b] -- | parse a PEM content using a dynamic bytestring pemParseLBS :: L.ByteString -> Either String [PEM]-pemParseLBS = AttoLazy.eitherResult . AttoLazy.parse pemParser+pemParseLBS bs = case partitionEithers $ pemParse $ LC.lines bs of+ (x:_,_ ) -> Left x+ ([] ,pems) -> Right pems
Data/PEM/Writer.hs view
@@ -7,8 +7,7 @@ -- Portability : portable -- module Data.PEM.Writer- ( pemWriteBuilder- , pemWriteLBS+ ( pemWriteLBS , pemWriteBS ) where @@ -18,33 +17,32 @@ import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Base64 as Base64-import Data.Serialize.Builder-import Data.Monoid-import Data.List -- | write a PEM structure to a builder-pemWriteBuilder :: PEM -> Builder-pemWriteBuilder pem = mconcat $ intersperse eol $ concat ([begin]:header:section:[end]:[[empty]])- where begin = mconcat $ map fromByteString ["-----BEGIN ", sectionName, "-----" ]- end = mconcat $ map fromByteString ["-----END ", sectionName, "-----" ]- section = map fromByteString $ (splitChunks $ Base64.encode $ pemContent pem)+pemWrite :: PEM -> L.ByteString+pemWrite pem = L.fromChunks $ ([begin,header]++section++[end])+ where begin = B.concat ["-----BEGIN ", sectionName, "-----\n"]+ end = B.concat ["-----END ", sectionName, "-----\n" ]+ section :: [ByteString]+ section = map encodeLine $ splitChunks $ pemContent pem+ header :: ByteString header = if null $ pemHeader pem- then []- else concatMap toHeader (pemHeader pem) ++ [empty]- toHeader (k,v) = [ mconcat $ map fromByteString [ bk, ":", v ] ]- where bk = BC.pack k+ then B.empty+ else B.concat ((concatMap toHeader (pemHeader pem)) ++ ["\n"])+ toHeader :: (String, ByteString) -> [ByteString]+ toHeader (k,v) = [ BC.pack k, ":", v, "\n" ] -- expect only ASCII. need to find a type to represent it. sectionName = BC.pack $ pemName pem+ encodeLine l = Base64.encode l `B.append` "\n" splitChunks b- | B.length b > 64 = let (x,y) = B.splitAt 64 b in x : splitChunks y+ | B.length b > 48 = let (x,y) = B.splitAt 48 b in x : splitChunks y | otherwise = [b]- eol = fromByteString $ B.singleton 0x0a -- | convert a PEM structure to a bytestring pemWriteBS :: PEM -> ByteString-pemWriteBS = toByteString . pemWriteBuilder+pemWriteBS = B.concat . L.toChunks . pemWrite -- | convert a PEM structure to a lazy bytestring pemWriteLBS :: PEM -> L.ByteString-pemWriteLBS = toLazyByteString . pemWriteBuilder+pemWriteLBS = pemWrite
Tests/pem.hs view
@@ -3,9 +3,12 @@ import Control.Applicative import Control.Monad +import qualified Data.ByteString.Char8 as BC import Test.QuickCheck hiding ((.&.)) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit ((@=?)) import Data.PEM import qualified Data.ByteString as B@@ -15,9 +18,57 @@ tests :: [Test] tests =- [ testProperty "marshall" testMarshall+ [ testGroup "units" $ testUnits+ , testDecodingMultiple+ , testUnmatchingNames+ , testProperty "marshall" testMarshall ] +testUnits = map (\(i, (p,bs)) -> testCase (show i) (pemWriteBS p @=? BC.pack bs))+ $ zip [0..] [ (p1, bp1), (p2, bp2) ]+ where p1 = PEM { pemName = "abc", pemHeader = [], pemContent = B.replicate 64 0 }+ bp1 = unlines+ [ "-----BEGIN abc-----"+ , "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"+ , "AAAAAAAAAAAAAAAAAAAAAA=="+ , "-----END abc-----"+ ]+ p2 = PEM { pemName = "xxx", pemHeader = [], pemContent = B.replicate 12 3 }+ bp2 = unlines+ [ "-----BEGIN xxx-----"+ , "AwMDAwMDAwMDAwMD"+ , "-----END xxx-----"+ ]++testDecodingMultiple = testCase ("multiple pems") (pemParseBS content @=? Right expected)+ where expected = [ PEM { pemName = "marker", pemHeader = [], pemContent = B.replicate 12 3 }+ , PEM { pemName = "marker2", pemHeader = [], pemContent = B.replicate 64 0 }+ ]+ content = BC.pack $ unlines+ [ "some text that is not related to PEM"+ , "and is just going to be ignored by the PEM parser."+ , ""+ , "even empty lines should be skip until the rightful marker"+ , "-----BEGIN marker-----"+ , "AwMDAwMDAwMDAwMD"+ , "-----END marker-----"+ , "some middle text"+ , "-----BEGIN marker2-----"+ , "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"+ , "AAAAAAAAAAAAAAAAAAAAAA=="+ , "-----END marker2-----"+ , "and finally some trailing text."+ ]++testUnmatchingNames = testCase "unmatching name" (let r = pemParseBS content in case r of+ Left _ -> True @=? True+ _ -> r @=? Left "")+ where content = BC.pack $ unlines+ [ "-----BEGIN marker-----"+ , "AAAA"+ , "-----END marker2-----"+ ]+ testMarshall pems = readPems == Right pems where readPems = pemParseBS writtenPems writtenPems = B.concat (map pemWriteBS pems)@@ -25,7 +76,7 @@ arbitraryName = choose (1, 30) >>= \i -> replicateM i arbitraryAscii where arbitraryAscii = elements ['A'..'Z'] -arbitraryContent = choose (1,10) >>= \i ->+arbitraryContent = choose (1,100) >>= \i -> (B.pack . map fromIntegral) `fmap` replicateM i (choose (0,255) :: Gen Int) instance Arbitrary PEM where
pem.cabal view
@@ -1,5 +1,5 @@ Name: pem-Version: 0.1.2+Version: 0.2.0 Description: Privacy Enhanced Mail (PEM) format reader and writer. License: BSD3 License-file: LICENSE@@ -19,8 +19,6 @@ Build-Depends: base >= 3 && < 5 , mtl , bytestring- , attoparsec- , cereal , base64-bytestring Exposed-modules: Data.PEM Other-modules: Data.PEM.Parser@@ -36,6 +34,8 @@ , bytestring , test-framework >= 0.3.3 , test-framework-quickcheck2+ , test-framework-hunit+ , HUnit , QuickCheck >= 2.4.0.1 , pem