Custom C main instead of wrapper binaryHEADmasterdevel

Changelog: Use custom C main instead of wrapper binary for unshare(2) call.

4 files changed, 92 insertions, 76 deletions

diff --git a/erebos-tester.cabal b/erebos-tester.cabal
index a6b3b70..f900823 100644
--- a/erebos-tester.cabal
+++ b/erebos-tester.cabal
@@ -30,10 +30,12 @@ source-repository head
     type:       git
     location:   git://erebosprotocol.net/tester
 
-common common
+executable erebos-tester
     ghc-options:
         -Wall
         -fdefer-typed-holes
+        -threaded
+        -no-hs-main
 
     if flag(ci)
         ghc-options:
@@ -41,36 +43,6 @@ common common
             -- sometimes needed for backward/forward compatibility:
             -Wno-error=unused-imports
 
-  build-depends:
-        base             ^>= { 4.15, 4.16, 4.17, 4.18, 4.19, 4.20 },
-
-executable erebos-tester
-  import: common
-  ghc-options:
-        -- disable interval timer to avoid spawing thread that breaks unshare(CLONE_NEWUSER)
-        -with-rtsopts=-V0
-  if impl(ghc >= 9.8)
-        ghc-options:
-            -- no multithreading is allowed for unshare(CLONE_NEWUSER)
-            -single-threaded
-
-  main-is:             Wrapper.hs
-  -- other-modules:
-  -- other-extensions:
-  build-depends:
-        directory        >=1.3 && <1.4,
-        filepath        ^>= { 1.4.2.1, 1.5.2 },
-        linux-namespaces^>=0.1.3,
-        process         ^>=1.6.9,
-        unix             >=2.7 && <2.9,
-  hs-source-dirs:      src
-  default-language:    Haskell2010
-
-executable erebos-tester-core
-  import: common
-  ghc-options:
-        -threaded
-
   main-is:             Main.hs
 
   other-modules:       Config
@@ -94,6 +66,9 @@ executable erebos-tester-core
 
   autogen-modules:     Paths_erebos_tester
 
+  c-sources:
+        src/main.c
+
   other-extensions:
         TemplateHaskell
   default-extensions:
@@ -117,6 +92,7 @@ executable erebos-tester-core
         TypeOperators
 
   build-depends:
+        base            ^>= { 4.15, 4.16, 4.17, 4.18, 4.19, 4.20 },
         bytestring      ^>= { 0.10, 0.11, 0.12 },
         containers      ^>= { 0.6.2.1, 0.7 },
         directory       ^>=1.3.6.0,
diff --git a/src/Main.hs b/src/Main.hs
index 42b2e5b..01bb766 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -157,3 +157,7 @@ main = do
     ok <- allM (uncurry $ runTest out $ optTest opts) $
         concat $ replicate (optRepeat opts) $ concat tests
     when (not ok) exitFailure
+
+foreign export ccall testerMain :: IO ()
+testerMain :: IO ()
+testerMain = main
diff --git a/src/Wrapper.hs b/src/Wrapper.hs
deleted file mode 100644
index 544e37c..0000000
--- a/src/Wrapper.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-module Main where
-
-import Control.Monad
-
-import GHC.Environment
-
-import System.Directory
-import System.Environment
-import System.FilePath
-import System.Linux.Namespaces
-import System.Posix.Process
-import System.Posix.User
-import System.Process
-
-main :: IO ()
-main = do
-    -- we must get uid/gid before unshare
-    uid <- getEffectiveUserID
-    gid <- getEffectiveGroupID
-
-    unshare [User, Network, Mount]
-    writeUserMappings Nothing [UserMapping 0 uid 1]
-    writeGroupMappings Nothing [GroupMapping 0 gid 1] True
-
-    -- needed for creating /run/netns
-    callCommand "mount -t tmpfs tmpfs /run"
-
-    epath <- takeDirectory <$> getExecutablePath -- directory containing executable
-    fpath <- map takeDirectory . filter (any isPathSeparator) . take 1 <$> getFullArgs
-        -- directory used for invocation, can differ from above for symlinked executable
-
-    let dirs = concat
-            [ [ epath ]
-            , [ epath </> "../../../erebos-tester-core/build/erebos-tester-core" ]
-            , fpath
-            ]
-
-    args <- getArgs
-    mapM_ (\file -> executeFile file False args Nothing) =<<
-        findExecutablesInDirectories dirs "erebos-tester-core"
-    when (null fpath) $
-        mapM_ (\file -> executeFile file False args Nothing) =<<
-            findExecutables "erebos-tester-core"
-
-    fail "core binary not found"
diff --git a/src/main.c b/src/main.c
new file mode 100644
index 0000000..98daf2c
--- /dev/null
+++ b/src/main.c
@@ -0,0 +1,81 @@
+#include "HsFFI.h"
+
+#if defined(__GLASGOW_HASKELL__)
+#include "Main_stub.h"
+#endif
+
+#include <errno.h>
+#include <fcntl.h>
+#include <sched.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <string.h>
+#include <sys/mount.h>
+#include <unistd.h>
+
+/*
+ * The unshare call with CLONE_NEWUSER needs to happen before starting
+ * additional threads, which means before initializing the Haskell RTS.
+ * To achieve that, replace Haskell main with a custom one here that does
+ * the unshare work and then executes the Haskell code.
+ */
+
+static bool writeProcSelfFile( const char * file, const char * data, size_t size )
+{
+	char path[ 256 ];
+	if( snprintf( path, sizeof( path ), "/proc/self/%s", file )
+			>= sizeof( path ) ){
+		fprintf( stderr, "buffer too small\n" );
+		return false;
+	}
+
+	int fd = open( path, O_WRONLY );
+	if( fd < 0 ){
+		fprintf( stderr, "failed to open %s: %s", path, strerror( errno ));
+		return false;
+	}
+
+	ssize_t written = write( fd, data, size );
+	if( written < 0 )
+		fprintf( stderr, "failed to write to %s: %s\n", path, strerror( errno ));
+
+	close( fd );
+	return written == size;
+}
+
+int main( int argc, char * argv[] )
+{
+	uid_t uid = geteuid();
+	gid_t gid = getegid();
+	unshare( CLONE_NEWUSER | CLONE_NEWNET | CLONE_NEWNS );
+
+	char buf[ 256 ];
+	int len;
+
+	len = snprintf( buf, sizeof( buf ), "%d %d %d\n", 0, uid, 1 );
+	if( len >= sizeof( buf ) ){
+		fprintf( stderr, "buffer too small\n" );
+		return 1;
+	}
+	if ( ! writeProcSelfFile( "uid_map", buf, len ) )
+		return 1;
+
+	if ( ! writeProcSelfFile( "setgroups", "deny\n", 5 ) )
+		return 1;
+
+	len = snprintf( buf, sizeof( buf ), "%d %d %d\n", 0, gid, 1 );
+	if( len >= sizeof( buf ) ){
+		fprintf( stderr, "buffer too small\n" );
+		return 1;
+	}
+	if ( ! writeProcSelfFile( "gid_map", buf, len ) )
+		return 1;
+
+	mount( "tmpfs", "/run", "tmpfs", 0, "size=4m" );
+
+	hs_init( &argc, &argv );
+	testerMain();
+	hs_exit();
+
+	return 0;
+}