484a74f073
Try to enable special remotes configured with autoenable=yes when git-annex auto-initialization happens in a new clone of an existing repo. Previously, git-annex init had to be explicitly run to enable them. That was a bit of a wart of a special case for users to need to keep in mind. Special remotes cannot display anything when autoenabled this way, to avoid interfering with the output of git-annex query commands. Any error messages will be hidden, and if it fails, nothing is displayed. The user will realize the remote isn't enable when they try to use it, and can run git-annex init manually then to try the autoenable again and see what failed. That seems like a reasonable approach, and it's less complicated than communicating something across a pipe in order to display it as a side message. Other reason not to do that is that, if the first command the user runs is one like git-annex find that has machine readable output, any message about autoenable failing would need to not be displayed anyway. So better to not display a failure message ever, for consistency. (Had to split out Remote.List.Util to avoid an import cycle.)
94 lines
3 KiB
Haskell
94 lines
3 KiB
Haskell
{- git-annex assistant config monitor thread
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.Threads.ConfigMonitor where
|
|
|
|
import Assistant.Common
|
|
import Assistant.BranchChange
|
|
import Assistant.DaemonStatus
|
|
import Assistant.Commits
|
|
import Utility.ThreadScheduler
|
|
import Logs
|
|
import Logs.UUID
|
|
import Logs.Trust
|
|
import Logs.PreferredContent
|
|
import Logs.Group
|
|
import Logs.NumCopies
|
|
import Remote.List.Util
|
|
import qualified Git.LsTree as LsTree
|
|
import Git.Types
|
|
import Git.FilePath
|
|
import qualified Annex.Branch
|
|
import Annex.FileMatcher
|
|
|
|
import qualified Data.Set as S
|
|
|
|
{- This thread detects when configuration changes have been made to the
|
|
- git-annex branch and reloads cached configuration.
|
|
-
|
|
- If the branch is frequently changing, it's checked for configuration
|
|
- changes no more often than once every 60 seconds. On the other hand,
|
|
- if the branch has not changed in a while, configuration changes will
|
|
- be detected immediately.
|
|
-}
|
|
configMonitorThread :: NamedThread
|
|
configMonitorThread = namedThread "ConfigMonitor" $ loop =<< getConfigs
|
|
where
|
|
loop old = do
|
|
waitBranchChange
|
|
new <- getConfigs
|
|
when (old /= new) $ do
|
|
let changedconfigs = new `S.difference` old
|
|
debug $ "reloading config" :
|
|
map (fromRawFilePath . fst)
|
|
(S.toList changedconfigs)
|
|
reloadConfigs new
|
|
{- Record a commit to get this config
|
|
- change pushed out to remotes. -}
|
|
recordCommit
|
|
liftIO $ threadDelaySeconds (Seconds 60)
|
|
loop new
|
|
|
|
{- Config files, and their checksums. -}
|
|
type Configs = S.Set (RawFilePath, Sha)
|
|
|
|
{- All git-annex's config files, and actions to run when they change. -}
|
|
configFilesActions :: [(RawFilePath, Assistant ())]
|
|
configFilesActions =
|
|
[ (uuidLog, void $ liftAnnex uuidDescMapLoad)
|
|
, (remoteLog, void $ liftAnnex remotesChanged)
|
|
, (trustLog, void $ liftAnnex trustMapLoad)
|
|
, (groupLog, void $ liftAnnex groupMapLoad)
|
|
, (numcopiesLog, void $ liftAnnex globalNumCopiesLoad)
|
|
, (scheduleLog, void updateScheduleLog)
|
|
-- Preferred and required content settings depend on most of the
|
|
-- other configs, so will be reloaded whenever any configs change.
|
|
, (preferredContentLog, noop)
|
|
, (requiredContentLog, noop)
|
|
, (groupPreferredContentLog, noop)
|
|
]
|
|
|
|
reloadConfigs :: Configs -> Assistant ()
|
|
reloadConfigs changedconfigs = do
|
|
sequence_ as
|
|
void $ liftAnnex $ preferredRequiredMapsLoad preferredContentTokens
|
|
{- Changes to the remote log, or the trust log, can affect the
|
|
- syncRemotes list. Changes to the uuid log may affect its
|
|
- display so are also included. -}
|
|
when (any (`elem` fs) [remoteLog, trustLog, uuidLog])
|
|
updateSyncRemotes
|
|
where
|
|
(fs, as) = unzip $ filter (flip S.member changedfiles . fst)
|
|
configFilesActions
|
|
changedfiles = S.map fst changedconfigs
|
|
|
|
getConfigs :: Assistant Configs
|
|
getConfigs = S.fromList . map extract
|
|
<$> liftAnnex (inRepo $ LsTree.lsTreeFiles Annex.Branch.fullname files)
|
|
where
|
|
files = map (fromRawFilePath . fst) configFilesActions
|
|
extract treeitem = (getTopFilePath $ LsTree.file treeitem, LsTree.sha treeitem)
|