diff options
| -rw-r--r-- | erebos-tester.cabal | 3 | ||||
| -rw-r--r-- | src/GDB.hs | 36 | ||||
| -rw-r--r-- | src/Main.hs | 25 | ||||
| -rw-r--r-- | src/Process.hs | 7 |
4 files changed, 49 insertions, 22 deletions
diff --git a/erebos-tester.cabal b/erebos-tester.cabal index bae7d1e..4964b6f 100644 --- a/erebos-tester.cabal +++ b/erebos-tester.cabal @@ -33,7 +33,8 @@ executable erebos-tester executable erebos-tester-core ghc-options: -Wall -threaded main-is: Main.hs - other-modules: Output + other-modules: GDB + Output Parser Process Test diff --git a/src/GDB.hs b/src/GDB.hs new file mode 100644 index 0000000..40a4e8f --- /dev/null +++ b/src/GDB.hs @@ -0,0 +1,36 @@ +module GDB ( + gdbCmd, gdbInit, + addInferior, + gdbSession, +) where + +import Data.Text qualified as T +import Data.Text.IO qualified as T + +import System.IO.Error +import System.Process + +import Process + +gdbCmd :: String +gdbCmd = "gdb --quiet --interpreter=mi3" + +gdbInit :: Process -> IO () +gdbInit gdb = do + send gdb $ T.pack "-gdb-set schedule-multiple on" + send gdb $ T.pack "-gdb-set mi-async on" + send gdb $ T.pack "-gdb-set print symbol-loading off" + +addInferior :: Process -> Int -> Pid -> IO () +addInferior gdb i pid = do + send gdb $ T.pack $ "-add-inferior" + send gdb $ T.pack $ "-target-attach --thread-group i" ++ show i ++ " " ++ show pid + send gdb $ T.pack $ "-exec-continue --thread-group i" ++ show i + +gdbSession :: Process -> IO () +gdbSession gdb = do + catchIOError (Just <$> T.getLine) (\e -> if isEOFError e then return Nothing else ioError e) >>= \case + Just line -> do + send gdb (T.pack "-interpreter-exec console \"" `T.append` line `T.append` T.pack "\"") + gdbSession gdb + Nothing -> return () diff --git a/src/Main.hs b/src/Main.hs index 6444058..20e01e6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -27,6 +27,7 @@ import System.Posix.Process import System.Posix.Signals import System.Process +import GDB import Output import Parser import Process @@ -78,11 +79,7 @@ initNetwork out useGDB = do "tcpdump -i br0 -w '" ++ testDir ++ "/br0.pcap' -U -Z root" when useGDB $ do - 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" - send gdb $ T.pack "-gdb-set print symbol-loading off" + gdbInit =<< spawnOn out (Left net) ProcNameGDB Nothing gdbCmd return net @@ -100,15 +97,8 @@ exitNetwork out net okTest = do forM_ processes $ \p -> 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 - send p (T.pack "-interpreter-exec console \"" `T.append` line `T.append` T.pack "\"") - gdbSession - Nothing -> return () - outPrompt out $ T.pack "gdb> " - gdbSession + gdbSession p outClearPrompt out hClose (procStdin p) @@ -194,9 +184,7 @@ spawnOn out target pname killWith cmd = do ps <- readMVar (netProcesses net) forM_ ps $ \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) + addInferior gdb (length ps) pid Nothing -> return () modifyMVar_ (netProcesses net) $ return . (process:) @@ -230,11 +218,6 @@ expect out opts p re pat = do outLine out OutputMatchFail (Just $ procName p) $ T.pack "expect failed /" `T.append` pat `T.append` T.pack "/" return False -send :: Process -> Text -> IO () -send p line = do - T.hPutStrLn (procStdin p) line - hFlush (procStdin p) - allM :: Monad m => [a] -> (a -> m Bool) -> m Bool allM (x:xs) p = p x >>= \case True -> allM xs p; False -> return False allM [] _ = return True diff --git a/src/Process.hs b/src/Process.hs index f409720..9943d30 100644 --- a/src/Process.hs +++ b/src/Process.hs @@ -2,12 +2,14 @@ module Process ( Process(..), ProcName(..), textProcName, unpackProcName, + send, ) where import Control.Concurrent.STM import Data.Text (Text) import qualified Data.Text as T +import qualified Data.Text.IO as T import System.IO import System.Posix.Signals @@ -33,3 +35,8 @@ textProcName ProcNameGDB = T.pack "gdb" unpackProcName :: ProcName -> String unpackProcName = T.unpack . textProcName + +send :: Process -> Text -> IO () +send p line = do + T.hPutStrLn (procStdin p) line + hFlush (procStdin p) |