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.

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

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'

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