diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index fc84a9c02b..3c2840c73d 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -42,6 +42,7 @@ import Git.FilePath import Types.Remote (RemoteConfig) import Types.ProposedAccepted import Annex.CheckAttr +import Annex.RepoSize.LiveUpdate import qualified Git.Config #ifdef WITH_MAGICMIME import Annex.Magic @@ -88,13 +89,16 @@ checkMatcher matcher mkey afile lu notpresent notconfigured d go mi = checkMatcher' matcher mi lu notpresent checkMatcher' :: FileMatcher Annex -> MatchInfo -> LiveUpdate -> AssumeNotPresent -> Annex Bool -checkMatcher' (matcher, (MatcherDesc matcherdesc)) mi lu notpresent = do - (matches, desc) <- runWriterT $ matchMrun' matcher $ \op -> - matchAction op lu notpresent mi - explain (mkActionItem mi) $ UnquotedString <$> - describeMatchResult matchDesc desc - ((if matches then "matches " else "does not match ") ++ matcherdesc ++ ": ") - return matches +checkMatcher' (matcher, (MatcherDesc matcherdesc)) mi lu notpresent = + checkLiveUpdate lu go + where + go = do + (matches, desc) <- runWriterT $ matchMrun' matcher $ \op -> + matchAction op lu notpresent mi + explain (mkActionItem mi) $ UnquotedString <$> + describeMatchResult matchDesc desc + ((if matches then "matches " else "does not match ") ++ matcherdesc ++ ": ") + return matches fileMatchInfo :: RawFilePath -> Maybe Key -> Annex MatchInfo fileMatchInfo file mkey = do diff --git a/Annex/RepoSize/LiveUpdate.hs b/Annex/RepoSize/LiveUpdate.hs index 3a05796bb5..8bd92921db 100644 --- a/Annex/RepoSize/LiveUpdate.hs +++ b/Annex/RepoSize/LiveUpdate.hs @@ -63,30 +63,36 @@ prepareLiveUpdate :: Maybe UUID -> Key -> SizeChange -> Annex LiveUpdate prepareLiveUpdate mu k sc = do h <- Db.getRepoSizeHandle u <- maybe getUUID pure mu + needv <- liftIO newEmptyMVar startv <- liftIO newEmptyMVar + readyv <- liftIO newEmptyMVar donev <- liftIO newEmptyMVar finishv <- liftIO newEmptyMVar - void $ liftIO $ forkIO $ waitstart startv donev finishv h u - return (LiveUpdate startv donev finishv) + void $ liftIO $ forkIO $ waitstart startv readyv donev finishv h u + return (LiveUpdate needv startv readyv donev finishv) where - {- Wait for startLiveUpdate, or for the LiveUpdate to get garbage - - collected in the case where it is never going to start. -} - waitstart startv donev finishv h u = tryNonAsync (takeMVar startv) >>= \case - Right _ -> do - {- Deferring updating the database until here - - avoids overhead except in cases where preferred - - content expressions need live updates. -} - Db.startingLiveSizeChange h u k sc - waitdone donev finishv h u - Left _ -> noop + {- Wait for checkLiveUpdate to request a start, or for the + - LiveUpdate to get garbage collected in the case where + - it is not needed. -} + waitstart startv readyv donev finishv h u = + tryNonAsync (takeMVar startv) >>= \case + Right () -> do + {- Deferring updating the database until + - here avoids overhead except in cases + - where preferred content expressions + - need live updates. -} + Db.startingLiveSizeChange h u k sc + putMVar readyv () + waitdone donev finishv h u + Left _ -> noop - {- Wait for finishedLiveUpdate to be called, or for the LiveUpdate to - - get garbage collected in the case where the change didn't + {- Wait for finishedLiveUpdate to be called, or for the LiveUpdate + - to get garbage collected in the case where the change didn't - actually happen. -} waitdone donev finishv h u = tryNonAsync (takeMVar donev) >>= \case -- TODO need to update RepoSize db -- in same transaction as Db.finishedLiveSizeChange - Right (u', k', sc') + Right (Just (u', k', sc')) | u' == u && k' == k && sc' == sc -> do done h u putMVar finishv () @@ -94,19 +100,37 @@ prepareLiveUpdate mu k sc = do -- causes fanout and so this is called with -- other UUIDs. | otherwise -> waitdone donev finishv h u + Right Nothing -> done h u Left _ -> done h u done h u = Db.finishedLiveSizeChange h u k sc -- Called when a preferred content check indicates that a live update is --- needed. Can be called more than once. -startLiveUpdate :: LiveUpdate -> Annex () -startLiveUpdate (LiveUpdate startv _donev _finishv) = - liftIO $ void $ tryPutMVar startv () -startLiveUpdate NoLiveUpdate = noop +-- needed. Can be called more than once on the same LiveUpdate. +needLiveUpdate :: LiveUpdate -> Annex () +needLiveUpdate NoLiveUpdate = noop +needLiveUpdate lu = liftIO $ void $ tryPutMVar (liveUpdateNeeded lu) () + +-- needLiveUpdate has to be called inside this to take effect. If the +-- action calls needLiveUpdate and then returns True, the live update is +-- started. If the action calls needLiveUpdate and then returns False, +-- the live update is not started. +-- +-- This can be called more than once on the same LiveUpdate. It will +-- only start it once. +checkLiveUpdate :: LiveUpdate -> Annex Bool -> Annex Bool +checkLiveUpdate NoLiveUpdate a = a +checkLiveUpdate lu a = do + r <- a + needed <- liftIO $ isJust <$> tryTakeMVar (liveUpdateNeeded lu) + when (r && needed) $ do + liftIO $ void $ tryPutMVar (liveUpdateStart lu) () + liftIO $ void $ readMVar (liveUpdateReady lu) + return r finishedLiveUpdate :: LiveUpdate -> UUID -> Key -> SizeChange -> IO () -finishedLiveUpdate (LiveUpdate _startv donev finishv) u k sc = do - tryNonAsync (putMVar donev (u, k, sc)) >>= \case - Right () -> void $ tryNonAsync $ readMVar finishv - Left _ -> noop finishedLiveUpdate NoLiveUpdate _ _ _ = noop +finishedLiveUpdate lu u k sc = do + tryNonAsync (putMVar (liveUpdateDone lu) (Just (u, k, sc))) >>= \case + Right () -> void $ + tryNonAsync $ readMVar $ liveUpdateFinish lu + Left _ -> noop diff --git a/Limit.hs b/Limit.hs index 3f8d480881..f05a3856db 100644 --- a/Limit.hs +++ b/Limit.hs @@ -672,7 +672,7 @@ limitFullyBalanced''' filtercandidates termname mu getgroupmap g n want = Right u `elem` picker candidates key n _ -> False when wanted $ - startLiveUpdate lu + needLiveUpdate lu return wanted , matchNeedsFileName = False , matchNeedsFileContent = False diff --git a/Types/RepoSize.hs b/Types/RepoSize.hs index 78f5d06ea7..f09aeff27d 100644 --- a/Types/RepoSize.hs +++ b/Types/RepoSize.hs @@ -31,7 +31,13 @@ newtype MaxSize = MaxSize { fromMaxSize :: Integer } -- the changes to its size into account. If NoLiveUpdate is used, it -- prevents that. data LiveUpdate - = LiveUpdate (MVar ()) (MVar (UUID, Key, SizeChange)) (MVar ()) + = LiveUpdate + { liveUpdateNeeded :: MVar () + , liveUpdateStart :: MVar () + , liveUpdateReady :: MVar () + , liveUpdateDone :: MVar (Maybe (UUID, Key, SizeChange)) + , liveUpdateFinish :: MVar () + } | NoLiveUpdate data SizeChange = AddingKey | RemovingKey diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn index 9ed68b1e83..6893faa532 100644 --- a/doc/todo/git-annex_proxies.mdwn +++ b/doc/todo/git-annex_proxies.mdwn @@ -145,20 +145,6 @@ Planned schedule of work: * Still implementing LiveUpdate. Check for TODO XXX markers -* In an expression like "balanced=foo and exclude=bar", - it will start a live update even if the overall expression doesn't - match. That is suboptimal, but also this will probably be a rare case, - it doesn't really make sense to to that. What will happen in that case - is the repo will temporarily be treated as having that key going - into it, even when it is not. As soon as the LiveUpdate gets GCed, - that resolves. Until then, other keys may not match that usually would, - if the repo would have been filled up by that key. - - What could be done in this case is, after checking preferred content, - when it's not preferred content, call stopLiveUpdate immediately, - rather than relying on GC. - That would also help with the next problem... - * In the case where a copy to a remote fails (due eg to annex.diskreserve), the LiveUpdate thread can not get a chance to catch its exception when the LiveUpdate is gced, before git-annex exits. In this case, the