diff options
author | tv <tv@krebsco.de> | 2019-01-26 16:04:29 +0100 |
---|---|---|
committer | tv <tv@krebsco.de> | 2019-01-26 16:04:29 +0100 |
commit | 3e8aabc3993e4ad1d34c25c1caeb75ff6faa97ff (patch) | |
tree | f6cb1332f225e50a03acbed1a9cefb7041266dfb /src/Reaktor/Plugins | |
parent | f8c5b4cfe57cb50503b8333d5d06bd0f99fdecc6 (diff) |
Reaktor.Plugins.System: add optional timeout
Diffstat (limited to 'src/Reaktor/Plugins')
-rw-r--r-- | src/Reaktor/Plugins/System.hs | 51 | ||||
-rw-r--r-- | src/Reaktor/Plugins/System/Internal.hs | 2 |
2 files changed, 35 insertions, 18 deletions
diff --git a/src/Reaktor/Plugins/System.hs b/src/Reaktor/Plugins/System.hs index 6d73e70..c23b4f0 100644 --- a/src/Reaktor/Plugins/System.hs +++ b/src/Reaktor/Plugins/System.hs @@ -23,6 +23,7 @@ import System.FilePath.Posix (takeBaseName) import System.IO (BufferMode(LineBuffering),hSetBuffering) import System.IO (Handle,hClose,hPutStr,hIsEOF) import System.Process +import System.Timeout import qualified Text.Regex.PCRE.Heavy as RE import qualified Text.Regex.PCRE.Light as RE @@ -158,8 +159,7 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do cwd = commandWorkDir <|> hWorkDir <|> cWorkDir - fork commandPath args cwd (Just env) "" onOutLine onErrLine onExit - `catch` onExcept + fork commandPath args cwd (Just env) "" hTimeout Callbacks{..} Nothing -> do let s = name <> ": command not found" @@ -167,28 +167,25 @@ run1 Config{..} Actions{..} Hook{..} prefix msgtarget text = do Nothing -> return () +data Callbacks = Callbacks + { onOutLine :: Text -> IO () + , onErrLine :: Text -> IO () + , onExit :: ExitCode -> IO () + , onExcept :: SomeException -> IO () + } + fork :: FilePath -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> String - -> (Text -> IO ()) - -> (Text -> IO ()) - -> (ExitCode -> IO ()) + -> Maybe Int + -> Callbacks -> IO () -fork path args cwd env input onOutLine onErrLine onExit = do - let - p = (proc path args) - { cwd = cwd - , env = env - , std_in = CreatePipe - , std_out = CreatePipe - , std_err = CreatePipe - , close_fds = True - , create_group = True - , new_session = True - } - withCreateProcess p $ \(Just inh) (Just outh) (Just errh) ph -> do +fork path args cwd env input hTimeout Callbacks{..} = + forkIO (withTimeout f `catch` onExcept) >> return () + where + f = withCreateProcess p $ \(Just inh) (Just outh) (Just errh) ph -> do mapM_ forkIO [ hPutStr inh input `finally` hClose inh, hWithLines outh onOutLine, @@ -196,6 +193,24 @@ fork path args cwd env input onOutLine onErrLine onExit = do ] waitForProcess ph >>= onExit + p = (proc path args) + { cwd = cwd + , env = env + , std_in = CreatePipe + , std_out = CreatePipe + , std_err = CreatePipe + , close_fds = True + , create_group = True + , new_session = True + } + + timeoutError = errorWithoutStackTrace "timeout" + + withTimeout = + case hTimeout of + Just time -> (maybe timeoutError return =<<) . timeout time + Nothing -> id + hWithLines :: Handle -> (Text -> IO ()) -> IO () hWithLines h f = do diff --git a/src/Reaktor/Plugins/System/Internal.hs b/src/Reaktor/Plugins/System/Internal.hs index 9b1b8de..45b7329 100644 --- a/src/Reaktor/Plugins/System/Internal.hs +++ b/src/Reaktor/Plugins/System/Internal.hs @@ -51,6 +51,7 @@ data Hook = Hook , hArguments :: [CaptureOr Text] , hWorkDir :: Maybe FilePath , hCommands :: HashMap Text Command + , hTimeout :: Maybe Int } deriving Show @@ -64,6 +65,7 @@ instance FromJSON Hook where <*> v .:? "arguments" .!= [] <*> v .:? "workdir" <*> v .:? "commands" .!= mempty + <*> (fmap (*1000000) <$> v .:? "timeoutSec" .!= Just 10) _ -> undefined |