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
|
module Main (main) where
-- | This is a valid PID 1 process in Haskell, intended as a Docker
-- entrypoint. It will handle reaping orphans and handling TERM and
-- INT signals.
import Data.Maybe (fromMaybe)
import System.Process.PID1
import System.Environment
import System.Console.GetOpt
import System.IO (stderr, hPutStr)
import System.Exit (exitFailure)
-- | `GetOpt` command line options
options :: [(String, String)] -> [OptDescr (RunOptions -> RunOptions)]
options defaultEnv =
[ Option ['e'] ["env"] (ReqArg (\opt opts -> setRunEnv (optEnvList (getRunEnv opts) opt) opts) "ENV") "override environment variable from given name=value pair. Can be specified multiple times to set multiple environment variables"
, Option ['u'] ["user"] (ReqArg setRunUser "USER") "run command as user"
, Option ['g'] ["group"] (ReqArg setRunGroup "GROUP") "run command as group"
, Option ['w'] ["workdir"] (ReqArg setRunWorkDir "DIR") "command working directory"
, Option ['t'] ["timeout"] (ReqArg (setRunExitTimeoutSec . read) "TIMEOUT") "timeout (in seconds) to wait for all child processes to exit" ]
where optEnv env' kv =
let kvp = fmap (drop 1) $ span (/= '=') kv in
kvp:filter ((fst kvp /=) . fst) env'
optEnvList = optEnv . fromMaybe defaultEnv
main :: IO ()
main = do
-- Figure out the actual thing to run and spawn it off.
args0 <- getArgs
defaultEnv <- getEnvironment
progName <- getProgName
let opts = options defaultEnv
case getOpt RequireOrder opts args0 of
(o, (cmd:args), []) -> let runOpts = foldl (flip id) defaultRunOptions o in
runWithOptions runOpts cmd args
_ -> do
let usage = "Usage: " ++ progName ++ " [OPTION...] command [args...]"
hPutStr stderr (usageInfo usage opts)
exitFailure
|
