sanitize filepaths provided by checkUrl

5 files changed, 41 insertions, 10 deletions

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 22e996a15..825d9bdbf 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -73,11 +73,11 @@ seek us = do
 						next $ next $ return False
 					Right (UrlContents sz mf) -> do
 						void $ commandAction $
-							startRemote r relaxed (fromMaybe deffile mf) u sz
+							startRemote r relaxed (maybe deffile fromSafeFilePath mf) u sz
 					Right (UrlMulti l) ->
 						forM_ l $ \(u', sz, f) ->
 							void $ commandAction $
-								startRemote r relaxed (deffile </> f) u' sz
+								startRemote r relaxed (deffile </> fromSafeFilePath f) u' sz
 
 startRemote :: Remote -> Bool -> FilePath -> URLString -> Maybe Integer -> CommandStart
 startRemote r relaxed file uri sz = do
diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index a34052110..d827d549f 100644
--- a/Command/ImportFeed.hs
+++ b/Command/ImportFeed.hs
@@ -156,7 +156,7 @@ performDownload relaxed cache todownload = case location todownload of
 								downloadRemoteFile r relaxed url f sz
 						Right (UrlMulti l) -> do
 							kl <- forM l $ \(url', sz, subf) ->
-								downloadRemoteFile r relaxed url' (f </> subf) sz
+								downloadRemoteFile r relaxed url' (f </> fromSafeFilePath subf) sz
 							return $ if all isJust kl
 								then catMaybes kl
 								else []
diff --git a/Remote/External.hs b/Remote/External.hs
index 7e2b2d0b0..47220c23c 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -434,12 +434,14 @@ checkurl :: External -> URLString -> Annex UrlContents
 checkurl external url = 
 	handleRequest external (CHECKURL url) Nothing $ \req -> case req of
 		CHECKURL_CONTENTS sz f -> Just $ return $ UrlContents sz
-			(if null f then Nothing else Just f)
+			(if null f then Nothing else Just $ mkSafeFilePath f)
 		-- Treat a single item multi response specially to
 		-- simplify the external remote implementation.
 		CHECKURL_MULTI ((_, sz, f):[]) ->
-			Just $ return $ UrlContents sz (Just f)
-		CHECKURL_MULTI l -> Just $ return $ UrlMulti l
+			Just $ return $ UrlContents sz $ Just $ mkSafeFilePath f
+		CHECKURL_MULTI l -> Just $ return $ UrlMulti $ map mkmulti l
 		CHECKURL_FAILURE errmsg -> Just $ error errmsg
 		UNSUPPORTED_REQUEST -> error "CHECKURL not implemented by external special remote"
 		_ -> Nothing
+  where
+	mkmulti (u, s, f) = (u, s, mkSafeFilePath f)
diff --git a/Types/UrlContents.hs b/Types/UrlContents.hs
index ae50c6b40..d6dee120b 100644
--- a/Types/UrlContents.hs
+++ b/Types/UrlContents.hs
@@ -5,14 +5,42 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Types.UrlContents where
+module Types.UrlContents (
+	UrlContents(..),
+	SafeFilePath,
+	mkSafeFilePath,
+	fromSafeFilePath
+) where
 
 import Utility.Url
+import Utility.Path
+
+import System.FilePath
 
 data UrlContents
 	-- An URL contains a file, whose size may be known.
 	-- There might be a nicer filename to use.
-	= UrlContents (Maybe Integer) (Maybe FilePath)
+	= UrlContents (Maybe Integer) (Maybe SafeFilePath)
 	-- Sometimes an URL points to multiple files, each accessible
 	-- by their own URL.
-	| UrlMulti [(URLString, Maybe Integer, FilePath)]
+	| UrlMulti [(URLString, Maybe Integer, SafeFilePath)]
+
+-- This is a FilePath, from an untrusted source,
+-- sanitized so it doesn't contain any directory traversal tricks
+-- and is always relative. It can still contain subdirectories.
+-- Any unusual characters are also filtered out.
+newtype SafeFilePath = SafeFilePath FilePath
+	deriving (Show)
+
+mkSafeFilePath :: FilePath -> SafeFilePath
+mkSafeFilePath p = SafeFilePath $ if null p' then "file" else p'
+  where
+	p' = joinPath $ filter safe $ map sanitizeFilePath $ splitDirectories p
+	safe s
+		| isDrive s = False
+		| s == ".." = False
+		| null s = False
+		| otherwise = True
+
+fromSafeFilePath :: SafeFilePath -> FilePath
+fromSafeFilePath (SafeFilePath p) = p
diff --git a/Utility/Path.hs b/Utility/Path.hs
index 9035cbc49..d21452efd 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -267,7 +267,8 @@ fileNameLengthLimit dir = do
  - sane FilePath.
  -
  - All spaces and punctuation and other wacky stuff are replaced
- - with '_', except for '.' "../" will thus turn into ".._", which is safe.
+ - with '_', except for '.'
+ - "../" will thus turn into ".._", which is safe.
  -}
 sanitizeFilePath :: String -> FilePath
 sanitizeFilePath = map sanitize