summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2022-12-06 20:35:37 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2022-12-15 22:18:28 +0100
commit66e6f51b732d351577bc04b4d6e21c8c20807840 (patch)
tree33e7d4b2efd2084f208969e15073c1b2c8141991 /src
parent671d3c183d17d018a865455190caca32a9cde3f2 (diff)
Kill process when it does not terminate within a second
Diffstat (limited to 'src')
-rw-r--r--src/Process.hs4
1 files changed, 4 insertions, 0 deletions
diff --git a/src/Process.hs b/src/Process.hs
index 8548e73..a1a421f 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -9,6 +9,7 @@ module Process (
) where
import Control.Arrow
+import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad.Except
@@ -89,6 +90,9 @@ closeProcess p = do
Nothing -> return ()
Just pid -> signalProcess sig pid
+ liftIO $ void $ forkIO $ do
+ threadDelay 1000000
+ terminateProcess $ procHandle p
liftIO (waitForProcess (procHandle p)) >>= \case
ExitSuccess -> return ()
ExitFailure code -> do