openpgp-asciiarmor 0.1.2 → 1.0

raw patch · 9 files changed

+406/−83 lines, 9 filesdep ~attoparsecbinary-addedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec

API changes (from Hackage documentation)

Files

• Codec/Encryption/OpenPGP/ASCIIArmor.hs +8/−4
• Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +157/−48
• Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +29/−6
• Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs +2/−2
• Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs +56/−4
• openpgp-asciiarmor.cabal +18/−9
• tests/data/seipdv2.pgp binary
• tests/data/seipdv2.pgp.aa +8/−0
• tests/suite.hs +128/−10

@@ -1,17 +1,21 @@--- ASCIIArmor.hs: OpenPGP (RFC4880) ASCII armor implementation--- Copyright © 2012  Clint Adams+-- ASCIIArmor.hs: OpenPGP (RFC9580) ASCII armor implementation+-- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).  module Codec.Encryption.OpenPGP.ASCIIArmor (    decode  , decodeLazy+ , decodeWith+ , decodeLazyWith  , encode  , encodeLazy+ , encodeWith+ , encodeLazyWith  , 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.Decode (decode, decodeLazy, decodeWith, decodeLazyWith, parseArmor)+import Codec.Encryption.OpenPGP.ASCIIArmor.Encode (encode, encodeLazy, encodeWith, encodeLazyWith) import Codec.Encryption.OpenPGP.ASCIIArmor.Multipart (multipartMerge)

@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}--- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation--- Copyright © 2012-2018  Clint Adams+-- ASCIIArmor/Decode.hs: OpenPGP (RFC9580) ASCII armor implementation+-- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). @@ -8,11 +8,14 @@    parseArmor  , decode  , decodeLazy+ , decodeWith+ , decodeLazyWith ) where  import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Codec.Encryption.OpenPGP.ASCIIArmor.Utils-import Control.Applicative (many, (<|>), (<$>), (<*), (<*>), (*>), optional)+import Control.Applicative (many, (<|>), optional)+import qualified Data.Attoparsec.Combinator as AC 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@@ -23,47 +26,58 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Base64 as Base64+import Data.Char (isAlphaNum, isSpace) import Data.Digest.CRC24 (crc24) import Data.Binary.Get (Get, runGetOrFail, getWord8) import Data.Functor (($>))+import Data.List (dropWhileEnd) import Data.String (IsString, fromString) import Data.Word (Word32)  decode :: IsString e => B.ByteString -> Either e [Armor]-decode bs = go (AS.parse parseArmors bs)+decode = decodeWith defaultDecodeOptions++decodeWith :: IsString e => DecodeOptions -> B.ByteString -> Either e [Armor]+decodeWith options bs = go (AS.parse (parseArmors options) bs)     where         go (AS.Fail _ _ 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)+decodeLazy = decodeLazyWith defaultDecodeOptions++decodeLazyWith :: IsString e => DecodeOptions -> BL.ByteString -> Either e [Armor]+decodeLazyWith options bs = go (AL.parse (parseArmors options) bs)     where         go (AL.Fail _ _ e) = Left (fromString e)         go (AL.Done _ r) = Right r -parseArmors :: Parser [Armor]-parseArmors = many parseArmor+parseArmors :: DecodeOptions -> Parser [Armor]+parseArmors options = many (parseArmorWith options)  parseArmor :: Parser Armor-parseArmor = prefixed (clearsigned <|> armor) <?> "armor"+parseArmor = parseArmorWith defaultDecodeOptions -clearsigned :: Parser Armor-clearsigned = do+parseArmorWith :: DecodeOptions -> Parser Armor+parseArmorWith options = prefixed (clearsigned options <|> armor options) <?> "armor"++clearsigned :: DecodeOptions -> Parser Armor+clearsigned options = do     _ <- string "-----BEGIN PGP SIGNED MESSAGE-----" <?> "clearsign header"     _ <- lineEnding <?> "line ending"-    headers <- armorHeaders <?> "clearsign headers"+    headers <- cleartextHeaders options <?> "clearsign headers"     _ <- blankishLine <?> "blank line"     cleartext <- dashEscapedCleartext-    sig <- armor+    sig <- armor options     return $ ClearSigned headers cleartext sig -armor :: Parser Armor-armor = do+armor :: DecodeOptions -> Parser Armor+armor options = do     atype <- beginLine <?> "begin line"     headers <- armorHeaders <?> "headers"     _ <- blankishLine <?> "blank line"-    payload <- base64Data <?> "base64 data"+    payload <- base64Data options <?> "base64 data"     _ <- endLine atype <?> "end line"     return $ Armor atype headers payload @@ -92,6 +106,31 @@ lineEnding :: Parser B.ByteString lineEnding = string "\n" <|> string "\r\n" +cleartextHeaders :: DecodeOptions -> Parser [(String, String)]+cleartextHeaders options+    | shouldRequireHashOnlyHeaders options = many hashHeader+    | otherwise = armorHeaders+    where+        hashHeader = do+            hdr@(k, v) <- armorHeader+            if k == "Hash" && isConformantHashHeader v+                then return hdr+                else fail "Only well-formed Hash headers are allowed before cleartext payload"++isConformantHashHeader :: String -> Bool+isConformantHashHeader v = not (null tokens) && all isValidToken tokens+    where+        tokens = map trim (splitOnComma v)+        splitOnComma [] = [""]+        splitOnComma xs =+            let (a, rest) = break (== ',') xs+             in a : case rest of+                 [] -> []+                 (_:ys) -> splitOnComma ys+        trim = dropWhileEnd isSpace . dropWhile isSpace+        isValidToken [] = False+        isValidToken t = all (\c -> isAlphaNum c || c == '-') t+ armorHeaders :: Parser [(String, String)] armorHeaders = many armorHeader @@ -124,36 +163,99 @@ l2s :: BL.ByteString -> B.ByteString l2s = B.concat . BL.toChunks -base64Data :: Parser ByteString-base64Data = do+base64Data :: DecodeOptions -> Parser ByteString+base64Data options = do     ls <- many1 base64Line-    cksum <- checksumLine     let payload = B.concat ls-    let ourcksum = crc24 payload-    case runGetOrFail d24 (BL.fromStrict cksum) of-        Left (_,_,err) -> fail err-        Right (_,_,theircksum) -> if theircksum == ourcksum then return (BL.fromStrict payload) else fail ("CRC24 mismatch: " ++ show (B.unpack cksum) ++ "/" ++ show theircksum ++ " vs. " ++ show ourcksum)-    where-        base64Line :: Parser B.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 B.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+    case crc24Validation options of+        DecodeCRC24ValidationStrict -> do+            decodedChecksum <- checksumLineStrict+            validateChecksum payload (Just decodedChecksum) True+            return (BL.fromStrict payload)+        DecodeCRC24ValidationPermissive -> do+            decodedChecksum <- optional checksumLinePermissive+            validateChecksum payload decodedChecksum False+            return (BL.fromStrict payload)+        DecodeCRC24ValidationAuto -> fail "Internal error: unresolved CRC24 validation mode"+  where+    base64Line :: Parser B.ByteString+    base64Line = do+        startsChecksum <- isChecksumLineStart+        if startsChecksum+            then fail "checksum line"+            else do+                b64line <- B.pack <$> many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/= \t"))+                _ <- lineEnding+                let cleaned = stripInlineWhitespace b64line+                case Base64.decode cleaned of+                    Left err -> fail err+                    Right bs -> return bs +    isChecksumLineStart :: Parser Bool+    isChecksumLineStart = AC.lookAhead $ do+        _ <- many (satisfy (inClass " \t"))+        c <- satisfy (notInClass "\n\r")+        return (c == fromIntegral (fromEnum '=')) +    checksumLineStrict :: Parser B.ByteString+    checksumLineStrict = do+        _ <- word8 (fromIntegral . fromEnum $ '=')+        b64 <- B.pack <$> many1 (satisfy (inClass "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/ \t"))+        _ <- lineEnding+        case Base64.decode (stripInlineWhitespace b64) of+            Left err -> fail err+            Right bs -> return bs++    checksumLinePermissive :: Parser B.ByteString+    checksumLinePermissive = do+        _ <- word8 (fromIntegral . fromEnum $ '=')+        raw <- B.pack <$> many (satisfy (notInClass "\n\r"))+        _ <- lineEnding+        case Base64.decode (stripInlineWhitespace raw) of+            Left _ -> return B.empty+            Right bs -> return bs++validateChecksum :: B.ByteString -> Maybe B.ByteString -> Bool -> Parser ()+validateChecksum payload mDecodedChecksum requireValidCrc =+    case mDecodedChecksum of+        Nothing ->+            if requireValidCrc+                then fail "Missing CRC24 checksum line"+                else return ()+        Just decodedChecksum ->+            if B.length decodedChecksum /= 3+                then if requireValidCrc then fail "Malformed CRC24 checksum line" else return ()+                else+                    case runGetOrFail d24 (BL.fromStrict decodedChecksum) of+                        Left (_,_,err) ->+                            if requireValidCrc then fail err else return ()+                        Right (_,_,theircksum) ->+                            let ourcksum = crc24 payload+                             in if theircksum == ourcksum || not requireValidCrc+                                   then return ()+                                   else fail ("CRC24 mismatch: " ++ show (B.unpack decodedChecksum) ++ "/" ++ show theircksum ++ " vs. " ++ show ourcksum)++stripInlineWhitespace :: B.ByteString -> B.ByteString+stripInlineWhitespace = B.filter (\w -> w /= 0x20 && w /= 0x09)++crc24Validation :: DecodeOptions -> DecodeCRC24Validation+crc24Validation options =+    case decodeCRC24Validation options of+        DecodeCRC24ValidationAuto ->+            case decodeConformanceProfile options of+                Strict_4880_AA -> DecodeCRC24ValidationStrict+                Strict_9580_AA -> DecodeCRC24ValidationPermissive+                Postel_AA -> DecodeCRC24ValidationPermissive+        explicitMode -> explicitMode++shouldRequireHashOnlyHeaders :: DecodeOptions -> Bool+shouldRequireHashOnlyHeaders options =+    case decodeCleartextHeaderPolicy options of+        DecodeCleartextHeaderPolicyAuto ->+            decodeConformanceProfile options == Strict_9580_AA+        DecodeCleartextHeaderPolicyLegacy -> False+        DecodeCleartextHeaderPolicyHashOnly -> True+ d24 :: Get Word32 d24 = do     a <- getWord8@@ -165,11 +267,18 @@ prefixed end = end <|> anyChar *> prefixed end  dashEscapedCleartext :: Parser ByteString-dashEscapedCleartext = do-    ls <- many1 ((deLine <|> unescapedLine) <* lineEnding)-    return . BL.fromStrict $ crlfUnlines ls+dashEscapedCleartext = BL.fromStrict . crlfUnlines <$> go []     where-        deLine :: Parser B.ByteString-        deLine = B.pack <$> (string "- " *> many (satisfy (notInClass "\n\r")))-        unescapedLine :: Parser B.ByteString-        unescapedLine = maybe B.empty B.pack <$> optional ((:) <$> satisfy (notInClass "-\n\r") <*> many (satisfy (notInClass "\n\r")))+        go acc = do+            isSignatureStart <- AC.lookAhead ((string "-----BEGIN PGP " >> return True) <|> return False)+            if isSignatureStart+                then return (reverse acc)+                else do+                    rawLine <- B.pack <$> many (satisfy (notInClass "\n\r"))+                    _ <- lineEnding+                    go (undash rawLine : acc)++        undash :: B.ByteString -> B.ByteString+        undash line+            | BC8.pack "- " `B.isPrefixOf` line = B.drop 2 line+            | otherwise = line

