a3fb1754f2
Doing this at shutdown is not very important at all, but I do like to make sure that when git-annex allocates a resource, it later cleans it up. More importantly, stopCoProcesses is used in eg, Remote.Git in a situation where it needs to stop long-running processes like these.
68 lines
1.6 KiB
Haskell
68 lines
1.6 KiB
Haskell
{- git-annex actions
|
|
-
|
|
- Copyright 2010-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.Action (
|
|
action,
|
|
verifiedAction,
|
|
startup,
|
|
shutdown,
|
|
stopCoProcesses,
|
|
stopNonConcurrentSafeCoProcesses,
|
|
) 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
|
|
|
|
{- 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 = return ()
|
|
|
|
{- Cleanup actions. -}
|
|
shutdown :: Bool -> Annex ()
|
|
shutdown nocommit = do
|
|
saveState nocommit
|
|
sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
|
|
stopCoProcesses
|
|
|
|
{- Stops all long-running child processes, including git query processes. -}
|
|
stopCoProcesses :: Annex ()
|
|
stopCoProcesses = do
|
|
stopNonConcurrentSafeCoProcesses
|
|
emptyTransferrerPool
|
|
|
|
{- Stops long-running child processes that use handles that are not safe
|
|
- for multiple threads to access at the same time. -}
|
|
stopNonConcurrentSafeCoProcesses :: Annex ()
|
|
stopNonConcurrentSafeCoProcesses = do
|
|
catFileStop
|
|
checkAttrStop
|
|
hashObjectStop
|
|
checkIgnoreStop
|