From 28a93e24f6a33a8254c16c31961d523c71bdb1d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sat, 5 Jul 2025 18:15:06 +0200 Subject: Isolate filesystems using mount namespace 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) --- src/Run.hs | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) (limited to 'src/Run.hs') 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 -- cgit v1.2.3