Command-line option to disable or force tcpdumpHEADmaster

Changelog: Added comman-line options to set path of tcpdump or disable its use

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
 
diff --git a/src/Run.hs b/src/Run.hs
index ad108e3..8a95daf 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -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