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 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

(limited to 'src/Network/Ip.hs')

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