Added remote.name.annex-web-options configuration setting, which can be used to provide parameters to whichever of wget or curl git-annex uses (depends on which is available, but most of their important options suitable for use here are the same).

7 files changed, 36 insertions, 13 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 3f1db37b5..1713b5e12 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -20,7 +20,8 @@ module Annex.Content (
 	fromAnnex,
 	moveBad,
 	getKeysPresent,
-	saveState
+	saveState,
+	downloadUrl,
 ) where
 
 import System.IO.Error (try)
@@ -36,6 +37,7 @@ import qualified Annex.Queue
 import qualified Annex.Branch
 import Utility.StatFS
 import Utility.FileMode
+import qualified Utility.Url as Url
 import Types.Key
 import Utility.DataUnits
 import Config
@@ -281,3 +283,10 @@ saveState :: Annex ()
 saveState = do
 	Annex.Queue.flush False
 	Annex.Branch.commit "update"
+
+{- Downloads content from any of a list of urls. -}
+downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool
+downloadUrl urls file = do
+	g <- gitRepo
+	o <- map Param . words <$> getConfig g "web-options" ""
+	liftIO $ anyM (\u -> Url.download u o file) urls
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 027c508bc..46584f0d8 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -12,7 +12,6 @@ import Network.URI
 import Common.Annex
 import Command
 import qualified Backend
-import qualified Utility.Url as Url
 import qualified Command.Add
 import qualified Annex
 import qualified Backend.URL
@@ -45,7 +44,7 @@ download url file = do
 	let dummykey = Backend.URL.fromUrl url
 	tmp <- fromRepo $ gitAnnexTmpLocation dummykey
 	liftIO $ createDirectoryIfMissing True (parentDir tmp)
-	stopUnless (liftIO $ Url.download url tmp) $ do
+	stopUnless (downloadUrl [url] tmp) $ do
 		[(backend, _)] <- Backend.chooseBackends [file]
 		k <- Backend.genKey tmp backend
 		case k of
diff --git a/Remote/Git.hs b/Remote/Git.hs
index b9d9966a4..da81241eb 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -209,10 +209,8 @@ copyFromRemote r key file
 		loc <- liftIO $ gitAnnexLocation key r
 		rsyncOrCopyFile params loc file
 	| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key file
-	| Git.repoIsHttp r = liftIO $ downloadurls $ keyUrls r key
+	| Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) file
 	| otherwise = error "copying from non-ssh, non-http repo not supported"
-	where
-		downloadurls us = untilTrue us $ \u -> Url.download u file
 
 {- Tries to copy a key's content to a remote's annex. -}
 copyToRemote :: Git.Repo -> Key -> Annex Bool
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 93e5770f0..4d6348e59 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -11,6 +11,7 @@ import Common.Annex
 import Types.Remote
 import qualified Git
 import qualified Git.Construct
+import Annex.Content
 import Config
 import Logs.Web
 import qualified Utility.Url as Url
@@ -55,7 +56,7 @@ downloadKey key file = get =<< getUrls key
 			return False
 		get urls = do
 			showOutput -- make way for download progress bar
-			liftIO $ anyM (`Url.download` file) urls
+			downloadUrl urls file
 
 uploadKey :: Key -> Annex Bool
 uploadKey _ = do
diff --git a/Utility/Url.hs b/Utility/Url.hs
index f215a1ebd..e10b8a92a 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -6,6 +6,7 @@
  -}
 
 module Utility.Url (
+	URLString,
 	exists,
 	canDownload,
 	download,
@@ -43,21 +44,21 @@ canDownload = (||) <$> inPath "wget" <*> inPath "curl"
  - would not be appropriate to test at configure time and build support
  - for only one in.
  -}
-download :: URLString -> FilePath -> IO Bool
-download url file = do
+download :: URLString -> [CommandParam] -> FilePath -> IO Bool
+download url options file = do
 	e <- inPath "wget"
 	if e
 		then
-			boolSystem "wget"
-				[Params "-c -O", File file, File url]
+			go "wget" [Params "-c -O", File file, File url]
 		else
 			-- Uses the -# progress display, because the normal
 			-- one is very confusing when resuming, showing
 			-- the remainder to download as the whole file,
 			-- and not indicating how much percent was
 			-- downloaded before the resume.
-			boolSystem "curl" 
-				[Params "-L -C - -# -o", File file, File url]
+			go "curl" [Params "-L -C - -# -o", File file, File url]
+	where
+		go cmd opts = boolSystem cmd (options++opts)
 
 {- Downloads a small file. -}
 get :: URLString -> IO String
diff --git a/debian/changelog b/debian/changelog
index 2732e87a6..80a39964d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,12 @@
+git-annex (3.20111232) UNRELEASED; urgency=low
+
+  * Added remote.name.annex-web-options configuration setting, which can be
+    used to provide parameters to whichever of wget or curl git-annex uses
+    (depends on which is available, but most of their important options
+    suitable for use here are the same).
+
+ -- Joey Hess <joeyh@debian.org>  Mon, 02 Jan 2012 14:19:19 -0400
+
 git-annex (3.20111231) unstable; urgency=low
 
   * sync: Improved to work well without a central bare repository.
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index a0dd3d3f1..ee7137e13 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -603,6 +603,12 @@ Here are all the supported configuration settings.
   to or from this remote. For example, to force ipv6, and limit
   the bandwidth to 100Kbyte/s, set it to "-6 --bwlimit 100"
 
+* `remote.<name>.annex-web-options`
+
+  Options to use when using wget or curl to download a file from the web.
+  (wget is always used in preference to curl if available).
+  For example, to force ipv4 only, set it to "-4"
+
 * `remote.<name>.annex-bup-split-options`
 
   Options to pass to bup split when storing content in this remote.