pem 0.1.2 → 0.2.4
raw patch · 8 files changed
Files
- Data/PEM.hs +2/−2
- Data/PEM/Parser.hs +68/−30
- Data/PEM/Types.hs +12/−4
- Data/PEM/Writer.hs +17/−19
- LICENSE +1/−1
- README.md +0/−4
- Tests/pem.hs +53/−2
- pem.cabal +7/−8
Data/PEM.hs view
@@ -8,10 +8,10 @@ -- Read and write PEM files -- module Data.PEM- ( module Data.PEM.Types+ ( module Data.PEM.Types , module Data.PEM.Writer , module Data.PEM.Parser- ) where+ ) where import Data.PEM.Types import Data.PEM.Writer
Data/PEM/Parser.hs view
@@ -11,49 +11,87 @@ -- A PEM contains contains from one to many PEM sections. -- Each section contains an optional key-value pair header -- 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 Prelude hiding (takeWhile)-import Data.Serialize.Builder-import Data.Monoid+import Data.PEM.Types+import Data.ByteArray.Encoding (Base(Base64), convertFromBase)+import qualified Data.ByteArray as BA +type Line = L.ByteString++parseOnePEM :: [Line] -> Either (Maybe String) (PEM, [Line])+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 :: String -> [(String,ByteString)] -> [BC.ByteString] -> [L.ByteString] -> Either (Maybe String) (PEM, [L.ByteString])+ getPemContent name hdrs contentLines lbs =+ case lbs of+ [] -> Left $ Just "invalid PEM: no end marker found"+ (l:ls) -> case endMarker `prefixEat` l of+ Nothing ->+ case convertFromBase Base64 $ L.toStrict l of+ Left err -> Left $ Just ("invalid PEM: decoding failed: " ++ err)+ Right content -> 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 = BA.concat $ reverse contentLines }+ in Right (pem, lbs)++ 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 :: [Line] -> [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 $ map unCR $ LC.lines bs of+ (x:_,_ ) -> Left x+ ([] ,pems) -> Right pems+ where unCR b | L.length b > 0 && L.last b == cr = L.init b+ | otherwise = b+ cr = fromIntegral $ fromEnum '\r'
Data/PEM/Types.hs view
@@ -8,13 +8,21 @@ module Data.PEM.Types where import Data.ByteString (ByteString)+import Basement.NormalForm -- | Represent one PEM section -- -- for now headers are not serialized at all. -- this is just available here as a placeholder for a later implementation. data PEM = PEM- { pemName :: String -- ^ the name of the section, found after the dash BEGIN tag.- , pemHeader :: [(String, ByteString)] -- ^ optionals key value pair header- , pemContent :: ByteString -- ^ binary content of the section- } deriving (Show,Eq)+ { pemName :: String -- ^ the name of the section, found after the dash BEGIN tag.+ , pemHeader :: [(String, ByteString)] -- ^ optionals key value pair header+ , pemContent :: ByteString -- ^ binary content of the section+ } deriving (Show,Eq)++instance NormalForm PEM where+ toNormalForm pem =+ toNormalForm (pemName pem) `seq` nfLbs (pemHeader pem) `seq` pemContent pem `seq` ()+ where+ nfLbs [] = ()+ nfLbs ((s,bs):l) = toNormalForm s `seq` bs `seq` nfLbs l
Data/PEM/Writer.hs view
@@ -7,8 +7,7 @@ -- Portability : portable -- module Data.PEM.Writer- ( pemWriteBuilder- , pemWriteLBS+ ( pemWriteLBS , pemWriteBS ) where @@ -17,34 +16,33 @@ import qualified Data.ByteString as B 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+import Data.ByteArray.Encoding (Base(Base64), convertToBase) -- | 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 = convertToBase Base64 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
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2010-2012 Vincent Hanquez <vincent@snarc.org>+Copyright (c) 2010-2018 Vincent Hanquez <vincent@snarc.org> All rights reserved.
− README.md
@@ -1,4 +0,0 @@-PEM haskell library-===================--Handle Privacy Enhanced Message (PEM) format.
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,27 +1,24 @@ Name: pem-Version: 0.1.2-Description: Privacy Enhanced Mail (PEM) format reader and writer.+Version: 0.2.4+Synopsis: Privacy Enhanced Mail (PEM) format reader and writer.+Description: Privacy Enhanced Mail (PEM) format reader and writer. long description License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez <vincent@snarc.org> Author: Vincent Hanquez <vincent@snarc.org> Maintainer: Vincent Hanquez <vincent@snarc.org>-Synopsis: Privacy Enhanced Mail (PEM) format reader and writer. Build-Type: Simple Category: Data stability: experimental Cabal-Version: >=1.8 Homepage: http://github.com/vincenthz/hs-pem-data-files: README.md extra-source-files: Tests/pem.hs Library Build-Depends: base >= 3 && < 5- , mtl , bytestring- , attoparsec- , cereal- , base64-bytestring+ , basement+ , memory Exposed-modules: Data.PEM Other-modules: Data.PEM.Parser Data.PEM.Writer@@ -36,6 +33,8 @@ , bytestring , test-framework >= 0.3.3 , test-framework-quickcheck2+ , test-framework-hunit+ , HUnit , QuickCheck >= 2.4.0.1 , pem