summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2022-09-28 13:31:49 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2022-09-30 22:45:58 +0200
commite6f8e2eeb66880950bd35fd82d439d87e7fa6bf5 (patch)
treed1c225b647bfea85749dc65e25e931f1457309c0 /src/Main.hs
parent8865c86aa904243ae91a598327e9dc1768ae8f3a (diff)
Generic record member selection expression
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs18
1 files changed, 10 insertions, 8 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 02d690f..b6c952f 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -165,27 +165,29 @@ createNode nname@(NodeName tnname) inner = do
net <- asks $ tsNetwork . snd
let name = T.unpack tnname
dir = netDir net </> ("erebos_" ++ name)
- node = Node { nodeName = nname
- , nodeNetwork = net
- , nodeDir = dir
- }
- ip <- liftIO $ do
+ node <- liftIO $ do
exists <- doesPathExist dir
when exists $ ioError $ userError $ dir ++ " exists"
createDirectoryIfMissing True dir
modifyMVar (netNodes net) $ \nodes -> do
let ip = "192.168.0." ++ show (11 + length nodes)
+ node = Node { nodeName = nname
+ , nodeIp = T.pack ip
+ , nodeNetwork = net
+ , nodeDir = dir
+ }
+
callCommand $ "ip netns add \""++ name ++ "\""
callCommand $ "ip link add \"veth_" ++ name ++ ".0\" group 1 type veth peer name \"veth_" ++ name ++ ".1\" netns \"" ++ name ++ "\""
callCommand $ "ip link set dev \"veth_" ++ name ++ ".0\" master br0 up"
callOn node $ "ip addr add " ++ ip ++ "/24 broadcast 192.168.0.255 dev \"veth_" ++ name ++ ".1\""
callOn node $ "ip link set dev \"veth_" ++ name++ ".1\" up"
callOn node $ "ip link set dev lo up"
- return $ (node : nodes, ip)
+ return $ (node : nodes, node)
- local (fmap $ \s -> s { tsVars = (VarName [tnname, T.pack "ip"], SomeVarValue (T.pack ip)) : tsVars s }) $ do
+ local (fmap $ \s -> s { tsVars = (VarName tnname, SomeVarValue node) : tsVars s }) $ do
inner node
callOn :: Node -> String -> IO ()
@@ -315,7 +317,7 @@ evalSteps = mapM_ $ \case
evalSteps inner
Spawn pname nname inner -> do
- getNode nname $ \node -> do
+ either getNode ((>>=) . eval) nname $ \node -> do
opts <- asks $ teOptions . fst
p <- spawnOn (Right node) pname Nothing $
fromMaybe (optDefaultTool opts) (lookup pname $ optProcTools opts)