diff options
| -rw-r--r-- | src/Network/Ip.hs | 14 | ||||
| -rw-r--r-- | src/Process.hs | 14 | ||||
| -rw-r--r-- | test/asset/run/sysinfo.et | 12 | ||||
| -rwxr-xr-x | test/asset/run/tools/sysinfo.sh | 9 | ||||
| -rw-r--r-- | test/script/run.et | 18 |
5 files changed, 58 insertions, 9 deletions
diff --git a/src/Network/Ip.hs b/src/Network/Ip.hs index a4fdf50..3750793 100644 --- a/src/Network/Ip.hs +++ b/src/Network/Ip.hs @@ -19,6 +19,7 @@ module Network.Ip ( addNetworkNamespace, setNetworkNamespace, textNetnsName, + runInNetworkNamespace, callOn, Link(..), @@ -33,6 +34,7 @@ module Network.Ip ( addRoute, ) where +import Control.Concurrent import Control.Concurrent.STM import Control.Exception import Control.Monad @@ -142,12 +144,20 @@ foreign import ccall unsafe "sched.h setns" c_setns :: CInt -> CInt -> IO CInt c_CLONE_NEWNET :: CInt c_CLONE_NEWNET = 0x40000000 +runInNetworkNamespace :: NetworkNamespace -> IO a -> IO a +runInNetworkNamespace netns act = do + mvar <- newEmptyMVar + void $ forkOS $ do + setNetworkNamespace netns + putMVar mvar =<< act + takeMVar mvar + + textNetnsName :: NetworkNamespace -> Text textNetnsName = netnsName callOn :: HasNetns a => a -> Text -> IO () -callOn n cmd = callCommand $ T.unpack $ "ip netns exec \"" <> ns <> "\" " <> cmd - where ns = textNetnsName $ getNetns n +callOn n cmd = runInNetworkNamespace (getNetns n) $ callCommand $ T.unpack cmd data Link a = Link diff --git a/src/Process.hs b/src/Process.hs index 290aedf..61a9fe8 100644 --- a/src/Process.hs +++ b/src/Process.hs @@ -93,7 +93,7 @@ lineReadingLoop process h act = spawnOn :: Either Network Node -> ProcName -> Maybe Signal -> String -> TestRun Process spawnOn target pname killWith cmd = do -- When executing command given with relative path, turn it to absolute one, - -- because working directory will be changed for the "ip netns exec" wrapper. + -- because working directory will be changed for the shell wrapper. cmd' <- liftIO $ do case span (/= ' ') cmd of ( path, rest ) @@ -104,13 +104,13 @@ spawnOn target pname killWith cmd = do _ -> return cmd let netns = either getNetns getNetns target - let prefix = T.unpack $ "ip netns exec \"" <> textNetnsName netns <> "\" " currentEnv <- liftIO $ getEnvironment - (Just hin, Just hout, Just herr, handle) <- liftIO $ createProcess (shell $ prefix ++ cmd') - { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe - , cwd = Just (either netDir nodeDir target) - , env = Just $ ( "EREBOS_DIR", "." ) : currentEnv - } + (Just hin, Just hout, Just herr, handle) <- liftIO $ do + runInNetworkNamespace netns $ createProcess (shell cmd') + { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe + , cwd = Just (either netDir nodeDir target) + , env = Just $ ( "EREBOS_DIR", "." ) : currentEnv + } pout <- liftIO $ newTVarIO [] let process = Process diff --git a/test/asset/run/sysinfo.et b/test/asset/run/sysinfo.et new file mode 100644 index 0000000..1b9f6aa --- /dev/null +++ b/test/asset/run/sysinfo.et @@ -0,0 +1,12 @@ +test SysInfo: + node n + spawn on n as p1 + with p1: + send "network-info" + expect /ip ${n.ifname} ${n.ip}/ + + spawn as p2 + guard (p2.node.ip /= p1.node.ip) + with p2: + send "network-info" + expect /ip ${n.ifname} ${p2.node.ip}/ diff --git a/test/asset/run/tools/sysinfo.sh b/test/asset/run/tools/sysinfo.sh new file mode 100755 index 0000000..38591f4 --- /dev/null +++ b/test/asset/run/tools/sysinfo.sh @@ -0,0 +1,9 @@ +#!/bin/sh + +while read cmd; do + case "$cmd" in + network-info) + ip -o addr show | sed -e 's/[0-9]*: \([a-z0-9]*\).*inet6\? \([0-9a-f:.]*\).*/ip \1 \2/' + ;; + esac +done diff --git a/test/script/run.et b/test/script/run.et index 103a3e1..973a786 100644 --- a/test/script/run.et +++ b/test/script/run.et @@ -45,3 +45,21 @@ test RunConfig: expect /match p abcdef/ expect /run-test-result ExpectEcho done/ expect /run-all-done/ + + +test GetSysInfo: + node n + shell on n: + cp ${scripts.path}/erebos-tester.yaml . + mkdir tools + cp ${scripts.path}/tools/sysinfo.sh ./tools/tool + mkdir scripts + cp ${scripts.path}/sysinfo.et ./scripts/ + + spawn as p on n + + with p: + send "load-config" + expect /load-config-done/ + send "run SysInfo" + expect /run-done/ |