wip

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)

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}

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

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