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) ( Annex.Branch.commit "update" , Annex.Branch.stage)
where where
alwayscommit = fromMaybe True . Git.configTrue alwayscommit = fromMaybe True . Git.configTrue
<$> getConfig "annex.alwayscommit" "" <$> getConfig (annexConfig "alwayscommit") ""
{- 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 "annex.web-options" "" o <- map Param . words <$> getConfig (annexConfig "web-options") ""
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

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

View file

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

View file

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

View file

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

View file

@ -46,7 +46,7 @@ orderedList = do
l' <- (lookupBackendName name :) <$> standard l' <- (lookupBackendName name :) <$> standard
Annex.changeState $ \s -> s { Annex.backends = l' } Annex.changeState $ \s -> s { Annex.backends = l' }
return l' return l'
standard = parseBackendList <$> getConfig "annex.backends" "" standard = parseBackendList <$> getConfig (annexConfig "backends") ""
parseBackendList [] = list parseBackendList [] = list
parseBackendList s = map lookupBackendName $ words s 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 :: Annex Int
bloomCapacity = fromMaybe 500000 . readish bloomCapacity = fromMaybe 500000 . readish
<$> getConfig "annex.bloomcapacity" "" <$> getConfig (annexConfig "bloomcapacity") ""
bloomAccuracy :: Annex Int bloomAccuracy :: Annex Int
bloomAccuracy = fromMaybe 1000 . readish bloomAccuracy = fromMaybe 1000 . readish
<$> getConfig "annex.bloomaccuracy" "" <$> getConfig (annexConfig "bloomaccuracy") ""
bloomBitsHashes :: Annex (Int, Int) bloomBitsHashes :: Annex (Int, Int)
bloomBitsHashes = do bloomBitsHashes = do
capacity <- bloomCapacity capacity <- bloomCapacity

View file

@ -1,6 +1,6 @@
{- Git configuration {- 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. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -14,29 +14,40 @@ import qualified Git.Command
import qualified Annex import qualified Annex
import Utility.DataUnits 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 -} {- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex () setConfig :: ConfigKey -> String -> Annex ()
setConfig k value = do setConfig (ConfigKey key) value = do
inRepo $ Git.Command.run "config" [Param k, Param value] inRepo $ Git.Command.run "config" [Param key, Param value]
-- re-read git config and update the repo's state -- re-read git config and update the repo's state
newg <- inRepo Git.Config.read newg <- inRepo Git.Config.read
Annex.changeState $ \s -> s { Annex.repo = newg } 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 :: 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. {- Looks up a per-remote config setting in git config.
- Failing that, tries looking for a global config option. -} - Failing that, tries looking for a global config option. -}
getRemoteConfig :: Git.Repo -> ConfigKey -> String -> Annex String getRemoteConfig :: Git.Repo -> UnqualifiedConfigKey -> String -> Annex String
getRemoteConfig r key def = getRemoteConfig r key def =
getConfig (remoteConfig r key) =<< getConfig key def getConfig (remoteConfig r key) =<< getConfig (annexConfig key) def
{- A per-remote config setting in git config. -} {- A per-remote config setting in git config. -}
remoteConfig :: Git.Repo -> ConfigKey -> String remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = "remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" ++ key 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 {- Calculates cost for a remote. Either the default, or as configured
- by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command - 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 where
use (Just n) = return n use (Just n) = return n
use Nothing = perhaps (return 1) =<< use Nothing = perhaps (return 1) =<<
readish <$> getConfig "annex.numcopies" "1" readish <$> getConfig (annexConfig "numcopies") "1"
perhaps fallback = maybe fallback (return . id) perhaps fallback = maybe fallback (return . id)
{- Gets the trust level set for a remote in git config. -} {- Gets the trust level set for a remote in git config. -}
getTrustLevel :: Git.Repo -> Annex (Maybe String) 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. -} {- Gets annex.diskreserve setting. -}
getDiskReserve :: Annex Integer getDiskReserve :: Annex Integer
getDiskReserve = fromMaybe megabyte . readSize dataUnits getDiskReserve = fromMaybe megabyte . readSize dataUnits
<$> getConfig "annex.diskreserve" "" <$> getConfig (annexConfig "diskreserve") ""
where where
megabyte = 1000000 megabyte = 1000000
@ -101,7 +114,7 @@ getDiskReserve = fromMaybe megabyte . readSize dataUnits
- splitting it into lines. -} - splitting it into lines. -}
getHttpHeaders :: Annex [String] getHttpHeaders :: Annex [String]
getHttpHeaders = do getHttpHeaders = do
cmd <- getConfig "annex.http-headers-command" "" cmd <- getConfig (annexConfig "http-headers-command") ""
if (null cmd) if (null cmd)
then fromRepo $ Git.Config.getList "annex.http-headers" then fromRepo $ Git.Config.getList "annex.http-headers"
else lines . snd <$> liftIO (pipeFrom "sh" ["-c", cmd]) 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 :: String -> String -> Annex (Maybe String)
lookupHook hooktype hook =do lookupHook hooktype hook =do
command <- getConfig hookname "" command <- getConfig (annexConfig hookname) ""
if null command if null command
then do then do
warning $ "missing configuration for " ++ hookname warning $ "missing configuration for " ++ hookname
return Nothing return Nothing
else return $ Just command else return $ Just command
where where
hookname = "annex." ++ hooktype ++ "-" ++ hook ++ "-hook" hookname = hooktype ++ "-" ++ hook ++ "-hook"
runHook :: String -> String -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool runHook :: String -> String -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype hook 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. * dropunused: Allow specifying ranges to drop.
* addunused: New command, the opposite of dropunused, it relinks unused * addunused: New command, the opposite of dropunused, it relinks unused
content into the git repository. 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 -- Joey Hess <joeyh@debian.org> Wed, 02 May 2012 13:06:18 -0400