@@ -1,11 +1,13 @@--- ASCIIArmor/Encode.hs: OpenPGP (RFC4880) ASCII armor implementation--- Copyright © 2012-2018  Clint Adams+-- ASCIIArmor/Encode.hs: OpenPGP (RFC9580) ASCII armor implementation+-- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).  module Codec.Encryption.OpenPGP.ASCIIArmor.Encode (    encode  , encodeLazy+ , encodeWith+ , encodeLazyWith ) where  import Codec.Encryption.OpenPGP.ASCIIArmor.Types@@ -21,12 +23,22 @@ encode = B.concat . BL.toChunks . encodeLazy  encodeLazy :: [Armor] -> ByteString-encodeLazy = BL.concat . map armor+encodeLazy = encodeLazyWith defaultEncodeOptions -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+encodeWith :: EncodeOptions -> [Armor] -> B.ByteString+encodeWith options = B.concat . BL.toChunks . encodeLazyWith options +encodeLazyWith :: EncodeOptions -> [Armor] -> ByteString+encodeLazyWith options = BL.concat . map (armor options)++armor :: EncodeOptions -> Armor -> ByteString+armor options (Armor atype ahs bs) = beginLine atype `BL.append` armorHeaders ahs `BL.append` blankLine `BL.append` armorData bs `BL.append` checksumBlock `BL.append` endLine atype+    where+        checksumBlock+            | shouldEmitCRC24 options = armorChecksum bs+            | otherwise = BL.empty+armor options (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 options csig+ blankLine :: ByteString blankLine = BLC8.singleton '\n' @@ -61,6 +73,17 @@  armorChecksum :: ByteString -> ByteString armorChecksum = BLC8.cons '=' . armorData . BL.tail . runPut . putWord32be . crc24Lazy++shouldEmitCRC24 :: EncodeOptions -> Bool+shouldEmitCRC24 options =+    case encodeCRC24Emission options of+        EncodeCRC24EmissionAlways -> True+        EncodeCRC24EmissionNever -> False+        EncodeCRC24EmissionAuto ->+            case encodeConformanceProfile options of+                Strict_4880_AA -> True+                Strict_9580_AA -> False+                Postel_AA -> False  dashEscape :: ByteString -> ByteString dashEscape = BLC8.unlines . map escapeLine . BLC8.lines

@@ -1,5 +1,5 @@--- ASCIIArmor/Multipart.hs: OpenPGP (RFC4880) ASCII armor implementation--- Copyright © 2012  Clint Adams+-- ASCIIArmor/Multipart.hs: OpenPGP (legacy RFC4880) ASCII armor implementation+-- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file). 

