diff --git a/src/Simplex/Chat/Files.hs b/src/Simplex/Chat/Files.hs index ca36d2992e..cf14b86424 100644 --- a/src/Simplex/Chat/Files.hs +++ b/src/Simplex/Chat/Files.hs @@ -4,6 +4,7 @@ module Simplex.Chat.Files ( SafeFileName, safeFileName, + safeFileNameStr, uniqueCombine, getChatTempDirectory, getDefaultFilesFolder, @@ -18,8 +19,13 @@ import UnliftIO.Directory (doesDirectoryExist, doesFileExist, getHomeDirectory, -- | A file name with directory components removed, so combining it with a folder cannot escape that folder. newtype SafeFileName = SafeFileName String +safeFileNameStr :: String -> String +safeFileNameStr = notDots . makeValid . takeFileName + where + notDots n = if n == "." || n == ".." then "_" else n + safeFileName :: String -> SafeFileName -safeFileName = SafeFileName . makeValid . takeFileName +safeFileName = SafeFileName . safeFileNameStr uniqueCombine :: FilePath -> SafeFileName -> IO FilePath uniqueCombine fPath (SafeFileName fName) = tryCombine (0 :: Int) 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 ae44132093..0f316eebcc 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -570,14 +570,16 @@ handleStoreFile rfKN fileName fileSize fileDigest getChunk = where storeFile :: Maybe FilePath -> CM' (Either RemoteProtocolError FilePath) storeFile = \case + -- must stay a bare name: the controller re-joins it with its own folder, and the host with filesFolder Just ff -> takeFileName <$$> storeFileTo ff Nothing -> storeFileTo =<< getDefaultFilesFolder storeFileTo :: FilePath -> CM' (Either RemoteProtocolError FilePath) storeFileTo dir = liftIO . tryAllErrors' $ do safeName <- either throwError pure $ remoteFileName fileName filePath <- liftIO $ dir `uniqueCombine` safeName - -- unreachable while safeName has no directory components - guards against a future change to either - inDir <- liftIO $ (==) <$> canonicalizePath dir <*> canonicalizePath (takeDirectory filePath) + -- 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 diff --git a/tests/RemoteTests.hs b/tests/RemoteTests.hs index 2b62dfdf28..6199210b02 100644 --- a/tests/RemoteTests.hs +++ b/tests/RemoteTests.hs @@ -18,6 +18,7 @@ import Data.Either (isLeft, isRight) 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 @@ -27,7 +28,7 @@ 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 @@ -43,15 +44,23 @@ remoteTests = describe "Remote" $ do _ -> False describe "stored file name" $ do it "rejects names with directory components" $ \_ -> - filter (isRight . remoteFileName) ["../x", "../../etc/passwd", "/etc/cron.d/x", "a/b", "", ".", ".."] + filter (isRight . remoteFileName) ["../x", "../../etc/passwd", "/etc/cron.d/x", "a/b", "x/", "", ".", ".."] `shouldBe` [] it "accepts bare file names" $ \_ -> filter (isLeft . remoteFileName) ["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 (\n -> let n' = safeFileNameStr n in n' /= takeFileName n') 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' /= ".." runRemoteTests :: SpecWith ((Bool, Bool), TestParams) runRemoteTests = do