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).

This commit is contained in:
Joey Hess 2012-01-02 14:20:20 -04:00
parent 50ebfd265f
commit aa0882691b
7 changed files with 36 additions and 13 deletions

View file

@ -20,7 +20,8 @@ module Annex.Content (
fromAnnex, fromAnnex,
moveBad, moveBad,
getKeysPresent, getKeysPresent,
saveState saveState,
downloadUrl,
) where ) where
import System.IO.Error (try) import System.IO.Error (try)
@ -36,6 +37,7 @@ import qualified Annex.Queue
import qualified Annex.Branch import qualified Annex.Branch
import Utility.StatFS import Utility.StatFS
import Utility.FileMode import Utility.FileMode
import qualified Utility.Url as Url
import Types.Key import Types.Key
import Utility.DataUnits import Utility.DataUnits
import Config import Config
@ -281,3 +283,10 @@ saveState :: Annex ()
saveState = do saveState = do
Annex.Queue.flush False Annex.Queue.flush False
Annex.Branch.commit "update" 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

View file

@ -12,7 +12,6 @@ import Network.URI
import Common.Annex import Common.Annex
import Command import Command
import qualified Backend import qualified Backend
import qualified Utility.Url as Url
import qualified Command.Add import qualified Command.Add
import qualified Annex import qualified Annex
import qualified Backend.URL import qualified Backend.URL
@ -45,7 +44,7 @@ download url file = do
let dummykey = Backend.URL.fromUrl url let dummykey = Backend.URL.fromUrl url
tmp <- fromRepo $ gitAnnexTmpLocation dummykey tmp <- fromRepo $ gitAnnexTmpLocation dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp) liftIO $ createDirectoryIfMissing True (parentDir tmp)
stopUnless (liftIO $ Url.download url tmp) $ do stopUnless (downloadUrl [url] tmp) $ do
[(backend, _)] <- Backend.chooseBackends [file] [(backend, _)] <- Backend.chooseBackends [file]
k <- Backend.genKey tmp backend k <- Backend.genKey tmp backend
case k of case k of

View file

@ -209,10 +209,8 @@ copyFromRemote r key file
loc <- liftIO $ gitAnnexLocation key r loc <- liftIO $ gitAnnexLocation key r
rsyncOrCopyFile params loc file rsyncOrCopyFile params loc file
| Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key 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" | 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. -} {- Tries to copy a key's content to a remote's annex. -}
copyToRemote :: Git.Repo -> Key -> Annex Bool copyToRemote :: Git.Repo -> Key -> Annex Bool

View file

@ -11,6 +11,7 @@ import Common.Annex
import Types.Remote import Types.Remote
import qualified Git import qualified Git
import qualified Git.Construct import qualified Git.Construct
import Annex.Content
import Config import Config
import Logs.Web import Logs.Web
import qualified Utility.Url as Url import qualified Utility.Url as Url
@ -55,7 +56,7 @@ downloadKey key file = get =<< getUrls key
return False return False
get urls = do get urls = do
showOutput -- make way for download progress bar showOutput -- make way for download progress bar
liftIO $ anyM (`Url.download` file) urls downloadUrl urls file
uploadKey :: Key -> Annex Bool uploadKey :: Key -> Annex Bool
uploadKey _ = do uploadKey _ = do

View file

@ -6,6 +6,7 @@
-} -}
module Utility.Url ( module Utility.Url (
URLString,
exists, exists,
canDownload, canDownload,
download, download,
@ -43,21 +44,21 @@ canDownload = (||) <$> inPath "wget" <*> inPath "curl"
- would not be appropriate to test at configure time and build support - would not be appropriate to test at configure time and build support
- for only one in. - for only one in.
-} -}
download :: URLString -> FilePath -> IO Bool download :: URLString -> [CommandParam] -> FilePath -> IO Bool
download url file = do download url options file = do
e <- inPath "wget" e <- inPath "wget"
if e if e
then then
boolSystem "wget" go "wget" [Params "-c -O", File file, File url]
[Params "-c -O", File file, File url]
else else
-- Uses the -# progress display, because the normal -- Uses the -# progress display, because the normal
-- one is very confusing when resuming, showing -- one is very confusing when resuming, showing
-- the remainder to download as the whole file, -- the remainder to download as the whole file,
-- and not indicating how much percent was -- and not indicating how much percent was
-- downloaded before the resume. -- downloaded before the resume.
boolSystem "curl" go "curl" [Params "-L -C - -# -o", File file, File url]
[Params "-L -C - -# -o", File file, File url] where
go cmd opts = boolSystem cmd (options++opts)
{- Downloads a small file. -} {- Downloads a small file. -}
get :: URLString -> IO String get :: URLString -> IO String

9
debian/changelog vendored
View file

@ -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 git-annex (3.20111231) unstable; urgency=low
* sync: Improved to work well without a central bare repository. * sync: Improved to work well without a central bare repository.

View file

@ -603,6 +603,12 @@ Here are all the supported configuration settings.
to or from this remote. For example, to force ipv6, and limit to or from this remote. For example, to force ipv6, and limit
the bandwidth to 100Kbyte/s, set it to "-6 --bwlimit 100" 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` * `remote.<name>.annex-bup-split-options`
Options to pass to bup split when storing content in this remote. Options to pass to bup split when storing content in this remote.