diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-09-29 22:36:08 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-09-29 22:36:08 -0400 |
commit | c85e2d09160e46d9bf38b711308708c8d13119d6 (patch) | |
tree | 8e22990c20f3551e87d96e15a0b5b05c6586cf38 /Annex | |
parent | b8248cf826a69ca43d3fe462b6686407cb859c65 (diff) |
fix process and FD leak
Fix process and file descriptor leak that was exposed when git-annex was
built with ghc 8.2.1. Apparently ghc has changed its behavior of GC
of open file handles that are pipes to running processes. That
broke git-annex test on OSX due to running out of FDs.
Audited for all uses of Annex.new and made stopCoProcesses be called
once it's done with the state. Fixed several places that might have
leaked in other situations than running the test suite.
This commit was sponsored by Ewen McNeill.
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/Action.hs | 13 | ||||
-rw-r--r-- | Annex/Concurrent.hs | 15 | ||||
-rw-r--r-- | Annex/MakeRepo.hs | 3 |
3 files changed, 17 insertions, 14 deletions
diff --git a/Annex/Action.hs b/Annex/Action.hs index a18ebaf78..fc8be6c91 100644 --- a/Annex/Action.hs +++ b/Annex/Action.hs @@ -17,6 +17,10 @@ import System.Posix.Signals import Annex.Common import qualified Annex import Annex.Content +import Annex.CatFile +import Annex.CheckAttr +import Annex.HashObject +import Annex.CheckIgnore {- Actions to perform each time ran. -} startup :: Annex () @@ -32,4 +36,13 @@ shutdown :: Bool -> Annex () shutdown nocommit = do saveState nocommit sequence_ =<< M.elems <$> Annex.getState Annex.cleanup + stopCoProcesses liftIO reapZombies -- zombies from long-running git processes + +{- Stops all long-running git query processes. -} +stopCoProcesses :: Annex () +stopCoProcesses = do + catFileStop + checkAttrStop + hashObjectStop + checkIgnoreStop diff --git a/Annex/Concurrent.hs b/Annex/Concurrent.hs index 71a70fa5b..65acb0450 100644 --- a/Annex/Concurrent.hs +++ b/Annex/Concurrent.hs @@ -7,12 +7,9 @@ module Annex.Concurrent where -import Annex.Common import Annex -import Annex.CatFile -import Annex.CheckAttr -import Annex.HashObject -import Annex.CheckIgnore +import Annex.Common +import Annex.Action import qualified Annex.Queue import qualified Data.Map as M @@ -61,11 +58,3 @@ mergeState st = do uncurry addCleanup Annex.Queue.mergeFrom st' changeState $ \s -> s { errcounter = errcounter s + errcounter st' } - -{- Stops all long-running git query processes. -} -stopCoProcesses :: Annex () -stopCoProcesses = do - catFileStop - checkAttrStop - hashObjectStop - checkIgnoreStop diff --git a/Annex/MakeRepo.hs b/Annex/MakeRepo.hs index adf49ed2c..e03196664 100644 --- a/Annex/MakeRepo.hs +++ b/Annex/MakeRepo.hs @@ -16,6 +16,7 @@ import qualified Git.Branch import qualified Annex import Annex.UUID import Annex.Direct +import Annex.Action import Types.StandardGroups import Logs.PreferredContent import qualified Annex.Branch @@ -42,7 +43,7 @@ makeRepo path bare = ifM (probeRepoExists path) inDir :: FilePath -> Annex a -> IO a inDir dir a = do state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir - Annex.eval state a + Annex.eval state $ a `finally` stopCoProcesses {- Creates a new repository, and returns its UUID. -} initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID |