From 4b2ca9364e1ca90f4e1e9b3d20508cf0e4aed140 Mon Sep 17 00:00:00 2001 From: shum Date: Fri, 2 Oct 2026 11:06:54 +0000 Subject: [PATCH] smp-server: reject corrId nonces of wrong size --- src/Simplex/Messaging/Protocol.hs | 13 +++++++- src/Simplex/Messaging/Server.hs | 36 ++++++++++++----------- tests/SMPProxyTests.hs | 49 ++++++++++++++++++++++++++++++- tests/ServerTests.hs | 44 ++++++++++++++++++++++----- 4 files changed, 116 insertions(+), 26 deletions(-) diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 14f2a967f..f6599b060 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -125,6 +125,7 @@ module Simplex.Messaging.Protocol SrvLoc (..), CorrId (..), pattern NoCorrId, + corrIdNonce, EntityId (..), pattern NoEntity, QueueId, @@ -249,6 +250,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as LB import Data.Char (isPrint, isSpace) import Data.Constraint (Dict (..)) +import Data.Either (isLeft) import Data.Functor (($>)) import Data.Int (Int64) import Data.Kind @@ -1427,6 +1429,10 @@ instance IsString CorrId where fromString = CorrId . fromString {-# INLINE fromString #-} +-- | Fails unless corrId is exactly 24 bytes, so it is never padded or truncated. +corrIdNonce :: CorrId -> Either String C.CbNonce +corrIdNonce = smpDecode . bs + instance StrEncoding CorrId where strEncode (CorrId cId) = strEncode cId strDecode s = CorrId <$> strDecode s @@ -2409,7 +2415,12 @@ tDecodeServer THandleParams {sessionId, thVersion = v, implySessId} = \case | implySessId || sessId == sessionId -> case decodeTAuthBytes authenticator serviceSig of Right tAuth -> bimap t ((tAuth,authorized,) . t) cmdOrErr where - cmdOrErr = parseProtocol @v @err @cmd v command >>= checkCredentials tAuth entityId + cmdOrErr + | invalidAuthNonce = Left $ fromProtocolError @v @err @cmd PECmdSyntax + | otherwise = parseProtocol @v @err @cmd v command >>= checkCredentials tAuth entityId + invalidAuthNonce = case tAuth of + Just (TAAuthenticator _, _) -> isLeft $ corrIdNonce corrId + _ -> False t :: a -> (CorrId, EntityId, a) t = (corrId,entityId,) Left _ -> tError corrId PEBlock diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 405e9b5f0..7c02290b9 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -64,7 +64,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.Constraint (Dict (..)) import Data.Dynamic (toDyn) -import Data.Either (fromRight, partitionEithers) +import Data.Either (fromRight, isLeft, partitionEithers) import Data.Foldable (foldrM) import Data.Functor (($>), (<&>)) import Data.IORef @@ -1453,20 +1453,22 @@ client Just THAuthClient {peerServerCertKey} -> PKEY srvSessId vr peerServerCertKey Nothing -> ERR $ transportErr TENoServerAuth _ -> ERR $ transportErr TEVersion - PFWD fwdV pubKey encBlock -> do - ProxyAgent {smpAgent = a} <- asks proxyAgent - ServerStats {pMsgFwds, pMsgFwdsOwn} <- asks serverStats - let inc = mkIncProxyStats pMsgFwds pMsgFwdsOwn - liftIO (lookupSMPServerClient a sessId) >>= \case - Just (own, smp) -> do - inc own pRequests - forkProxiedCmd $ do - liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `E.catches` clientHandlers) >>= \case - Right r -> PRES r <$ inc own pSuccesses - Left e -> ERR (smpProxyError e) <$ case e of - PCEProtocolError {} -> inc own pSuccesses - _ -> inc own pErrorsOther - Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION) + PFWD fwdV pubKey encBlock + | isLeft (corrIdNonce corrId) -> pure $ Just $ ERR $ CMD SYNTAX + | otherwise -> do + ProxyAgent {smpAgent = a} <- asks proxyAgent + ServerStats {pMsgFwds, pMsgFwdsOwn} <- asks serverStats + let inc = mkIncProxyStats pMsgFwds pMsgFwdsOwn + liftIO (lookupSMPServerClient a sessId) >>= \case + Just (own, smp) -> do + inc own pRequests + forkProxiedCmd $ do + liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `E.catches` clientHandlers) >>= \case + Right r -> PRES r <$ inc own pSuccesses + Left e -> ERR (smpProxyError e) <$ case e of + PCEProtocolError {} -> inc own pSuccesses + _ -> inc own pErrorsOther + Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION) where forkProxiedCmd :: M s BrokerMsg -> M s (Maybe BrokerMsg) forkProxiedCmd = forkCmd serverClientConcurrency corrId (EntityId sessId) @@ -2125,12 +2127,12 @@ client processForwardedCommand (EncFwdTransmission s) = fmap (either (Just . ERR) id) . runExceptT $ do THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams') sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret' - let proxyNonce = C.cbNonce $ bs corrId + proxyNonce <- liftEitherWith (const $ CMD SYNTAX) $ corrIdNonce corrId s' <- liftEitherWith (const CRYPTO) $ C.cbDecryptNoPad sessSecret proxyNonce s FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission et} <- liftEitherWith (const $ CMD SYNTAX) $ smpDecode s' unless (fwdVersion `isCompatible` thServerVRange thParams') $ throwE $ transportErr TEVersion + clientNonce <- liftEitherWith (const $ CMD SYNTAX) $ corrIdNonce fwdCorrId let clientSecret = C.dh' fwdKey serverPrivKey - clientNonce = C.cbNonce $ bs fwdCorrId b <- liftEitherWith (const CRYPTO) $ C.cbDecrypt clientSecret clientNonce et let clntTHParams = smpTHParamsSetVersion fwdVersion thParams' -- only allowing single forwarded transactions diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs index 430d52304..95548d4ba 100644 --- a/tests/SMPProxyTests.hs +++ b/tests/SMPProxyTests.hs @@ -26,7 +26,7 @@ import qualified Data.List.NonEmpty as L import Data.Time.Clock (getCurrentTime) import SMPAgentClient import SMPClient -import ServerTests (decryptMsgV3, sendRecv) +import ServerTests (decryptMsgV3, sendRecv, wrongSizeCorrIds) import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage) import qualified Simplex.Messaging.Agent as A import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..)) @@ -36,11 +36,13 @@ import Simplex.Messaging.Client import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.Ratchet (pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR +import Simplex.Messaging.Encoding (smpEncode) import Simplex.Messaging.Protocol (EncRcvMsgBody (..), MsgBody, QueueReqData (..), RcvMessage (..), SubscriptionMode (..), maxMessageLength, noMsgFlags) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Server.Env.STM (AStoreType (..), ServerConfig (..)) import Simplex.Messaging.Server.MsgStore.Types (SQSType (..)) import Simplex.Messaging.Transport +import qualified Simplex.Messaging.Transport.Client as TC import Simplex.Messaging.Util (bshow, tshow) import Simplex.Messaging.Version (mkVersionRange) import System.FilePath (splitExtensions) @@ -58,6 +60,9 @@ smpProxyTests = do describe "server configuration" $ do it "refuses proxy handshake unless enabled" testNoProxy it "checks basic auth in proxy requests" testProxyAuth + describe "corrId used as nonce" $ do + it "proxy rejects PFWD with corrId of wrong size" testPFWDCorrIdSize + it "relay rejects RFWD with corrId of wrong size" testRFWDCorrIdSize describe "relay reconnection" $ do it "recovers when unresponsive relay restarts (control, no disconnect)" $ \_ -> testProxyRecoversWithoutDisconnect @@ -441,6 +446,48 @@ testProxyAuth msType = do where proxyCfgAuth = updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {newQueueBasicAuth = Just "correct"} +testPFWDCorrIdSize :: AStoreType -> IO () +testPFWDCorrIdSize msType = + withSmpServerConfigOn (transport @TLS) (proxyCfgMS msType) testPort $ \_ -> + testSMPClient_ "127.0.0.1" testPort supportedServerSMPRelayVRange Nothing $ \(th@THandle {params} :: THandleSMP TLS 'TClient) -> do + g <- C.newRandom + (cmdKey, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g + let pfwd corrId = do + (_, _, reply) <- sendRecv th (Nothing, corrId, SMP.EntityId "unknown session", SMP.PFWD (thVersion params) cmdKey $ SMP.EncTransmission "invalid") + pure reply + corrId <- atomically $ C.randomBytes 24 g + pfwd corrId `shouldReturn` Right (SMP.ERR $ SMP.PROXY SMP.NO_SESSION) + forM_ (wrongSizeCorrIds corrId) $ \badCorrId -> + pfwd badCorrId `shouldReturn` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX) + +testRFWDCorrIdSize :: AStoreType -> IO () +testRFWDCorrIdSize msType = + withSmpServerConfigOn (transport @TLS) (cfgMS msType) testPort2 $ \_ -> + testProxyModeClient $ \th@THandle {params = THandleParams {thVersion, thAuth}} -> do + Just THAuthClient {sessSecret = Just sessSecret} <- pure thAuth + g <- C.newRandom + (fwdKey, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g + let rfwd corrId fwdCorrId = do + let fwdT = SMP.FwdTransmission {fwdCorrId = SMP.CorrId fwdCorrId, fwdVersion = thVersion, fwdKey, fwdTransmission = SMP.EncTransmission "invalid"} + eft = SMP.EncFwdTransmission $ C.cbEncryptNoPad sessSecret (C.cbNonce corrId) (smpEncode fwdT) + (_, _, reply) <- sendRecv th (Nothing, corrId, NoEntity, SMP.RFWD eft) + pure reply + corrId <- atomically $ C.randomBytes 24 g + fwdCorrId <- atomically $ C.randomBytes 24 g + rfwd corrId fwdCorrId `shouldReturn` Right (SMP.ERR SMP.CRYPTO) + forM_ (wrongSizeCorrIds corrId) $ \badCorrId -> do + rfwd badCorrId fwdCorrId `shouldReturn` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX) + rfwd corrId badCorrId `shouldReturn` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX) + +-- Connect to the relay on testPort2 the same way the proxy does, with the session secret. +testProxyModeClient :: (THandleSMP TLS 'TClient -> IO a) -> IO a +testProxyModeClient client = do + g <- C.newRandom + ks <- atomically $ C.generateKeyPair g + let tcConfig = TC.defaultTransportClientConfig {TC.clientALPN = Just alpnSupportedSMPHandshakes} + TC.runTransportClient tcConfig Nothing "127.0.0.1" testPort2 (Just testKeyHash) $ \h -> + runExceptT (smpClientHandshake h (Just ks) testKeyHash supportedClientSMPRelayVRange True Nothing) >>= either (fail . show) client + -- Connect a sender client to the proxy and request a relay session to testSMPServer2 (PRXY). -- On success the reply is PKEY; otherwise it is the proxy error for the relay connection. requestRelaySession :: IO (Either SMP.ErrorType SMP.BrokerMsg) diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs index 116b4f0ec..d16f3a210 100644 --- a/tests/ServerTests.hs +++ b/tests/ServerTests.hs @@ -97,6 +97,7 @@ serverTests = do describe "Restore messages (old / v2)" testRestoreExpireMessages describe "Save prometheus metrics" testPrometheusMetrics describe "Timing of AUTH error" testTiming + describe "Authenticator nonce" testAuthenticatorCorrIdSize describe "Message notifications" $ do testMessageNotifications testMessageServiceNotifications @@ -1302,9 +1303,9 @@ testTiming = g <- C.newRandom (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g - Resp "abcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", NoEntity, New rPub dhPub) + Resp "abcdabcdabcdabcdabcdabcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcdabcdabcdabcdabcdabcd", NoEntity, New rPub dhPub) let dec = decryptMsgV3 $ C.dh' srvDh dhPriv - Resp "cdab" _ resp <- signSendRecv rh rKey ("cdab", rId, SUB) + Resp "cdabcdabcdabcdabcdabcdab" _ resp <- signSendRecv rh rKey ("cdabcdabcdabcdabcdabcdab", rId, SUB) case resp of OK -> pure () SOK Nothing -> pure () @@ -1314,9 +1315,9 @@ testTiming = runTimingTest rh badKey rId SUB (sPub, sKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g - Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, KEY sPub) + Resp "dabcdabcdabcdabcdabcdabc" _ OK <- signSendRecv rh rKey ("dabcdabcdabcdabcdabcdabc", rId, KEY sPub) - Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, _SEND "hello") + Resp "bcdabcdabcdabcdabcdabcda" _ OK <- signSendRecv sh sKey ("bcdabcdabcdabcdabcdabcda", sId, _SEND "hello") Resp "" _ (Msg mId msg) <- tGet1 rh (dec mId msg, Right "hello") #== "delivered from queue" @@ -1327,15 +1328,15 @@ testTiming = threadDelay 100000 _ <- timeRepeat n $ do -- "warm up" the server - Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd) + Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd) return () threadDelay 100000 timeWrongKey <- timeRepeat n $ do - Resp "cdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdab", qId, cmd) + Resp "cdabcdabcdabcdabcdabcdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdabcdabcdabcdabcdabcdab", qId, cmd) return () threadDelay 100000 timeNoQueue <- timeRepeat n $ do - Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd) + Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd) return () let ok = similarTime timeNoQueue timeWrongKey msType unless ok . putStrLn . unwords $ @@ -1347,6 +1348,35 @@ testTiming = ] ok `shouldBe` True +testAuthenticatorCorrIdSize :: SpecWith (ASrvTransport, AStoreType) +testAuthenticatorCorrIdSize = + it "should reject X25519 authenticator unless corrId is 24 bytes" $ \(ATransport t, msType) -> + smpTest2 t msType $ \r s -> do + g <- C.newRandom + let newCorrId = atomically $ C.randomBytes 24 g + rejected cId entId = (CorrId cId, entId, Right (ERR $ CMD SYNTAX)) + badCorrIds <- wrongSizeCorrIds <$> newCorrId + (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SX25519 g + (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g + forM_ badCorrIds $ \cId -> + signSendRecv r rKey (cId, NoEntity, New rPub dhPub) `shouldReturn` rejected cId NoEntity + corrId1 <- newCorrId + Resp _ NoEntity (Ids rId sId srvDh) <- signSendRecv r rKey (corrId1, NoEntity, New rPub dhPub) + (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + corrId2 <- newCorrId + Resp _ _ OK <- signSendRecv r rKey (corrId2, rId, KEY sPub) + Resp "bcda" _ OK <- signSendRecv s sKey ("bcda", sId, _SEND "hello") + Resp "" _ (Msg mId msg) <- tGet1 r + (decryptMsgV3 (C.dh' srvDh dhPriv) mId msg, Right "hello") #== "delivered from queue" + forM_ badCorrIds $ \cId -> + signSendRecv r rKey (cId, rId, ACK mId) `shouldReturn` rejected cId rId + corrId3 <- newCorrId + Resp _ _ OK <- signSendRecv r rKey (corrId3, rId, ACK mId) + pure () + +wrongSizeCorrIds :: ByteString -> [ByteString] +wrongSizeCorrIds corrId = ["", B.take 4 corrId, corrId <> "x"] + testMessageNotifications :: SpecWith (ASrvTransport, AStoreType) testMessageNotifications = it "should create simplex connection, subscribe notifier and deliver notifications" $ \(ATransport t, msType) -> do