Work around wget bug #784348 which could cause it to clobber git-annex symlinks when downloading from ftp.

1 files changed, 12 insertions, 4 deletions

diff --git a/Utility/Url.hs b/Utility/Url.hs
index 1b0c394b7..9c5d6a708 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -25,6 +25,9 @@ module Utility.Url (
 ) where
 
 import Common
+import Utility.Tmp
+import qualified Build.SysConfig
+
 import Network.URI
 import Network.HTTP.Conduit
 import Network.HTTP.Types
@@ -32,8 +35,6 @@ import qualified Data.CaseInsensitive as CI
 import qualified Data.ByteString as B
 import qualified Data.ByteString.UTF8 as B8
 
-import qualified Build.SysConfig
-
 type URLString = String
 
 type Headers = [String]
@@ -242,8 +243,15 @@ download' quiet url file uo = do
 		writeFile file ""
 		go "curl" $ headerparams ++ quietopt "-s" ++
 			[Params "-f -L -C - -# -o"]
-	go cmd opts = boolSystem cmd $
-		addUserAgent uo $ reqParams uo++opts++[File file, File url]
+	
+	{- Run wget in a temp directory because it has been buggy
+	 - and overwritten files in the current directory, even though
+	 - it was asked to write to a file elsewhere. -}
+	go cmd opts = withTmpDir "downloadurl" $ \tmp -> do
+		relfile <- relPathDirToFile tmp file
+		let ps = addUserAgent uo $ reqParams uo++opts++[File relfile, File url]
+		boolSystem' cmd ps $ \p -> p { cwd = Just tmp }
+	
 	quietopt s
 		| quiet = [Param s]
 		| otherwise = []