diff options
| -rw-r--r-- | Annex/Branch.hs | 2 | ||||
| -rw-r--r-- | Command/Log.hs | 2 | ||||
| -rw-r--r-- | Git/Command.hs | 41 | ||||
| -rw-r--r-- | Git/LsFiles.hs | 13 | ||||
| -rw-r--r-- | Git/LsTree.hs | 2 | ||||
| -rw-r--r-- | Git/UnionMerge.hs | 6 | ||||
| -rw-r--r-- | Git/UpdateIndex.hs | 5 |
7 files changed, 42 insertions, 29 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index e74ab3a29..99dba623c 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 aa39aea9c..9aaebeca6 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 71579808b..2e9562860 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 321913334..51879fe13 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 8f9066f0f..dc03b8896 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 504147e1d..d77e9313c 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 69e5f1b3d..bc96570de 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] |