diff --git a/src/Simplex/Chat/Files.hs b/src/Simplex/Chat/Files.hs index 0c04b22e28..791f34c6ff 100644 --- a/src/Simplex/Chat/Files.hs +++ b/src/Simplex/Chat/Files.hs @@ -5,14 +5,20 @@ module Simplex.Chat.Files where import Simplex.Chat.Controller import Simplex.Messaging.Util (ifM) -import System.FilePath (combine, splitExtensions) +import System.FilePath (combine, makeValid, splitExtensions, takeFileName) import UnliftIO.Directory (doesDirectoryExist, doesFileExist, getHomeDirectory, getTemporaryDirectory) +safeFileNameStr :: String -> String +safeFileNameStr = notDots . makeValid . takeFileName + where + notDots n = if n == "." || n == ".." then "_" else n + +-- | The file name is sanitized, so the combined path cannot escape the folder. uniqueCombine :: FilePath -> String -> IO FilePath uniqueCombine fPath fName = tryCombine (0 :: Int) where tryCombine n = - let (name, ext) = splitExtensions fName + let (name, ext) = splitExtensions $ safeFileNameStr fName suffix = if n == 0 then "" else "_" <> show n f = fPath `combine` (name <> suffix <> ext) in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f) diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 9ca11f5146..19d1aeb0a2 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -48,7 +48,7 @@ import Data.Word (Word32) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Delivery -import Simplex.Chat.Files (getChatTempDirectory) +import Simplex.Chat.Files (getChatTempDirectory, safeFileNameStr) import Simplex.Chat.Library.Internal import Simplex.Chat.Web (channelContentChanged, channelProfileUpdated, channelRemoved) import Simplex.Chat.Messages @@ -101,7 +101,6 @@ import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Transport (TransportError (..)) import Simplex.Messaging.Util import Simplex.Messaging.Version -import qualified System.FilePath as FP import System.Mem.Weak (Weak) import Text.Read (readMaybe) import UnliftIO.Concurrent (ThreadId, forkIO, mkWeakThreadId) @@ -1966,7 +1965,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = pure (ft', CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol}) mkValidFileInvitation :: FileInvitation -> FileInvitation - mkValidFileInvitation fInv@FileInvitation {fileName} = fInv {fileName = FP.makeValid $ FP.takeFileName fileName} + mkValidFileInvitation fInv@FileInvitation {fileName} = fInv {fileName = safeFileNameStr fileName} validateFileInvitation :: FileInvitation -> CM FileInvitation validateFileInvitation fInv@FileInvitation {fileName, fileSize} diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index 39405bd1ba..0e23cc795c 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -65,10 +65,10 @@ import Simplex.Messaging.Util import Simplex.RemoteControl.Client import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..), RCVerifiedInvitation (..), verifySignedInvitation) import Simplex.RemoteControl.Types -import System.FilePath (takeFileName, ()) +import System.FilePath (takeDirectory, takeFileName, ()) import UnliftIO import UnliftIO.Concurrent (forkIO) -import UnliftIO.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, removeDirectoryRecursive, renameFile) +import UnliftIO.Directory (canonicalizePath, copyFile, createDirectoryIfMissing, doesDirectoryExist, removeDirectoryRecursive, renameFile) remoteFilesFolder :: String remoteFilesFolder = "simplex_v1_files" @@ -574,10 +574,19 @@ handleStoreFile rfKN fileName fileSize fileDigest getChunk = Nothing -> storeFileTo =<< getDefaultFilesFolder storeFileTo :: FilePath -> CM' (Either RemoteProtocolError FilePath) storeFileTo dir = liftIO . tryAllErrors' $ do + unless (validRemoteFileName fileName) $ throwError $ RPEInvalidBody "invalid file name" filePath <- liftIO $ dir `uniqueCombine` fileName + -- resolves symlinks, so it also catches a final component linking outside the folder + canonPath <- liftIO $ canonicalizePath filePath + inDir <- liftIO $ (takeDirectory canonPath ==) <$> canonicalizePath dir + unless inDir $ throwError $ RPEInvalidBody "file path outside of files folder" receiveEncryptedFile rfKN getChunk fileSize fileDigest filePath pure filePath +-- The controller only ever sends a bare file name (see storeRemoteFile), so a path is a protocol violation. +validRemoteFileName :: FilePath -> Bool +validRemoteFileName fName = fName == takeFileName fName && fName `notElem` (["", ".", ".."] :: [FilePath]) + handleGetFile :: User -> RemoteFile -> Respond -> CM () handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do logDebug $ "GetFile: " <> tshow filePath diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index e96d531805..1bb6ac34eb 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -11,22 +11,25 @@ import ChatTests.DBUtils import ChatTests.Utils import Control.Logger.Simple import Control.Monad +import Control.Monad.Except (runExceptT) import qualified Data.Aeson as J import qualified Data.ByteString as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.List (find, isPrefixOf) import qualified Data.Map.Strict as M 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) +import Simplex.Chat.Remote (remoteFilesFolder, validRemoteFileName) +import Simplex.Chat.Remote.Protocol (remoteStoreFile) import Simplex.Chat.Remote.Types import Simplex.Messaging.Crypto.File (CryptoFileArgs (..)) import Simplex.Messaging.Encoding.String (strEncode) import Simplex.Messaging.Util import Simplex.RemoteControl.Types (RCCtrlAddress (..)) -import System.FilePath (()) +import System.FilePath (takeFileName, ()) import Test.Hspec hiding (it) import UnliftIO import UnliftIO.Concurrent @@ -40,10 +43,26 @@ remoteTests = describe "Remote" $ do `shouldSatisfy` \case Right (StartRemoteHost Nothing (Just (RCCtrlAddress _ "Ethernet 2")) (Just 12345)) -> True _ -> False + describe "stored file name" $ do + it "rejects names with directory components" $ \_ -> + filter validRemoteFileName ["../x", "../../etc/passwd", "/etc/cron.d/x", "a/b", "x/", "", ".", ".."] + `shouldBe` [] + it "accepts bare file names" $ \_ -> + filter (not . validRemoteFileName) ["test.pdf", "test_1.pdf", ".hidden", "a b.tar.gz"] + `shouldBe` [] + it "sanitizes any name to a real file name" $ \_ -> + filter (not . sanitized) fileNames `shouldBe` [] + it "sanitizes to a name with no directory components" $ \_ -> + filter (not . bareName) fileNames `shouldBe` [] xdescribe "No compression" $ aroundWith (. ((False, False),)) runRemoteTests xdescribe "Mobile offers compression" $ aroundWith (. ((True, False),)) runRemoteTests xdescribe "Desktop offers compression" $ aroundWith (. ((False, True),)) runRemoteTests describe "With compression" $ aroundWith (. ((True, True),)) runRemoteTests + where + fileNames :: [FilePath] + fileNames = ["", ".", "..", "...", "../x", "../../etc/passwd", "/etc/cron.d/x", "a/b", "x/", "test.pdf", ".hidden", "a b.tar.gz"] + sanitized n = let n' = safeFileNameStr n in n' /= "" && n' /= "." && n' /= ".." + bareName n = let n' = safeFileNameStr n in n' == takeFileName n' runRemoteTests :: SpecWith ((Bool, Bool), TestParams) runRemoteTests = do @@ -243,8 +262,9 @@ remoteStoreFileTest = contactBob desktop bob rhs <- readTVarIO (Controller.remoteHostSessions $ chatController desktop) - desktopHostStore <- case M.lookup (RHId 1) rhs of - Just (_, RHSessionConnected {storePath}) -> pure $ desktopHostFiles storePath remoteFilesFolder + (rhClient, desktopHostStore) <- case M.lookup (RHId 1) rhs of + Just (_, RHSessionConnected {rhClient, storePath}) -> + pure (rhClient, desktopHostFiles storePath remoteFilesFolder) _ -> fail "Host session 1 should be started" desktop ##> "/store remote file 1 tests/fixtures/test.pdf" desktop <## "file test.pdf stored on remote host 1" @@ -261,6 +281,17 @@ remoteStoreFileTest = chatReadFile (mobileFiles "test_2.pdf") (strEncode key) (strEncode nonce) `shouldReturn` Right (LB.fromStrict src) chatReadFile (desktopHostStore "test_2.pdf") (strEncode key) (strEncode nonce) `shouldReturn` Right (LB.fromStrict src) + -- the host rejects a traversal name before draining the attachment; only calling the protocol + -- directly can put such a name on the wire, as /store remote file sanitizes it controller-side + runExceptT (remoteStoreFile rhClient "tests/fixtures/test.pdf" "../x") >>= \case + Left (RPEInvalidBody _) -> pure () + r -> fail $ "expected RPEInvalidBody, got " <> show r + doesFileExist "./tests/tmp/x" `shouldReturn` False + -- the undrained attachment did not break the session + desktop ##> "/store remote file 1 tests/fixtures/test.pdf" + desktop <## "file test_3.pdf stored on remote host 1" + B.readFile (mobileFiles "test_3.pdf") `shouldReturn` src + removeFile (desktopHostStore "test_1.pdf") removeFile (desktopHostStore "test_2.pdf")