mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

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

Browse source
This commit is contained in:
Joey Hess 2014-01-01 21:42:25 -04:00
parent e3344c1c71
commit 858eb26303
4 changed files with 17 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Utility/CoProcess.hs
View file

@ -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