From da0a1360d7b57d034620338996552752ab873045 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 17 Aug 2017 12:26:14 -0400 Subject: add annex-ignore-command and annex-sync-command configs Added remote configuration settings annex-ignore-command and annex-sync-command, which are dynamic equivilants of the annex-ignore and annex-sync configurations. For this I needed a new DynamicConfig infrastructure. Its implementation should be as fast as before when there is no dynamic config, and it caches so shell commands are only run once. Note that annex-ignore-command exits nonzero when the remote should be ignored. While that may seem backwards, it allows using the same command for it as for annex-sync-command when you want to disable both. This commit was sponsored by Trenton Cronholm on Patreon. --- Assistant/DaemonStatus.hs | 7 ++++--- Assistant/MakeRemote.hs | 4 +++- Assistant/Sync.hs | 5 +++-- 3 files changed, 10 insertions(+), 6 deletions(-) (limited to 'Assistant') diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index ce5f01e27..58cb28c01 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -19,6 +19,7 @@ import Logs.Trust import Logs.TimeStamp import qualified Remote import qualified Types.Remote as Remote +import Config.DynamicConfig import Control.Concurrent.STM import System.Posix.Types @@ -47,12 +48,12 @@ modifyDaemonStatus a = do - and other associated information. -} calcSyncRemotes :: Annex (DaemonStatus -> DaemonStatus) calcSyncRemotes = do - rs <- filter (remoteAnnexSync . Remote.gitconfig) . - concat . Remote.byCost <$> Remote.remoteList + rs <- filterM (liftIO . getDynamicConfig . remoteAnnexSync . Remote.gitconfig) + =<< (concat . Remote.byCost <$> Remote.remoteList) alive <- trustExclude DeadTrusted (map Remote.uuid rs) let good r = Remote.uuid r `elem` alive let syncable = filter good rs - let syncdata = filter (not . remoteAnnexIgnore . Remote.gitconfig) $ + syncdata <- filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) $ filter (\r -> Remote.uuid r /= NoUUID) $ filter (not . Remote.isXMPPRemote) syncable diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 6d0377206..57abb86fd 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -24,6 +24,7 @@ import Git.Types (RemoteName) import Creds import Assistant.Gpg import Utility.Gpg (KeyId) +import Types.GitConfig import qualified Data.Map as M @@ -102,7 +103,8 @@ setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) = do - pool is drained, and as of now there's no way to tell the user - to perform IO actions to refill the pool. -} let weakc = M.insert "highRandomQuality" "false" $ M.union config c - (c', u) <- R.setup remotetype ss mu mcreds weakc def + dummycfg <- liftIO dummyRemoteGitConfig + (c', u) <- R.setup remotetype ss mu mcreds weakc dummycfg configSet u c' when setdesc $ whenM (isNothing . M.lookup u <$> uuidMap) $ diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index e6a5bc5d5..aba90f64c 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -27,6 +27,7 @@ import Annex.TaggedPush import Annex.Ssh import qualified Config import Git.Config +import Config.DynamicConfig import Assistant.NamedThread import Assistant.Threads.Watcher (watchThread, WatcherControl(..)) import Assistant.TransferSlots @@ -77,8 +78,8 @@ reconnectRemotes rs = void $ do go = do (failed, diverged) <- sync =<< liftAnnex (join Command.Sync.getCurrBranch) - addScanRemotes diverged $ - filter (not . remoteAnnexIgnore . Remote.gitconfig) + addScanRemotes diverged =<< + filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) nonxmppremotes return failed signal r = liftIO . mapM_ (flip tryPutMVar ()) -- cgit v1.2.3