summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-03-26 21:34:44 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-03-28 22:10:06 +0200
commitc9a90244a7b4f9c752541c5ff19616f7ff980ee4 (patch)
treeefe53e9eab497f446538c9171c77dd3a66468f3f /src/Main.hs
parenta76fa89bf612f39a053390dfe1c78ba1f9331bd8 (diff)
Network subnets and routing
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs31
1 files changed, 21 insertions, 10 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 0d8a3fd..b49fe09 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -64,22 +64,28 @@ atomicallyTest act = do
Left e -> throwError e
Right x -> return x
-withNetwork :: (Network -> TestRun a) -> TestRun a
-withNetwork inner = do
+withInternet :: (Network -> TestRun a) -> TestRun a
+withInternet inner = do
testDir <- asks $ optTestDir . teOptions . fst
inet <- newInternet testDir
- let net = inetRoot inet
+ res <- withNetwork (inetRoot inet) $ \net -> do
+ local (fmap $ \s -> s { tsNetwork = net }) $ inner net
+ delInternet inet
+ return res
+withSubnet :: Network -> Maybe (TypedVarName Network) -> (Network -> TestRun a) -> TestRun a
+withSubnet parent tvname inner = do
+ net <- newSubnet parent (fromTypedVarName <$> tvname)
+ withNetwork net inner
+
+withNetwork :: Network -> (Network -> TestRun a) -> TestRun a
+withNetwork net inner = do
tcpdump <- liftIO (findExecutable "tcpdump") >>= return . \case
Just path -> withProcess (Left net) ProcNameTcpdump (Just softwareTermination)
- (path ++ " -i br0 -w '" ++ testDir ++ "/br0.pcap' -U -Z root") . const
+ (path ++ " -i br0 -w '" ++ netDir net ++ "/br0.pcap' -U -Z root") . const
Nothing -> id
- res <- tcpdump $ do
- local (fmap $ \s -> s { tsNetwork = net }) $ inner net
-
- delInternet inet
- return res
+ tcpdump $ inner net
withNode :: Expr Network -> Either (TypedVarName Node) (TypedVarName Process) -> (Node -> TestRun a) -> TestRun a
withNode netexpr tvname inner = do
@@ -156,6 +162,11 @@ evalSteps = mapM_ $ \case
forM_ value $ \i -> do
withVar name i $ evalSteps inner
+ Subnet name@(TypedVarName vname) parentExpr inner -> do
+ parent <- eval parentExpr
+ withSubnet parent (Just name) $ \net -> do
+ withVar vname net $ evalSteps inner
+
DeclNode name@(TypedVarName vname) net inner -> do
withNode net (Left name) $ \node -> do
withVar vname node $ evalSteps inner
@@ -243,7 +254,7 @@ runTest out opts test = do
oldHandler <- installHandler processStatusChanged (CatchInfo sigHandler) Nothing
res <- runExceptT $ flip runReaderT (tenv, tstate) $ fromTestRun $ do
- withNetwork $ \_ -> evalSteps (testSteps test)
+ withInternet $ \_ -> evalSteps (testSteps test)
void $ installHandler processStatusChanged oldHandler Nothing