From 8b804a4fbacf23d694c375ae99fa290cb2d59266 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Tue, 29 Sep 2026 23:01:33 +0100 Subject: [PATCH] core: restrict body size for XRCP commands and responses, limit decompressed size (#7616) Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> --- src/Simplex/Chat/Remote.hs | 2 +- src/Simplex/Chat/Remote/Protocol.hs | 22 +++++++----- tests/RemoteTests.hs | 52 ++++++++++++++++++++++++++++- 3 files changed, 65 insertions(+), 11 deletions(-) diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index 4de4f4f6b7..70c4943ea3 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -517,7 +517,7 @@ handleRemoteCommand execCC encryption remoteOutputQ HTTP2Request {request, reqBo where parseRequest :: ExceptT RemoteProtocolError IO (C.SbKeyNonce, GetChunk, RemoteCommand) parseRequest = do - (rfKN, header, getNext) <- parseDecryptHTTP2Body encryption request reqBody + (rfKN, header, getNext) <- parseDecryptHTTP2Body maxCommandBodySize encryption request reqBody (rfKN,getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecodeStrict header) replyError = reply . RRChatResponse . RRError processCommand :: User -> C.SbKeyNonce -> GetChunk -> RemoteCommand -> CM () diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs index b71c6baed8..6f187b98fb 100644 --- a/src/Simplex/Chat/Remote/Protocol.hs +++ b/src/Simplex/Chat/Remote/Protocol.hs @@ -40,7 +40,8 @@ import Simplex.Chat.Controller import Simplex.Chat.Remote.Transport import Simplex.Chat.Remote.Types import Simplex.Chat.Types (BoolDef (..)) -import Simplex.FileTransfer.Description (FileDigest (..)) +import Simplex.FileTransfer.Description (FileDigest (..), mb) +import Simplex.Messaging.Compression (limitDecompress') import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) import Simplex.Messaging.Crypto.Lazy (LazyByteString) @@ -180,7 +181,7 @@ sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} file_ encFile_ <- mapM (prepareEncryptedFile sfKN) file_ let req = httpRequest encFile_ encCmd HTTP2Response {response, respBody} <- liftError' (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing - (rfKN, header, getNext) <- parseDecryptHTTP2Body encryption response respBody + (rfKN, header, getNext) <- parseDecryptHTTP2Body maxResponseBodySize encryption response respBody rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecodeStrict header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding pure (rfKN, getNext, rr) where @@ -273,9 +274,15 @@ encryptEncodeHTTP2Body corrId cmdKN RemoteCrypto {sessionCode, signatures, compr sign :: C.PrivateKeyEd25519 -> CH.Context SHA512 -> ByteString sign k = C.signatureBytes . C.sign' k . BA.convert . CH.hashFinalize +maxCommandBodySize :: Int +maxCommandBodySize = mb 64 + +maxResponseBodySize :: Int +maxResponseBodySize = mb 512 + -- | Parse and decrypt HTTP2 request/response -parseDecryptHTTP2Body :: HTTP2BodyChunk a => RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, ByteString, Int -> IO ByteString) -parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures, compression} hr HTTP2Body {bodyBuffer} = do +parseDecryptHTTP2Body :: HTTP2BodyChunk a => Int -> RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, ByteString, Int -> IO ByteString) +parseDecryptHTTP2Body maxSize rc@RemoteCrypto {sessionCode, signatures, compression} hr HTTP2Body {bodyBuffer} = do (corrId, ct) <- getBody (cmdKN, rfKN) <- ExceptT $ atomically $ getRemoteRcvKeys rc corrId s <- liftError PRERemoteControl $ RC.rcDecryptBody cmdKN ct @@ -287,7 +294,7 @@ parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures, compression} hr corrIdStr <- liftIO $ getNext 4 ctLenStr <- liftIO $ getNext 4 let ctLen = decodeWord32 ctLenStr - when (ctLen > fromIntegral (maxBound :: Int)) $ throwError RPEInvalidSize + when (ctLen > fromIntegral maxSize) $ throwError RPEInvalidSize chunks <- liftIO $ getLazy $ fromIntegral ctLen let hc = CH.hashUpdates (CH.hashInit @SHA512) [corrIdStr, ctLenStr] hc' = CH.hashUpdates hc chunks @@ -330,8 +337,5 @@ parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures, compression} hr getNext sz = getBuffered bodyBuffer sz Nothing $ getBodyChunk hr decompress :: LazyByteString -> ExceptT RemoteProtocolError IO ByteString decompress s - | compression = case Z1.decompress $ LB.toStrict s of - Z1.Error e -> throwError $ RPEInvalidBody e - Z1.Skip -> pure B.empty - Z1.Decompress s' -> pure s' + | compression = liftEitherWith RPEInvalidBody $ limitDecompress' maxSize $ LB.toStrict s | otherwise = pure $ LB.toStrict s diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index 1bb6ac34eb..3b1cfa1cae 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -14,19 +14,26 @@ import Control.Monad import Control.Monad.Except (runExceptT) import qualified Data.Aeson as J import qualified Data.ByteString as B +import Data.ByteString.Builder (toLazyByteString) import qualified Data.ByteString.Lazy.Char8 as LB import Data.List (find, isPrefixOf) import qualified Data.Map.Strict as M +import Data.Word (Word32) import Simplex.Chat.Controller (ChatCommand (..), ChatConfig (..), versionNumber) import Simplex.Chat.Files (safeFileNameStr) import Simplex.Chat.Library.Commands (parseChatCommand) import qualified Simplex.Chat.Controller as Controller import Simplex.Chat.Mobile.File import Simplex.Chat.Remote (remoteFilesFolder, validRemoteFileName) -import Simplex.Chat.Remote.Protocol (remoteStoreFile) +import Simplex.Chat.Remote.Protocol (encryptEncodeHTTP2Body, parseDecryptHTTP2Body, remoteStoreFile) import Simplex.Chat.Remote.Types +import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) +import Simplex.Messaging.Encoding (smpEncode) import Simplex.Messaging.Encoding.String (strEncode) +import qualified Simplex.Messaging.TMap as TM +import Simplex.Messaging.Transport (TSbChainKeys (..)) +import Simplex.Messaging.Transport.HTTP2 (HTTP2BodyChunk (..), getHTTP2Body) import Simplex.Messaging.Util import Simplex.RemoteControl.Types (RCCtrlAddress (..)) import System.FilePath (takeFileName, ()) @@ -54,6 +61,24 @@ remoteTests = describe "Remote" $ do filter (not . sanitized) fileNames `shouldBe` [] it "sanitizes to a name with no directory components" $ \_ -> filter (not . bareName) fileNames `shouldBe` [] + describe "body size limit" $ do + it "rejects encrypted body above limit without reading it" $ \_ -> do + rc <- testRemoteCrypto + chunks <- newIORef [smpEncode (1 :: Word32, 1025 :: Word32), "body"] + r <- parseDecryptChunks 1024 rc chunks + r `shouldSatisfy` \case + Left RPEInvalidSize -> True + _ -> False + readIORef chunks `shouldReturn` ["body"] + it "rejects decompressed body above limit" $ \_ -> do + rc <- testRemoteCrypto + (corrId, cmdKN, _) <- atomically $ getRemoteSndKeys rc + Right encBody <- runExceptT $ encryptEncodeHTTP2Body corrId cmdKN rc $ LB.replicate 1025 'a' + chunks <- newIORef $ LB.toChunks $ toLazyByteString encBody + r <- parseDecryptChunks 1024 rc chunks + r `shouldSatisfy` \case + Left (RPEInvalidBody _) -> True + _ -> False xdescribe "No compression" $ aroundWith (. ((False, False),)) runRemoteTests xdescribe "Mobile offers compression" $ aroundWith (. ((True, False),)) runRemoteTests xdescribe "Desktop offers compression" $ aroundWith (. ((False, True),)) runRemoteTests @@ -665,3 +690,28 @@ eventually retries action = Left err | retries == 0 -> throwIO err Left _ -> eventually (retries - 1) action Right r -> pure r + +newtype TestBody = TestBody (IORef [B.ByteString]) + +instance HTTP2BodyChunk TestBody where + getBodyChunk (TestBody chunks) = atomicModifyIORef' chunks $ \case + c : cs -> (cs, c) + [] -> ([], "") + getBodySize _ = Nothing + +testRemoteCrypto :: IO RemoteCrypto +testRemoteCrypto = do + drg <- C.newRandom + (_, idPrivKey) <- atomically $ C.generateKeyPair drg + (_, sessPrivKey) <- atomically $ C.generateKeyPair drg + let (chainKey, _) = C.sbcInit "" ("secret" :: B.ByteString) + chainKeys <- TSbChainKeys <$> newTVarIO chainKey <*> newTVarIO chainKey + sndCounter <- newTVarIO 0 + rcvCounter <- newTVarIO 0 + skippedKeys <- TM.emptyIO + pure RemoteCrypto {sessionCode = "", sndCounter, rcvCounter, chainKeys, skippedKeys, signatures = RSSign {idPrivKey, sessPrivKey}, compression = True} + +parseDecryptChunks :: Int -> RemoteCrypto -> IORef [B.ByteString] -> IO (Either RemoteProtocolError ()) +parseDecryptChunks maxSize rc chunks = do + body <- getHTTP2Body (TestBody chunks) 0 + runExceptT . void $ parseDecryptHTTP2Body maxSize rc (TestBody chunks) body