mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-10-04 21:08:04 +00:00
smp-server: reject corrId nonces of wrong size
This commit is contained in:
shum
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+48
-1
@@ -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)
|
||||
|
||||
+37
-7
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user