diff --git a/src/Simplex/FileTransfer/Util.hs b/src/Simplex/FileTransfer/Util.hs index fad920747..0714f090c 100644 --- a/src/Simplex/FileTransfer/Util.hs +++ b/src/Simplex/FileTransfer/Util.hs @@ -1,19 +1,26 @@ module Simplex.FileTransfer.Util ( uniqueCombine, + safeFileNameStr, removePath, ) where import Simplex.Messaging.Util (ifM, whenM) -import System.FilePath (splitExtensions, ()) +import System.FilePath (makeValid, splitExtensions, takeFileName, ()) import UnliftIO import UnliftIO.Directory +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 :: MonadIO m => FilePath -> String -> m FilePath uniqueCombine filePath fileName = tryCombine (0 :: Int) where tryCombine n = - let (name, ext) = splitExtensions fileName + let (name, ext) = splitExtensions $ safeFileNameStr fileName suffix = if n == 0 then "" else "_" <> show n f = filePath (name <> suffix <> ext) in ifM (doesPathExist f) (tryCombine $ n + 1) (pure f) diff --git a/tests/XFTPCLI.hs b/tests/XFTPCLI.hs index ac422c072..3fe2f3bf5 100644 --- a/tests/XFTPCLI.hs +++ b/tests/XFTPCLI.hs @@ -9,10 +9,11 @@ import Simplex.FileTransfer.Client.Main xftpClientDeprecationNotice, ) import Simplex.FileTransfer.Description (kb, mb) +import Simplex.FileTransfer.Util (safeFileNameStr, uniqueCombine) import System.Directory (createDirectoryIfMissing, getFileSize, listDirectory, removeDirectoryRecursive) import System.Environment (withArgs) import System.Exit (ExitCode (ExitSuccess)) -import System.FilePath (()) +import System.FilePath (takeFileName, ()) import System.IO.Silently (capture, capture_) import Test.Hspec hiding (fit, it) import Util @@ -29,6 +30,18 @@ xftpCLIFileTests = around_ testBracket $ do it "should delete file from 2 servers" $ \fsType -> withXFTPServerConfigOn (cfgFS fsType) $ \_ -> withXFTPServerConfigOn (cfgFS2 fsType) $ \_ -> testXFTPCLIDelete_ it "prepareChunkSizes should use 2 chunk sizes" $ \_ -> testPrepareChunkSizes + describe "received file name" $ do + 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` [] + it "combines a sanitized name inside the destination folder" $ \_ -> + testReceivedFileNameCombine + 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' testBracket :: IO () -> IO () testBracket = @@ -162,6 +175,10 @@ testXFTPCLIDelete_ = do xftpCLI ["recv", fdRcv2, recipientFiles, "--tmp=tests/tmp"] `shouldThrow` anyException +testReceivedFileNameCombine :: IO () +testReceivedFileNameCombine = + uniqueCombine recipientFiles "../../escaped.txt" `shouldReturn` (recipientFiles "escaped.txt") + testPrepareChunkSizes :: IO () testPrepareChunkSizes = do prepareChunkSizes (mb 9 + kb 256) `shouldBe` [mb 4, mb 4, mb 1, mb 1]