FIX don't hang if one of the process we need to kill has died

This commit is contained in:
Nathan Dwarshuis 2020-04-11 13:46:51 -04:00
parent 8dcbcd054b
commit e47e4fb7e6
1 changed files with 9 additions and 5 deletions

View File

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