diff --git a/Codec/Encryption/OpenPGP/SerializeForSigs.hs b/Codec/Encryption/OpenPGP/SerializeForSigs.hs --- a/Codec/Encryption/OpenPGP/SerializeForSigs.hs +++ b/Codec/Encryption/OpenPGP/SerializeForSigs.hs @@ -97,11 +97,10 @@ putWord32be . fromIntegral . (+ 6) . BL.length $ runPut $ mapM_ put hs --- this +6 seems like a bug in RFC4880 putSigTrailerCase signatureCase@(SignatureSerializationCaseV6 _) = do putWord8 0x06 putWord8 0xff - putWord32be . fromIntegral . (+ 6) . BL.length $ + putWord32be . fromIntegral . BL.length $ runPut (putPartialSigforSigningCase signatureCase) putSigforSigningCase :: SignatureSerializationCase -> Put 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 @@ -601,25 +601,22 @@ | not (isBindingSignatureType sigType) = Right () | otherwise = case payload of - UserDefinedSigSub {} -> - case applyVerificationPolicy - (vpUnsupportedCriticalSubpacket policy) - ( "Unsupported critical subpacket in " - ++ show sigType - ++ " signature" - ) of - Left err -> verificationError (UnsupportedCriticalSubpacket sigType) - Right warn -> Right () -- We don't have a warning type for this yet - OtherSigSub {} -> - case applyVerificationPolicy - (vpUnsupportedCriticalSubpacket policy) - ( "Unsupported critical subpacket in " - ++ show sigType - ++ " signature" - ) of - Left err -> verificationError (UnsupportedCriticalSubpacket sigType) - Right warn -> Right () + UserDefinedSigSub {} -> rejectUnsupported policy sigType + OtherSigSub {} -> rejectUnsupported policy sigType _ -> Right () +rejectUnsupported + :: VerificationPolicy + -> SigType + -> Either VerificationError () +rejectUnsupported policy sigType = + case applyVerificationPolicy + (vpUnsupportedCriticalSubpacket policy) + ( "Unsupported critical subpacket in " + ++ show sigType + ++ " signature" + ) of + Left err -> verificationError (UnsupportedCriticalSubpacket sigType) + Right warn -> Right () -- We don't have a warning type for this yet isBindingSignatureType :: SigType -> Bool isBindingSignatureType SubkeyBindingSig = True @@ -1277,6 +1274,12 @@ ) of Left err -> verificationError (SignaturePolicyPKAMismatch sigPka keyPka) Right warn -> Right [PkaMismatchWarning sigPka keyPka] + enforceDeprecatedHash vp ha msg = + case applyVerificationPolicy + (vpDeprecatedHashAlgorithm vp) + ("Deprecated hash algorithm: " ++ msg) of + Left _ -> verificationError (SignaturePolicyHashUnsupported ha) + Right _ -> Right [DeprecatedHashAlgorithmWarning ha] enforceSignatureHashPolicy vp sigHash = case sigHash of OtherHA {} -> @@ -1285,24 +1288,9 @@ ("Unsupported hash algorithm: " ++ show sigHash) of Left err -> verificationError (SignaturePolicyHashUnsupported sigHash) Right warn -> Right [UnsupportedHashAlgorithmWarning sigHash] - DeprecatedMD5 -> - case applyVerificationPolicy - (vpDeprecatedHashAlgorithm vp) - ("Deprecated hash algorithm: MD5") of - Left err -> verificationError (SignaturePolicyHashUnsupported sigHash) - Right warn -> Right [DeprecatedHashAlgorithmWarning sigHash] - SHA1 -> - case applyVerificationPolicy - (vpDeprecatedHashAlgorithm vp) - ("Deprecated hash algorithm: SHA1") of - Left err -> verificationError (SignaturePolicyHashUnsupported sigHash) - Right warn -> Right [DeprecatedHashAlgorithmWarning sigHash] - RIPEMD160 -> - case applyVerificationPolicy - (vpDeprecatedHashAlgorithm vp) - ("Deprecated hash algorithm: RIPEMD160") of - Left err -> verificationError (SignaturePolicyHashUnsupported sigHash) - Right warn -> Right [DeprecatedHashAlgorithmWarning sigHash] + DeprecatedMD5 -> enforceDeprecatedHash vp sigHash "MD5" + SHA1 -> enforceDeprecatedHash vp sigHash "SHA1" + RIPEMD160 -> enforceDeprecatedHash vp sigHash "RIPEMD160" _ -> Right [] enforceLeft16Prefix sigClass sigHash signedPayload = do expectedLeft16 <- @@ -1351,28 +1339,28 @@ dsaVerify pub mpis hd pkey bs verify'' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs = ecdsaVerify pub mpis hd pkey bs - verify'' (sigPka, mpis) hd pub (EdDSAPubKey EdSigningCurve25519 pkey) bs - | sigPka `elem` [EdDSA, PKA.Ed25519] = - ed25519Verify sigPka pub mpis hd pkey bs - verify'' (sigPka, mpis) hd pub (EdDSAPubKey EdSigningCurve448 pkey) bs - | sigPka `elem` [EdDSA, PKA.Ed448] = - ed448Verify sigPka pub mpis hd pkey bs + verify'' (sigPka, mpis) hd pub key@(EdDSAPubKey {}) bs = + edVerify sigPka pub mpis hd key bs verify'' (RSA, mpis) hd pub (RSAPubKey (RSA_PublicKey pkey)) bs = rsaVerify pub mpis hd pkey bs verify'' (pka, _) _ _ _ _ = verificationError (UnsupportedKeyType pka) + verifyNoRSA ha' (sigPka, mpis) hd pub key@(EdDSAPubKey {}) bs = + edVerify sigPka pub mpis hd key bs verifyNoRSA ha' (DSA, mpis) hd pub (DSAPubKey (DSA_PublicKey pkey)) bs = dsaVerify pub mpis hd pkey bs verifyNoRSA ha' (ECDSA, mpis) hd pub (ECDSAPubKey (ECDSA_PublicKey pkey)) bs = ecdsaVerify pub mpis hd pkey bs - verifyNoRSA ha' (sigPka, mpis) hd pub (EdDSAPubKey EdSigningCurve25519 pkey) bs - | sigPka `elem` [EdDSA, PKA.Ed25519] = - ed25519Verify sigPka pub mpis hd pkey bs - verifyNoRSA ha' (sigPka, mpis) hd pub (EdDSAPubKey EdSigningCurve448 pkey) bs - | sigPka `elem` [EdDSA, PKA.Ed448] = - ed448Verify sigPka pub mpis hd pkey bs verifyNoRSA ha' (RSA, _) _ _ _ _ = verificationError (SignatureHashUnsupportedByAlgorithm ha' RSA) verifyNoRSA _ (pka, _) _ _ _ _ = verificationError (UnsupportedKeyType pka) + edVerify sigPka pub mpis hd key bs = case key of + EdDSAPubKey EdSigningCurve25519 pkey + | sigPka `elem` [EdDSA, PKA.Ed25519] -> + ed25519Verify sigPka pub mpis hd pkey bs + EdDSAPubKey EdSigningCurve448 pkey + | sigPka `elem` [EdDSA, PKA.Ed448] -> + ed448Verify sigPka pub mpis hd pkey bs + _ -> verificationError (UnsupportedKeyType sigPka) dsaVerify pub (r :| [s]) hd pkey bs = if DSA.verify hd pkey (dsaMPIsToSig r s) bs then Right pub @@ -1503,9 +1491,16 @@ expiredBefore _ _ = False finalPayload :: Pkt -> ByteString -> ByteString -finalPayload s pl = BL.concat [pl, sigbit, trailer s] +finalPayload s pl = BL.concat [v6Salt s, pl, sigbit, trailer s] where sigbit = runPut $ putPartialSigforSigning s + v6Salt (SignaturePkt sigPayload) = + case fromSignaturePayloadVerifiableSignatureV sigPayload of + Just + (VerifiableSignatureV6 (SigPayloadV6Data _ _ _ salt _ _ _ _)) -> + unSignatureSalt salt + _ -> BL.empty + v6Salt _ = BL.empty trailer :: Pkt -> ByteString trailer (SignaturePkt sigPayload) = maybe 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.2.0.1 +Version: 3.2.1 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 @@ -170,6 +170,9 @@ , tests/data/seipdv2-three-recipients.pgp.aa , tests/data/seipdv2-two-recipients.pgp.aa , tests/data/encryption-sym-aes256-sha256.pgp + , tests/data/v6.msg + , tests/data/v6.txt + , tests/data/v6.txt.sig flag use-memory description: Use the 'memory' package instead of 'ram' @@ -334,4 +337,4 @@ source-repository this type: git location: https://salsa.debian.org/clint/hOpenPGP.git - tag: v3.2.0.1 + tag: v3.2.1 diff --git a/tests/Tests/Common.hs b/tests/Tests/Common.hs --- a/tests/Tests/Common.hs +++ b/tests/Tests/Common.hs @@ -41,6 +41,7 @@ , extractV4SignatureAlgorithmFields , fp , loadKeyring + , loadArmorKeyring , loadDeterministicEd25519Signer , loadDeterministicEd25519SignerV6 , loadDeterministicEd448Signer @@ -804,11 +805,23 @@ loadKeyring keyring = DC.runConduitRes $ CB.sourceFile (fixturePath keyring) - DC..| conduitGet get - DC..| conduitToSomeTKsEither - DC..| CL.map (fmap someTKToPublicViewTK . join . hush) - DC..| CL.catMaybes - DC..| sinkPublicKeyringMap + DC..| loadKeyringPipeline + +loadArmorKeyring :: FilePath -> IO PublicKeyring +loadArmorKeyring keyring = do + payload <- readFixturePayload keyring + DC.runConduitRes $ + CB.sourceLbs payload + DC..| loadKeyringPipeline + +loadKeyringPipeline + :: DC.ConduitT B.ByteString DC.Void (ResourceT IO) PublicKeyring +loadKeyringPipeline = + conduitGet get + DC..| conduitToSomeTKsEither + DC..| CL.map (fmap someTKToPublicViewTK . join . hush) + DC..| CL.catMaybes + DC..| sinkPublicKeyringMap loadAndDecompressPkts :: FilePath -> IO [Pkt] loadAndDecompressPkts = readFixtureDecompressedPackets diff --git a/tests/Tests/Keys.hs b/tests/Tests/Keys.hs --- a/tests/Tests/Keys.hs +++ b/tests/Tests/Keys.hs @@ -73,12 +73,8 @@ ( SecretKeyEncryptOptions (..) , decryptPrivateKey , decryptSecretKey - , decryptSecretKeyAddendum - , encryptSecretKey - , encryptSecretKeyWithPolicy , mkUnencryptedSKAddendum , reencryptSecretKey - , reencryptSecretKeyRandom , reinterpretUnknownSKeyForPKPayload ) import Codec.Encryption.OpenPGP.Serialize diff --git a/tests/Tests/MessageAndArmor.hs b/tests/Tests/MessageAndArmor.hs --- a/tests/Tests/MessageAndArmor.hs +++ b/tests/Tests/MessageAndArmor.hs @@ -13,8 +13,6 @@ , ArmorType (..) ) import Control.Lens ((^.)) -import qualified Crypto.PubKey.Ed25519 as Ed25519 -import qualified Crypto.PubKey.RSA as RSA import Data.Binary (get, put) import Data.Binary.Get (Get, runGetOrFail) import Data.Binary.Put @@ -29,6 +27,9 @@ import qualified Data.ByteString.Lazy as BL import Data.Either (isLeft, isRight) import Data.Foldable (forM_) +import qualified Data.IxSet.Typed as IxSet + ( toList + ) import Data.List (isInfixOf) import qualified Data.List.NonEmpty as NE import Test.Tasty (TestTree, testGroup) @@ -45,6 +46,7 @@ ( decryptPreservingNonce , validateSEIPD1MDC ) +import Codec.Encryption.OpenPGP.Compression (decompressPkt) import Codec.Encryption.OpenPGP.Encrypt ( encryptSEIPDv2WithSKESKBlock ) @@ -72,6 +74,8 @@ import Codec.Encryption.OpenPGP.SerializeForSigs ( payloadForSig , payloadForSigWith + , putPartialSigforSigning + , putSigTrailer ) import Codec.Encryption.OpenPGP.Signatures ( SignError (..) @@ -81,14 +85,11 @@ , signCertRevocationWithRSA , signCertificationWithRSA , signDataWithEd25519 - , signDataWithEd25519Builder , signDataWithEd25519V6 - , signDataWithEd25519V6Builder , signDataWithEd448 , signDataWithEd448V6 , signDataWithRSA , signDataWithRSABuilder - , signDirectKeyWithRSA , signKeyRevocationWithRSA , signSubkeyRevocationWithRSA , verifyAgainstKeyring @@ -106,9 +107,6 @@ ) import Codec.Encryption.OpenPGP.Types import qualified Codec.Encryption.OpenPGP.Types.Internal.Base as PKA -import Codec.Encryption.OpenPGP.Types.Internal.TK - ( someTKToPublicTK - ) import Data.Conduit.OpenPGP.Message ( verifyMessage , verifyMessagePackets @@ -125,6 +123,7 @@ , fp , loadAndDecompressPkts , loadArmor + , loadArmorKeyring , loadDeterministicEd25519Signer , loadDeterministicEd25519SignerV6 , loadDeterministicEd448Signer @@ -132,9 +131,9 @@ , loadKeyring , loadUnencryptedRsaSigner , loadUnencryptedRsaSignerV6 - , messageIssuerSubpacketsAt , mkTestKeyring , readFixtureLazy + , readFixtureStrict , setPKAlgorithm , signBinaryMessageWithEd25519At , signBinaryMessageWithRSAAt @@ -260,6 +259,15 @@ , testCase "streaming whitespace functions match strict variants" testStreamingWhitespaceMatchesStrict + , testCase + "v6.txt.sig V6 trailer length equals partial signature length" + testV6DetachedTrailerLength + , testCase + "v6.msg V6 trailer length equals partial signature length" + testV6MessageTrailerLength + , testCase + "v6.txt.sig verifies against v6.txt with v6-secret.pgp.aa public key" + testV6DetachedVerification ] , testGroup "ASCII armor fixture group" @@ -2859,6 +2867,88 @@ Left err -> assertFailure ( "Ed25519 SigV4 verification with Ed25519 key algorithm failed: " + ++ renderVerificationError err + ) + Right _ -> pure () + +loadV6SignatureFrom :: FilePath -> IO Pkt +loadV6SignatureFrom file = do + armors <- loadArmor file + payload <- + case armors of + [Armor _ _ p] -> pure p + _ -> + assertFailure + (file ++ " should contain one armored payload") + >> fail "expected one armored payload" + case parsePkts payload of + (sigPkt@(SignaturePkt (SigV6 _ _ _ _ _ _ _ _)) : _) -> pure sigPkt + other -> + assertFailure + ( file + ++ " should contain a SigV6 signature packet, got: " + ++ show other + ) + >> fail "expected SigV6 signature packet" + +assertV6TrailerLength :: Pkt -> Assertion +assertV6TrailerLength sigPkt = do + let partialSig = runPut (putPartialSigforSigning sigPkt) + expectedTrailer = runPut $ do + putWord8 0x06 + putWord8 0xff + putWord32be (fromIntegral (BL.length partialSig)) + actualTrailer = runPut (putSigTrailer sigPkt) + assertEqual + "V6 signature trailer length equals partial signature length (not partial + 6)" + expectedTrailer + actualTrailer + +testV6DetachedTrailerLength :: Assertion +testV6DetachedTrailerLength = do + sigPkt <- loadV6SignatureFrom "v6.txt.sig" + assertV6TrailerLength sigPkt + +testV6MessageTrailerLength :: Assertion +testV6MessageTrailerLength = do + armors <- loadArmor "v6.msg" + payload <- + case armors of + [Armor _ _ p] -> pure p + _ -> + assertFailure "v6.msg should contain one armored payload" + >> fail "expected one armored payload" + let pkts = parsePkts payload + decompressed = concatMap (either (const []) id . decompressPkt) pkts + v6Sigs = + [ SignaturePkt sig + | SignaturePkt sig@(SigV6 _ _ _ _ _ _ _ _) <- decompressed + ] + assertBool + "v6.msg should contain at least one V6 signature packet" + (not (null v6Sigs)) + forM_ v6Sigs assertV6TrailerLength + +testV6DetachedVerification :: Assertion +testV6DetachedVerification = do + keyring <- loadArmorKeyring "v6-secret.pgp.aa" + fileContents <- readFixtureStrict "v6.txt" + sigPkt <- loadV6SignatureFrom "v6.txt.sig" + let publicTKs = IxSet.toList keyring + state = + emptyPSC + { lastLD = + LiteralDataPkt BinaryData BL.empty 0 (BL.fromStrict fileContents) + } + case verifySigWith + defaultVerificationPolicy + (verifyAgainstKeys publicTKs) + sigPkt + state + Nothing of + Left err -> + assertFailure + ( "v6 detached signature should verify with v6-secret.pgp.aa public key: " ++ renderVerificationError err ) Right _ -> pure () diff --git a/tests/data/v6.msg b/tests/data/v6.msg new file mode 100644 --- /dev/null +++ b/tests/data/v6.msg @@ -0,0 +1,9 @@ +-----BEGIN PGP MESSAGE----- + +xEYGAAobIAZnWPc3iaOTXqmsLq49dDMdeY+d8QpB6JeN6N8je3aCBLW7iQgbOArh +Brulq39k17BEfv5Fbv8epvSfbah+Rf0Byw5iAAAAAAB2ZWUgc2l4CsKYBgAbCgAA +ACkFgmp6do8iIQYEtbuJCBs4CuEGu6Wrf2TXsER+/kVu/x6m9J9tqH5F/QAAAAA4 +2SAGZ1j3N4mjk16prC6uPXQzHXmPnfEKQeiXjejfI3t2guAkHYrXf08Q6plu9Cy0 +EPUl8rFyf7aYa9eHXanmUL4AtrscpZ9N6+am3mmIwY1tb59okpQ0XkkbhGz3VtZ+ +cAA= +-----END PGP MESSAGE----- diff --git a/tests/data/v6.txt b/tests/data/v6.txt new file mode 100644 --- /dev/null +++ b/tests/data/v6.txt @@ -0,0 +1,1 @@ +vee six diff --git a/tests/data/v6.txt.sig b/tests/data/v6.txt.sig new file mode 100644 --- /dev/null +++ b/tests/data/v6.txt.sig @@ -0,0 +1,7 @@ +-----BEGIN PGP SIGNATURE----- + +wpgGABsKAAAAKQWCanp2pyIhBgS1u4kIGzgK4Qa7pat/ZNewRH7+RW7/Hqb0n22o +fkX9AAAAADPIIHP16EU0Q6gmc1h8ROLFmA6v8bX6xZH9EZpIhItuRDee/6cLBU6F +YCn080AzDt0oF7z427CPrSAo6afVbRpXshK/UV2j9H7P/jmbSA52ljHLoxQxcuQK +fwPZmQgY6q2PBA== +-----END PGP SIGNATURE-----