summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs25
-rw-r--r--src/Process.hs35
-rw-r--r--src/Test.hs11
3 files changed, 45 insertions, 26 deletions
diff --git a/src/Main.hs b/src/Main.hs
index ae4ca4c..c7be179 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -26,6 +26,7 @@ import System.Process
import Output
import Parser
+import Process
import Test
data Network = Network
@@ -40,15 +41,6 @@ data Node = Node
, nodeDir :: FilePath
}
-data Process = Process
- { procName :: ProcName
- , procHandle :: ProcessHandle
- , procNode :: Either Network Node
- , procStdin :: Handle
- , procOutput :: TVar [Text]
- , procKillWith :: Maybe Signal
- }
-
data Options = Options
{ optGDB :: Bool
}
@@ -73,11 +65,11 @@ initNetwork out useGDB = do
callCommand "ip link set dev lo up"
net <- Network <$> newMVar [] <*> newMVar [] <*> pure testDir
- void $ spawnOn out (Left net) (ProcName (T.pack "tcpdump")) (Just softwareTermination) $
+ void $ spawnOn out (Left net) (ProcNameTcpdump) (Just softwareTermination) $
"tcpdump -i br0 -w '" ++ testDir ++ "/br0.pcap' -U -Z root"
when useGDB $ do
- gdb <- spawnOn out (Left net) (ProcName (T.pack "gdb")) Nothing $
+ gdb <- spawnOn out (Left net) (ProcNameGDB) Nothing $
"gdb --quiet --interpreter=mi3"
send gdb $ T.pack "-gdb-set schedule-multiple on"
send gdb $ T.pack "-gdb-set mi-async on"
@@ -89,7 +81,7 @@ exitNetwork :: Output -> Network -> Bool -> IO ()
exitNetwork out net okTest = do
processes <- readMVar (netProcesses net)
forM_ processes $ \p -> do
- when (procName p /= ProcName (T.pack "gdb")) $ do
+ when (procName p /= ProcNameGDB) $ do
hClose (procStdin p)
case procKillWith p of
Nothing -> return ()
@@ -98,7 +90,7 @@ exitNetwork out net okTest = do
Just pid -> signalProcess sig pid
forM_ processes $ \p -> do
- when (procName p == ProcName (T.pack "gdb")) $ do
+ when (procName p == ProcNameGDB) $ do
let gdbSession = do
catchIOError (Just <$> T.getLine) (\e -> if isEOFError e then return Nothing else ioError e) >>= \case
Just line -> do
@@ -175,25 +167,24 @@ spawnOn out target pname killWith cmd = do
atomically $ modifyTVar pout (++[line])
void $ forkIO $ readingLoop herr $ \line -> do
case pname of
- ProcName tname | tname == T.pack "tcpdump" -> return ()
+ ProcNameTcpdump -> return ()
_ -> outLine out OutputChildStderr (Just pname) line
let process = Process
{ procName = pname
, procHandle = handle
- , procNode = target
, procStdin = hin
, procOutput = pout
, procKillWith = killWith
}
let net = either id nodeNetwork target
- when (pname /= ProcName (T.pack "gdb")) $ do
+ when (pname /= ProcNameGDB) $ do
getPid handle >>= \case
Just pid -> void $ do
ps <- readMVar (netProcesses net)
forM_ ps $ \gdb -> do
- when (procName gdb == ProcName (T.pack "gdb")) $ do
+ when (procName gdb == ProcNameGDB) $ do
send gdb $ T.pack $ "-add-inferior"
send gdb $ T.pack $ "-target-attach --thread-group i" ++ show (length ps) ++ " " ++ show pid
send gdb $ T.pack $ "-exec-continue --thread-group i" ++ show (length ps)
diff --git a/src/Process.hs b/src/Process.hs
new file mode 100644
index 0000000..f409720
--- /dev/null
+++ b/src/Process.hs
@@ -0,0 +1,35 @@
+module Process (
+ Process(..),
+ ProcName(..),
+ textProcName, unpackProcName,
+) where
+
+import Control.Concurrent.STM
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import System.IO
+import System.Posix.Signals
+import System.Process
+
+data Process = Process
+ { procName :: ProcName
+ , procHandle :: ProcessHandle
+ , procStdin :: Handle
+ , procOutput :: TVar [Text]
+ , procKillWith :: Maybe Signal
+ }
+
+data ProcName = ProcName Text
+ | ProcNameTcpdump
+ | ProcNameGDB
+ deriving (Eq, Ord)
+
+textProcName :: ProcName -> Text
+textProcName (ProcName name) = name
+textProcName ProcNameTcpdump = T.pack "tcpdump"
+textProcName ProcNameGDB = T.pack "gdb"
+
+unpackProcName :: ProcName -> String
+unpackProcName = T.unpack . textProcName
diff --git a/src/Test.hs b/src/Test.hs
index 4988098..465b424 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -11,6 +11,8 @@ import qualified Data.Text as T
import Text.Regex.TDFA
+import Process
+
data Test = Test
{ testName :: Text
, testSteps :: [TestStep]
@@ -21,15 +23,6 @@ data TestStep = Spawn ProcName NodeName
| Expect ProcName Regex Text
| Wait
-newtype ProcName = ProcName Text
- deriving (Eq, Ord)
-
-textProcName :: ProcName -> Text
-textProcName (ProcName name) = name
-
-unpackProcName :: ProcName -> String
-unpackProcName (ProcName tname) = T.unpack tname
-
newtype NodeName = NodeName Text
deriving (Eq, Ord)