ba7ecbc6a9
The flush was only done Annex.run' to make sure that the queue was flushed before git-annex exits. But, doing it there means that as soon as one change gets queued, it gets flushed soon after, which contributes to excessive writes to the database, slowing git-annex down. (This does not yet speed git-annex up, but it is a stepping stone to doing so.) Database queues do not autoflush when garbage collected, so have to be flushed explicitly. I don't think it's possible to make them autoflush (except perhaps if git-annex sqitched to using ResourceT..). The comment in Database.Keys.closeDb used to be accurate, since the automatic flushing did mean that all writes reached the database even when closeDb was not called. But now, closeDb or flushDb needs to be called before stopping using an Annex state. So, removed that comment. In Remote.Git, change to using quiesce everywhere that it used to use stopCoProcesses. This means that uses on onLocal in there are just as slow as before. I considered only calling closeDb on the local git remotes when git-annex exits. But, the reason that Remote.Git calls stopCoProcesses in each onLocal is so as not to leave git processes running that have files open on the remote repo, when it's on removable media. So, it seemed to make sense to also closeDb after each one, since sqlite may also keep files open. Although that has not seemed to cause problems with removable media so far. It was also just easier to quiesce in each onLocal than once at the end. This does likely leave performance on the floor, so could be revisited. In Annex.Content.saveState, there was no reason to close the db, flushing it is enough. The rest of the changes are from auditing for Annex.new, and making sure that quiesce is called, after any action that might possibly need it. After that audit, I'm pretty sure that the change to Annex.run' is safe. The only concern might be that this does let more changes get queued for write to the db, and if git-annex is interrupted, those will be lost. But interrupting git-annex can obviously already prevent it from writing the most recent change to the db, so it must recover from such lost data... right? Sponsored-by: Dartmouth College's Datalad project
105 lines
2.5 KiB
Haskell
105 lines
2.5 KiB
Haskell
{- git-annex actions
|
|
-
|
|
- Copyright 2010-2022 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Action (
|
|
action,
|
|
verifiedAction,
|
|
startup,
|
|
quiesce,
|
|
stopCoProcesses,
|
|
) where
|
|
|
|
import qualified Data.Map as M
|
|
|
|
import Annex.Common
|
|
import qualified Annex
|
|
import Annex.Content
|
|
import Annex.CatFile
|
|
import Annex.CheckAttr
|
|
import Annex.HashObject
|
|
import Annex.CheckIgnore
|
|
import Annex.TransferrerPool
|
|
import qualified Database.Keys
|
|
|
|
import Control.Concurrent.STM
|
|
#ifndef mingw32_HOST_OS
|
|
import System.Posix.Signals
|
|
#endif
|
|
|
|
{- Runs an action that may throw exceptions, catching and displaying them. -}
|
|
action :: Annex () -> Annex Bool
|
|
action a = tryNonAsync a >>= \case
|
|
Right () -> return True
|
|
Left e -> do
|
|
warning (show e)
|
|
return False
|
|
|
|
verifiedAction :: Annex Verification -> Annex (Bool, Verification)
|
|
verifiedAction a = tryNonAsync a >>= \case
|
|
Right v -> return (True, v)
|
|
Left e -> do
|
|
warning (show e)
|
|
return (False, UnVerified)
|
|
|
|
|
|
{- Actions to perform each time ran. -}
|
|
startup :: Annex ()
|
|
startup = do
|
|
#ifndef mingw32_HOST_OS
|
|
av <- Annex.getRead Annex.signalactions
|
|
let propagate sig = liftIO $ installhandleronce sig av
|
|
propagate sigINT
|
|
propagate sigQUIT
|
|
propagate sigTERM
|
|
propagate sigTSTP
|
|
propagate sigCONT
|
|
propagate sigHUP
|
|
-- sigWINCH is not propagated; it should not be needed,
|
|
-- and the concurrent-output library installs its own signal
|
|
-- handler for it.
|
|
-- sigSTOP and sigKILL cannot be caught, so will not be propagated.
|
|
where
|
|
installhandleronce sig av = void $
|
|
installHandler sig (CatchOnce (gotsignal sig av)) Nothing
|
|
gotsignal sig av = do
|
|
mapM_ (\a -> a (fromIntegral sig)) =<< atomically (readTVar av)
|
|
raiseSignal sig
|
|
installhandleronce sig av
|
|
#else
|
|
return ()
|
|
#endif
|
|
|
|
{- Rn all cleanup actions, save all state, stop all long-running child
|
|
- processes.
|
|
-
|
|
- This can be run repeatedly with other Annex actions run in between,
|
|
- but usually it is run only once at the end.
|
|
-
|
|
- When passed True, avoids making any commits to the git-annex branch,
|
|
- leaving changes in the journal for later commit.
|
|
-}
|
|
quiesce :: Bool -> Annex ()
|
|
quiesce nocommit = do
|
|
cas <- Annex.withState $ \st -> return
|
|
( st { Annex.cleanupactions = mempty }
|
|
, Annex.cleanupactions st
|
|
)
|
|
sequence_ (M.elems cas)
|
|
saveState nocommit
|
|
stopCoProcesses
|
|
Database.Keys.closeDb
|
|
|
|
{- Stops all long-running child processes, including git query processes. -}
|
|
stopCoProcesses :: Annex ()
|
|
stopCoProcesses = do
|
|
catFileStop
|
|
checkAttrStop
|
|
hashObjectStop
|
|
checkIgnoreStop
|
|
emptyTransferrerPool
|