Avoid looping if long-running git cat-file or git hash-object crashes and keeps crashing when restarted.

1 files changed, 7 insertions, 6 deletions

diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs
index 710d2af13..c1134011b 100644
--- a/Utility/CoProcess.hs
+++ b/Utility/CoProcess.hs
@@ -30,15 +30,15 @@ data CoProcessState = CoProcessState
 	}
 
 data CoProcessSpec = CoProcessSpec
-	{ coProcessRestartable :: Bool
+	{ coProcessNumRestarts :: Int
 	, coProcessCmd :: FilePath
 	, coProcessParams :: [String]
 	, coProcessEnv :: Maybe [(String, String)]
 	}
 
-start :: Bool -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle
-start restartable cmd params env = do
-	s <- start' $ CoProcessSpec restartable cmd params env
+start :: Int -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle
+start numrestarts cmd params env = do
+	s <- start' $ CoProcessSpec numrestarts cmd params env
 	newMVar s
 
 start' :: CoProcessSpec -> IO CoProcessState
@@ -66,7 +66,7 @@ query ch send receive = do
 				return
   where
   	restartable s a cont
-		| coProcessRestartable (coProcessSpec s) =
+		| coProcessNumRestarts (coProcessSpec s) > 0 =
 			maybe restart cont =<< catchMaybeIO a
 		| otherwise = cont =<< a
 	restart = do
@@ -75,7 +75,8 @@ query ch send receive = do
 			hClose $ coProcessTo s
 			hClose $ coProcessFrom s
 		void $ waitForProcess $ coProcessPid s
-		s' <- start' (coProcessSpec s)
+		s' <- start' $ (coProcessSpec s)
+			{ coProcessNumRestarts = coProcessNumRestarts (coProcessSpec s) - 1 }
 		putMVar ch s'
 		query ch send receive