add another setting to GitConfig

This commit is contained in:
Joey Hess 2013-01-28 00:33:19 +11:00
parent 0942d3aed3
commit 0e3f931f37
2 changed files with 5 additions and 2 deletions

View file

@ -412,7 +412,7 @@ saveState nocommit = doSideAction $ do
{- Downloads content from any of a list of urls. -} {- Downloads content from any of a list of urls. -}
downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool
downloadUrl urls file = do downloadUrl urls file = do
o <- map Param . words <$> getConfig (annexConfig "web-options") "" o <- map Param . annexWebOptions <$> Annex.getGitConfig
headers <- getHttpHeaders headers <- getHttpHeaders
liftIO $ anyM (\u -> Url.download u headers o file) urls liftIO $ anyM (\u -> Url.download u headers o file) urls

View file

@ -34,6 +34,7 @@ data GitConfig = GitConfig
, annexHttpHeaders :: [String] , annexHttpHeaders :: [String]
, annexHttpHeadersCommand :: Maybe String , annexHttpHeadersCommand :: Maybe String
, annexAutoCommit :: Bool , annexAutoCommit :: Bool
, annexWebOptions :: [String]
} }
extractGitConfig :: Git.Repo -> GitConfig extractGitConfig :: Git.Repo -> GitConfig
@ -43,7 +44,7 @@ extractGitConfig r = GitConfig
, annexDiskReserve = fromMaybe onemegabyte $ , annexDiskReserve = fromMaybe onemegabyte $
readSize dataUnits =<< getmaybe "diskreserve" readSize dataUnits =<< getmaybe "diskreserve"
, annexDirect = getbool "direct" False , annexDirect = getbool "direct" False
, annexBackends = fromMaybe [] $ words <$> getmaybe "backends" , annexBackends = getwords "backends"
, annexQueueSize = getmayberead "queuesize" , annexQueueSize = getmayberead "queuesize"
, annexBloomCapacity = getmayberead "bloomcapacity" , annexBloomCapacity = getmayberead "bloomcapacity"
, annexBloomAccuracy = getmayberead "bloomaccuracy" , annexBloomAccuracy = getmayberead "bloomaccuracy"
@ -53,6 +54,7 @@ extractGitConfig r = GitConfig
, annexHttpHeaders = getlist "http-headers" , annexHttpHeaders = getlist "http-headers"
, annexHttpHeadersCommand = getmaybe "http-headers-command" , annexHttpHeadersCommand = getmaybe "http-headers-command"
, annexAutoCommit = getbool "autocommit" True , annexAutoCommit = getbool "autocommit" True
, annexWebOptions = getwords "web-options"
} }
where where
get k def = fromMaybe def $ getmayberead k get k def = fromMaybe def $ getmayberead k
@ -61,6 +63,7 @@ extractGitConfig r = GitConfig
getmayberead k = readish =<< getmaybe k getmayberead k = readish =<< getmaybe k
getmaybe k = Git.Config.getMaybe (key k) r getmaybe k = Git.Config.getMaybe (key k) r
getlist k = Git.Config.getList (key k) r getlist k = Git.Config.getList (key k) r
getwords k = fromMaybe [] $ words <$> getmaybe k
key k = "annex." ++ k key k = "annex." ++ k