add ConfigMonitor thread

Monitors git-annex branch for changes, which are noticed by the Merger
thread whenever the branch ref is changed (either due to an incoming push,
or a local change), and refreshes cached config values for modified config
files.

Rate limited to run no more often than once per minute. This is important
because frequent git-annex branch changes happen when files are being
added, or transferred, etc.

A primary use case is that, when preferred content changes are made,
and get pushed to remotes, the remotes start honoring those settings.
Other use cases include propigating repository description and trust
changes to remotes, and learning when a remote has added a new special
remote, so the webapp can present the GUI to enable that special remote
locally.

Also added a uuid.log cache. All other config files already had caches.
This commit is contained in:
Joey Hess 2012-10-20 16:37:06 -04:00
parent b281584422
commit c7c2015435
14 changed files with 216 additions and 63 deletions

View file

@ -6,10 +6,12 @@
-}
module Logs.Group (
groupLog,
groupChange,
groupSet,
lookupGroups,
groupMap,
groupMapLoad,
getStandardGroup,
) where
@ -47,18 +49,18 @@ groupChange NoUUID _ = error "unknown UUID; cannot modify"
groupSet :: UUID -> S.Set Group -> Annex ()
groupSet u g = groupChange u (const g)
{- Read the groupLog into a map. The map is cached for speed. -}
{- The map is cached for speed. -}
groupMap :: Annex GroupMap
groupMap = do
cached <- Annex.getState Annex.groupmap
case cached of
Just m -> return m
Nothing -> do
m <- makeGroupMap . simpleMap .
parseLog (Just . S.fromList . words) <$>
Annex.Branch.get groupLog
Annex.changeState $ \s -> s { Annex.groupmap = Just m }
return m
groupMap = maybe groupMapLoad return =<< Annex.getState Annex.groupmap
{- Loads the map, updating the cache. -}
groupMapLoad :: Annex GroupMap
groupMapLoad = do
m <- makeGroupMap . simpleMap .
parseLog (Just . S.fromList . words) <$>
Annex.Branch.get groupLog
Annex.changeState $ \s -> s { Annex.groupmap = Just m }
return m
makeGroupMap :: M.Map UUID (S.Set Group) -> GroupMap
makeGroupMap byuuid = GroupMap byuuid bygroup

View file

