summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Branch.hs2
-rw-r--r--Command/Log.hs2
-rw-r--r--Git/Command.hs41
-rw-r--r--Git/LsFiles.hs13
-rw-r--r--Git/LsTree.hs2
-rw-r--r--Git/UnionMerge.hs6
-rw-r--r--Git/UpdateIndex.hs5
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]
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-05 01:07:27 +0000