1 files changed, 60 insertions, 17 deletions
diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs
index f72850fc5..534229d51 100644
--- a/Utility/CoProcess.hs
+++ b/Utility/CoProcess.hs
@@ -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