Fix use of several config settings

annex.ssh-options, annex.rsync-options, annex.bup-split-options.

And adjust types to avoid the bugs that broke several config settings
recently. Now "annex." prefixing is enforced at the type level.
This commit is contained in:
Joey Hess 2012-05-05 20:15:32 -04:00
parent 657d09d499
commit f7d8982672
10 changed files with 49 additions and 33 deletions

View file

@ -1,6 +1,6 @@
{- Git configuration
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -14,29 +14,40 @@ import qualified Git.Command
import qualified Annex
import Utility.DataUnits
type ConfigKey = String
type UnqualifiedConfigKey = String
data ConfigKey = ConfigKey String
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex ()
setConfig k value = do
inRepo $ Git.Command.run "config" [Param k, Param value]
setConfig (ConfigKey key) value = do
inRepo $ Git.Command.run "config" [Param key, Param value]
-- re-read git config and update the repo's state
newg <- inRepo Git.Config.read
Annex.changeState $ \s -> s { Annex.repo = newg }
{- Looks up a git config setting in git config. -}
{- Unsets a git config setting. (Leaves it in state currently.) -}
unsetConfig :: ConfigKey -> Annex ()
unsetConfig (ConfigKey key) = inRepo $ Git.Command.run "config"
[Param "--unset", Param key]
{- Looks up a setting in git config. -}
getConfig :: ConfigKey -> String -> Annex String
getConfig key def = fromRepo $ Git.Config.get key def
getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def
{- Looks up a per-remote config setting in git config.
- Failing that, tries looking for a global config option. -}
getRemoteConfig :: Git.Repo -> ConfigKey -> String -> Annex String
getRemoteConfig r key def =
getConfig (remoteConfig r key) =<< getConfig key def
getRemoteConfig :: Git.Repo -> UnqualifiedConfigKey -> String -> Annex String
getRemoteConfig r key def =
getConfig (remoteConfig r key) =<< getConfig (annexConfig key) def
{- A per-remote config setting in git config. -}
remoteConfig :: Git.Repo -> ConfigKey -> String
remoteConfig r key = "remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" ++ key
remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = ConfigKey $
"remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" ++ key
{- A global annex setting in git config. -}
annexConfig :: UnqualifiedConfigKey -> ConfigKey
annexConfig key = ConfigKey $ "annex." ++ key
{- Calculates cost for a remote. Either the default, or as configured
- by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
@ -83,17 +94,19 @@ getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies
where
use (Just n) = return n
use Nothing = perhaps (return 1) =<<
readish <$> getConfig "annex.numcopies" "1"
readish <$> getConfig (annexConfig "numcopies") "1"
perhaps fallback = maybe fallback (return . id)
{- Gets the trust level set for a remote in git config. -}
getTrustLevel :: Git.Repo -> Annex (Maybe String)
getTrustLevel r = fromRepo $ Git.Config.getMaybe $ remoteConfig r "trustlevel"
getTrustLevel r = fromRepo $ Git.Config.getMaybe key
where
(ConfigKey key) = remoteConfig r "trustlevel"
{- Gets annex.diskreserve setting. -}
getDiskReserve :: Annex Integer
getDiskReserve = fromMaybe megabyte . readSize dataUnits
<$> getConfig "annex.diskreserve" ""
<$> getConfig (annexConfig "diskreserve") ""
where
megabyte = 1000000
@ -101,7 +114,7 @@ getDiskReserve = fromMaybe megabyte . readSize dataUnits
- splitting it into lines. -}
getHttpHeaders :: Annex [String]
getHttpHeaders = do
cmd <- getConfig "annex.http-headers-command" ""
cmd <- getConfig (annexConfig "http-headers-command") ""
if (null cmd)
then fromRepo $ Git.Config.getList "annex.http-headers"
else lines . snd <$> liftIO (pipeFrom "sh" ["-c", cmd])