From 720232475dcec37b1c57e4d8f02daf635ac4c373 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 28 Sep 2016 04:41:44 +0000 Subject: [PATCH] First version of code --- .gitignore | 3 + LICENSE | 21 +++++ README.md | 37 +++++++++ Setup.hs | 2 + app/Main.hs | 16 ++++ build-docker.sh | 25 ++++++ pid1.cabal | 35 +++++++++ src/System/Process/PID1.hs | 155 +++++++++++++++++++++++++++++++++++++ stack.yaml | 66 ++++++++++++++++ 9 files changed, 360 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 app/Main.hs create mode 100755 build-docker.sh create mode 100644 pid1.cabal create mode 100644 src/System/Process/PID1.hs create mode 100644 stack.yaml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bb5c52e --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +build-docker/ +*.swp diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..4c5e1da --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2016 FP Complete + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..9ef9201 --- /dev/null +++ b/README.md @@ -0,0 +1,37 @@ +## pid1 + +Do signal handling and orphan reaping for Unix PID1 init processes. + +This provides a Haskell library, and an executable based on that library, for +initializing signal handlers, spawning and child process, and reaping orphan +processes. These are the responsibilities that must be fulfilled by the initial +process in a Unix system, and in particular comes up when running Docker +containers. + +This library/executable will automatically detect if it is run as some process +besides PID1 and, if so, use a straightforward `exec` system call instead. + +__NOTE__ This package is decidedly _not_ portable, and will not work on +Windows. If you have a use case where you think it makes sense to run on +Windows, I'd be interested in hearing about it. + +Blog post on some of the finer points here expected in the future. + +### Usage + +The recommended use case for this executable is to embed it in a Docker image. +Assuming you've placed it at `/sbin/pid1`, the two commonly recommended usages +are: + +1. Override the entrypoint, either via `ENTRYPOINT` in your Dockerfile or + `--entrypoint` on the command line. + + ``` + docker run --rm --entrypoint /sbin/pid1 fpco/pid1 ps + ``` + +2. Add `/sbin/pid1` to the beginning of your command. + + ``` + docker run --rm --entrypoint /usr/bin/env fpco/pid1 /sbin/pid1 ps + ``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..7ecf4fb --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,16 @@ +module Main where + +import System.Process.PID1 +import System.Environment + +main :: IO () +main = do + -- Figure out the actual thing to run and spawn it off. + args0 <- getArgs + + (cmd, args) <- + case args0 of + [] -> error "No arguments provided" + cmd:args -> return (cmd, args) + + run cmd args Nothing diff --git a/build-docker.sh b/build-docker.sh new file mode 100755 index 0000000..4ac136d --- /dev/null +++ b/build-docker.sh @@ -0,0 +1,25 @@ +#!/usr/bin/env bash + +set -eux + +rm -rf build-docker +mkdir -p build-docker +stack install --local-bin-path build-docker + +cat > build-docker/Dockerfile <=1.10 + +library + hs-source-dirs: src + exposed-modules: System.Process.PID1 + build-depends: base >= 4 && < 5 + , process + , unix + default-language: Haskell2010 + ghc-options: -Wall + +executable pid1 + hs-source-dirs: app + main-is: Main.hs + ghc-options: -Wall -threaded + build-depends: base + , pid1 + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/fpco/pid1 diff --git a/src/System/Process/PID1.hs b/src/System/Process/PID1.hs new file mode 100644 index 0000000..7c6f6bd --- /dev/null +++ b/src/System/Process/PID1.hs @@ -0,0 +1,155 @@ +-- 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. +module System.Process.PID1 + ( run + ) where + +import Control.Concurrent (forkIO, newEmptyMVar, takeMVar, + threadDelay, tryPutMVar) +import Control.Exception (assert, catch, throwIO) +import Control.Monad (forever, void) +import System.Exit (ExitCode (ExitFailure), exitWith) +import System.IO.Error (isDoesNotExistError) +import System.Posix.Process (ProcessStatus (..), executeFile, + exitImmediately, getAnyProcessStatus, + getProcessID) +import System.Posix.Signals (Handler (Catch), Signal, + installHandler, sigINT, sigKILL, + sigTERM, signalProcess) +import System.Posix.Types (CPid) +import System.Process (createProcess, proc, env) +import System.Process.Internals (ProcessHandle__ (..), + modifyProcessHandle) + +-- | Run the given command with specified arguments, with optional environment +-- variable override (default is to use the current process's environment).. +-- +-- This function will check if the current process has a process ID of 1. If it +-- does, it will install signal handlers for SIGTERM and SIGINT, set up a loop +-- to reap all orphans, spawn a child process, and when that child dies, kill +-- all other processes (first with a SIGTERM and then a SIGKILL) and exit with +-- the child's exit code. +-- +-- If this process is not PID1, then it will simply @exec@ the given command. +-- +-- This function will never exit: it will always terminate your process, unless +-- some exception is thrown. +-- +-- @since 0.1.0.0 +run :: FilePath -- ^ command to run + -> [String] -- ^ command line arguments + -> Maybe [(String, String)] + -- ^ optional environment variable override, default is current env + -> IO a +run cmd args env' = do + -- check if we should act as pid1 or just exec the process + myID <- getProcessID + if myID == 1 + then runAsPID1 cmd args env' + else executeFile cmd True args env' + +-- | Run as a child with signal handling and orphan reaping. +runAsPID1 :: FilePath -> [String] -> Maybe [(String, String)] -> IO a +runAsPID1 cmd args env' = do + -- Set up an MVar to indicate we're ready to start killing all + -- children processes. Then start a thread waiting for that + -- variable to be filled and do the actual killing. + killChildrenVar <- newEmptyMVar + _ <- forkIO $ do + takeMVar killChildrenVar + killAllChildren + + -- Helper function to start killing, used below + let startKilling = void $ tryPutMVar killChildrenVar () + + -- Install signal handlers for TERM and INT, which will start + -- killing all children + void $ installHandler sigTERM (Catch startKilling) Nothing + void $ installHandler sigINT (Catch startKilling) Nothing + + -- Spawn the child process + (Nothing, Nothing, Nothing, ph) <- createProcess (proc cmd args) + { env = env' + } + + -- Determine the child PID. We want to exit once this child + -- process is dead. + p_ <- modifyProcessHandle ph $ \p_ -> return (p_, p_) + child <- + case p_ of + ClosedHandle e -> assert False (exitWith e) + OpenHandle pid -> return pid + + -- Loop on reaping child processes + reap startKilling child + +reap :: IO () -> CPid -> IO a +reap startKilling child = do + -- Track the ProcessStatus of the child + childStatus <- newEmptyMVar + + -- Keep reaping one child. Eventually, when all children are dead, + -- we'll get an exception. We catch that exception and, assuming + -- it's the DoesNotExistError we're expecting, know that all + -- children are dead and exit. + forever (reapOne childStatus) `catch` \e -> + if isDoesNotExistError e + -- no more child processes + then do + takeMVar childStatus >>= exitImmediately . toExitCode + error "This can never be reached" + -- some other exception occurred, reraise it + else throwIO e + where + reapOne childStatus = do + -- Block until a child process exits + mres <- getAnyProcessStatus True False + case mres of + -- This should never happen, if there are no more child + -- processes we'll get an exception instead + Nothing -> assert False (return ()) + -- Got a new dead child. If it's the child we created in + -- main, then start killing all other children. Otherwise, + -- we're just reaping. + Just (pid, status) + | pid == child -> do + -- Take the first status of the child. It's possible - + -- however unlikely - that the process ID could end up + -- getting reused and there will be another child exiting + -- with the same PID. Just ignore that. + void $ tryPutMVar childStatus status + startKilling + | otherwise -> return () + +killAllChildren :: IO () +killAllChildren = do + -- Send all children processes the TERM signal + signalProcess sigTERM (-1) `catch` \e -> + if isDoesNotExistError e + then return () + else throwIO e + + -- Wait for five seconds. We don't need to put in any logic about + -- whether there are still child processes; if all children have + -- exited, then the reap loop will exit and our process will shut + -- down. + threadDelay $ 5 * 1000 * 1000 + + -- OK, some children didn't exit. Now time to get serious! + signalProcess sigKILL (-1) `catch` \e -> + if isDoesNotExistError e + then return () + else throwIO e + +-- | Convert a ProcessStatus to an ExitCode. In the case of a signal being the +-- cause of termination, see 'signalToEC'. +toExitCode :: ProcessStatus -> ExitCode +toExitCode (Exited ec) = ec +toExitCode (Terminated sig _) = signalToEC sig +toExitCode (Stopped sig) = signalToEC sig + +-- | Follow the convention of converting a signal into an exit code by adding +-- 128. +signalToEC :: Signal -> ExitCode +signalToEC sig = ExitFailure (fromIntegral sig + 128) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..aa2774a --- /dev/null +++ b/stack.yaml @@ -0,0 +1,66 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-7.1 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: [] + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.1" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor \ No newline at end of file