diff options
| -rw-r--r-- | Annex/Content.hs | 11 | ||||
| -rw-r--r-- | Command/AddUrl.hs | 3 | ||||
| -rw-r--r-- | Remote/Git.hs | 4 | ||||
| -rw-r--r-- | Remote/Web.hs | 3 | ||||
| -rw-r--r-- | Utility/Url.hs | 13 | ||||
| -rw-r--r-- | debian/changelog | 9 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 6 |
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. |