sanitize filepaths provided by checkUrl

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

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 []

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)
+			Just $ return $ UrlContents sz $ Just $ mkSafeFilePath f
-		CHECKURL_MULTI l -> Just $ return $ UrlMulti l
+		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)

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

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