diff options
| -rw-r--r-- | src/Main.hs | 24 | ||||
| -rw-r--r-- | src/Run.hs | 2 | ||||
| -rw-r--r-- | src/Run/Monad.hs | 2 |
3 files changed, 26 insertions, 2 deletions
diff --git a/src/Main.hs b/src/Main.hs index b3f7a2a..3285bee 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -37,6 +37,7 @@ data CmdlineOptions = CmdlineOptions , optShowHelp :: Bool , optShowVersion :: Bool , optTestMode :: Bool + , optCmdlineTcpdump :: TcpdumpOption } defaultCmdlineOptions :: CmdlineOptions @@ -49,8 +50,15 @@ defaultCmdlineOptions = CmdlineOptions , optShowHelp = False , optShowVersion = False , optTestMode = False + , optCmdlineTcpdump = TcpdumpAuto } +data TcpdumpOption + = TcpdumpAuto + | TcpdumpManual FilePath + | TcpdumpOff + + options :: [ OptDescr (CmdlineOptions -> CmdlineOptions) ] options = [ Option ['T'] ["tool"] @@ -91,6 +99,12 @@ options = , Option [] ["wait"] (NoArg $ to $ \opts -> opts { optWait = True }) "wait at the end of each test" + , Option [] [ "no-tcpdump" ] + (NoArg (\opts -> opts { optCmdlineTcpdump = TcpdumpOff })) + "do not run tcpdump to capture network traffic" + , Option [] [ "tcpdump" ] + (OptArg (\str opts -> opts { optCmdlineTcpdump = maybe TcpdumpAuto TcpdumpManual str }) "<path>") + "use tcpdump to capture network traffic, at given <path> or found in PATH" , Option ['h'] ["help"] (NoArg $ \opts -> opts { optShowHelp = True }) "show this help and exit" @@ -199,7 +213,15 @@ main = do hPutStrLn stderr $ "Test ‘" <> T.unpack name <> "’ not found" exitFailure - ok <- allM (runTest out (optTest opts) globalDefs) $ + tcpdump <- case optCmdlineTcpdump opts of + TcpdumpAuto -> findExecutable "tcpdump" + TcpdumpManual path -> return (Just path) + TcpdumpOff -> return Nothing + + let topts = (optTest opts) + { optTcpdump = tcpdump + } + ok <- allM (runTest out topts globalDefs) $ concat $ replicate (optRepeat opts) tests when (not ok) exitFailure @@ -253,7 +253,7 @@ withSubnet parent tvname inner = do withNetwork :: Network -> (Network -> TestRun a) -> TestRun a withNetwork net inner = do - tcpdump <- liftIO (findExecutable "tcpdump") >>= return . \case + tcpdump <- asks (optTcpdump . teOptions . fst) >>= return . \case Just path -> withProcess (Left net) ProcNameTcpdump (Just softwareTermination) (path ++ " -i br0 -w './br0.pcap' -U -Z root") . const Nothing -> id diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs index f506b62..7a1d3c5 100644 --- a/src/Run/Monad.hs +++ b/src/Run/Monad.hs @@ -63,6 +63,7 @@ data TestOptions = TestOptions , optProcTools :: [(ProcName, String)] , optTestDir :: FilePath , optTimeout :: Scientific + , optTcpdump :: Maybe FilePath , optGDB :: Bool , optForce :: Bool , optKeep :: Bool @@ -75,6 +76,7 @@ defaultTestOptions = TestOptions , optProcTools = [] , optTestDir = ".test" , optTimeout = 1 + , optTcpdump = Nothing , optGDB = False , optForce = False , optKeep = False |