@@ -1,11 +1,19 @@--- ASCIIArmor/Decode.hs: OpenPGP (RFC4880) ASCII armor implementation--- Copyright © 2012  Clint Adams+-- ASCIIArmor/Decode.hs: OpenPGP (RFC9580) ASCII armor implementation+-- Copyright © 2012-2026  Clint Adams -- This software is released under the terms of the Expat license. -- (See the LICENSE file).  module Codec.Encryption.OpenPGP.ASCIIArmor.Types (    Armor(..)  , ArmorType(..)+ , ConformanceProfile(..)+ , DecodeOptions(..)+ , DecodeCRC24Validation(..)+ , DecodeCleartextHeaderPolicy(..)+ , defaultDecodeOptions+ , EncodeOptions(..)+ , EncodeCRC24Emission(..)+ , defaultEncodeOptions ) where  import Data.ByteString.Lazy (ByteString)@@ -16,8 +24,52 @@  data ArmorType = ArmorMessage                | ArmorPublicKeyBlock-               | ArmorPrivateKeyBlock-               | ArmorSplitMessage ByteString ByteString+               | ArmorPrivateKeyBlock -- RFC4880 legacy+               | ArmorSplitMessage ByteString ByteString -- RFC4880 legacy                | ArmorSplitMessageIndefinite ByteString                | ArmorSignature     deriving (Show, Eq)++data ConformanceProfile = Strict_4880_AA+                        | Strict_9580_AA+                        | Postel_AA+    deriving (Show, Eq)++data DecodeCRC24Validation = DecodeCRC24ValidationAuto+                           | DecodeCRC24ValidationStrict+                           | DecodeCRC24ValidationPermissive+    deriving (Show, Eq)++data DecodeCleartextHeaderPolicy = DecodeCleartextHeaderPolicyAuto+                                 | DecodeCleartextHeaderPolicyLegacy+                                 | DecodeCleartextHeaderPolicyHashOnly+    deriving (Show, Eq)++data DecodeOptions = DecodeOptions {+    decodeConformanceProfile :: ConformanceProfile+  , decodeCRC24Validation :: DecodeCRC24Validation+  , decodeCleartextHeaderPolicy :: DecodeCleartextHeaderPolicy+} deriving (Show, Eq)++defaultDecodeOptions :: DecodeOptions+defaultDecodeOptions = DecodeOptions {+    decodeConformanceProfile = Postel_AA+  , decodeCRC24Validation = DecodeCRC24ValidationAuto+  , decodeCleartextHeaderPolicy = DecodeCleartextHeaderPolicyAuto+}++data EncodeCRC24Emission = EncodeCRC24EmissionAuto+                         | EncodeCRC24EmissionAlways+                         | EncodeCRC24EmissionNever+    deriving (Show, Eq)++data EncodeOptions = EncodeOptions {+    encodeConformanceProfile :: ConformanceProfile+  , encodeCRC24Emission :: EncodeCRC24Emission+} deriving (Show, Eq)++defaultEncodeOptions :: EncodeOptions+defaultEncodeOptions = EncodeOptions {+    encodeConformanceProfile = Strict_9580_AA+  , encodeCRC24Emission = EncodeCRC24EmissionAuto+}