@ -6,9 +6,11 @@
-}
module Logs.PreferredContent (
preferredContentLog,
preferredContentSet,
isPreferredContent,
preferredContentMap,
preferredContentMapLoad,
preferredContentMapRaw,
checkPreferredContentExpression,
setStandardGroup,
@ -60,19 +62,20 @@ isPreferredContent mu notpresent file = do
Just matcher -> Utility.Matcher.matchMrun matcher $ \a ->
a notpresent fi
{- Read the preferredContentLog into a map. The map is cached for speed. -}
{- The map is cached for speed. -}
preferredContentMap :: Annex Annex.PreferredContentMap
preferredContentMap = do
preferredContentMap = maybe preferredContentMapLoad return
=<< Annex.getState Annex.preferredcontentmap
{- Loads the map, updating the cache. -}
preferredContentMapLoad :: Annex Annex.PreferredContentMap
preferredContentMapLoad = do
groupmap <- groupMap
cached <- Annex.getState Annex.preferredcontentmap
case cached of
Just m -> return m
Nothing -> do
m <- simpleMap
. parseLogWithUUID ((Just .) . makeMatcher groupmap)
<$> Annex.Branch.get preferredContentLog
Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
return m
m <- simpleMap
. parseLogWithUUID ((Just .) . makeMatcher groupmap)
<$> Annex.Branch.get preferredContentLog
Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
return m
preferredContentMapRaw :: Annex (M.Map UUID String)
preferredContentMapRaw = simpleMap . parseLog Just

View file

@ -6,6 +6,7 @@
-}
module Logs.Remote (
remoteLog,
readRemoteLog,
configSet,
keyValToConfig,

View file

@ -6,11 +6,13 @@
-}
module Logs.Trust (
trustLog,
TrustLevel(..),
trustGet,
trustSet,
trustPartition,
lookupTrust,
trustMapLoad,
trustMapRaw,
) where
@ -65,27 +67,29 @@ trustPartition level ls
candidates <- trustGet level
return $ partition (`elem` candidates) ls
{- Read the trustLog into a map, overriding with any
- values from forcetrust or the git config. The map is cached for speed. -}
{- trustLog in a map, overridden with any values from forcetrust or
- the git config. The map is cached for speed. -}
trustMap :: Annex TrustMap
trustMap = do
cached <- Annex.getState Annex.trustmap
case cached of
Just m -> return m
Nothing -> do
overrides <- Annex.getState Annex.forcetrust
logged <- trustMapRaw
configured <- M.fromList . catMaybes
<$> (mapM configuredtrust =<< remoteList)
let m = M.union overrides $ M.union configured logged
Annex.changeState $ \s -> s { Annex.trustmap = Just m }
return m
trustMap = maybe trustMapLoad return =<< Annex.getState Annex.trustmap
{- Loads the map, updating the cache, -}
trustMapLoad :: Annex TrustMap
trustMapLoad = do
overrides <- Annex.getState Annex.forcetrust
logged <- trustMapRaw
configured <- M.fromList . catMaybes
<$> (mapM configuredtrust =<< remoteList)
let m = M.union overrides $ M.union configured logged
Annex.changeState $ \s -> s { Annex.trustmap = Just m }
return m
where
configuredtrust r =
maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$>
maybe Nothing readTrustLevel
<$> getTrustLevel (Types.Remote.repo r)
{- Does not include forcetrust or git config values, just those from the
- log file. -}
trustMapRaw :: Annex TrustMap
trustMapRaw = simpleMap . parseLog (Just . parseTrustLog)
<$> Annex.Branch.get trustLog

View file

@ -8,34 +8,38 @@
-
- uuid.log stores a list of known uuids, and their descriptions.
-
- 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.
-}
module Logs.UUID (
uuidLog,
describeUUID,
recordUUID,
uuidMap
uuidMap,
uuidMapLoad
) where
import qualified Data.Map as M
import Data.Time.Clock.POSIX
import Types.UUID
import Common.Annex
import qualified Annex
import qualified Annex.Branch
import Logs.UUIDBased
import qualified Annex.UUID
{- Filename of uuid.log. -}
logfile :: FilePath
logfile = "uuid.log"
uuidLog :: FilePath
uuidLog = "uuid.log"
{- Records a description for a uuid in the log. -}
describeUUID :: UUID -> String -> Annex ()
describeUUID uuid desc = do
ts <- liftIO getPOSIXTime
Annex.Branch.change logfile $
Annex.Branch.change uuidLog $
showLog id . changeLog ts uuid desc . fixBadUUID . parseLog Just
{- Temporarily here to fix badly formatted uuid logs generated by
@ -76,14 +80,20 @@ recordUUID u = go . M.lookup u =<< uuidMap
go _ = noop
set = describeUUID u ""
{- The map is cached for speed. -}
uuidMap :: Annex UUIDMap
uuidMap = maybe uuidMapLoad return =<< Annex.getState Annex.uuidmap
{- Read the uuidLog into a simple Map.
-
- The UUID of the current repository is included explicitly, since
- it may not have been described and so otherwise would not appear. -}
uuidMap :: Annex (M.Map UUID String)
uuidMap = do
m <- (simpleMap . parseLog Just) <$> Annex.Branch.get logfile
uuidMapLoad :: Annex UUIDMap
uuidMapLoad = do
m <- (simpleMap . parseLog Just) <$> Annex.Branch.get uuidLog
u <- Annex.UUID.getUUID
return $ M.insertWith' preferold u "" m
let m' = M.insertWith' preferold u "" m
Annex.changeState $ \s -> s { Annex.uuidmap = Just m' }
return m'
where
preferold = flip const