summaryrefslogtreecommitdiff
path: root/src/Process.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Process.hs')
-rw-r--r--src/Process.hs29
1 files changed, 28 insertions, 1 deletions
diff --git a/src/Process.hs b/src/Process.hs
index 958910d..bb33953 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -3,19 +3,25 @@ module Process (
ProcName(..),
textProcName, unpackProcName,
send,
+ outProc,
+ closeProcess,
) where
import Control.Concurrent.STM
-import Control.Monad.IO.Class
+import Control.Monad.Except
+import Data.Function
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
+import System.Exit
import System.IO
import System.Posix.Signals
import System.Process
+import Output
+
data Process = Process
{ procName :: ProcName
, procHandle :: ProcessHandle
@@ -24,6 +30,9 @@ data Process = Process
, procKillWith :: Maybe Signal
}
+instance Eq Process where
+ (==) = (==) `on` procStdin
+
data ProcName = ProcName Text
| ProcNameTcpdump
| ProcNameGDB
@@ -41,3 +50,21 @@ send :: MonadIO m => Process -> Text -> m ()
send p line = liftIO $ do
T.hPutStrLn (procStdin p) line
hFlush (procStdin p)
+
+outProc :: MonadOutput m => OutputType -> Process -> Text -> m ()
+outProc otype p line = outLine otype (textProcName $ procName p) line
+
+closeProcess :: (MonadIO m, MonadOutput m, MonadError () m) => Process -> m ()
+closeProcess p = do
+ liftIO $ hClose $ procStdin p
+ case procKillWith p of
+ Nothing -> return ()
+ Just sig -> liftIO $ getPid (procHandle p) >>= \case
+ Nothing -> return ()
+ Just pid -> signalProcess sig pid
+
+ liftIO (waitForProcess (procHandle p)) >>= \case
+ ExitSuccess -> return ()
+ ExitFailure code -> do
+ outProc OutputChildFail p $ T.pack $ "exit code: " ++ show code
+ throwError ()