@@ -1,13 +1,13 @@ Name:                openpgp-asciiarmor-Version:             0.1.2-Synopsis:            OpenPGP (RFC4880) ASCII Armor codec-Description:         OpenPGP (RFC4880) ASCII Armor codec-Homepage:            http://floss.scru.org/openpgp-asciiarmor+Version:             1.0+Synopsis:            OpenPGP (RFC9580) ASCII Armor codec+Description:         OpenPGP (RFC9580) ASCII Armor codec with legacy (RFC4880) compatibility+Homepage:            https://salsa.debian.org/clint/openpgp-asciiarmor License:             MIT License-file:        LICENSE Author:              Clint Adams Maintainer:          Clint Adams <clint@debian.org>-Copyright:           2012-2019 Clint Adams+Copyright:           2012-2026 Clint Adams Category:            Codec, Data Build-type:          Simple Extra-source-files: tests/suite.hs@@ -24,6 +24,8 @@   , tests/data/msg4   , tests/data/msg4.asc   , tests/data/msg4.sig+  , tests/data/seipdv2.pgp.aa+  , tests/data/seipdv2.pgp  Cabal-version:       >= 1.10 @@ -38,10 +40,10 @@                , Codec.Encryption.OpenPGP.ASCIIArmor.Utils   Ghc-options: -Wall   Build-depends: attoparsec-               , base                  > 4       && < 5+               , base                  >= 4.7       && < 5                , base64-bytestring-               , binary-               , bytestring+               , binary                >= 0.6.4.0+               , bytestring            >= 0.10   default-language: Haskell2010  @@ -49,6 +51,13 @@   type:       exitcode-stdio-1.0   main-is:    tests/suite.hs   Ghc-options: -Wall+  Other-Modules:       Codec.Encryption.OpenPGP.ASCIIArmor+                     , Codec.Encryption.OpenPGP.ASCIIArmor.Decode+                     , Codec.Encryption.OpenPGP.ASCIIArmor.Encode+                     , Codec.Encryption.OpenPGP.ASCIIArmor.Types+                     , Codec.Encryption.OpenPGP.ASCIIArmor.Multipart+                     , Codec.Encryption.OpenPGP.ASCIIArmor.Utils+                     , Data.Digest.CRC24   Build-depends: attoparsec                , base                  > 4       && < 5                , base64-bytestring@@ -75,4 +84,4 @@ source-repository this   type:     git   location: https://salsa.debian.org/clint/openpgp-asciiarmor.git-  tag:      openpgp-asciiarmor/v0.1.1+  tag:      openpgp-asciiarmor/1.0

