clean up transferrer pool

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.

diff --git a/Annex/Action.hs b/Annex/Action.hs
index fca7e14958a486ddce9030cf101a4d4ce3ac4394..b1ab48f9a29234f3f9aa603d90406873d872fdef 100644 (file)
--- a/Annex/Action.hs
+++ b/Annex/Action.hs
@@ -1,6 +1,6 @@
 {- git-annex actions
  -
- - Copyright 2010-2015 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -11,6 +11,7 @@ module Annex.Action (
        startup,
        shutdown,
        stopCoProcesses,
+       stopNonConcurrentSafeCoProcesses,
 ) where
 
 import qualified Data.Map as M
@@ -22,6 +23,7 @@ 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
@@ -50,9 +52,16 @@ shutdown nocommit = do
        sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
        stopCoProcesses
 
-{- Stops all long-running git query processes. -}
+{- 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

diff --git a/Annex/Concurrent.hs b/Annex/Concurrent.hs
index 856555bbe8e862479a570b571192e77a4bc38a95..6f10e338859526ef63c61069f724c43059711e44 100644 (file)
--- a/Annex/Concurrent.hs
+++ b/Annex/Concurrent.hs
@@ -99,7 +99,7 @@ dupState = do
  - Also closes various handles in it. -}
 mergeState :: AnnexState -> Annex ()
 mergeState st = do
-       st' <- liftIO $ snd <$> run st stopCoProcesses
+       st' <- liftIO $ snd <$> run st stopNonConcurrentSafeCoProcesses
        forM_ (M.toList $ Annex.cleanup st') $
                uncurry addCleanup
        Annex.Queue.mergeFrom st'

diff --git a/Annex/TransferrerPool.hs b/Annex/TransferrerPool.hs
index f2c885f815b22cf8ada6b115ecb31e3bd586fe1d..f6babdcc632be654dc536dc0ae49bf7f18f8fc9f 100644 (file)
--- a/Annex/TransferrerPool.hs
+++ b/Annex/TransferrerPool.hs
@@ -265,3 +265,12 @@ killTransferrer t = do
        interruptProcessGroupOf $ transferrerHandle t
        threadDelay 50000 -- 0.05 second grace period
        terminateProcess $ transferrerHandle t
+
+{- Stop all transferrers in the pool. -}
+emptyTransferrerPool :: Annex ()
+emptyTransferrerPool = do
+       poolvar <- Annex.getState Annex.transferrerpool
+       pool <- liftIO $ atomically $ swapTVar poolvar []
+       liftIO $ forM_ pool $ \case
+               TransferrerPoolItem (Just t) _ -> shutdownTransferrer t
+               TransferrerPoolItem Nothing _ -> noop