diff options
| -rw-r--r-- | Annex.hs | 25 | ||||
| -rw-r--r-- | Annex/Content.hs | 8 | ||||
| -rw-r--r-- | Annex/Queue.hs | 5 | ||||
| -rw-r--r-- | Annex/Ssh.hs | 6 | ||||
| -rw-r--r-- | Assistant/Threads/Committer.hs | 7 | ||||
| -rw-r--r-- | Backend.hs | 22 | ||||
| -rw-r--r-- | Command/Status.hs | 2 | ||||
| -rw-r--r-- | Command/Unused.hs | 7 | ||||
| -rw-r--r-- | Config.hs | 47 | ||||
| -rw-r--r-- | GitAnnex.hs | 10 | ||||
| -rw-r--r-- | Types.hs | 2 | ||||
| -rw-r--r-- | Types/Config.hs | 64 |
12 files changed, 127 insertions, 78 deletions
@@ -1,6 +1,6 @@ {- git-annex monad - - - Copyright 2010-2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2012 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -28,6 +28,9 @@ module Annex ( gitRepo, inRepo, fromRepo, + getConfig, + changeConfig, + changeGitRepo, ) where import "mtl" Control.Monad.State.Strict @@ -43,6 +46,7 @@ import Git.CheckAttr import Git.SharedRepository import qualified Git.Queue import Types.Backend +import Types.Config import qualified Types.Remote import Types.Crypto import Types.BranchState @@ -88,6 +92,7 @@ type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> Fi -- internal state storage data AnnexState = AnnexState { repo :: Git.Repo + , config :: Config , backends :: [BackendA Annex] , remotes :: [Types.Remote.RemoteA Annex] , output :: MessageState @@ -99,7 +104,6 @@ data AnnexState = AnnexState , catfilehandle :: Maybe CatFileHandle , checkattrhandle :: Maybe CheckAttrHandle , forcebackend :: Maybe String - , forcenumcopies :: Maybe Int , limit :: Matcher (FileInfo -> Annex Bool) , uuidmap :: Maybe UUIDMap , preferredcontentmap :: Maybe PreferredContentMap @@ -118,6 +122,7 @@ data AnnexState = AnnexState newState :: Git.Repo -> AnnexState newState gitrepo = AnnexState { repo = gitrepo + , config = extractConfig gitrepo , backends = [] , remotes = [] , output = defaultMessageState @@ -129,7 +134,6 @@ newState gitrepo = AnnexState , catfilehandle = Nothing , checkattrhandle = Nothing , forcebackend = Nothing - , forcenumcopies = Nothing , limit = Left [] , uuidmap = Nothing , preferredcontentmap = Nothing @@ -197,3 +201,18 @@ inRepo a = liftIO . a =<< gitRepo {- Extracts a value from the annex's git repisitory. -} fromRepo :: (Git.Repo -> a) -> Annex a fromRepo a = a <$> gitRepo + +{- Gets the Config settings. -} +getConfig :: Annex Config +getConfig = getState config + +{- Modifies a Config setting. -} +changeConfig :: (Config -> Config) -> Annex () +changeConfig a = changeState $ \s -> s { config = a (config s) } + +{- Changing the git Repo data also involves re-extracting its Config. -} +changeGitRepo :: Git.Repo -> Annex () +changeGitRepo r = changeState $ \s -> s + { repo = r + , config = extractConfig r + } diff --git a/Annex/Content.hs b/Annex/Content.hs index 54e019345..1f7516fe1 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -35,7 +35,6 @@ import System.IO.Unsafe (unsafeInterleaveIO) import Common.Annex import Logs.Location import qualified Git -import qualified Git.Config import qualified Annex import qualified Annex.Queue import qualified Annex.Branch @@ -188,7 +187,7 @@ withTmp key action = do - in a destination (or the annex) printing a warning if not. -} checkDiskSpace :: Maybe FilePath -> Key -> Integer -> Annex Bool checkDiskSpace destination key alreadythere = do - reserve <- getDiskReserve + reserve <- annexDiskReserve <$> Annex.getConfig free <- liftIO . getDiskFree =<< dir force <- Annex.getState Annex.force case (free, keySize key) of @@ -396,11 +395,8 @@ saveState :: Bool -> Annex () saveState nocommit = doSideAction $ do Annex.Queue.flush unless nocommit $ - whenM alwayscommit $ + whenM (annexAlwaysCommit <$> Annex.getConfig) $ Annex.Branch.commit "update" - where - alwayscommit = fromMaybe True . Git.Config.isTrue - <$> getConfig (annexConfig "alwayscommit") "" {- Downloads content from any of a list of urls. -} downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool diff --git a/Annex/Queue.hs b/Annex/Queue.hs index 64cc92897..0f8c38ab9 100644 --- a/Annex/Queue.hs +++ b/Annex/Queue.hs @@ -17,7 +17,6 @@ import Common.Annex import Annex hiding (new) import qualified Git.Queue import qualified Git.UpdateIndex -import Config {- Adds a git command to the queue. -} addCommand :: String -> [CommandParam] -> [FilePath] -> Annex () @@ -55,11 +54,9 @@ get = maybe new return =<< getState repoqueue new :: Annex Git.Queue.Queue new = do - q <- Git.Queue.new <$> queuesize + q <- Git.Queue.new . annexQueueSize <$> getConfig store q return q - where - queuesize = readish <$> getConfig (annexConfig "queuesize") "" store :: Git.Queue.Queue -> Annex () store q = changeState $ \s -> s { repoqueue = Just q } diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index cb46c06bc..d3622686c 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -18,9 +18,8 @@ import Common.Annex import Annex.LockPool import Annex.Perms #ifndef WITH_OLD_SSH -import qualified Git.Config -import Config import qualified Build.SysConfig as SysConfig +import qualified Annex #endif {- Generates parameters to ssh to a given host (or user@host) on a given @@ -60,8 +59,7 @@ sshInfo (host, port) = ifM caching caching = return False #else caching = fromMaybe SysConfig.sshconnectioncaching - . Git.Config.isTrue - <$> getConfig (annexConfig "sshcaching") "" + . annexSshCaching <$> Annex.getConfig #endif cacheParams :: FilePath -> [CommandParam] diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index e968959c6..7940b0836 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -32,6 +32,7 @@ import Types.KeySource import Config import Annex.Exception import Annex.Content +import qualified Annex import Data.Time.Clock import Data.Tuple.Utils @@ -41,9 +42,9 @@ import Data.Either {- This thread makes git commits at appropriate times. -} commitThread :: NamedThread commitThread = NamedThread "Committer" $ do - delayadd <- liftAnnex $ do - v <- readish <$> getConfig (annexConfig "delayadd") "" - maybe delayaddDefault (return . Just . Seconds) v + delayadd <- liftAnnex $ + maybe delayaddDefault (return . Just . Seconds) + =<< annexDelayAdd <$> Annex.getConfig runEvery (Seconds 1) <~> do -- We already waited one second as a simple rate limiter. -- Next, wait until at least one change is available for diff --git a/Backend.hs b/Backend.hs index 1e3d8f94f..4972288c3 100644 --- a/Backend.hs +++ b/Backend.hs @@ -18,7 +18,6 @@ module Backend ( import System.Posix.Files import Common.Annex -import Config import qualified Annex import Annex.CheckAttr import Types.Key @@ -39,17 +38,18 @@ orderedList = do l <- Annex.getState Annex.backends -- list is cached here if not $ null l then return l - else handle =<< Annex.getState Annex.forcebackend + else do + f <- Annex.getState Annex.forcebackend + case f of + Just name | not (null name) -> + return [lookupBackendName name] + _ -> do + l' <- gen . annexBackends <$> Annex.getConfig + Annex.changeState $ \s -> s { Annex.backends = l' } + return l' where - handle Nothing = standard - handle (Just "") = standard - handle (Just name) = do - l' <- (lookupBackendName name :) <$> standard - Annex.changeState $ \s -> s { Annex.backends = l' } - return l' - standard = parseBackendList <$> getConfig (annexConfig "backends") "" - parseBackendList [] = list - parseBackendList s = map lookupBackendName $ words s + gen [] = list + gen l = map lookupBackendName l {- Generates a key for a file, trying each backend in turn until one - accepts it. -} diff --git a/Command/Status.hs b/Command/Status.hs index d2307798f..9c5e3e70a 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -200,7 +200,7 @@ transfer_list = stat "transfers in progress" $ nojson $ lift $ do disk_size :: Stat disk_size = stat "available local disk space" $ json id $ lift $ calcfree - <$> getDiskReserve + <$> (annexDiskReserve <$> Annex.getConfig) <*> inRepo (getDiskFree . gitAnnexDir) where calcfree reserve (Just have) = unwords diff --git a/Command/Unused.hs b/Command/Unused.hs index c0551ddea..2823ccefd 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -22,7 +22,6 @@ import Logs.Unused import Annex.Content import Utility.FileMode import Logs.Location -import Config import qualified Annex import qualified Git import qualified Git.Command @@ -181,11 +180,9 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller - so will easily fit on even my lowest memory systems. -} bloomCapacity :: Annex Int -bloomCapacity = fromMaybe 500000 . readish - <$> getConfig (annexConfig "bloomcapacity") "" +bloomCapacity = fromMaybe 500000 . annexBloomCapacity <$> Annex.getConfig bloomAccuracy :: Annex Int -bloomAccuracy = fromMaybe 1000 . readish - <$> getConfig (annexConfig "bloomaccuracy") "" +bloomAccuracy = fromMaybe 1000 . annexBloomAccuracy <$> Annex.getConfig bloomBitsHashes :: Annex (Int, Int) bloomBitsHashes = do capacity <- bloomCapacity @@ -12,7 +12,6 @@ import qualified Git import qualified Git.Config import qualified Git.Command import qualified Annex -import Utility.DataUnits type UnqualifiedConfigKey = String data ConfigKey = ConfigKey String @@ -21,8 +20,7 @@ data ConfigKey = ConfigKey String setConfig :: ConfigKey -> String -> Annex () setConfig (ConfigKey key) value = do inRepo $ Git.Command.run "config" [Param key, Param value] - newg <- inRepo Git.Config.reRead - Annex.changeState $ \s -> s { Annex.repo = newg } + Annex.changeGitRepo =<< inRepo Git.Config.reRead {- Unsets a git config setting. (Leaves it in state currently.) -} unsetConfig :: ConfigKey -> Annex () @@ -93,49 +91,28 @@ repoSyncable :: Git.Repo -> Annex Bool repoSyncable r = fromMaybe True . Git.Config.isTrue <$> getRemoteConfig r "sync" "" -{- If a value is specified, it is used; otherwise the default is looked up - - in git config. forcenumcopies overrides everything. -} -getNumCopies :: Maybe Int -> Annex Int -getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies - where - use (Just n) = return n - use Nothing = perhaps (return 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 key where (ConfigKey key) = remoteConfig r "trustlevel" -{- Gets annex.diskreserve setting. -} -getDiskReserve :: Annex Integer -getDiskReserve = fromMaybe megabyte . readSize dataUnits - <$> getConfig (annexConfig "diskreserve") "" - where - megabyte = 1000000 +getNumCopies :: Maybe Int -> Annex Int +getNumCopies (Just v) = return v +getNumCopies Nothing = annexNumCopies <$> Annex.getConfig -{- Gets annex.direct setting, cached for speed. -} isDirect :: Annex Bool -isDirect = maybe fromconfig return =<< Annex.getState Annex.direct - where - fromconfig = do - direct <- fromMaybe False . Git.Config.isTrue <$> - getConfig (annexConfig "direct") "" - Annex.changeState $ \s -> s { Annex.direct = Just direct } - return direct +isDirect = annexDirect <$> Annex.getConfig setDirect :: Bool -> Annex () setDirect b = do - setConfig (annexConfig "direct") (if b then "true" else "false") - Annex.changeState $ \s -> s { Annex.direct = Just b } + setConfig (annexConfig "direct") $ if b then "true" else "false" + Annex.changeConfig $ \c -> c { annexDirect = b } -{- Gets annex.httpheaders or annex.httpheaders-command setting, - - splitting it into lines. -} +{- Gets the http headers to use. -} getHttpHeaders :: Annex [String] getHttpHeaders = do - cmd <- getConfig (annexConfig "http-headers-command") "" - if null cmd - then fromRepo $ Git.Config.getList "annex.http-headers" - else lines <$> liftIO (readProcess "sh" ["-c", cmd]) + v <- annexHttpHeadersCommand <$> Annex.getConfig + case v of + Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd]) + Nothing -> annexHttpHeaders <$> Annex.getConfig diff --git a/GitAnnex.hs b/GitAnnex.hs index 270f5cce8..c807326ad 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -170,12 +170,10 @@ options = Option.common ++ , Option [] ["trust-glacier"] (NoArg (Annex.setFlag "trustglacier")) "Trust Amazon Glacier inventory" ] ++ Option.matcher where - setnumcopies v = Annex.changeState $ - \s -> s { Annex.forcenumcopies = readish v } - setgitconfig :: String -> Annex () - setgitconfig v = do - newg <- inRepo $ Git.Config.store v - Annex.changeState $ \s -> s { Annex.repo = newg } + setnumcopies v = maybe noop + (\n -> Annex.changeConfig $ \c -> c { annexNumCopies = n }) + (readish v) + setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v) header :: String header = "Usage: git-annex command [option ..]" @@ -10,6 +10,7 @@ module Types ( Backend, Key, UUID(..), + Config(..), Remote, RemoteType, Option, @@ -18,6 +19,7 @@ module Types ( import Annex import Types.Backend +import Types.Config import Types.Key import Types.UUID import Types.Remote diff --git a/Types/Config.hs b/Types/Config.hs new file mode 100644 index 000000000..898c153d5 --- /dev/null +++ b/Types/Config.hs @@ -0,0 +1,64 @@ +{- git-annex configuration + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Types.Config ( + Config(..), + extractConfig, +) where + +import Common +import qualified Git +import qualified Git.Config +import Utility.DataUnits + +{- Main git-annex settings. Each setting corresponds to a git-config key + - such as annex.foo -} +data Config = Config + { annexNumCopies :: Int + , annexDiskReserve :: Integer + , annexDirect :: Bool + , annexBackends :: [String] + , annexQueueSize :: Maybe Int + , annexBloomCapacity :: Maybe Int + , annexBloomAccuracy :: Maybe Int + , annexSshCaching :: Maybe Bool + , annexAlwaysCommit :: Bool + , annexDelayAdd :: Maybe Int + , annexHttpHeaders :: [String] + , annexHttpHeadersCommand :: Maybe String + } + +extractConfig :: Git.Repo -> Config +extractConfig r = Config + { annexNumCopies = get "numcopies" 1 + , annexDiskReserve = fromMaybe onemegabyte $ + readSize dataUnits =<< getmaybe "diskreserve" + , annexDirect = getbool "direct" False + , annexBackends = fromMaybe [] $ + words <$> getmaybe "backends" + , annexQueueSize = getmayberead "queuesize" + , annexBloomCapacity = getmayberead "bloomcapacity" + , annexBloomAccuracy = getmayberead "bloomaccuracy" + , annexSshCaching = getmaybebool "sshcaching" + , annexAlwaysCommit = getbool "alwayscommit" True + , annexDelayAdd = getmayberead "delayadd" + , annexHttpHeaders = getlist "http-headers" + , annexHttpHeadersCommand = getmaybe "http-headers-command" + } + where + get k def = fromMaybe def $ getmayberead k + getbool k def = fromMaybe def $ getmaybebool k + getmaybebool k = Git.Config.isTrue =<< getmaybe k + getmayberead k = readish =<< getmaybe k + getmaybe k = Git.Config.getMaybe (key k) r + getlist k = Git.Config.getList (key k) r + key k = "annex." ++ k + + onemegabyte = 1000000 + +{- Per-remote git-annex settings. Each setting corresponds to a git-config + - key such as annex.<remote>.foo -} |