Isolate filesystems using mount namespaceHEADmaster

Recursively bind and set to read-only all the host filesystems and
bind-mount as read-write only the test dir. Provide new writable tmpfs
under /tmp.

Changelog: Make host filesystems read-only for the test process (except for test dir)

1 files changed, 16 insertions, 5 deletions

diff --git a/src/Run.hs b/src/Run.hs
index d5b0d29..b38bedd 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -39,6 +39,7 @@ import Output
 import Parser
 import Process
 import Run.Monad
+import Sandbox
 import Script.Expr
 import Script.Module
 import Script.Object
@@ -102,11 +103,21 @@ runTest out opts gdefs test = do
     oldHandler <- installHandler processStatusChanged (CatchInfo sigHandler) Nothing
 
     resetOutputTime out
-    ( res, [] ) <- runWriterT $ runExceptT $ flip runReaderT (tenv, tstate) $ fromTestRun $ do
-        withInternet $ \_ -> do
-            runStep =<< eval (testSteps test)
-            when (optWait opts) $ do
-                void $ outPromptGetLine $ "Test '" <> testName test <> "' completed, waiting..."
+    testRunResult <- newEmptyMVar
+
+    void $ forkOS $ do
+        isolateFilesystem testDir >>= \case
+            True -> do
+                tres <- runWriterT $ runExceptT $ flip runReaderT (tenv, tstate) $ fromTestRun $ do
+                    withInternet $ \_ -> do
+                        runStep =<< eval (testSteps test)
+                        when (optWait opts) $ do
+                            void $ outPromptGetLine $ "Test '" <> testName test <> "' completed, waiting..."
+                putMVar testRunResult tres
+            _ -> do
+                putMVar testRunResult ( Left Failed, [] )
+
+    ( res, [] ) <- takeMVar testRunResult
 
     void $ installHandler processStatusChanged oldHandler Nothing