diff --git a/Codec/Encryption/OpenPGP/Encrypt.hs b/Codec/Encryption/OpenPGP/Encrypt.hs --- a/Codec/Encryption/OpenPGP/Encrypt.hs +++ b/Codec/Encryption/OpenPGP/Encrypt.hs @@ -1638,11 +1638,7 @@ RecipientCapabilityNegotiationOn -> case seipdVersion of SEIPDv2 -> - negotiateAEADAlgorithmWithSymmetric - messagePolicy - targets - symOverride - >>= \aead -> Right (symOverride, aead) + negotiateCiphersuite messagePolicy targets SEIPDv1 -> Right ( symOverride @@ -1703,28 +1699,6 @@ ] in nubOrd (supportedPreferred ++ [implicitSEIPDv2Ciphersuite]) Nothing -> [implicitSEIPDv2Ciphersuite] - -negotiateAEADAlgorithmWithSymmetric - :: MessageEncryptionPolicy - -> [RecipientEncryptionTarget] - -> SymmetricAlgorithm - -> Either PKESKEncryptError AEADAlgorithm -negotiateAEADAlgorithmWithSymmetric messagePolicy targets symOverride = - chooseCommonAlgorithm - recipientChoices - (RecipientCapabilityNoCommonAEADAlgorithms []) - where - supportedAEADSet = supportedSEIPDv2AEADAlgorithms - recipientChoices = map choicesForTarget targets - choicesForTarget target = - case recipientEncryptionTargetCapabilities target of - Just caps -> - let preferred = recipientCapabilityPreferredCiphersuites caps - matching = [a | (s, a) <- preferred, s == symOverride] - supportedMatching = [a | a <- matching, a `Set.member` supportedAEADSet] - in nubOrd - (supportedMatching ++ [messageDefaultAEADAlgorithm messagePolicy]) - Nothing -> [messageDefaultAEADAlgorithm messagePolicy] negotiateSymmetricAlgorithmWithAEADOverride :: MessageEncryptionPolicy diff --git a/Codec/Encryption/OpenPGP/Internal.hs b/Codec/Encryption/OpenPGP/Internal.hs --- a/Codec/Encryption/OpenPGP/Internal.hs +++ b/Codec/Encryption/OpenPGP/Internal.hs @@ -70,8 +70,15 @@ leftPadTo :: Int -> B.ByteString -> B.ByteString leftPadTo targetLen bs - | B.length bs >= targetLen = bs - | otherwise = B.replicate (targetLen - B.length bs) 0 <> bs + | B.length bs > targetLen = + error + ( "byte string length " + ++ show (B.length bs) + ++ " exceeds target " + ++ show targetLen + ) + | otherwise = + B.replicate (targetLen - B.length bs) 0 <> bs checksum16 :: B.ByteString -> Word16 checksum16 = diff --git a/Codec/Encryption/OpenPGP/Serialize.hs b/Codec/Encryption/OpenPGP/Serialize.hs --- a/Codec/Encryption/OpenPGP/Serialize.hs +++ b/Codec/Encryption/OpenPGP/Serialize.hs @@ -2326,11 +2326,11 @@ putPubkeyV6 :: PKey -> Put putPubkeyV6 (EdDSAPubKey P.EdSigningCurve25519 (NativeEPoint (EPoint x))) = do - let bs = fixedLengthOctets 32 x + let bs = leftPadTo 32 (i2osp x) putWord32be . fromIntegral . B.length $ bs putByteString bs putPubkeyV6 (EdDSAPubKey P.EdSigningCurve448 (NativeEPoint (EPoint x))) = do - let bs = fixedLengthOctets 57 x + let bs = leftPadTo 57 (i2osp x) putWord32be . fromIntegral . B.length $ bs putByteString bs putPubkeyV6 @@ -2339,7 +2339,7 @@ kha ksa ) = do - let bs = fixedLengthOctets 32 x + let bs = leftPadTo 32 (i2osp x) putWord32be . fromIntegral . B.length $ bs putByteString bs put kha @@ -2350,7 +2350,7 @@ kha ksa ) = do - let bs = fixedLengthOctets 56 x + let bs = leftPadTo 56 (i2osp x) putWord32be . fromIntegral . B.length $ bs putByteString bs put kha @@ -2366,18 +2366,6 @@ putByteString bs putPubkeyV6 p = putPubkey p -fixedLengthOctets :: Int -> Integer -> B.ByteString -fixedLengthOctets targetLen x = - let bs = i2osp x - in if B.length bs > targetLen - then - error - ( "public key element does not fit in " - ++ show targetLen - ++ " octets" - ) - else B.replicate (targetLen - B.length bs) 0 <> bs - validatePrefixedNativePoint :: Int -> String -> Integer -> Get EPoint validatePrefixedNativePoint targetLen label i = @@ -2707,7 +2695,7 @@ putPubkeyV4Fixed :: Int -> P.EdSigningCurve -> PKey -> Put putPubkeyV4Fixed targetLen expectedCurve (EdDSAPubKey curve (NativeEPoint (EPoint x))) | curve == expectedCurve = - putByteString (fixedLengthOctets targetLen x) + putByteString (leftPadTo targetLen (i2osp x)) putPubkeyV4Fixed _ _ pk = putPubkey pk getSKAddendum :: SomePKPayload -> Get SKAddendum diff --git a/Codec/Encryption/OpenPGP/Signatures.hs b/Codec/Encryption/OpenPGP/Signatures.hs --- a/Codec/Encryption/OpenPGP/Signatures.hs +++ b/Codec/Encryption/OpenPGP/Signatures.hs @@ -1222,7 +1222,7 @@ Right ep -> case cf2es ( Ed25519.signature - (pad32 (i2osp (unMPI r)) <> pad32 (i2osp (unMPI s))) + (leftPadTo 32 (i2osp (unMPI r)) <> leftPadTo 32 (i2osp (unMPI s))) ) of Left err -> verificationError (SignatureEncodingInvalidCrypto sigPka err) @@ -1248,7 +1248,7 @@ Right ep -> case cf2es ( Ed448.signature - (padN 57 (i2osp (unMPI r)) <> padN 57 (i2osp (unMPI s))) + (leftPadTo 57 (i2osp (unMPI r)) <> leftPadTo 57 (i2osp (unMPI s))) ) of Left err -> verificationError (SignatureEncodingInvalidCrypto sigPka err) @@ -1275,16 +1275,8 @@ exactLengthPublic expectedLen label bs | B.length bs == expectedLen = Right bs | otherwise = Left (BadLength label expectedLen (B.length bs)) - pad32 bs = - let l = B.length bs - in if l >= 32 - then bs - else B.replicate (32 - l) 0 <> bs - padN n bs = - let l = B.length bs - in if l >= n - then bs - else B.replicate (n - l) 0 <> bs + pad32 bs = leftPadTo 32 bs + padN n bs = leftPadTo n bs cf2es = eitherCryptoError rsaVerify pub mpis hd pkey bs = if P15.verify (Just hd) pkey bs (rsaMPItoSig pkey mpis) @@ -1295,8 +1287,7 @@ rsaMPItoSig pkey (s :| []) = let sz = RSATypes.public_size pkey raw = i2osp (unMPI s) - pad = sz - B.length raw - in B.replicate pad 0 <> raw + in leftPadTo sz raw crazyHash h = BA.convert . hashWith h isSignatureExpired diff --git a/hOpenPGP.cabal b/hOpenPGP.cabal --- a/hOpenPGP.cabal +++ b/hOpenPGP.cabal @@ -1,6 +1,6 @@ Cabal-version: 3.4 Name: hOpenPGP -Version: 3.6.8 +Version: 3.6.9 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.8 + tag: v3.6.9 diff --git a/tests/Tests/Encryption.hs b/tests/Tests/Encryption.hs --- a/tests/Tests/Encryption.hs +++ b/tests/Tests/Encryption.hs @@ -780,6 +780,9 @@ "encryptForRecipients falls back to SEIPDv1 when recipients do not advertise SEIPDv2 support" testEncryptRecipientsSEIPDv2FallsBackWhenRecipientsDoNotAdvertiseV2 , testCase + "encryptForRecipients SEIPDv2 ignores symmetricOverride and negotiates from ciphersuites" + testEncryptRecipientsSEIPDv2IgnoresSymmetricOverride + , testCase "SEIPDv1 negotiation selects symmetric algorithm from PreferredSymmetricAlgorithms ignoring ciphersuites" testEncryptRecipientsSEIPDv1NegotiatesSymmetricAlgorithmIgnoringAEADCiphersuites , testCase @@ -3558,6 +3561,68 @@ assertFailure "Expected SEIPDv1 fallback when recipients do not advertise SEIPDv2 support" other -> assertFailure ("Unexpected SEIPD packets: " ++ show other) + +testEncryptRecipientsSEIPDv2IgnoresSymmetricOverride + :: Assertion +testEncryptRecipientsSEIPDv2IgnoresSymmetricOverride = do + (baseRecipient, _privateKey) <- loadUnencryptedRsaSigner + let v6Recipient = setKeyVersion V6 baseRecipient + v6Caps = + RecipientCapabilities + { recipientCapabilityKeyVersion = V6 + , recipientCapabilityPublicKeyAlgorithm = _pkalgo v6Recipient + , recipientCapabilityKeyFlags = Set.empty + , recipientCapabilityFeatures = + Set.fromList [FeatureSEIPDv1, FeatureSEIPDv2] + , recipientCapabilityPreferredSymmetricAlgorithms = [] + , recipientCapabilityPreferredCiphersuites = [(AES128, OCB)] + } + request = + RecipientEncryptRequest + { recipientEncryptRequestTargets = + [recipientEncryptionTargetWithCapabilities v6Recipient v6Caps] + , recipientEncryptRequestPayloadShape = + defaultRecipientPayloadShape + , recipientEncryptRequestPayload = + "seipd v2 symmetric override ignored payload" + , recipientEncryptRequestSymmetricOverride = Just AES256 + , recipientEncryptRequestOverrides = + RecipientEncryptRequestSEIPDv2Overrides + { recipientEncryptRequestAEADOverride = Nothing + , recipientEncryptRequestChunkSizeOverride = Just 6 + , recipientEncryptRequestSaltOverride = + Just (Salt (B.replicate 32 0x29)) + } + } + result <- + encryptForRecipientsWithCapabilityNegotiation + RecipientCapabilityNegotiationOn + request + case result of + Left err -> + assertFailure + ( "Expected SEIPDv2 negotiation to ignore symmetricOverride and succeed, got " + ++ show err + ) + Right + RecipientEncryptResult + { recipientEncryptPackets = packets + , recipientEncryptSessionMaterial = material + } -> do + assertEqual + "SEIPDv2 negotiation should ignore symmetricOverride and select symmetric from ciphersuite" + AES128 + (pkeskSessionAlgorithm material) + case [ aa + | SymEncIntegrityProtectedDataPkt (SEIPD2 _ aa _ _ _) <- packets + ] of + [selectedAEAD] -> + assertEqual + "SEIPDv2 negotiation should pick AEAD from common ciphersuite entry" + OCB + selectedAEAD + other -> + assertFailure ("Expected one SEIPDv2 packet, got " ++ show other) testEncryptRecipientsSEIPDv1NegotiatesSymmetricAlgorithmIgnoringAEADCiphersuites :: Assertion