diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 25 | ||||
| -rw-r--r-- | src/Process.hs | 35 | ||||
| -rw-r--r-- | src/Test.hs | 11 |
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) |