diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2022-09-28 13:31:49 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2022-09-30 22:45:58 +0200 |
| commit | e6f8e2eeb66880950bd35fd82d439d87e7fa6bf5 (patch) | |
| tree | d1c225b647bfea85749dc65e25e931f1457309c0 /src/Main.hs | |
| parent | 8865c86aa904243ae91a598327e9dc1768ae8f3a (diff) | |
Generic record member selection expression
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 18 |
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) |