mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Send a git-annex user-agent when downloading urls.

Browse source 
Overridable with --user-agent option.

Not yet done for S3 or WebDAV due to limitations of libraries used --
nether allows a user-agent header to be specified.

This commit sponsored by Michael Zehrer.
This commit is contained in:
Joey Hess 2013-09-28 14:35:21 -04:00
parent 55362462ae
commit 12f6b9693a
14 changed files with 90 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

7
Remote/Git.hs
View file

@ -30,7 +30,7 @@ import Annex.Exception
import qualified Annex.Content
import qualified Annex.BranchState
import qualified Annex.Branch
import qualified Utility.Url as Url
import qualified Annex.Url as Url
import Utility.Tmp
import Config
import Config.Cost
@ -177,9 +177,10 @@ tryGitConfigRead r
Left l -> return $ Left l
geturlconfig headers = do
ua <- Url.getUserAgent
v <- liftIO $ withTmpFile "git-annex.tmp" $ \tmpfile h -> do
hClose h
ifM (Url.downloadQuiet (Git.repoLocation r ++ "/config") headers [] tmpfile)
ifM (Url.downloadQuiet (Git.repoLocation r ++ "/config") headers [] tmpfile ua)
( pipedconfig "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]
, return $ Left undefined
)
@ -240,7 +241,7 @@ inAnnex r key
where
checkhttp headers = do
showChecking r
liftIO $ ifM (anyM (\u -> Url.check u headers (keySize key)) (keyUrls r key))
ifM (anyM (\u -> Url.withUserAgent $ Url.check u headers (keySize key)) (keyUrls r key))
( return $ Right True
, return $ Left "not found"
)