diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 25 | 
1 files changed, 8 insertions, 17 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) |