-- TODO: Currently we usually exit successfully even when there was a -- problem. Need to sort out the exit code business. -- A possible feature: importing by default ShowQ and ShowFun. Lambdabot seems to find them worthwhile. module Main (main) where import Control.Concurrent (forkIO, myThreadId, threadDelay, throwTo, ThreadId) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, MVar) import Control.Exception (catchDyn, Exception(ErrorCall)) import System.Environment (getArgs) import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering)) import System.Posix.Signals (sigXCPU, installHandler, Handler(CatchOnce)) import qualified Mueval.Context (cleanModules) import Mueval.Interpreter import Mueval.ParseArgs import qualified Mueval.Resources (limitResources) main :: IO () main = do input <- getArgs (a,_) <- interpreterOpts input if (Mueval.Context.cleanModules $ modules a) then do mvar <- newEmptyMVar Mueval.Resources.limitResources myThreadId >>= watchDog a forkIO $ forkedMain (mvar) a (modules a) (expression a) takeMVar mvar -- block until a ErrorCall or the forkedMain succeeds return () else error "Unknown or untrusted module supplied! Aborting." -- Set a watchdog, and then evaluate. forkedMain :: MVar [Char] -> Options -> [ModuleName] -> String -> IO () forkedMain mvar tout mdls expr = do -- This *should* be redundant with the previous watchDog, -- but maybe not. myThreadId >>= watchDog tout hSetBuffering stdout NoBuffering -- Our modules and expression are set up. Let's do stuff. interpreterSession mdls expr `catchDyn` (printInterpreterError) putMVar mvar "Done." -- | Fork off a thread which will sleep and kill off another thread at some point. watchDog :: Options -> ThreadId -> IO () watchDog tout tid = do installHandler sigXCPU (CatchOnce $ throwTo tid $ ErrorCall "Time limit exceeded by handler") Nothing forkIO $ threadDelay (timeLimit tout * 1000000) >> throwTo tid (ErrorCall "Time limit exceeded") return ()