Can now restart certain long-running git processes if they crash, and continue working.

Fuzz tests have shown that git cat-file --batch sometimes stops running.
It's not yet known why (no error message; repo seems ok). But this is
something we can deal with in the CoProcess framework, since all 3 types of
long-running git processes should be restartable if they fail.

Note that, as implemented, only IO errors are caught. So an error thrown
by the reveiver, when it sees something that is not valid output from
git cat-file (etc) will not cause a restart. I don't want it to retry
if git commands change their output or are just outputting garbage.
This does mean that if the command did a partial output and crashed in the
middle, it would still not be restarted.

There is currently no guard against restarting a command repeatedly, if,
for example, it crashes repeatedly on startup.
This commit is contained in:
Joey Hess 2013-05-31 12:20:17 -04:00
parent 8100cad9d5
commit 91c4dcfc69
6 changed files with 69 additions and 22 deletions

View file

@ -1,7 +1,7 @@
{- Interface for running a shell command as a coprocess,
- sending it queries and getting back results.
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -18,29 +18,72 @@ module Utility.CoProcess (
import Common
type CoProcessHandle = (ProcessHandle, Handle, Handle, CreateProcess)
import Control.Concurrent.MVar
start :: FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle
start command params env = do
(from, to, _err, pid) <- runInteractiveProcess command params Nothing env
return (pid, to, from, proc command params)
type CoProcessHandle = MVar CoProcessState
data CoProcessState = CoProcessState
{ coProcessPid :: ProcessHandle
, coProcessTo :: Handle
, coProcessFrom :: Handle
, coProcessSpec :: CoProcessSpec
}
data CoProcessSpec = CoProcessSpec
{ coProcessRestartable :: Bool
, 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
newMVar s
start' :: CoProcessSpec -> IO CoProcessState
start' s = do
(to, from, _err, pid) <- runInteractiveProcess (coProcessCmd s) (coProcessParams s) Nothing (coProcessEnv s)
return $ CoProcessState pid to from s
stop :: CoProcessHandle -> IO ()
stop (pid, from, to, p) = do
hClose to
hClose from
forceSuccessProcess p pid
stop ch = do
s <- readMVar ch
hClose $ coProcessTo s
hClose $ coProcessFrom s
let p = proc (coProcessCmd $ coProcessSpec s) (coProcessParams $ coProcessSpec s)
forceSuccessProcess p (coProcessPid s)
{- To handle a restartable process, any IO exception thrown by the send and
- receive actions are assumed to mean communication with the process
- failed, and the failed action is re-run with a new process. -}
query :: CoProcessHandle -> (Handle -> IO a) -> (Handle -> IO b) -> IO b
query (_, from, to, _) send receive = do
_ <- send to
hFlush to
receive from
query ch send receive = do
s <- readMVar ch
restartable s (send $ coProcessTo s) $ const $
restartable s (hFlush $ coProcessTo s) $ const $
restartable s (receive $ coProcessFrom s) $
return
where
restartable s a cont
| coProcessRestartable (coProcessSpec s) =
maybe restart cont =<< catchMaybeIO a
| otherwise = cont =<< a
restart = do
s <- takeMVar ch
void $ catchMaybeIO $ do
hClose $ coProcessTo s
hClose $ coProcessFrom s
void $ waitForProcess $ coProcessPid s
s' <- start' (coProcessSpec s)
putMVar ch s'
query ch send receive
rawMode :: CoProcessHandle -> IO CoProcessHandle
rawMode ch@(_, from, to, _) = do
raw from
raw to
rawMode ch = do
s <- readMVar ch
raw $ coProcessFrom s
raw $ coProcessTo s
return ch
where
raw h = do