Send a git-annex user-agent when downloading urls.
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:
parent
55362462ae
commit
12f6b9693a
14 changed files with 90 additions and 36 deletions
27
Annex/Url.hs
Normal file
27
Annex/Url.hs
Normal file
|
@ -0,0 +1,27 @@
|
|||
{- Url downloading, with git-annex user agent.
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Annex.Url (
|
||||
module U,
|
||||
withUserAgent,
|
||||
getUserAgent,
|
||||
) where
|
||||
|
||||
import Common.Annex
|
||||
import qualified Annex
|
||||
import Utility.Url as U
|
||||
import qualified Build.SysConfig as SysConfig
|
||||
|
||||
defaultUserAgent :: U.UserAgent
|
||||
defaultUserAgent = "git-annex/" ++ SysConfig.packageversion
|
||||
|
||||
getUserAgent :: Annex (Maybe U.UserAgent)
|
||||
getUserAgent = Annex.getState $
|
||||
Just . fromMaybe defaultUserAgent . Annex.useragent
|
||||
|
||||
withUserAgent :: (Maybe U.UserAgent -> IO a) -> Annex a
|
||||
withUserAgent a = liftIO . a =<< getUserAgent
|
Loading…
Add table
Add a link
Reference in a new issue