diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 31 |
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 |