FIX don't hang if one of the process we need to kill has died
This commit is contained in:
parent
8dcbcd054b
commit
e47e4fb7e6
|
@ -17,6 +17,8 @@ import Control.Concurrent
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
||||||
|
import Data.Maybe
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO
|
import System.IO
|
||||||
|
@ -38,11 +40,13 @@ waitUntilExit pid = do
|
||||||
|
|
||||||
killHandle :: ProcessHandle -> IO ()
|
killHandle :: ProcessHandle -> IO ()
|
||||||
killHandle ph = do
|
killHandle ph = do
|
||||||
pid <- getPid ph
|
ec <- getProcessExitCode ph
|
||||||
forM_ pid $ signalProcess sigTERM
|
unless (isJust ec) $ do
|
||||||
-- this may fail if the process exits instantly and the handle
|
pid <- getPid ph
|
||||||
-- is destroyed by the time we get to this line (I think?)
|
forM_ pid $ signalProcess sigTERM
|
||||||
void (try $ waitForProcess ph :: IO (Either IOException ExitCode))
|
-- this may fail if the process exits instantly and the handle
|
||||||
|
-- is destroyed by the time we get to this line (I think?)
|
||||||
|
void (try $ waitForProcess ph :: IO (Either IOException ExitCode))
|
||||||
|
|
||||||
withDefaultSignalHandlers :: IO a -> IO a
|
withDefaultSignalHandlers :: IO a -> IO a
|
||||||
withDefaultSignalHandlers =
|
withDefaultSignalHandlers =
|
||||||
|
|
Loading…
Reference in New Issue