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:
parent
657d09d499
commit
f7d8982672
10 changed files with 49 additions and 33 deletions
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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 }
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ""
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
41
Config.hs
41
Config.hs
|
@ -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])
|
||||||
|
|
|
@ -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
3
debian/changelog
vendored
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue