blob: 544e37c6a3a072c01bad4a47aa5733beadb81622 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
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"
|