binary file changed (absent → 219 bytes)

@@ -0,0 +1,8 @@+-----BEGIN PGP MESSAGE-----++wW0GIQav44SnLNNBPMT5pEw1RZY8zjlKostWz+pDmoUF+5URxRkwyaitZyn0JaLC+SYnwTOoiZgF9sz6WtxJJJrT8fRJbWyiTIxpSVr0gf/BBsHqDWDma0wfYo7QI+YIC+0i291xBNy1zBewWq0U6o0moCCQIG0KgYQaeiO2e9CrpgecrqyVQdPZv2H6UMMWws+DM6crtsjhM572grlZ5Kzf55ybvQh0IOS9nQGi0naPQAI7VOrBENunE79qeW3z29r+vZMR+ZZL3TRbqFaBZJy8tORC8NVaA6sLnZ4I+-----END PGP MESSAGE-----

@@ -1,7 +1,7 @@ import Test.Tasty (defaultMain, testGroup, TestTree) import Test.Tasty.HUnit (Assertion, assertEqual, assertFailure, testCase) -import Codec.Encryption.OpenPGP.ASCIIArmor (decode, decodeLazy, encode, encodeLazy, multipartMerge)+import Codec.Encryption.OpenPGP.ASCIIArmor (decode, decodeLazy, decodeLazyWith, encode, encodeLazy, encodeLazyWith, multipartMerge) import Codec.Encryption.OpenPGP.ASCIIArmor.Types import Codec.Encryption.OpenPGP.ASCIIArmor.Utils @@ -11,8 +11,18 @@ import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Lazy.Char8 as BLC8 import Data.Digest.CRC24 (crc24)+import Data.List (find) import Data.Word (Word32) +legacyDecodeOptions :: DecodeOptions+legacyDecodeOptions = defaultDecodeOptions { decodeConformanceProfile = Strict_4880_AA }++legacyEncodeOptions :: EncodeOptions+legacyEncodeOptions = defaultEncodeOptions { encodeConformanceProfile = Strict_4880_AA }++modernDecodeOptions :: DecodeOptions+modernDecodeOptions = defaultDecodeOptions { decodeConformanceProfile = Strict_9580_AA }+ testCRC24 :: ByteString -> Word32 -> Assertion testCRC24 bs crc = assertEqual "crc24" crc (crc24 bs) @@ -63,18 +73,18 @@         getSig (ClearSigned _ _ (Armor _ _ sig)) = sig         getSig _ = error "This should not happen." -testArmorEncode :: [FilePath] -> FilePath -> Assertion-testArmorEncode fps target = do+testLegacyArmorEncode :: [FilePath] -> FilePath -> Assertion+testLegacyArmorEncode fps target = do     bss <- mapM (\fp -> BL.readFile $ "tests/data/" ++ fp) fps     tbs <- BL.readFile $ "tests/data/" ++ target-    assertEqual "literaldata" tbs (encodeLazy (map (Armor ArmorMessage [("Version","OpenPrivacy 0.99")]) bss))+    assertEqual "literaldata" tbs (encodeLazyWith legacyEncodeOptions (map (Armor ArmorMessage [("Version","OpenPrivacy 0.99")]) bss)) -testClearsignedEncode :: FilePath -> FilePath -> FilePath -> Assertion-testClearsignedEncode ftxt fsig ftarget = do+testLegacyClearsignedEncode :: FilePath -> FilePath -> FilePath -> Assertion+testLegacyClearsignedEncode 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)])+    assertEqual "clearsigned encode" target (encodeLazyWith legacyEncodeOptions [ClearSigned [("Hash","SHA1")] txt (Armor ArmorSignature [("Version","OpenPrivacy 0.99")] sig)])  testStrictDecode :: FilePath -> Assertion testStrictDecode fp = do@@ -87,6 +97,105 @@     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]) +testModernDecodeAllowsMissingCRC :: Assertion+testModernDecodeAllowsMissingCRC = do+    bs <- BL.readFile "tests/data/msg1.asc"+    let noCrc = removeLinePrefix (BLC8.pack "=") bs+    case decodeLazyWith defaultDecodeOptions noCrc of+        Left e -> assertFailure $ "modern decode should allow missing CRC24: " ++ e+        Right _ -> return ()++testLegacyDecodeRejectsMissingCRC :: Assertion+testLegacyDecodeRejectsMissingCRC = do+    bs <- BL.readFile "tests/data/msg1.asc"+    let noCrc = removeLinePrefix (BLC8.pack "=") bs+    case (decodeLazyWith legacyDecodeOptions noCrc :: Either String [Armor]) of+        Left _ -> return ()+        Right [] -> return ()+        Right _ -> assertFailure "legacy decode should reject missing CRC24"++testModernDecodeAllowsMalformedCRC :: Assertion+testModernDecodeAllowsMalformedCRC = do+    bs <- BL.readFile "tests/data/msg1.asc"+    let malformed = replaceLinePrefix (BLC8.pack "=") (BLC8.pack "=??!!") bs+    case decodeLazyWith defaultDecodeOptions malformed of+        Left e -> assertFailure $ "modern decode should allow malformed CRC24: " ++ e+        Right _ -> return ()++testModernDecodeAllowsMismatchedCRC :: Assertion+testModernDecodeAllowsMismatchedCRC = do+    bs <- BL.readFile "tests/data/msg1.asc"+    let mismatch = replaceLinePrefix (BLC8.pack "=") (BLC8.pack "=AAAA") bs+    case decodeLazyWith defaultDecodeOptions mismatch of+        Left e -> assertFailure $ "modern decode should allow mismatched CRC24: " ++ e+        Right _ -> return ()++testDecodeIgnoresBase64Whitespace :: Assertion+testDecodeIgnoresBase64Whitespace = do+    bs <- BL.readFile "tests/data/msg1.asc"+    let whitespacey = addWhitespaceToBase64 bs+    assertEqual "whitespace-tolerant decode" (decodeLazy bs :: Either String [Armor]) (decodeLazy whitespacey :: Either String [Armor])++testModernCleartextHeaderStrictness :: Assertion+testModernCleartextHeaderStrictness = do+    bs <- BL.readFile "tests/data/msg3.asc"+    let withVersionHeader = insertHeaderAfterPgpSigned (BLC8.pack "Version: Test 1.0") bs+    case decodeLazyWith legacyDecodeOptions withVersionHeader :: Either String [Armor] of+        Left e -> assertFailure $ "legacy decode should allow non-Hash cleartext headers: " ++ e+        Right as+            | any isClearSigned as -> return ()+            | otherwise -> assertFailure "legacy decode should parse cleartext message"+    case decodeLazyWith modernDecodeOptions withVersionHeader :: Either String [Armor] of+        Left _ -> return ()+        Right as+            | any isClearSigned as -> assertFailure "modern decode should reject non-Hash cleartext headers"+            | otherwise -> return ()+  where+    isClearSigned (ClearSigned _ _ _) = True+    isClearSigned _ = False++testEncodeModernOmitsCRC24 :: Assertion+testEncodeModernOmitsCRC24 = do+    bs <- BL.readFile "tests/data/msg1.gpg"+    let encoded = encodeLazyWith defaultEncodeOptions [Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs]+    case find (BL.isPrefixOf (BLC8.pack "=")) (BLC8.lines encoded) of+        Nothing -> return ()+        Just _ -> assertFailure "modern encode should omit CRC24 line"++testEncodeLegacyIncludesCRC24 :: Assertion+testEncodeLegacyIncludesCRC24 = do+    bs <- BL.readFile "tests/data/msg1.gpg"+    let encoded = encodeLazyWith legacyEncodeOptions [Armor ArmorMessage [("Version","OpenPrivacy 0.99")] bs]+    case find (BL.isPrefixOf (BLC8.pack "=")) (BLC8.lines encoded) of+        Nothing -> assertFailure "legacy encode should include CRC24 line"+        Just _ -> return ()++removeLinePrefix :: BL.ByteString -> BL.ByteString -> BL.ByteString+removeLinePrefix prefix = BLC8.unlines . filter (not . BL.isPrefixOf prefix) . BLC8.lines++replaceLinePrefix :: BL.ByteString -> BL.ByteString -> BL.ByteString -> BL.ByteString+replaceLinePrefix prefix replacement = BLC8.unlines . map replace . BLC8.lines+    where+        replace line+            | BL.isPrefixOf prefix line = replacement+            | otherwise = line++insertHeaderAfterPgpSigned :: BL.ByteString -> BL.ByteString -> BL.ByteString+insertHeaderAfterPgpSigned header bs =+    case BLC8.lines bs of+        [] -> bs+        (x:xs) -> BLC8.unlines (x : header : xs)++addWhitespaceToBase64 :: BL.ByteString -> BL.ByteString+addWhitespaceToBase64 = BLC8.unlines . map tweak . BLC8.lines+    where+        tweak line+            | BL.null line = line+            | BL.isPrefixOf (BLC8.pack "-----") line = line+            | BLC8.elem ':' line = line+            | BL.isPrefixOf (BLC8.pack "=") line = BL.append (BLC8.pack "= ") (BL.drop 1 line)+            | otherwise = BL.append (BLC8.pack " ") line+ tests :: TestTree tests = testGroup "openpgp-asciiarmor" [    testGroup "CRC24" [@@ -102,11 +211,20 @@     , 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 "Encode (legacy) sample armor" (testLegacyArmorEncode ["msg1.gpg"] "msg1.asc")+    , testCase "Encode (legacy) multiple sample armors" (testLegacyArmorEncode ["msg1.gpg","msg1.gpg","msg1.gpg"] "msg1c.asc")+    , testCase "Encode (legacy) clear-signed sig" (testLegacyClearsignedEncode "msg3" "msg3.sig" "msg3.asc")     , testCase "Decode from strict ByteString" (testStrictDecode "msg1.asc")     , testCase "Encode to strict ByteString" (testStrictEncode "msg1.gpg")+    , testCase "Decode sample RFC9580 armor" (testArmorDecode "seipdv2.pgp.aa" ["seipdv2.pgp"])+    , testCase "Modern decode accepts missing CRC24" testModernDecodeAllowsMissingCRC+    , testCase "Legacy decode rejects missing CRC24" testLegacyDecodeRejectsMissingCRC+    , testCase "Modern decode accepts malformed CRC24" testModernDecodeAllowsMalformedCRC+    , testCase "Modern decode accepts mismatched CRC24" testModernDecodeAllowsMismatchedCRC+    , testCase "Decode ignores base64 whitespace" testDecodeIgnoresBase64Whitespace+    , testCase "Modern cleartext profile rejects non-Hash headers" testModernCleartextHeaderStrictness+    , testCase "Modern encode omits CRC24" testEncodeModernOmitsCRC24+    , testCase "Legacy encode includes CRC24" testEncodeLegacyIncludesCRC24     ]  ]