Merge from git-annex.

1 files changed, 29 insertions, 24 deletions

diff --git a/Git/Command.hs b/Git/Command.hs
index 15157a0..fef7eb9 100644
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -1,6 +1,6 @@
 {- running git commands
  -
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -43,15 +43,19 @@ run params repo = assertLocal repo $
 
 {- Runs git and forces it to be quiet, throwing an error if it fails. -}
 runQuiet :: [CommandParam] -> Repo -> IO ()
-runQuiet params repo = withQuietOutput createProcessSuccess $
-	(proc "git" $ toCommand $ gitCommandLine (params) repo)
-		{ env = gitEnv repo }
+runQuiet params repo = withNullHandle $ \nullh ->
+	let p = (proc "git" $ toCommand $ gitCommandLine (params) repo)
+		{ env = gitEnv repo
+		, std_out = UseHandle nullh
+		, std_err = UseHandle nullh
+		}
+	in withCreateProcess p $ \_ _ _ -> forceSuccessProcess p
 
 {- Runs a git command and returns its output, lazily.
  -
  - Also returns an action that should be used when the output is all
  - read, that will wait on the command, and
- - return True if it succeeded. Failure to wait will result in zombies.
+ - return True if it succeeded.
  -}
 pipeReadLazy :: [CommandParam] -> Repo -> IO (L.ByteString, IO Bool)
 pipeReadLazy params repo = assertLocal repo $ do
@@ -70,13 +74,17 @@ pipeReadStrict = pipeReadStrict' S.hGetContents
 
 {- The reader action must be strict. -}
 pipeReadStrict' :: (Handle -> IO a) -> [CommandParam] -> Repo -> IO a
-pipeReadStrict' reader params repo = assertLocal repo $
-	withHandle StdoutHandle (createProcessChecked ignoreFailureProcess) p $ \h -> do
-		output <- reader h
-		hClose h
-		return output
+pipeReadStrict' reader params repo = assertLocal repo $ withCreateProcess p go
   where
-	p  = gitCreateProcess params repo
+	p  = (gitCreateProcess params repo)
+		{ std_out = CreatePipe }
+
+	go _ (Just outh) _ pid = do
+		output <- reader outh
+		hClose outh
+		void $ waitForProcess pid
+		return output
+	go _ _ _ _ = error "internal"
 
 {- Runs a git command, feeding it an input, and returning its output,
  - which is expected to be fairly small, since it's all read into memory
@@ -95,9 +103,16 @@ pipeWriteRead params writer repo = assertLocal repo $
 
 {- Runs a git command, feeding it input on a handle with an action. -}
 pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()
-pipeWrite params repo = assertLocal repo $ 
-	withHandle StdinHandle createProcessSuccess $
-		gitCreateProcess params repo
+pipeWrite params repo feeder = assertLocal repo $
+	let p = (gitCreateProcess params repo)
+		{ std_in = CreatePipe }
+	in withCreateProcess p (go p)
+  where
+	go p (Just hin) _ _ pid = do
+		feeder hin
+		hClose hin
+		forceSuccessProcess p pid
+	go _ _ _ _ _ = error "internal"
 
 {- Reads null terminated output of a git command (as enabled by the -z 
  - parameter), and splits it. -}
@@ -119,16 +134,6 @@ pipeNullSplitStrict params repo = do
 	s <- pipeReadStrict params repo
 	return $ filter (not . S.null) $ S.split 0 s
 
-pipeNullSplitZombie :: [CommandParam] -> Repo -> IO [L.ByteString]
-pipeNullSplitZombie params repo = leaveZombie <$> pipeNullSplit params repo
-
-pipeNullSplitZombie' :: [CommandParam] -> Repo -> IO [S.ByteString]
-pipeNullSplitZombie' params repo = leaveZombie <$> pipeNullSplit' params repo
-
-{- Doesn't run the cleanup action. A zombie results. -}
-leaveZombie :: (a, IO Bool) -> a
-leaveZombie = fst
-
 {- Runs a git command as a coprocess. -}
 gitCoProcessStart :: Bool -> [CommandParam] -> Repo -> IO CoProcess.CoProcessHandle
 gitCoProcessStart restartable params repo = CoProcess.start numrestarts "git"