File: watchdog.hs

package info (click to toggle)
haskell-mueval 0.9.1.1.2-9
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 164 kB
  • ctags: 1
  • sloc: haskell: 429; sh: 85; makefile: 4
file content (30 lines) | stat: -rw-r--r-- 1,633 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
-- | This implements a watchdog process. It calls mueval with all the
--   user-specified arguments, sleeps, and then if mueval is still running
--   kills it.
--   Even an out-of-control mueval will have trouble avoiding 'terminateProcess'.
--   Note that it's too difficult to parse the user arguments to get the timeout,
--   so we specify it as a constant which is a little more generous than the default.
module Main where

import Control.Concurrent (forkIO, threadDelay)
import System.Environment (getArgs)
import System.Exit (exitWith, ExitCode(ExitFailure))
import System.Posix.Signals (signalProcess)
import System.Process (getProcessExitCode, runProcess, terminateProcess, waitForProcess)
import System.Process.Internals (withProcessHandle, ProcessHandle__(OpenHandle))

main :: IO ()
main = do args <- getArgs
          hdl <- runProcess "mueval-core" args Nothing Nothing Nothing Nothing Nothing
          _ <- forkIO $ do
                     threadDelay (7 * 700000)
                     status <- getProcessExitCode hdl
                     case status of 
                         Nothing -> do terminateProcess hdl
                                       _ <- withProcessHandle hdl (\x -> case x of 
                                                                      OpenHandle pid -> signalProcess 9 pid >> return (undefined, undefined)
                                                                      _ -> return (undefined,undefined))
                                       exitWith (ExitFailure 1)
                         Just a -> exitWith a
          stat <- waitForProcess hdl
          exitWith stat