packages feed

hOpenPGP 3.6.9 → 3.6.10

raw patch · 8 files changed

+267/−48 lines, 8 files

Files

Codec/Encryption/OpenPGP/BlockCipher.hs view
@@ -16,7 +16,6 @@ import qualified Crypto.Cipher.TripleDES as TripleDES import qualified Crypto.Nettle.Ciphers as CNC import qualified Data.ByteString as B-import qualified Data.Set as Set  import Codec.Encryption.OpenPGP.Internal.CryptoCipherTypes     ( HOWrappedOldCCT (..)@@ -124,18 +123,17 @@ Decryption backward-compatibility is unaffected: 'withSymmetricCipher' still handles all ten algorithms, including the three forbidden above. -}-supportedSymmetricAlgorithmsForCFB :: Set.Set SymmetricAlgorithm+supportedSymmetricAlgorithmsForCFB :: [SymmetricAlgorithm] supportedSymmetricAlgorithmsForCFB =-    Set.fromList-        [ Twofish-        , Blowfish-        , AES128-        , AES192-        , AES256-        , Camellia128-        , Camellia192-        , Camellia256-        ]+    [ AES256+    , AES192+    , AES128+    , Camellia256+    , Camellia192+    , Camellia128+    , Twofish+    , Blowfish+    ]  initAndRun     :: HOBlockCipher cipher
Codec/Encryption/OpenPGP/Encrypt.hs view
@@ -1730,19 +1730,17 @@         recipientChoices         (RecipientCapabilityNoCommonSymmetricAlgorithms [])   where-    senderSymmetricAlgorithms = Set.toList supportedSymmetricAlgorithmsForCFB+    senderSet = Set.fromList supportedSymmetricAlgorithmsForCFB     recipientChoices = map choicesForTarget targets     choicesForTarget target =         case recipientEncryptionTargetCapabilities target of             Just caps ->                 let preferred = recipientCapabilityPreferredSymmetricAlgorithms caps-                    preferredSet = Set.fromList preferred-                    allowed =-                        [s | s <- senderSymmetricAlgorithms, s `Set.member` preferredSet]+                    allowed = [s | s <- preferred, s `Set.member` senderSet]                  in if null allowed-                        then senderSymmetricAlgorithms+                        then supportedSymmetricAlgorithmsForCFB                         else allowed-            Nothing -> senderSymmetricAlgorithms+            Nothing -> supportedSymmetricAlgorithmsForCFB  chooseCommonAlgorithm     :: (Eq a, Ord a)@@ -1761,7 +1759,11 @@     intersectOrdered as bs = [a | a <- as, a `Set.member` Set.fromList bs]     orderByRecipientPreference candidates choices =         sortOn-            ( \c -> sum [fromMaybe 0 (elemIndex c allowed) | allowed <- choices]+            ( \c ->+                sum+                    [ fromMaybe (maxBound :: Int) (elemIndex c allowed)+                    | allowed <- choices+                    ]             )             candidates @@ -2458,19 +2460,25 @@                         materialBytes = unPKESKV3SessionMaterial material                         algoByte = B.head materialBytes                         rawKey = B.dropEnd 2 (B.drop 1 materialBytes)-                    wrapped <--                        first (RecipientKeyWrapFailureCipher X25519)-                            . aesKeyWrapRFC3394 AES128 kek-                            $ rawKey-                    Right-                        ( PKESKPayloadV3-                            3-                            eoki-                            X25519-                            ( MPI (os2ip ephPublicBytes)-                                :| [MPI (os2ip (B.singleton algoByte <> wrapped))]-                            )-                        )+                        algoSym = toFVal algoByte+                    if algoSym `notElem` [AES128, AES192, AES256]+                        then+                            Left+                                (UnsupportedSessionKeyAlgorithmForPKESK X25519 algoSym)+                        else do+                            wrapped <-+                                first (RecipientKeyWrapFailureCipher X25519)+                                    . aesKeyWrapRFC3394 AES128 kek+                                    $ rawKey+                            Right+                                ( PKESKPayloadV3+                                    3+                                    eoki+                                    X25519+                                    ( MPI (os2ip ephPublicBytes)+                                        :| [MPI (os2ip (B.singleton algoByte <> wrapped))]+                                    )+                                )  buildX448PKESKv3     :: MonadRandom m@@ -2501,19 +2509,25 @@                         materialBytes = unPKESKV3SessionMaterial material                         algoByte = B.head materialBytes                         rawKey = B.dropEnd 2 (B.drop 1 materialBytes)-                    wrapped <--                        first (RecipientKeyWrapFailureCipher X448)-                            . aesKeyWrapRFC3394 AES256 kek-                            $ rawKey-                    Right-                        ( PKESKPayloadV3-                            3-                            eoki-                            X448-                            ( MPI (os2ip ephPublicBytes)-                                :| [MPI (os2ip (B.singleton algoByte <> wrapped))]-                            )-                        )+                        algoSym = toFVal algoByte+                    if algoSym `notElem` [AES128, AES192, AES256]+                        then+                            Left+                                (UnsupportedSessionKeyAlgorithmForPKESK X448 algoSym)+                        else do+                            wrapped <-+                                first (RecipientKeyWrapFailureCipher X448)+                                    . aesKeyWrapRFC3394 AES256 kek+                                    $ rawKey+                            Right+                                ( PKESKPayloadV3+                                    3+                                    eoki+                                    X448+                                    ( MPI (os2ip ephPublicBytes)+                                        :| [MPI (os2ip (B.singleton algoByte <> wrapped))]+                                    )+                                )  buildEcdhV6Esk     :: SomePKPayload
Codec/Encryption/OpenPGP/Policy.hs view
@@ -246,6 +246,18 @@     -- ^ Action for unsupported/unknown hash algorithms     , vpPkaMismatch :: VerificationPolicyAction     -- ^ Action for PKA mismatch between signature and key+    , vpDeprecatedSignatureAlgorithms :: Set.Set PubKeyAlgorithm+    {- ^ Signature PKAs the caller considers deprecated+    (e.g. RFC 9580 §9.3 forbids new DSA signatures).+    -}+    , vpDeprecatedSignatureAlgorithm :: VerificationPolicyAction+    {- ^ Action for signatures using a PKA in+    'vpDeprecatedSignatureAlgorithms'.+    -}+    , vpUnsupportedSignatureAlgorithm :: VerificationPolicyAction+    {- ^ Action for signatures using a PKA we cannot verify at all+    (e.g. 'OtherPKA').+    -}     , vpUnsupportedCriticalSubpacket :: VerificationPolicyAction     -- ^ Action for unsupported critical subpackets     , vpLegacyIssuerKeyIdInV6 :: VerificationPolicyAction@@ -268,6 +280,9 @@         { vpDeprecatedHashAlgorithm = VerificationWarning         , vpUnsupportedHashAlgorithm = VerificationError         , vpPkaMismatch = VerificationError+        , vpDeprecatedSignatureAlgorithms = Set.fromList [DSA]+        , vpDeprecatedSignatureAlgorithm = VerificationWarning+        , vpUnsupportedSignatureAlgorithm = VerificationError         , vpUnsupportedCriticalSubpacket = VerificationError         , vpLegacyIssuerKeyIdInV6 = VerificationError         , vpMissingSubkeyBackSignature = VerificationWarning@@ -282,6 +297,9 @@         { vpDeprecatedHashAlgorithm = VerificationError         , vpUnsupportedHashAlgorithm = VerificationError         , vpPkaMismatch = VerificationError+        , vpDeprecatedSignatureAlgorithms = Set.fromList [DSA]+        , vpDeprecatedSignatureAlgorithm = VerificationError+        , vpUnsupportedSignatureAlgorithm = VerificationError         , vpUnsupportedCriticalSubpacket = VerificationError         , vpLegacyIssuerKeyIdInV6 = VerificationError         , vpMissingSubkeyBackSignature = VerificationError@@ -298,6 +316,9 @@         { vpDeprecatedHashAlgorithm = VerificationWarning         , vpUnsupportedHashAlgorithm = VerificationWarning         , vpPkaMismatch = VerificationWarning+        , vpDeprecatedSignatureAlgorithms = Set.empty+        , vpDeprecatedSignatureAlgorithm = VerificationWarning+        , vpUnsupportedSignatureAlgorithm = VerificationWarning         , vpUnsupportedCriticalSubpacket = VerificationWarning         , vpLegacyIssuerKeyIdInV6 = VerificationWarning         , vpMissingSubkeyBackSignature = VerificationWarning
Codec/Encryption/OpenPGP/Signatures.hs view
@@ -1086,13 +1086,17 @@             Right             (sigHA sigPayload)     sigDetails <- signaturePKAAndMPIsFromClass sigClass+    algoWarnings <- enforceSignatureAlgorithmPolicy policy sigDetails     warnings <- enforcePKACompatibility policy sigPayload     hashWarnings <- enforceSignatureHashPolicy policy sigHash     _ <- isSignatureExpired sig mt     let signedPayload = BL.toStrict (finalPayload sig payload)     enforceLeft16Prefix sigClass sigHash signedPayload     ( \verifiedSigner ->-            Verification verifiedSigner sigPayload (warnings ++ hashWarnings)+            Verification+                verifiedSigner+                sigPayload+                (warnings ++ algoWarnings ++ hashWarnings)         )         <$> verify' sigDetails pkp sigHash signedPayload   where@@ -1110,6 +1114,22 @@                     ) of                     Left err -> verificationError (SignaturePolicyPKAMismatch sigPka keyPka)                     Right warn -> Right [PkaMismatchWarning sigPka keyPka]+    enforceSignatureAlgorithmPolicy vp (sigPka, _) =+        if sigPka `Set.member` vpDeprecatedSignatureAlgorithms vp+            then case applyVerificationPolicy+                (vpDeprecatedSignatureAlgorithm vp)+                ("Deprecated signature algorithm: " ++ show sigPka) of+                Left _ -> verificationError (SignaturePolicyAlgorithmDeprecated sigPka)+                Right _ -> Right [DeprecatedSignatureAlgorithmWarning sigPka]+            else case sigPka of+                OtherPKA _ ->+                    case applyVerificationPolicy+                        (vpUnsupportedSignatureAlgorithm vp)+                        ("Unsupported signature algorithm: " ++ show sigPka) of+                        Left _ ->+                            verificationError (SignaturePolicyAlgorithmUnsupported sigPka)+                        Right _ -> Right [UnsupportedSignatureAlgorithmWarning sigPka]+                _ -> Right []     enforceDeprecatedHash vp ha msg =         case applyVerificationPolicy             (vpDeprecatedHashAlgorithm vp)
Codec/Encryption/OpenPGP/Types/Internal/Errors.hs view
@@ -576,6 +576,8 @@     | SignatureEncodingInvalidLength !PubKeyAlgorithm !String !Int !Int     | SignaturePolicyHashUnsupported !HashAlgorithm     | SignaturePolicyPKAMismatch !PubKeyAlgorithm !PubKeyAlgorithm+    | SignaturePolicyAlgorithmDeprecated !PubKeyAlgorithm+    | SignaturePolicyAlgorithmUnsupported !PubKeyAlgorithm     | SignatureExpired     | CandidateKeyFailures [VerificationError]     | InvalidSubkeyBackSignature !VerificationError@@ -674,6 +676,12 @@         ++ show sigPka         ++ " does not match key algorithm "         ++ show keyPka+renderVerificationError (SignaturePolicyAlgorithmDeprecated pka) =+    "verification failed: signature uses deprecated public-key algorithm "+        ++ show pka+renderVerificationError (SignaturePolicyAlgorithmUnsupported pka) =+    "verification failed: signature uses unsupported public-key algorithm "+        ++ show pka renderVerificationError SignatureExpired =     "verification failed: signature expired" renderVerificationError (CandidateKeyFailures errs) =@@ -762,6 +770,9 @@     | RecipientKeyWrapFailureCipher !PubKeyAlgorithm !CipherError     | RecipientKeyWrapFailureRSA !PubKeyAlgorithm !RSA.Error     | RecipientKeyWrapFailureCrypto !PubKeyAlgorithm !CE.CryptoError+    | UnsupportedSessionKeyAlgorithmForPKESK+        !PubKeyAlgorithm+        !SymmetricAlgorithm     | RecipientCapabilitySelectionFailure !RecipientCapabilityError     | PayloadBuildFailureCipher !CipherError     | PayloadBuildFailureS2K !S2KError@@ -820,6 +831,11 @@         ++ show algo         ++ ": "         ++ show err+renderPKESKEncryptError (UnsupportedSessionKeyAlgorithmForPKESK algo symAlgo) =+    "unsupported session key algorithm "+        ++ show symAlgo+        ++ " for v3 PKESK recipient algorithm "+        ++ show algo renderPKESKEncryptError (RecipientCapabilitySelectionFailure err) =     renderRecipientCapabilityError err renderPKESKEncryptError (PayloadBuildFailureCipher err) =
Codec/Encryption/OpenPGP/Types/Internal/Pkt.hs view
@@ -712,6 +712,8 @@     | DeprecatedHashAlgorithmWarning HashAlgorithm     | UnsupportedHashAlgorithmWarning HashAlgorithm     | PkaMismatchWarning PubKeyAlgorithm PubKeyAlgorithm+    | DeprecatedSignatureAlgorithmWarning PubKeyAlgorithm+    | UnsupportedSignatureAlgorithmWarning PubKeyAlgorithm     | UnsupportedCriticalSubpacketWarning SigType     | LegacyIssuerKeyIdInV6Warning     | InvalidSignatureContextWarning SigType
hOpenPGP.cabal view
@@ -1,6 +1,6 @@ Cabal-version:       3.4 Name:                hOpenPGP-Version:             3.6.9+Version:             3.6.10 Synopsis:            native Haskell implementation of OpenPGP (RFC9580) Description:         native Haskell implementation of OpenPGP (RFC9580), with some backwards compatibility Homepage:            https://salsa.debian.org/clint/hOpenPGP@@ -347,4 +347,4 @@ source-repository this   type:     git   location: https://salsa.debian.org/clint/hOpenPGP.git-  tag:      v3.6.9+  tag:      v3.6.10
tests/Tests/Keys.hs view
@@ -68,6 +68,7 @@     , isAllowedPrimaryKeySig     , isAllowedSubkeySig     , isAllowedUIDSig+    , strictVerificationPolicy     ) import Codec.Encryption.OpenPGP.SecretKey     ( SecretKeyEncryptOptions (..)@@ -279,6 +280,27 @@                 (testRevokedCertificateMessage "revoked.pubkey")             ]         , testGroup+            "Signature algorithm policy group"+            [ testCase+                "default policy accepts DSA signature with deprecation warning"+                ( testDsaDefaultPolicyWarns+                    "pubring.gpg"+                    "uncompressed-ops-dsa.gpg"+                )+            , testCase+                "strict policy rejects DSA signature"+                ( testDsaStrictPolicyRejects+                    "pubring.gpg"+                    "uncompressed-ops-dsa.gpg"+                )+            , testCase+                "strict policy rejects signature with unimplemented PKA"+                ( testStrictPolicyRejectsUnsupportedPka+                    "pubring.gpg"+                    "uncompressed-ops-dsa.gpg"+                )+            ]+        , testGroup             "Key expiration group"             [ testCase                 "6F87040E pubkey"@@ -520,6 +542,132 @@             )             publicKs         )++testDsaDefaultPolicyWarns :: FilePath -> FilePath -> Assertion+testDsaDefaultPolicyWarns keyring message = do+    ks <- loadKeyringAsPublicTKs keyring+    (payload, sigPkt) <- loadSignedMessage keyring message+    case verifyAgainstKeysWithPolicy+        defaultVerificationPolicy+        ks+        sigPkt+        Nothing+        payload of+        Right verification ->+            assertTrue+                "expected DSA deprecation warning"+                ( DeprecatedSignatureAlgorithmWarning DSA+                    `elem` _verificationWarnings verification+                )+        Left err ->+            assertFailure $+                "expected verification to succeed under default policy, got: "+                    ++ renderVerificationError err++testDsaStrictPolicyRejects :: FilePath -> FilePath -> Assertion+testDsaStrictPolicyRejects keyring message = do+    ks <- loadKeyringAsPublicTKs keyring+    (payload, sigPkt) <- loadSignedMessage keyring message+    case verifyAgainstKeysWithPolicy+        strictVerificationPolicy+        ks+        sigPkt+        Nothing+        payload of+        Right verification ->+            assertFailure $+                "expected strict policy to reject signature, but it verified: "+                    ++ show (_verificationWarnings verification)+        Left err ->+            assertFailureUnlessMatches+                "expected SignaturePolicyAlgorithmDeprecated DSA in candidate failures"+                [SignaturePolicyAlgorithmDeprecated DSA]+                err++testStrictPolicyRejectsUnsupportedPka+    :: FilePath -> FilePath -> Assertion+testStrictPolicyRejectsUnsupportedPka keyring message = do+    ks <- loadKeyringAsPublicTKs keyring+    pkts <- loadAndDecompressPkts message+    let (origSig : _) =+            [ s+            | SignaturePkt s <- pkts+            ]+        synthSig = case origSig of+            SigV3 st ts eoki _ ha w16 mpis ->+                SigV3 st ts eoki (OtherPKA 99) ha w16 mpis+            SigV4 st _ ha hsps usps w16 mpis ->+                SigV4 st (OtherPKA 99) ha hsps usps w16 mpis+            SigV6 st _ ha salt hsps usps w16 mpis ->+                SigV6 st (OtherPKA 99) ha salt hsps usps w16 mpis+            SigVOther v bs -> SigVOther v bs+        newPkts =+            SignaturePkt synthSig+                : filter (\p -> case p of SignaturePkt _ -> False; _ -> True) pkts+    assertEqual+        "we must mutate exactly one signature packet"+        (length pkts)+        (length newPkts)+    (payload, sigPkt) <- loadSignedMessagePackets newPkts+    case verifyAgainstKeysWithPolicy+        strictVerificationPolicy+        ks+        sigPkt+        Nothing+        payload of+        Right verification ->+            assertFailure $+                "expected strict policy to reject signature, but it verified: "+                    ++ show (_verificationWarnings verification)+        Left err ->+            assertFailureUnlessMatches+                "expected SignaturePolicyAlgorithmUnsupported (OtherPKA 99) in candidate failures"+                [SignaturePolicyAlgorithmUnsupported (OtherPKA 99)]+                err++assertFailureUnlessMatches+    :: String -> [VerificationError] -> VerificationError -> Assertion+assertFailureUnlessMatches label expected err =+    let actualErrors = case err of+            CandidateKeyFailures errs -> errs+            other -> [other]+        matches = filter (`elem` actualErrors) expected+     in assertBool+            ( label+                ++ "; actual = "+                ++ show actualErrors+            )+            (not (null matches))++loadSignedMessage+    :: FilePath -> FilePath -> IO (BL.ByteString, Pkt)+loadSignedMessage _ message = do+    pkts <- loadAndDecompressPkts message+    loadSignedMessagePackets pkts++loadSignedMessagePackets :: [Pkt] -> IO (BL.ByteString, Pkt)+loadSignedMessagePackets pkts = case find (\p -> case p of SignaturePkt _ -> True; _ -> False) pkts of+    Just sigPkt@(SignaturePkt _) -> do+        let payload :: BL.ByteString+            payload = case [bs | Just bs <- map mLiteralDataPayload pkts] of+                (bs : _) -> bs+                [] -> BL.empty+        pure (payload, sigPkt)+    _ -> error "no signature packet found"++mLiteralDataPayload :: Pkt -> Maybe BL.ByteString+mLiteralDataPayload (LiteralDataPkt _ _ _ bs) = Just bs+mLiteralDataPayload _ = Nothing++loadKeyringAsPublicTKs :: FilePath -> IO [TK 'PublicTK]+loadKeyringAsPublicTKs keyring =+    fmap (mapMaybe someTKToPublicTK) $+        DC.runConduitRes $+            CB.sourceFile ("tests/data/" ++ keyring)+                DC..| conduitGet get+                DC..| conduitToSomeTKsEither+                DC..| conduitDropErrorsAndNothings+                DC..| CL.consume  testKeysSelfVerification :: Bool -> FilePath -> Assertion testKeysSelfVerification expectsuccess keyfile = do