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

@ -304,12 +304,12 @@ saveState oneshot = doSideAction $ do
( Annex.Branch.commit "update" , Annex.Branch.stage)
where
alwayscommit = fromMaybe True . Git.configTrue
<$> getConfig "annex.alwayscommit" ""
<$> getConfig (annexConfig "alwayscommit") ""
{- Downloads content from any of a list of urls. -}
downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool
downloadUrl urls file = do
o <- map Param . words <$> getConfig "annex.web-options" ""
o <- map Param . words <$> getConfig (annexConfig "web-options") ""
headers <- getHttpHeaders
liftIO $ anyM (\u -> Url.download u headers o file) urls

View file

@ -46,7 +46,7 @@ new = do
store q
return q
where
queuesize = readish <$> getConfig "annex.queuesize" ""
queuesize = readish <$> getConfig (annexConfig "queuesize") ""
store :: Git.Queue.Queue -> Annex ()
store q = changeState $ \s -> s { repoqueue = Just q }

View file

@ -48,7 +48,7 @@ sshInfo (host, port) = ifM caching
where
caching = fromMaybe SysConfig.sshconnectioncaching
. Git.configTrue
<$> getConfig "annex.sshcaching" ""
<$> getConfig (annexConfig "sshcaching") ""
cacheParams :: FilePath -> [CommandParam]
cacheParams socketfile =

View file

@ -23,12 +23,11 @@ module Annex.UUID (
import Common.Annex
import qualified Git
import qualified Git.Config
import qualified Git.Command
import qualified Build.SysConfig as SysConfig
import Config
configkey :: String
configkey = "annex.uuid"
configkey :: ConfigKey
configkey = annexConfig "uuid"
{- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -}
@ -64,16 +63,17 @@ getRepoUUID r = do
cachekey = remoteConfig r "uuid"
removeRepoUUID :: Annex ()
removeRepoUUID = inRepo $ Git.Command.run "config"
[Param "--unset", Param configkey]
removeRepoUUID = unsetConfig configkey
getUncachedUUID :: Git.Repo -> UUID
getUncachedUUID = toUUID . Git.Config.get configkey ""
getUncachedUUID = toUUID . Git.Config.get key ""
where
(ConfigKey key) = configkey
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex ()
prepUUID = whenM ((==) NoUUID <$> getUUID) $
storeUUID configkey =<< liftIO genUUID
storeUUID :: String -> UUID -> Annex ()
storeUUID :: ConfigKey -> UUID -> Annex ()
storeUUID configfield = setConfig configfield . fromUUID

View file

@ -21,8 +21,8 @@ supportedVersions = [defaultVersion]
upgradableVersions :: [Version]
upgradableVersions = ["0", "1", "2"]
versionField :: String
versionField = "annex.version"
versionField :: ConfigKey
versionField = annexConfig "version"
getVersion :: Annex (Maybe Version)
getVersion = handle <$> getConfig versionField ""

View file

@ -46,7 +46,7 @@ orderedList = do
l' <- (lookupBackendName name :) <$> standard
Annex.changeState $ \s -> s { Annex.backends = l' }
return l'
standard = parseBackendList <$> getConfig "annex.backends" ""
standard = parseBackendList <$> getConfig (annexConfig "backends") ""
parseBackendList [] = list
parseBackendList s = map lookupBackendName $ words s

View file

@ -183,10 +183,10 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller
-}
bloomCapacity :: Annex Int
bloomCapacity = fromMaybe 500000 . readish
<$> getConfig "annex.bloomcapacity" ""
<$> getConfig (annexConfig "bloomcapacity") ""
bloomAccuracy :: Annex Int
bloomAccuracy = fromMaybe 1000 . readish
<$> getConfig "annex.bloomaccuracy" ""
<$> getConfig (annexConfig "bloomaccuracy") ""
bloomBitsHashes :: Annex (Int, Int)
bloomBitsHashes = do
capacity <- bloomCapacity

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])

View file

@ -74,14 +74,14 @@ hookEnv k f = Just $ fileenv f ++ keyenv
lookupHook :: String -> String -> Annex (Maybe String)
lookupHook hooktype hook =do
command <- getConfig hookname ""
command <- getConfig (annexConfig hookname) ""
if null command
then do
warning $ "missing configuration for " ++ hookname
return Nothing
else return $ Just command
where
hookname = "annex." ++ hooktype ++ "-" ++ hook ++ "-hook"
hookname = hooktype ++ "-" ++ hook ++ "-hook"
runHook :: String -> String -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype hook

3
debian/changelog vendored
View file

@ -8,6 +8,9 @@ git-annex (3.20120431) UNRELEASED; urgency=low
* dropunused: Allow specifying ranges to drop.
* addunused: New command, the opposite of dropunused, it relinks unused
content into the git repository.
* 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.)
-- Joey Hess <joeyh@debian.org> Wed, 02 May 2012 13:06:18 -0400