2 files changed, 55 insertions, 8 deletions
diff --git a/src/Script/Object.hs b/src/Script/Object.hs
new file mode 100644
index 0000000..9232b21
--- /dev/null
+++ b/src/Script/Object.hs
@@ -0,0 +1,42 @@
+module Script.Object (
+    ObjectId(..),
+    ObjectType(..),
+    Object(..), SomeObject(..),
+    toSomeObject, fromSomeObject,
+    destroySomeObject,
+) where
+
+import Data.Kind
+import Data.Typeable
+
+
+newtype ObjectId = ObjectId Int
+
+class Typeable a => ObjectType m a where
+    type ConstructorArgs a :: Type
+    type ConstructorArgs a = ()
+
+    createObject :: ObjectId -> ConstructorArgs a -> m (Object m a)
+    destroyObject :: Object m a -> m ()
+
+data Object m a = ObjectType m a => Object
+    { objId :: ObjectId
+    , objImpl :: a
+    }
+
+data SomeObject m = forall a. ObjectType m a => SomeObject
+    { sobjId :: ObjectId
+    , sobjImpl :: a
+    }
+
+toSomeObject :: Object m a -> SomeObject m
+toSomeObject Object {..} = SomeObject { sobjId = objId, sobjImpl = objImpl }
+
+fromSomeObject :: ObjectType m a => SomeObject m -> Maybe (Object m a)
+fromSomeObject SomeObject {..} = do
+    let objId = sobjId
+    objImpl <- cast sobjImpl
+    return Object {..}
+
+destroySomeObject :: SomeObject m -> m ()
+destroySomeObject (SomeObject oid impl) = destroyObject (Object oid impl)
diff --git a/src/Script/Shell.hs b/src/Script/Shell.hs
index 60ec929..9bbf06c 100644
--- a/src/Script/Shell.hs
+++ b/src/Script/Shell.hs
@@ -20,21 +20,25 @@ import System.IO
 import System.Process hiding (ShellCommand)
 
 import Network
+import Network.Ip
 import Output
 import Process
 import Run.Monad
+import Script.Var
 
 
 data ShellStatement = ShellStatement
     { shellCommand :: Text
     , shellArguments :: [ Text ]
+    , shellSourceLine :: SourceLine
     }
 
 newtype ShellScript = ShellScript [ ShellStatement ]
 
 
-executeScript :: Node -> ProcName -> Handle -> Handle -> Handle -> ShellScript -> TestRun ()
-executeScript node pname pstdin pstdout pstderr (ShellScript statements) = do
+executeScript :: Node -> ProcName -> MVar ExitCode -> Handle -> Handle -> Handle -> ShellScript -> TestRun ()
+executeScript node pname statusVar pstdin pstdout pstderr (ShellScript statements) = do
+    setNetworkNamespace $ getNetns node
     forM_ statements $ \ShellStatement {..} -> case shellCommand of
         "echo" -> liftIO $ do
             T.hPutStrLn pstdout $ T.intercalate " " shellArguments
@@ -50,9 +54,11 @@ executeScript node pname pstdin pstdout pstderr (ShellScript statements) = do
                     }
             liftIO (waitForProcess phandle) >>= \case
                 ExitSuccess -> return ()
-                ExitFailure code -> do
-                    outLine OutputChildFail (Just $ textProcName pname) $ T.pack $ "exit code: " ++ show code
+                status -> do
+                    outLine OutputChildFail (Just $ textProcName pname) $ "failed at: " <> textSourceLine shellSourceLine
+                    liftIO $ putMVar statusVar status
                     throwError Failed
+    liftIO $ putMVar statusVar ExitSuccess
 
 spawnShell :: Node -> ProcName -> ShellScript -> TestRun Process
 spawnShell procNode procName script = do
@@ -61,9 +67,8 @@ spawnShell procNode procName script = do
     ( pstdin, procStdin ) <- liftIO $ createPipe
     ( hout, pstdout ) <- liftIO $ createPipe
     ( herr, pstderr ) <- liftIO $ createPipe
-    procHandle <- fmap (Right . (, statusVar)) $ forkTest $ do
-        executeScript procNode procName pstdin pstdout pstderr script
-        liftIO $ putMVar statusVar ExitSuccess
+    procHandle <- fmap (Right . (, statusVar)) $ forkTestUsing forkOS $ do
+        executeScript procNode procName statusVar pstdin pstdout pstderr script
 
     let procKillWith = Nothing
     let process = Process {..}
@@ -85,5 +90,5 @@ withShellProcess node pname script inner = do
 
     inner process `finally` do
         ps <- liftIO $ takeMVar procVar
-        closeProcess process `finally` do
+        closeTestProcess process `finally` do
             liftIO $ putMVar procVar $ filter (/=process) ps