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:
parent
50ebfd265f
commit
aa0882691b
7 changed files with 36 additions and 13 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
9
debian/changelog
vendored
9
debian/changelog
vendored
|
@ -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.
|
||||
|
|
|
@ -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.
|
||||
|
|
Loading…
Reference in a new issue