hOpenPGP 3.6.7 → 3.6.8
raw patch · 4 files changed
+153/−9 lines, 4 files
Files
- Codec/Encryption/OpenPGP/Encrypt.hs +14/−6
- Codec/Encryption/OpenPGP/Serialize.hs +8/−1
- hOpenPGP.cabal +2/−2
- tests/Tests/Encryption.hs +129/−0
Codec/Encryption/OpenPGP/Encrypt.hs view
@@ -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
Codec/Encryption/OpenPGP/Serialize.hs view
@@ -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
hOpenPGP.cabal view
@@ -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
tests/Tests/Encryption.hs view
@@ -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