From 7aacee405ea12e1b935e4dc18543ddb90eda1e38 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 7 May 2021 06:57:53 +0100 Subject: [PATCH] agent: send CON to user when the 1st party responds HELLO; fix REPLY vulnerability (#130) * agent: send CON to user when the 1st party responds HELLO; fix REPLY vulnerability * test for getRcvConn * add commented OK response to JOIN command * store: use Only newtype to select one field --- src/Simplex/Messaging/Agent.hs | 164 ++++++++++++-------- src/Simplex/Messaging/Agent/Store.hs | 3 +- src/Simplex/Messaging/Agent/Store/SQLite.hs | 36 ++--- tests/AgentTests.hs | 4 +- tests/AgentTests/SQLiteTests.hs | 12 +- 5 files changed, 120 insertions(+), 99 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index b3e1a80b7..9acfd888c 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -165,7 +165,8 @@ processCommand c@AgentClient {sndQ} st (corrId, connAlias, cmd) = withStore $ createSndConn st sq connectToSendQueue c st sq senderKey verifyKey when (replyMode == On) $ createReplyQueue sq - respond CON + -- TODO this response is disabled to avoid two responses in terminal client (OK + CON), + -- respond OK subscribeConnection :: ConnAlias -> m () subscribeConnection cAlias = @@ -257,15 +258,44 @@ subscriber c@AgentClient {msgQ} st = forever $ do processSMPTransmission :: forall m. AgentMonad m => AgentClient -> SQLiteStore -> SMPServerTransmission -> m () processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do - rq@RcvQueue {connAlias, status} <- withStore $ getRcvQueue st srv rId - case cmd of - SMP.MSG srvMsgId srvTs msgBody -> do - -- TODO deduplicate with previously received - msg <- decryptAndVerify rq msgBody - let msgHash = C.sha256Hash msg - agentMsg <- liftEither $ parseSMPMessage msg - case agentMsg of - SMPConfirmation senderKey -> do + withStore (getRcvConn st srv rId) >>= \case + SomeConn SCDuplex (DuplexConnection _ rq _) -> processSMP SCDuplex rq + SomeConn SCRcv (RcvConnection _ rq) -> processSMP SCRcv rq + _ -> atomically $ writeTBQueue sndQ ("", "", ERR $ CONN SIMPLEX) + where + processSMP :: SConnType c -> RcvQueue -> m () + processSMP cType rq@RcvQueue {connAlias, status} = + case cmd of + SMP.MSG srvMsgId srvTs msgBody -> do + -- TODO deduplicate with previously received + msg <- decryptAndVerify rq msgBody + let msgHash = C.sha256Hash msg + agentMsg <- liftEither $ parseSMPMessage msg + case agentMsg of + SMPConfirmation senderKey -> smpConfirmation senderKey + SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} -> + case agentMessage of + HELLO verifyKey _ -> helloMsg verifyKey msgBody + REPLY qInfo -> replyMsg qInfo + A_MSG body -> agentClientMsg previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash + sendAck c rq + return () + SMP.END -> do + removeSubscription c connAlias + logServer "<--" c srv rId "END" + notify END + _ -> do + logServer "<--" c srv rId $ "unexpected: " <> bshow cmd + notify . ERR $ BROKER UNEXPECTED + where + notify :: ACommand 'Agent -> m () + notify msg = atomically $ writeTBQueue sndQ ("", connAlias, msg) + + prohibited :: m () + prohibited = notify . ERR $ AGENT A_PROHIBITED + + smpConfirmation :: SenderPublicKey -> m () + smpConfirmation senderKey = do logServer "<--" c srv rId "MSG " case status of New -> do @@ -275,68 +305,64 @@ processSMPTransmission c@AgentClient {sndQ} st (srv, rId, cmd) = do -- TODO update sender key in the store? secureQueue c rq senderKey withStore $ setRcvQueueStatus st rq Secured - _ -> notify connAlias . ERR $ AGENT A_PROHIBITED - SMPMessage {agentMessage, senderMsgId, senderTimestamp, previousMsgHash} -> - case agentMessage of - HELLO verifyKey _ -> do - logServer "<--" c srv rId "MSG " - case status of - Active -> notify connAlias . ERR $ AGENT A_PROHIBITED - _ -> do - void $ verifyMessage (Just verifyKey) msgBody - withStore $ setRcvQueueActive st rq verifyKey - REPLY qInfo -> do - logServer "<--" c srv rId "MSG " + _ -> prohibited + + helloMsg :: SenderPublicKey -> ByteString -> m () + helloMsg verifyKey msgBody = do + logServer "<--" c srv rId "MSG " + case status of + Active -> prohibited + _ -> do + void $ verifyMessage (Just verifyKey) msgBody + withStore $ setRcvQueueActive st rq verifyKey + case cType of + SCDuplex -> notify CON + _ -> pure () + + replyMsg :: SMPQueueInfo -> m () + replyMsg qInfo = do + logServer "<--" c srv rId "MSG " + case cType of + SCRcv -> do (sq, senderKey, verifyKey) <- newSendQueue qInfo connAlias withStore $ upgradeRcvConnToDuplex st connAlias sq connectToSendQueue c st sq senderKey verifyKey - notify connAlias CON - A_MSG body -> agentClientMsg rq previousMsgHash (senderMsgId, senderTimestamp) (srvMsgId, srvTs) body msgHash - sendAck c rq - return () - SMP.END -> do - removeSubscription c connAlias - logServer "<--" c srv rId "END" - notify connAlias END - _ -> do - logServer "<--" c srv rId $ "unexpected: " <> bshow cmd - notify connAlias . ERR $ BROKER UNEXPECTED - where - notify :: ConnAlias -> ACommand 'Agent -> m () - notify connAlias msg = atomically $ writeTBQueue sndQ ("", connAlias, msg) - agentClientMsg :: RcvQueue -> PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m () - agentClientMsg rq@RcvQueue {connAlias, status} receivedPrevMsgHash senderMeta brokerMeta msgBody msgHash = do - logServer "<--" c srv rId "MSG " - case status of - Active -> do - internalTs <- liftIO getCurrentTime - (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore $ updateRcvIds st rq - let msgIntegrity = checkMsgIntegrity prevExtSndId (fst senderMeta) prevRcvMsgHash - withStore $ - createRcvMsg st rq $ - RcvMsgData - { internalId, - internalRcvId, - internalTs, - senderMeta, - brokerMeta, - msgBody, - internalHash = msgHash, - externalPrevSndHash = receivedPrevMsgHash, - msgIntegrity - } - notify connAlias $ - MSG - { recipientMeta = (unId internalId, internalTs), - senderMeta, - brokerMeta, - msgBody, - msgIntegrity - } - _ -> notify connAlias . ERR $ AGENT A_PROHIBITED - where - checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> MsgIntegrity - checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash + notify CON + _ -> prohibited + + agentClientMsg :: PrevRcvMsgHash -> (ExternalSndId, ExternalSndTs) -> (BrokerId, BrokerTs) -> MsgBody -> MsgHash -> m () + agentClientMsg receivedPrevMsgHash senderMeta brokerMeta msgBody msgHash = do + logServer "<--" c srv rId "MSG " + case status of + Active -> do + internalTs <- liftIO getCurrentTime + (internalId, internalRcvId, prevExtSndId, prevRcvMsgHash) <- withStore $ updateRcvIds st rq + let msgIntegrity = checkMsgIntegrity prevExtSndId (fst senderMeta) prevRcvMsgHash receivedPrevMsgHash + withStore $ + createRcvMsg st rq $ + RcvMsgData + { internalId, + internalRcvId, + internalTs, + senderMeta, + brokerMeta, + msgBody, + internalHash = msgHash, + externalPrevSndHash = receivedPrevMsgHash, + msgIntegrity + } + notify + MSG + { recipientMeta = (unId internalId, internalTs), + senderMeta, + brokerMeta, + msgBody, + msgIntegrity + } + _ -> prohibited + + checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity + checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash | extSndId == prevExtSndId + 1 && internalPrevMsgHash == receivedPrevMsgHash = MsgOk | extSndId < prevExtSndId = MsgError $ MsgBadId extSndId | extSndId == prevExtSndId = MsgError MsgDuplicate -- ? deduplicate diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs index 778b6b6be..06089ca73 100644 --- a/src/Simplex/Messaging/Agent/Store.hs +++ b/src/Simplex/Messaging/Agent/Store.hs @@ -34,7 +34,7 @@ class Monad m => MonadAgentStore s m where createSndConn :: s -> SndQueue -> m () getConn :: s -> ConnAlias -> m SomeConn getAllConnAliases :: s -> m [ConnAlias] -- TODO remove - hack for subscribing to all - getRcvQueue :: s -> SMPServer -> SMP.RecipientId -> m RcvQueue + getRcvConn :: s -> SMPServer -> SMP.RecipientId -> m SomeConn deleteConn :: s -> ConnAlias -> m () upgradeRcvConnToDuplex :: s -> ConnAlias -> SndQueue -> m () upgradeSndConnToDuplex :: s -> ConnAlias -> RcvQueue -> m () @@ -148,6 +148,7 @@ type PrevRcvMsgHash = MsgHash type PrevSndMsgHash = MsgHash -- ? merge/replace these with RcvMsg and SndMsg + -- * Message data containers - used on Msg creation to reduce number of parameters data RcvMsgData = RcvMsgData diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index 39e21a777..9578cf384 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -29,7 +29,7 @@ import Data.Maybe (fromMaybe) import Data.Text (isPrefixOf) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) -import Database.SQLite.Simple (FromRow, NamedParam (..), SQLData (..), SQLError, field) +import Database.SQLite.Simple (FromRow, NamedParam (..), Only (..), SQLData (..), SQLError, field) import qualified Database.SQLite.Simple as DB import Database.SQLite.Simple.FromField import Database.SQLite.Simple.Internal (Field (..)) @@ -115,26 +115,20 @@ instance (MonadUnliftIO m, MonadError StoreError m) => MonadAgentStore SQLiteSto r <- DB.query_ dbConn "SELECT conn_alias FROM connections;" :: IO [[ConnAlias]] return (concat r) - getRcvQueue :: SQLiteStore -> SMPServer -> SMP.RecipientId -> m RcvQueue - getRcvQueue SQLiteStore {dbConn} SMPServer {host, port} rcvId = do - r <- - liftIO $ - DB.queryNamed - dbConn - [sql| - SELECT - s.key_hash, q.host, q.port, q.rcv_id, q.conn_alias, q.rcv_private_key, - q.snd_id, q.snd_key, q.decrypt_key, q.verify_key, q.status - FROM rcv_queues q - INNER JOIN servers s ON q.host = s.host AND q.port = s.port - WHERE q.host = :host AND q.port = :port AND q.rcv_id = :rcv_id; - |] - [":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId] - case r of - [(keyHash, hst, prt, rId, connAlias, rcvPrivateKey, sndId, sndKey, decryptKey, verifyKey, status)] -> - let srv = SMPServer hst (deserializePort_ prt) keyHash - in pure $ RcvQueue srv rId connAlias rcvPrivateKey sndId sndKey decryptKey verifyKey status - _ -> throwError SEConnNotFound + getRcvConn :: SQLiteStore -> SMPServer -> SMP.RecipientId -> m SomeConn + getRcvConn SQLiteStore {dbConn} SMPServer {host, port} rcvId = + liftIOEither . DB.withTransaction dbConn $ + DB.queryNamed + dbConn + [sql| + SELECT q.conn_alias + FROM rcv_queues q + WHERE q.host = :host AND q.port = :port AND q.rcv_id = :rcv_id; + |] + [":host" := host, ":port" := serializePort_ port, ":rcv_id" := rcvId] + >>= \case + [Only connAlias] -> getConn_ dbConn connAlias + _ -> pure $ Left SEConnNotFound deleteConn :: SQLiteStore -> ConnAlias -> m () deleteConn SQLiteStore {dbConn} connAlias = diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs index e4d01ec96..712b5e7ec 100644 --- a/tests/AgentTests.hs +++ b/tests/AgentTests.hs @@ -87,7 +87,7 @@ testDuplexConnection :: Handle -> Handle -> IO () testDuplexConnection alice bob = do ("1", "bob", Right (INV qInfo)) <- alice #: ("1", "bob", "NEW") let qInfo' = serializeSmpQueueInfo qInfo - bob #: ("11", "alice", "JOIN " <> qInfo') #> ("11", "alice", CON) + bob #: ("11", "alice", "JOIN " <> qInfo') #> ("", "alice", CON) alice <# ("", "bob", CON) alice #: ("2", "bob", "SEND :hello") =#> \case ("2", "bob", SENT 1) -> True; _ -> False alice #: ("3", "bob", "SEND :how are you?") =#> \case ("3", "bob", SENT 2) -> True; _ -> False @@ -106,7 +106,7 @@ testSubscription :: Handle -> Handle -> Handle -> IO () testSubscription alice1 alice2 bob = do ("1", "bob", Right (INV qInfo)) <- alice1 #: ("1", "bob", "NEW") let qInfo' = serializeSmpQueueInfo qInfo - bob #: ("11", "alice", "JOIN " <> qInfo') #> ("11", "alice", CON) + bob #: ("11", "alice", "JOIN " <> qInfo') #> ("", "alice", CON) bob #: ("12", "alice", "SEND 5\nhello") =#> \case ("12", "alice", SENT _) -> True; _ -> False bob #: ("13", "alice", "SEND 11\nhello again") =#> \case ("13", "alice", SENT _) -> True; _ -> False alice1 <# ("", "bob", CON) diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs index 5442705f0..798d90a7a 100644 --- a/tests/AgentTests/SQLiteTests.hs +++ b/tests/AgentTests/SQLiteTests.hs @@ -64,7 +64,7 @@ storeTests = withStore do testCreateSndConn testCreateSndConnDuplicate describe "getAllConnAliases" testGetAllConnAliases - describe "getRcvQueue" testGetRcvQueue + describe "getRcvConn" testGetRcvConn describe "deleteConn" do testDeleteRcvConn testDeleteSndConn @@ -178,14 +178,14 @@ testGetAllConnAliases = do getAllConnAliases store `returnsResult` ["conn1" :: ConnAlias, "conn2" :: ConnAlias] -testGetRcvQueue :: SpecWith SQLiteStore -testGetRcvQueue = do - it "should get RcvQueue" $ \store -> do +testGetRcvConn :: SpecWith SQLiteStore +testGetRcvConn = do + it "should get connection using rcv queue id and server" $ \store -> do let smpServer = SMPServer "smp.simplex.im" (Just "5223") testKeyHash let recipientId = "1234" _ <- runExceptT $ createRcvConn store rcvQueue1 - getRcvQueue store smpServer recipientId - `returnsResult` rcvQueue1 + getRcvConn store smpServer recipientId + `returnsResult` SomeConn SCRcv (RcvConnection (connAlias (rcvQueue1 :: RcvQueue)) rcvQueue1) testDeleteRcvConn :: SpecWith SQLiteStore testDeleteRcvConn = do