diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor.hs b/Codec/Encryption/OpenPGP/ASCIIArmor.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor.hs @@ -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) diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Decode.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Encode.hs @@ -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 diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Multipart.hs @@ -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). diff --git a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs --- a/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs +++ b/Codec/Encryption/OpenPGP/ASCIIArmor/Types.hs @@ -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 +} diff --git a/openpgp-asciiarmor.cabal b/openpgp-asciiarmor.cabal --- a/openpgp-asciiarmor.cabal +++ b/openpgp-asciiarmor.cabal @@ -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 -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 diff --git a/tests/data/seipdv2.pgp b/tests/data/seipdv2.pgp new file mode 100644 Binary files /dev/null and b/tests/data/seipdv2.pgp differ diff --git a/tests/data/seipdv2.pgp.aa b/tests/data/seipdv2.pgp.aa new file mode 100644 --- /dev/null +++ b/tests/data/seipdv2.pgp.aa @@ -0,0 +1,8 @@ +-----BEGIN PGP MESSAGE----- + +wW0GIQav44SnLNNBPMT5pEw1RZY8zjlKostWz+pDmoUF+5URxRkwyaitZyn0JaLC +SYnwTOoiZgF9sz6WtxJJJrT8fRJbWyiTIxpSVr0gf/BBsHqDWDma0wfYo7QI+YIC +0i291xBNy1zBewWq0U6o0moCCQIG0KgYQaeiO2e9CrpgecrqyVQdPZv2H6UMMWws +DM6crtsjhM572grlZ5Kzf55ybvQh0IOS9nQGi0naPQAI7VOrBENunE79qeW3z29r +vZMR+ZZL3TRbqFaBZJy8tORC8NVaA6sLnZ4I +-----END PGP MESSAGE----- diff --git a/tests/suite.hs b/tests/suite.hs --- a/tests/suite.hs +++ b/tests/suite.hs @@ -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 ] ]