diff options
author | Joey Hess <joey@kitenet.net> | 2012-06-15 16:27:44 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-06-15 19:00:06 -0400 |
commit | c27c751b34af993a67e04e079d6f860a69f25038 (patch) | |
tree | e2c0b001bd4d7c9449fb5d6f246883d5d4b50876 /Assistant/Committer.hs | |
parent | 8c7dfc93b523957334c3b93530a85b7dcfa5cfb1 (diff) |
preliminary deferring of file adds to commit time
Defer adding files to the annex until commit time, when during a batch
operation, a bundle of files will be available. This will allow for
checking a them all with a single lsof call.
The tricky part is that adding the file causes a symlink change inotify.
So I made it wait for an appropriate number of symlink changes to be
received before continuing with the commit. This avoids any delay
in the commit process. It is possible that some unrelated symlink change is
made; if that happens it'll commit it and delay committing the newly added
symlink for 1 second. This seems ok. I do rely on the expected symlink
change event always being received, but only when the add succeeds.
Another way to do it might be to directly stage the symlink, and then
ignore the redundant symlink change event. That would involve some
redundant work, and perhaps an empty commit, but if this code turns
out to have some bug, that'd be the best way to avoid it.
FWIW, this change seems to, as a bonus, have produced better grouping
of batch changes into single commits. Before, a large batch change would
result in a series of commits, with the first containing only one file,
and each of the rest bundling a number of files. Now, the added wait for
the symlink changes to arrive gives time for additional add changes to
be processed, all within the same commit.
Diffstat (limited to 'Assistant/Committer.hs')
-rw-r--r-- | Assistant/Committer.hs | 68 |
1 files changed, 61 insertions, 7 deletions
diff --git a/Assistant/Committer.hs b/Assistant/Committer.hs index a572556de..6e56c2235 100644 --- a/Assistant/Committer.hs +++ b/Assistant/Committer.hs @@ -9,17 +9,21 @@ import Common.Annex import Assistant.ThreadedMonad import qualified Annex.Queue import qualified Git.Command +import qualified Command.Add import Utility.ThreadScheduler import Control.Concurrent.STM import Data.Time.Clock +data ChangeType = PendingAddChange | LinkChange | RmChange | RmDirChange + deriving (Show, Eq) + type ChangeChan = TChan Change data Change = Change { changeTime :: UTCTime , changeFile :: FilePath - , changeDesc :: String + , changeType :: ChangeType } deriving (Show) @@ -30,11 +34,12 @@ newChangeChan :: IO ChangeChan newChangeChan = atomically newTChan {- Handlers call this when they made a change that needs to get committed. -} -madeChange :: FilePath -> String -> Annex (Maybe Change) -madeChange file desc = do +madeChange :: FilePath -> ChangeType -> Annex (Maybe Change) +madeChange f t = do -- Just in case the commit thread is not flushing the queue fast enough. - Annex.Queue.flushWhenFull - liftIO $ Just <$> (Change <$> getCurrentTime <*> pure file <*> pure desc) + when (t /= PendingAddChange) $ + Annex.Queue.flushWhenFull + liftIO $ Just <$> (Change <$> getCurrentTime <*> pure f <*> pure t) noChange :: Annex (Maybe Change) noChange = return Nothing @@ -66,9 +71,58 @@ commitThread st changechan = runEvery (Seconds 1) $ do -- Now see if now's a good time to commit. time <- getCurrentTime if shouldCommit time cs - then void $ tryIO $ runThreadState st commitStaged + then do + handleAdds st changechan cs + void $ tryIO $ runThreadState st commitStaged else refillChanges changechan cs +{- If there are PendingAddChanges, the files have not yet actually been + - added to the annex, and that has to be done now, before committing. + - + - Deferring the adds to this point causes batches to be bundled together, + - which allows faster checking with lsof that the files are not still open + - for write by some other process. + - + - When a file is added, Inotify will notice the new symlink. So this waits + - for one new LinkChange to be received per file that's successfully + - added, to ensure that its symlink has been staged before returning. + -} +handleAdds :: ThreadState -> ChangeChan -> [Change] -> IO () +handleAdds st changechan cs + | null added = noop + | otherwise = do + numadded <- length . filter id <$> + runThreadState st (forM added add) + waitforlinkchanges numadded + where + added = filter isPendingAdd cs + + isPendingAdd (Change { changeType = PendingAddChange }) = True + isPendingAdd _ = False + isLinkChange (Change { changeType = LinkChange }) = True + isLinkChange _ = False + + add (Change { changeFile = file }) = do + showStart "add" file + handle file =<< Command.Add.ingest file + + handle _ Nothing = do + showEndFail + return False + handle file (Just key) = do + Command.Add.link file key True + showEndOk + return True + + waitforlinkchanges 0 = noop + waitforlinkchanges n = do + c <- runChangeChan $ readTChan changechan + if (isLinkChange c) + then waitforlinkchanges (n-1) + else do + handleAdds st changechan [c] + waitforlinkchanges n + commitStaged :: Annex () commitStaged = do Annex.Queue.flush @@ -87,7 +141,7 @@ commitStaged = do {- Decide if now is a good time to make a commit. - Note that the list of change times has an undefined order. - - - Current strategy: If there have been 10 commits within the past second, + - Current strategy: If there have been 10 changes within the past second, - a batch activity is taking place, so wait for later. -} shouldCommit :: UTCTime -> [Change] -> Bool |