From 55a699fcbb6d222e08f6fc7739ed1d3d9d98d09f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Wed, 4 Aug 2021 22:05:05 +0200
Subject: Create EREBOS_DIR and pass it via environment

---
 .gitignore          |  1 +
 erebos-tester.cabal |  2 ++
 src/Main.hs         | 24 ++++++++++++++++++++++--
 3 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/.gitignore b/.gitignore
index c33954f..edc0c50 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1 +1,2 @@
 dist-newstyle/
+.test
diff --git a/erebos-tester.cabal b/erebos-tester.cabal
index d9e25c7..ab52ab4 100644
--- a/erebos-tester.cabal
+++ b/erebos-tester.cabal
@@ -37,6 +37,8 @@ executable erebos-tester-core
   -- other-extensions:
   default-extensions:  LambdaCase
   build-depends:       base ^>=4.13.0.0,
+                       directory ^>=1.3.6.0,
+                       filepath ^>=1.4.2.1,
                        process ^>=1.6.9,
                        regex-tdfa ^>=1.3.1.0,
                        stm ^>=2.5.0.1,
diff --git a/src/Main.hs b/src/Main.hs
index 169cec4..e1d4c41 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,18 +7,22 @@ import Control.Monad
 import Text.Regex.TDFA
 import Text.Regex.TDFA.String
 
+import System.Directory
 import System.Environment
+import System.FilePath
 import System.IO
 import System.IO.Error
 import System.Process
 
 data Network = Network
     { netNodes :: MVar [(Int, Node)]
+    , netDir :: FilePath
     }
 
 data Node = Node
     { nodeNetwork :: Network
     , nodeName :: String
+    , nodeDir :: FilePath
     }
 
 data Process = Process
@@ -28,22 +32,36 @@ data Process = Process
     , procOutput :: TVar [String]
     }
 
+testDir :: FilePath
+testDir = "./.test"
+
 initNetwork :: IO Network
 initNetwork = do
+    exists <- doesPathExist testDir
+    when exists $ ioError $ userError $ testDir ++ " exists"
+    createDirectoryIfMissing True testDir
+
     callCommand "ip link add name br0 type bridge"
     callCommand "ip addr add 192.168.0.1/24 broadcast 192.168.0.255 dev br0"
     callCommand "ip link set dev br0 up"
     callCommand "ip link set dev lo up"
-    Network <$> newMVar []
+    Network <$> newMVar [] <*> pure testDir
 
 getNode :: Network -> Int -> IO Node
 getNode net idx = (lookup idx <$> readMVar (netNodes net)) >>= \case
     Just node -> return node
     _ -> do
         let name = "node" ++ show idx
+            dir = netDir net </> ("erebos" ++ show idx)
             node = Node { nodeNetwork = net
                         , nodeName = name
+                        , nodeDir = dir
                         }
+
+        exists <- doesPathExist dir
+        when exists $ ioError $ userError $ dir ++ " exists"
+        createDirectoryIfMissing True dir
+
         callCommand $ "ip netns add \""++ name ++ "\""
         callCommand $ "ip link add \"veth" ++ show idx ++ ".0\" type veth peer name \"veth" ++ show idx ++ ".1\" netns \"" ++ name ++ "\""
         callCommand $ "ip link set dev \"veth" ++ show idx ++ ".0\" master br0 up"
@@ -59,7 +77,9 @@ callOn node cmd = callCommand $ "ip netns exec \"" ++ nodeName node ++ "\" " ++
 spawnOn :: Node -> String -> IO Process
 spawnOn node cmd = do
     (Just hin, Just hout, Just herr, handle) <- createProcess (shell $ "ip netns exec \"" ++ nodeName node ++ "\" " ++ cmd)
-        { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
+        { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe
+        , env = Just [("EREBOS_DIR", nodeDir node)]
+        }
     out <- newTVarIO []
 
     let readingLoop :: Handle -> (String -> IO ()) -> IO ()
-- 
cgit v1.2.3