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:
parent
b281584422
commit
c7c2015435
14 changed files with 216 additions and 63 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -6,6 +6,7 @@
|
|||
-}
|
||||
|
||||
module Logs.Remote (
|
||||
remoteLog,
|
||||
readRemoteLog,
|
||||
configSet,
|
||||
keyValToConfig,
|
||||
|
|
|
@ -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
|
||||
|
|
28
Logs/UUID.hs
28
Logs/UUID.hs
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue