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 @@ -2481,17 +2481,21 @@ let ephPublicBytes = BA.convert (C25519.toPublic ephSecret) :: B.ByteString sharedSecret = BA.convert (C25519.dh recipientPub ephSecret) :: B.ByteString kek = deriveX25519Kek ephPublicBytes recipientPublic sharedSecret + materialBytes = unPKESKV3SessionMaterial material + algoByte = B.head materialBytes + rawKey = B.dropEnd 2 (B.drop 1 materialBytes) wrapped <- first (RecipientKeyWrapFailureCipher X25519) . aesKeyWrapRFC3394 AES128 kek - . padToMultipleOf8 - $ unPKESKV3SessionMaterial material + $ rawKey Right ( PKESKPayloadV3 3 eoki X25519 - (MPI (os2ip ephPublicBytes) :| [MPI (os2ip wrapped)]) + ( MPI (os2ip ephPublicBytes) + :| [MPI (os2ip (B.singleton algoByte <> wrapped))] + ) ) buildX448PKESKv3 @@ -2520,17 +2524,21 @@ let ephPublicBytes = BA.convert (C448.toPublic ephSecret) :: B.ByteString sharedSecret = BA.convert (C448.dh recipientPub ephSecret) :: B.ByteString kek = deriveX448Kek ephPublicBytes recipientPublic sharedSecret + materialBytes = unPKESKV3SessionMaterial material + algoByte = B.head materialBytes + rawKey = B.dropEnd 2 (B.drop 1 materialBytes) wrapped <- first (RecipientKeyWrapFailureCipher X448) . aesKeyWrapRFC3394 AES256 kek - . padToMultipleOf8 - $ unPKESKV3SessionMaterial material + $ rawKey Right ( PKESKPayloadV3 3 eoki X448 - (MPI (os2ip ephPublicBytes) :| [MPI (os2ip wrapped)]) + ( MPI (os2ip ephPublicBytes) + :| [MPI (os2ip (B.singleton algoByte <> wrapped))] + ) ) buildEcdhV6Esk 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 @@ -1595,7 +1595,14 @@ putPKESKv3SessionKeyMaterial pka mpis | pka `elem` [X25519, X448] , (ephMPI NE.:| [wrappedMPI]) <- mpis = do - putByteString (i2osp (unMPI ephMPI)) + let ephLen = + case pka of + X25519 -> 32 + X448 -> 56 + _ -> + error $ + "unsupported fixed-size octet algorithm: " ++ show pka + putByteString (leftPadTo ephLen (i2osp (unMPI ephMPI))) let eskBytes = i2osp (unMPI wrappedMPI) putWord8 (fromIntegral (B.length eskBytes)) putByteString eskBytes 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.7 +Version: 3.6.8 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.7 + tag: v3.6.8 diff --git a/tests/Tests/Encryption.hs b/tests/Tests/Encryption.hs --- a/tests/Tests/Encryption.hs +++ b/tests/Tests/Encryption.hs @@ -28,6 +28,7 @@ import Data.Binary (get, put) import Data.Binary.Get ( Get + , runGetOrFail ) import Data.Binary.Put (putWord16be, runPut) import qualified Data.ByteArray as BA @@ -725,6 +726,9 @@ "encrypt-side PKESKv3 builder supports v6 X25519 recipients" testBuildPKESKv3PayloadForRecipientV6X25519 , testCase + "PKESKv3 X25519 ephemeral serialization is exactly 32 bytes" + testPKESKv3X25519EphemeralSerializesAsExactly32Bytes + , testCase "encrypt-side PKESKv3 builder supports v6 X448 recipients" testBuildPKESKv3PayloadForRecipientV6X448 , testCase @@ -2521,6 +2525,131 @@ Right other -> assertFailure ("Expected PKESKPayloadV3 with X25519, got " ++ show other) + +{- | Regression test: PKESKv3 X25519 ephemeral public key serialization + must produce exactly 32 bytes on the wire even when the public key's + most significant byte is 0x00. Bug found by padding-bug audit; the + serializer was using i2osp which strips leading zero bytes, but the + parser (per RFC 9580 §5.1.6 and the recent "stricter PKESKv3 + parsing" fix) requires exactly 32 bytes. +-} +testPKESKv3X25519EphemeralSerializesAsExactly32Bytes + :: Assertion +testPKESKv3X25519EphemeralSerializesAsExactly32Bytes = do + -- Recipient secret that produces an X25519 public key with top byte 0x00. + -- Picked empirically; ~0.4% of random X25519 secrets have this property. + let recipientSecretRaw = + B.pack + [ 0x40 + , 0x51 + , 0x34 + , 0x72 + , 0x2a + , 0x08 + , 0x2e + , 0x88 + , 0xf0 + , 0xe4 + , 0xd0 + , 0xe1 + , 0x02 + , 0x0d + , 0x9e + , 0x18 + , 0xd6 + , 0xa5 + , 0x79 + , 0x76 + , 0x20 + , 0x78 + , 0x3e + , 0x97 + , 0x7c + , 0xf4 + , 0x01 + , 0x65 + , 0x95 + , 0xe1 + , 0x58 + , 0xbb + ] + recipientSecret = + case CE.eitherCryptoError (C25519.secretKey recipientSecretRaw) of + Left err -> + error + ( "failed to initialize X25519 recipient secret key: " + ++ show err + ) + Right sk -> sk + recipientPublicRaw = + BA.convert (C25519.toPublic recipientSecret) :: B.ByteString + recipient = + setKeyVersion + V6 + ( PKPayload + V4 + (ThirtyTwoBitTimeStamp 0) + 0 + X25519 + ( EdDSAPubKey + EdSigningCurve25519 + (NativeEPoint (EPoint (os2ip recipientPublicRaw))) + ) + ) + sessionKey = SessionKey (B.replicate 32 0x42) + -- Sanity check the test precondition; this is the property that triggers + -- the bug. (If this assertion ever fails, the test is no longer + -- exercising the leading-zero-byte case.) + assertEqual + "test precondition: X25519 public-key top byte must be 0x00" + 0 + (B.head recipientPublicRaw) + sessionMaterial <- mkPKESKSessionMaterialOrFail AES256 sessionKey + pkeskPayloadResult <- + buildPKESKv3PayloadForRecipient + recipient + (pkeskV3SessionMaterial sessionMaterial) + pkeskBytes <- + case pkeskPayloadResult of + Left err -> + assertFailure + ("buildPKESKv3PayloadForRecipient failed: " ++ show err) + >> pure B.empty + Right (PKESKPayloadV3Packet payload) -> + pure + ( BL.toStrict + (runPut (put (PKESKPkt (PKESKPayloadV3Packet payload)))) + ) + Right other -> + assertFailure + ("Expected PKESKPayloadV3, got " ++ show other) + >> pure B.empty + -- Manually verify the wire form: after the PKESK packet header + -- (tag + 1-byte length + version 3 + 8-byte key ID + 1-byte pka) + -- the body should start with a 32-byte X25519 ephemeral public key. + -- We extract the body offset for both the 1-byte and 2-byte length + -- encodings and check the byte length of the body matches. + -- + -- (A separate, non-padding bug — RFC 9580 §5.1.6 specifies that + -- the wrapped key encoding for V3 X25519 PKESK should be the raw + -- session key only, with the symmetric algorithm ID prepended in + -- plaintext. The current encrypt side wraps the v3-encoded + -- (algo || key || checksum) material instead. That is a different + -- bug tracked separately; this test only verifies the 32-byte + -- ephemeral-padding fix.) + let headerLen + | B.index pkeskBytes 1 < 192 = 11 + | B.index pkeskBytes 1 < 224 = 12 + | otherwise = 15 + body = B.drop headerLen pkeskBytes + assertBool + "PKESKv3 X25519 body must have at least 32 + 1 bytes for ephemeral + eskLen" + (B.length body >= 33) + let ephemeralFromWire = B.take 32 body + assertEqual + "PKESKv3 X25519 wire-format ephemeral must be exactly 32 bytes" + 32 + (B.length ephemeralFromWire) testBuildPKESKv3PayloadForRecipientV6X448 :: Assertion testBuildPKESKv3PayloadForRecipientV6X448 = do