From 255e8baa916f9103dc703447474ca38ba118abe8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 2 Jun 2025 19:50:40 +0200
Subject: Replace 'ip netns exec' with direct setns syscall

---
 src/Network/Ip.hs | 14 ++++++++++++--
 src/Process.hs    | 14 +++++++-------
 2 files changed, 19 insertions(+), 9 deletions(-)

(limited to 'src')

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
-- 
cgit v1.2.3