From 5594bf0643b80c239b6856aec8efdd4b62803c06 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 4 Oct 2012 18:47:31 -0400 Subject: [PATCH] more zombie fighting I'm down to 9 places in the code that can produce unwaited for zombies. Most of these are pretty innocuous, at least for now, are only used in short-running commands, or commands that run a set of actions and explicitly reap zombies after each one. The one from Annex.Branch.files could be trouble later, since both Command.Fsck and Command.Unused can trigger it, and the assistant will be doing those eventally. Ditto the one in Git.LsTree.lsTree, which Command.Unused uses. The only ones currently affecting the assistant though, are in Git.LsFiles. Several threads use several of those. (And yeah, using pipes or ResourceT would be a less ad-hoc approach, but I don't really feel like ripping my entire code base apart right now to change a foundation monad. Maybe one of these days..) --- Annex/Branch.hs | 2 +- Command/Log.hs | 2 +- Git/Command.hs | 41 ++++++++++++++++++++++++----------------- Git/LsFiles.hs | 13 +++++++------ Git/LsTree.hs | 2 +- Git/UnionMerge.hs | 6 ++++-- Git/UpdateIndex.hs | 5 ++++- 7 files changed, 42 insertions(+), 29 deletions(-) diff --git a/Annex/Branch.hs b/Annex/Branch.hs index e74ab3a29a..99dba623c9 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -261,7 +261,7 @@ files :: Annex [FilePath] files = do update withIndex $ do - bfiles <- inRepo $ Git.Command.pipeNullSplit + bfiles <- inRepo $ Git.Command.pipeNullSplitZombie [Params "ls-tree --name-only -r -z", Param $ show fullname] jfiles <- getJournalledFiles return $ jfiles ++ bfiles diff --git a/Command/Log.hs b/Command/Log.hs index aa39aea9c7..9aaebeca69 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -136,7 +136,7 @@ getLog key os = do top <- fromRepo Git.repoPath p <- liftIO $ relPathCwdToFile top let logfile = p Logs.Location.logFile key - inRepo $ pipeNullSplit $ + inRepo $ pipeNullSplitZombie $ [ Params "log -z --pretty=format:%ct --raw --abbrev=40" , Param "--remove-empty" ] ++ os ++ diff --git a/Git/Command.hs b/Git/Command.hs index 71579808b0..2e95628603 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -8,7 +8,7 @@ module Git.Command where import System.Posix.Process (getAnyProcessStatus) -import System.Process +import System.Process (std_in, env) import Common import Git @@ -38,16 +38,17 @@ run subcommand params repo = assertLocal repo $ unlessM (runBool subcommand params repo) $ error $ "git " ++ subcommand ++ " " ++ show params ++ " failed" -{- Runs a git subcommand and returns its output, lazily. +{- Runs a git subcommand and returns its output, lazily. - - - Note that this leaves the git process running, and so zombies will - - result unless reap is called. + - Also returns an action that should be used when the output is all + - read (or no more is needed), that will wait on the command, and + - return True if it succeeded. Failure to wait will result in zombies. -} -pipeReadLazy :: [CommandParam] -> Repo -> IO String -pipeReadLazy params repo = assertLocal repo $ - withHandle StdoutHandle createBackgroundProcess p $ \h -> do - fileEncoding h - hGetContents h +pipeReadLazy :: [CommandParam] -> Repo -> IO (String, IO Bool) +pipeReadLazy params repo = assertLocal repo $ do + (Just h, _, _, pid) <- createProcess p { std_in = CreatePipe } + c <- hGetContents h + return (c, checkSuccessProcess pid) where p = gitCreateProcess params repo @@ -78,19 +79,20 @@ pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO () pipeWrite params repo = withHandle StdinHandle createProcessSuccess $ gitCreateProcess params repo -gitCreateProcess :: [CommandParam] -> Repo -> CreateProcess -gitCreateProcess params repo = - (proc "git" $ toCommand $ gitCommandLine params repo) - { env = gitEnv repo } - {- Reads null terminated output of a git command (as enabled by the -z - parameter), and splits it. -} -pipeNullSplit :: [CommandParam] -> Repo -> IO [String] -pipeNullSplit params repo = - filter (not . null) . split sep <$> pipeReadLazy params repo +pipeNullSplit :: [CommandParam] -> Repo -> IO ([String], IO Bool) +pipeNullSplit params repo = do + (s, cleanup) <- pipeReadLazy params repo + return (filter (not . null) $ split sep s, cleanup) where sep = "\0" +{- Does not wait on the git command when it's done, so produces + - one zombie. -} +pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [String] +pipeNullSplitZombie params repo = fst <$> pipeNullSplit params repo + {- Reaps any zombie git processes. -} reap :: IO () reap = do @@ -101,3 +103,8 @@ reap = do {- Runs a git command as a coprocess. -} gitCoProcessStart :: [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle gitCoProcessStart params repo = CoProcess.start "git" (toCommand $ gitCommandLine params repo) (gitEnv repo) + +gitCreateProcess :: [CommandParam] -> Repo -> CreateProcess +gitCreateProcess params repo = + (proc "git" $ toCommand $ gitCommandLine params repo) + { env = gitEnv repo } diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 321913334b..51879fe130 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -26,11 +26,11 @@ import Git.Sha {- Scans for files that are checked into git at the specified locations. -} inRepo :: [FilePath] -> Repo -> IO [FilePath] -inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l +inRepo l = pipeNullSplitZombie $ Params "ls-files --cached -z --" : map File l {- Scans for files at the specified locations that are not checked into git. -} notInRepo :: Bool -> [FilePath] -> Repo -> IO [FilePath] -notInRepo include_ignored l repo = pipeNullSplit params repo +notInRepo include_ignored l repo = pipeNullSplitZombie params repo where params = [Params "ls-files --others"] ++ exclude ++ [Params "-z --"] ++ map File l @@ -48,14 +48,14 @@ stagedNotDeleted :: [FilePath] -> Repo -> IO [FilePath] stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"] staged' :: [CommandParam] -> [FilePath] -> Repo -> IO [FilePath] -staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix +staged' ps l = pipeNullSplitZombie $ prefix ++ ps ++ suffix where prefix = [Params "diff --cached --name-only -z"] suffix = Param "--" : map File l {- Returns a list of files that have unstaged changes. -} changedUnstaged :: [FilePath] -> Repo -> IO [FilePath] -changedUnstaged l = pipeNullSplit params +changedUnstaged l = pipeNullSplitZombie params where params = Params "diff --name-only -z --" : map File l @@ -71,7 +71,7 @@ typeChanged = typeChanged' [] typeChanged' :: [CommandParam] -> [FilePath] -> Repo -> IO [FilePath] typeChanged' ps l repo = do - fs <- pipeNullSplit (prefix ++ ps ++ suffix) repo + fs <- pipeNullSplitZombie (prefix ++ ps ++ suffix) repo -- git diff returns filenames relative to the top of the git repo; -- convert to filenames relative to the cwd, like git ls-files. let top = repoPath repo @@ -108,7 +108,8 @@ unmerged :: [FilePath] -> Repo -> IO [Unmerged] unmerged l repo = reduceUnmerged [] . catMaybes . map parseUnmerged <$> list repo where files = map File l - list = pipeNullSplit $ Params "ls-files --unmerged -z --" : files + list = pipeNullSplitZombie $ + Params "ls-files --unmerged -z --" : files data InternalUnmerged = InternalUnmerged { isus :: Bool diff --git a/Git/LsTree.hs b/Git/LsTree.hs index 8f9066f0f3..dc03b88960 100644 --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -30,7 +30,7 @@ data TreeItem = TreeItem {- Lists the contents of a Ref -} lsTree :: Ref -> Repo -> IO [TreeItem] lsTree t repo = map parseLsTree <$> - pipeNullSplit [Params "ls-tree --full-tree -z -r --", File $ show t] repo + pipeNullSplitZombie [Params "ls-tree --full-tree -z -r --", File $ show t] repo {- Parses a line of ls-tree output. - (The --long format is not currently supported.) -} diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index 504147e1dc..d77e9313ce 100644 --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -58,9 +58,11 @@ diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"] {- Streams update-index changes to perform a merge, - using git to get a raw diff. -} doMerge :: CatFileHandle -> [String] -> Repo -> Streamer -doMerge ch differ repo streamer = gendiff >>= go +doMerge ch differ repo streamer = do + (diff, cleanup) <- pipeNullSplit (map Param differ) repo + go diff + void $ cleanup where - gendiff = pipeNullSplit (map Param differ) repo go [] = noop go (info:file:rest) = mergeFile info file ch repo >>= maybe (go rest) (\l -> streamer l >> go rest) diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 69e5f1b3dd..bc96570dea 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -48,7 +48,10 @@ streamUpdateIndex repo as = pipeWrite params repo $ \h -> do {- A streamer that adds the current tree for a ref. Useful for eg, copying - and modifying branches. -} lsTree :: Ref -> Repo -> Streamer -lsTree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo +lsTree (Ref x) repo streamer = do + (s, cleanup) <- pipeNullSplit params repo + mapM_ streamer s + void $ cleanup where params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]