diff options
| -rw-r--r-- | src/Flameshot/Internal/Process.hs | 45 |
1 files changed, 44 insertions, 1 deletions
diff --git a/src/Flameshot/Internal/Process.hs b/src/Flameshot/Internal/Process.hs index 31e2fee..a4dc963 100644 --- a/src/Flameshot/Internal/Process.hs +++ b/src/Flameshot/Internal/Process.hs @@ -3,7 +3,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -module Flameshot.Internal.Process (run,Callbacks(..),writeDaemon) where +module Flameshot.Internal.Process (Callbacks(..),run,runAway,writeDaemon) where import Control.Concurrent (forkIO,threadDelay) import Control.Concurrent.Async (race) @@ -129,6 +129,49 @@ writeDaemon path args input = do BS.hPut hin input hClose hin void (getProcessStatus True False pid) + +runAway :: FilePath + -> [String] + -> Maybe FilePath + -> Maybe [(String, String)] + -> ByteString + -> Maybe Int + -> Callbacks + -> IO () +runAway path args cwd env input hTimeout Callbacks{..} = + f `catch` onError (-1) + where + f = do + (Just inh, Just outh, Just errh, ph) <- createProcess p + + Just pid <- getPid ph + + onStart pid + + mapM_ forkIO [ + BS.hPutStr inh input `finally` hClose inh, + hWithLines outh (onOutLine pid), + hWithLines errh (onErrLine pid) + ] + + case hTimeout of + Just time -> + race (threadDelay time) (waitForProcess ph) >>= \case + Left () -> onError pid (SomeException (ErrorCall "timeout")) + Right code -> onExit pid code + Nothing -> + waitForProcess ph >>= onExit pid + + 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 + } killProcessGroup :: ProcessGroupID -> IO () killProcessGroup = signalProcessGroup' killProcess |