summaryrefslogtreecommitdiffstats
path: root/src/Flameshot
diff options
context:
space:
mode:
Diffstat (limited to 'src/Flameshot')
-rw-r--r--src/Flameshot/Internal/Process.hs45
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