diff options
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/Content.hs | 4 | ||||
-rw-r--r-- | Annex/Url.hs | 27 |
2 files changed, 29 insertions, 2 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index c7afa8070..da0189c74 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -43,7 +43,7 @@ import qualified Annex.Queue import qualified Annex.Branch import Utility.DiskFree import Utility.FileMode -import qualified Utility.Url as Url +import qualified Annex.Url as Url import Types.Key import Utility.DataUnits import Utility.CopyFile @@ -458,7 +458,7 @@ downloadUrl urls file = go =<< annexWebDownloadCommand <$> Annex.getGitConfig go Nothing = do opts <- map Param . annexWebOptions <$> Annex.getGitConfig headers <- getHttpHeaders - liftIO $ anyM (\u -> Url.download u headers opts file) urls + anyM (\u -> Url.withUserAgent $ Url.download u headers opts file) urls go (Just basecmd) = liftIO $ anyM (downloadcmd basecmd) urls downloadcmd basecmd url = boolSystem "sh" [Param "-c", Param $ gencmd url basecmd] diff --git a/Annex/Url.hs b/Annex/Url.hs new file mode 100644 index 000000000..0401ffe07 --- /dev/null +++ b/Annex/Url.hs @@ -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 |