summaryrefslogtreecommitdiff
path: root/Assistant/Committer.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-15 16:27:44 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-15 19:00:06 -0400
commitc27c751b34af993a67e04e079d6f860a69f25038 (patch)
treee2c0b001bd4d7c9449fb5d6f246883d5d4b50876 /Assistant/Committer.hs
parent8c7dfc93b523957334c3b93530a85b7dcfa5cfb1 (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.hs68
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