diff --git a/Angel/Config.hs b/Angel/Config.hs --- a/Angel/Config.hs +++ b/Angel/Config.hs @@ -2,20 +2,24 @@ import Control.Exception (try, SomeException) import qualified Data.Map as M -import Control.Monad (when, mapM_) +import Control.Monad (when, mapM_, (>=>)) import Control.Concurrent.STM import Control.Concurrent.STM.TVar (readTVar, writeTVar) import Data.Configurator (load, getMap, Worth(..)) import Data.Configurator.Types (Config, Value(..), Name) +import qualified Data.Traversable as T import qualified Data.HashMap.Lazy as HM import Data.String.Utils (split) import Data.List (foldl') +import Data.Maybe (isJust, isNothing) +import Data.Monoid ((<>)) import qualified Data.Text as T import Angel.Job (syncSupervisors) import Angel.Data import Angel.Log (logger) -import Angel.Util (waitForWake) +import Angel.Util (waitForWake, + expandPath) import Debug.Trace (trace) @@ -25,10 +29,10 @@ -- |produce a mapping of name -> program for every program buildConfigMap :: HM.HashMap Name Value -> IO SpecKey buildConfigMap cfg = - return $! HM.foldlWithKey' addToMap M.empty $ cfg + return $! HM.foldlWithKey' addToMap M.empty cfg where addToMap :: SpecKey -> Name -> Value -> SpecKey - addToMap m + addToMap m (split "." . T.unpack -> [basekey, localkey]) value = let !newprog = case M.lookup basekey m of @@ -41,7 +45,10 @@ checkConfigValues :: SpecKey -> IO SpecKey checkConfigValues progs = (mapM_ checkProgram $ M.elems progs) >> (return progs) where - checkProgram p = void $ when (exec p == Nothing) $ error $ name p ++ " does not have an 'exec' specification" + checkProgram p = do + when (isNothing $ exec p) $ error $ name p ++ " does not have an 'exec' specification" + when ((isJust $ logExec p) && + (isJust (stdout p) || isJust (stderr p) )) $ error $ name p ++ " cannot have both a logger process and stderr/stdout" modifyProg :: Program -> String -> Value -> Program modifyProg prog "exec" (String s) = prog{exec = Just (T.unpack s)} @@ -60,6 +67,9 @@ modifyProg prog "directory" (String s) = prog{workingDir = (Just $ T.unpack s)} modifyProg prog "directory" _ = error "wrong type for field 'directory'; string required" +modifyProg prog "logger" (String s) = prog{logExec = (Just $ T.unpack s)} +modifyProg prog "logger" _ = error "wrong type for field 'logger'; string required" + modifyProg prog n _ = prog @@ -67,13 +77,47 @@ -- |produce a SpecKey processConfig :: String -> IO (Either String SpecKey) processConfig configPath = do - mconf <- try $ load [Required configPath] >>= getMap >>= buildConfigMap >>= checkConfigValues + mconf <- try $ process =<< load [Required configPath] case mconf of Right config -> return $ Right config Left (e :: SomeException) -> return $ Left $ show e - + where process = getMap >=> + return . expandByCount >=> + buildConfigMap >=> + expandPaths >=> + checkConfigValues +-- |preprocess config into multiple programs if "count" is specified +expandByCount :: HM.HashMap Name Value -> HM.HashMap Name Value +expandByCount cfg = HM.unions expanded + where expanded :: [HM.HashMap Name Value] + expanded = concat $ HM.foldlWithKey' expand' [] groupedByProgram + expand' :: [[HM.HashMap Name Value]] -> Name -> HM.HashMap Name Value -> [[HM.HashMap Name Value]] + expand' acc = fmap (:acc) . expand + groupedByProgram :: HM.HashMap Name (HM.HashMap Name Value) + groupedByProgram = HM.foldlWithKey' binByProg HM.empty cfg + binByProg h + (T.split (== '.') -> [prog, k]) + v = HM.insertWith HM.union prog (HM.singleton k v) h + binByProg h _ _ = h + expand :: Name -> HM.HashMap Name Value -> [HM.HashMap Name Value] + expand prog pcfg = maybe [reflatten prog pcfg] + expandWithCount + (HM.lookup "count" pcfg) + where expandWithCount (Number n) + | n >= 0 = [ reflatten (genProgName i) pcfg | i <- [1..n] ] + | otherwise = error "count must be >= 0" + expandWithCount _ = error "count must be a number or not specified" + genProgName i = prog <> "-" <> progNumber + where progNumber = T.pack . show . truncate $ i + +reflatten :: Name -> HM.HashMap Name Value -> HM.HashMap Name Value +reflatten prog pcfg = HM.fromList asList + where asList = map prependKey $ filter notCount $ HM.toList pcfg + prependKey (k, v) = ((prog <> "." <> k), v) + notCount = not . (== "count") . fst + -- |given a new SpecKey just parsed from the file, update the -- |shared state TVar updateSpecConfig :: TVar GroupConfig -> SpecKey -> STM () @@ -97,3 +141,17 @@ syncSupervisors sharedGroupConfig waitForWake wakeSig log "HUP caught, reloading config" + +expandPaths :: SpecKey -> IO SpecKey +expandPaths = T.mapM expandProgramPaths + +expandProgramPaths :: Program -> IO Program +expandProgramPaths prog = do exec' <- maybeExpand $ exec prog + stdout' <- maybeExpand $ stdout prog + stderr' <- maybeExpand $ stderr prog + workingDir' <- maybeExpand $ workingDir prog + return prog { exec = exec', + stdout = stdout', + stderr = stderr', + workingDir = workingDir'} + where maybeExpand = T.traverse expandPath diff --git a/Angel/Data.hs b/Angel/Data.hs --- a/Angel/Data.hs +++ b/Angel/Data.hs @@ -28,7 +28,8 @@ delay :: Maybe Int, stdout :: Maybe String, stderr :: Maybe String, - workingDir :: Maybe FilePath + workingDir :: Maybe FilePath, + logExec :: Maybe String } deriving (Show, Eq, Ord) -- |Lower-level atoms in the configuration process @@ -36,7 +37,7 @@ -- |a template for an empty program; the variable set to "" -- |are required, and must be overridden in the config file -defaultProgram = Program "" Nothing Nothing Nothing Nothing Nothing +defaultProgram = Program "" Nothing Nothing Nothing Nothing Nothing Nothing defaultDelay = 5 :: Int defaultStdout = "/dev/null" defaultStderr = "/dev/null" diff --git a/Angel/Job.hs b/Angel/Job.hs --- a/Angel/Job.hs +++ b/Angel/Job.hs @@ -1,5 +1,6 @@ module Angel.Job where +import Control.Exception (finally) import Data.String.Utils (split, strip) import Data.Maybe (isJust, fromJust, fromMaybe) import System.Process (createProcess, proc, waitForProcess, ProcessHandle) @@ -29,7 +30,7 @@ let my_spec = find_me cfg ifEmpty (name my_spec) - (log "QUIT (missing from config on restart)" >> deleteRunning) + (log "QUIT (missing from config on restart)") (do (attachOut, attachErr) <- makeFiles my_spec cfg @@ -53,7 +54,6 @@ then do log "QUIT" - deleteRunning else do log "WAITING" @@ -73,22 +73,36 @@ running=M.insertWith' (\n o-> n) id (my_spec, mpid) (running wcfg) } - deleteRunning = atomically $ do - wcfg <- readTVar sharedGroupConfig - writeTVar sharedGroupConfig wcfg{ - running=M.delete id (running wcfg) - } - makeFiles my_spec cfg = do - let useout = fromMaybe defaultStdout $ stdout my_spec - attachOut <- UseHandle `fmap` getFile useout cfg + case (logExec my_spec) of + Just path -> logWithExec path + Nothing -> logWithFiles - let useerr = fromMaybe defaultStderr $ stderr my_spec - attachErr <- UseHandle `fmap` getFile useerr cfg + where + logWithFiles = do + let useout = fromMaybe defaultStdout $ stdout my_spec + attachOut <- UseHandle `fmap` getFile useout cfg - return $ (attachOut, attachErr) + let useerr = fromMaybe defaultStderr $ stderr my_spec + attachErr <- UseHandle `fmap` getFile useerr cfg + return $ (attachOut, attachErr) + logWithExec path = do + let (cmd, args) = cmdSplit path + + attachOut <- UseHandle `fmap` getFile "/dev/null" cfg + + (inPipe, _, _, p) <- createProcess (proc cmd args){ + std_out = attachOut, + std_err = attachOut, + std_in = CreatePipe, + cwd = workingDir my_spec + } + + return $ (UseHandle (fromJust inPipe), + UseHandle (fromJust inPipe)) + -- |send a TERM signal to all provided process handles killProcesses :: [ProcessHandle] -> IO () killProcesses pids = mapM_ terminateProcess pids @@ -97,7 +111,33 @@ startProcesses :: TVar GroupConfig -> [String] -> IO () startProcesses sharedGroupConfig starts = mapM_ spawnWatcher starts where - spawnWatcher s = forkIO $ supervise sharedGroupConfig s + spawnWatcher s = forkIO $ wrapProcess sharedGroupConfig s + +wrapProcess :: TVar GroupConfig -> String -> IO () +wrapProcess sharedGroupConfig id = do + run <- createRunningEntry + when run $ finally (supervise sharedGroupConfig id) deleteRunning + where + deleteRunning = atomically $ do + wcfg <- readTVar sharedGroupConfig + writeTVar sharedGroupConfig wcfg{ + running=M.delete id (running wcfg) + } + + createRunningEntry = + atomically $ do + cfg <- readTVar sharedGroupConfig + let specmap = spec cfg + case M.lookup id specmap of + Nothing -> return False + Just target -> do + let runmap = running cfg + case M.lookup id runmap of + Just _ -> return False + Nothing -> do + writeTVar sharedGroupConfig cfg{running= + M.insert id (target, Nothing) runmap} + return True -- |diff the requested config against the actual run state, and -- |do any start/kill action necessary diff --git a/Angel/Main.hs b/Angel/Main.hs --- a/Angel/Main.hs +++ b/Angel/Main.hs @@ -2,6 +2,7 @@ import Control.Concurrent (threadDelay, forkIO, forkOS) import Control.Concurrent +import Control.Concurrent.MVar (newEmptyMVar, MVar, takeMVar, putMVar) import Control.Concurrent.STM import Control.Concurrent.STM.TVar (readTVar, writeTVar) import Control.Concurrent.STM.TChan (newTChan) @@ -15,7 +16,7 @@ import Angel.Log (logger) import Angel.Config (monitorConfig) import Angel.Data (GroupConfig(..)) -import Angel.Job (pollStale) +import Angel.Job (pollStale, syncSupervisors) import Angel.Files (startFileManager) -- |Signal handler: when a HUP is trapped, write to the wakeSig Tvar @@ -23,6 +24,9 @@ handleHup :: TVar (Maybe Int) -> IO () handleHup wakeSig = atomically $ writeTVar wakeSig $ Just 1 +handleExit :: MVar Bool -> IO () +handleExit mv = putMVar mv True + main = do hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering @@ -44,9 +48,24 @@ wakeSig <- newTVarIO Nothing installHandler sigHUP (Catch $ handleHup wakeSig) Nothing + -- Handle dying + bye <- newEmptyMVar + installHandler sigTERM (Catch $ handleExit bye) Nothing + installHandler sigINT (Catch $ handleExit bye) Nothing + -- Fork off an ongoing state monitor to watch for inconsistent state forkIO $ pollStale sharedGroupConfig forkIO $ startFileManager fileReqChan -- Finally, run the config load/monitor thread - runInUnboundThread $ forever $ monitorConfig configPath sharedGroupConfig wakeSig + forkIO $ forever $ monitorConfig configPath sharedGroupConfig wakeSig + + _ <- takeMVar bye + log "INT | TERM received; initiating shutdown..." + log " 1. Clearing config" + atomically $ do + cfg <- readTVar sharedGroupConfig + writeTVar sharedGroupConfig cfg {spec = M.empty} + log " 2. Forcing sync to kill running going" + syncSupervisors sharedGroupConfig + log "That's all folks!" diff --git a/Angel/Util.hs b/Angel/Util.hs --- a/Angel/Util.hs +++ b/Angel/Util.hs @@ -5,6 +5,9 @@ import Control.Concurrent.STM import Control.Concurrent.STM.TVar (readTVar, writeTVar) import Control.Concurrent (threadDelay, forkIO, forkOS) +import System.Posix.User (getEffectiveUserName, + UserEntry(homeDirectory), + getUserEntryForName) -- |sleep for `s` seconds in an thread sleepSecs :: Int -> IO () @@ -17,3 +20,13 @@ case state of Just x -> writeTVar wakeSig Nothing Nothing -> retry + +expandPath :: FilePath -> IO FilePath +expandPath ('~':rest) = do home <- getHome =<< getUser + return $ home ++ relativePath + where (userName, relativePath) = span (/= '/') rest + getUser = if null userName + then getEffectiveUserName + else return userName + getHome user = homeDirectory `fmap` getUserEntryForName user +expandPath path = return path diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,273 @@ +Angel +===== + +`angel` is a daemon that runs and monitors other processes. It +is similar to djb's `daemontools` or the Ruby project `god`. + +It's goals are to keep a set of services running, and to facilitate +the easy configuration and restart of those services. + +Motivation +---------- + +The author is a long-time user of `daemontools` due to its reliability +and simplicity; however, `daemontools` is quirky and follows many +unusual conventions. + +`angel` is an attempt to recreate `daemontools`'s capabilities (though +not the various bundled utility programs which are still quite useful) +in a more intuitive and modern unix style. + + +Functionality +------------- + +`angel` is driven by a configuration file that contains a list of +program specifications to run. `angel` assumes every program listed in +the specification file should be running at all times. + +`angel` starts each program, and optionally sets the program's stdout +and stderr to some file(s) which have been opened in append mode +(or pipes stdout and stderr to some logger process); at +this point, the program is said to be "supervised". + +If the program dies for any reason, `angel` waits a specified number +of seconds (default, 5), then restarts the program. + +The `angel` process itself will respond to a HUP signal by +re-processing its configuration file, and synchronizing the run +states with the new configuration. Specifically: + + * If a new program has been added to the file, it is started and + supervised + * If a program's specification has changed (command line path, + stdin/stdout path, delay time, etc) that supervised child + process will be sent a TERM signal, and as a consequence of + normal supervision, will be restarted with the updated spec + * If a program has been removed from the configuration file, + the corresponding child process will be sent a TERM signal; + when it dies, supervision of the process will end, and + therefore, it will not be restarted + +Safety and Reliability +---------------------- + +Because of `angel`'s role in policing the behavior of other +daemons, it has been written to be very reliable: + + * It is written in Haskell, which boasts a combination of + strong, static typing and purity-by-default that lends + itself to very low bug counts + * It uses multiple, simple, independent lightweight threads + with specific roles, ownership, and interfaces + * It uses STM for mutex-free state synchronization between + these threads + * It falls back to polling behavior to ensure eventual + synchronization between configuration state and run + state, just in case odd timing issues should make + event-triggered changes fail + * It simply logs errors and keeps running the last good + configuration if it runs into problems on configuration + reloads + * It has logged hundreds of thousands of uptime-hours + since 2010-07 supervising all the daemons that power + http://bu.mp without a single memory leak or crash + +Building +-------- + + 1. Install the haskell-platform (or somehow, ghc 7.0 + + cabal-install) + 2. Run `cabal install` in the project root (this directory) + 3. Either add the ~/.cabal/bin file to your $PATH or copy + the `angel` executable to /usr/local/bin + +Notes: + + * I have not tried building `angel` against ghc 6.10 or earlier; + 6.12, 7.0, 7.2, 7.4, and 7.6 are known to work + +Testing +------- +There are a few ways to run tests. The simplest is `make spec`. This requires +you have `cabal-dev` installed. + +If you have Ruby installed and bundler installed (`gem install bundler`), you +can use Guard to monitor source files and automatically run the test suite +after you save: + +1. Run `bundle install` +2. Run `guard start`. Hit enter to force rebuild. + +Configuration and Usage Example +------------------------------- + +The `angel` executable takes exactly one argument: a path to +an angel configuration file. + +`angel`'s configuration system is based on Bryan O'Sullivan's `configurator` +package. A full description of the format can be found here: + +http://hackage.haskell.org/packages/archive/configurator/0.1.0.0/doc/html/Data-Configurator.html + +A basic configuration file might look like this: + + watch-date { + exec = "watch date" + } + + ls { + exec = "ls" + stdout = "/tmp/ls_log" + stderr = "/tmp/ls_log" + delay = 7 + } + + workers { + directory = "/path/to/worker" + exec = "run_worker" + count = 30 + } + +Each program that should be supervised starts a `program-id` block: + + watch-date { + +Then, a series of corresponding configuration commands follow: + + * `exec` is the exact command line to run (required) + * `stdout` is a path to a file where the program's standard output + should be appended (optional, defaults to /dev/null) + * `stderr` is a path to a file where the program's standard error + should be appended (optional, defaults to /dev/null) + * `delay` is the number of seconds (integer) `angel` should wait + after the program dies before attempting to start it again + (optional, defaults to 5) + * `directory` is the current working directory of the newly + executed program (optional, defaults to angel's cwd) + * `logger` is another process that should be launched to handle + logging. The `exec` process will then have its stdout and stderr + piped into stdin of this logger. Recommended log + rotation daemons include [clog](https://github.com/jamwt/clog) + or [multilog](http://cr.yp.to/daemontools.html). *Note that + if you use a logger process, it is a configuration error + to specify either stdout or stderr as well.* + * `count` is an optional argument to specify the number of processes to spawn. + For instance, if you specified a count of 2, it will spawn the program + twice, internally as `workers-1` and `workers-2`, for example. + +Assuming the above configuration was in a file called "example.conf", +here's what a shell session might look like: + + jamie@choo:~/random/angel$ angel example.conf + [2010/08/24 15:21:22] {main} Angel started + [2010/08/24 15:21:22] {main} Using config file: example.conf + [2010/08/24 15:21:22] {process-monitor} Must kill=0, must start=2 + [2010/08/24 15:21:22] {- program: watch-date -} START + [2010/08/24 15:21:22] {- program: watch-date -} RUNNING + [2010/08/24 15:21:22] {- program: ls -} START + [2010/08/24 15:21:22] {- program: ls -} RUNNING + [2010/08/24 15:21:22] {- program: ls -} ENDED + [2010/08/24 15:21:22] {- program: ls -} WAITING + [2010/08/24 15:21:29] {- program: ls -} RESTART + [2010/08/24 15:21:29] {- program: ls -} START + [2010/08/24 15:21:29] {- program: ls -} RUNNING + [2010/08/24 15:21:29] {- program: ls -} ENDED + [2010/08/24 15:21:29] {- program: ls -} WAITING + +.. etc + +You can see that when the configuration is parsed, the process-monitor +notices that two programs need to be started. A supervisor is started +in a lightweight thread for each, and starts logging with the context +`program: `. + +`watch-date` starts up and runs. Since `watch` is a long-running process +it just keeps running in the background. + +`ls`, meanwhile, runs and immediately ends, of course; then, the WAITING +state is entered until `delay` seconds pass. Finally, the RESTART event +is triggered and it is started again, ad naseum. + +Now, let's see what happens if we modify the config file to look like this: + + #watch-date { + # exec = "watch date" + #} + + ls { + exec = "ls" + stdout = "/tmp/ls_log" + stderr = "/tmp/ls_log" + delay = 7 + } + +.. and then send HUP to angel. + + [2010/08/24 15:33:59] {config-monitor} HUP caught, reloading config + [2010/08/24 15:33:59] {process-monitor} Must kill=1, must start=0 + [2010/08/24 15:33:59] {- program: watch-date -} ENDED + [2010/08/24 15:33:59] {- program: watch-date -} QUIT + [2010/08/24 15:34:03] {- program: ls -} RESTART + [2010/08/24 15:34:03] {- program: ls -} START + [2010/08/24 15:34:03] {- program: ls -} RUNNING + [2010/08/24 15:34:03] {- program: ls -} ENDED + [2010/08/24 15:34:03] {- program: ls -} WAITING + +As you can see, the config monitor reloaded on HUP, and then the +process monitor marked the watch-date process for killing. TERM +was sent to the child process, and then the supervisor loop QUIT +because the watch-date program no longer had a config entry. + +This also works for when you specify count. Incrementing/decrementing the count +will intelligently shut down excess processes and spin new ones up. + +Advanced Configuration +---------------------- + +The `configurator` package supports `import` statements, as +well as environment variable expansion. Using collections +of configuration files and host-based or service-based +environment variables, efficient, templated `angel` +configurations can be had. + +FAQ +--- + +**Can I have multiple programs logging to the same file?** + +Yes, angel `dup()`s file descriptors and makes effort to safely +allow concurrent writes by child programs; you should DEFINITELY +make sure your child program is doing stdout/stderr writes in +line-buffered mode so this doesn't result in a complete interleaved +mess in the log file. + +**Will angel restart programs for me?** + +No; the design is just to send your programs TERM, then `angel` will +restart them. `angel` tries to work in harmony with traditional +Unix process management conventions. + +**How can I take a service down without wiping out its configuration?** + +Currently, the only way to achieve this is by employing the "commenting +out" method illustrated above. + +CHANGELOG +--------- +### 0.4.1 + +* Add `count` option to program spec to launch multiple instances of a program. + + +Author +------ + +Jamie Turner + +Thanks to Bump Technologies, Inc. (http://bu.mp) for sponsoring some +of the work on angel. + +And, of course, thanks to all Angel's contributors: + +https://github.com/jamwt/Angel/contributors diff --git a/angel.cabal b/angel.cabal --- a/angel.cabal +++ b/angel.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.3.4 +Version: 0.4.1 -- A short (one-line) description of the package. -- Synopsis: @@ -37,9 +37,9 @@ -- An email address to which users can send suggestions, bug reports, -- and patches. -Maintainer: jamie@bu.mp +Maintainer: Michael Xavier -Homepage: http://github.com/jamwt/Angel +Homepage: http://github.com/MichaelXavier/Angel -- A copyright notice. -- Copyright: @@ -51,15 +51,15 @@ -- Extra files to be distributed with the package, such as examples or -- a README. --- Extra-source-files: +Extra-source-files: README.md -- Constraint on the version of Cabal needed to build this package. -Cabal-version: >=1.10 +Cabal-version: >=1.8 source-repository head type: git - location: https://github.com/jamwt/Angel.git + location: https://github.com/MichaelXavier/Angel.git Executable angel -- .hs or .lhs file containing the Main module. @@ -67,7 +67,8 @@ -- Packages needed in order to build this package. Build-depends: base >= 4.0 && < 5 - Build-depends: process >= 1.0 + -- binding to the internals of process here, gotta be careful + Build-depends: process >= 1.0 && < 2.0 Build-depends: mtl Build-depends: MissingH Build-depends: configurator >= 0.1 @@ -92,8 +93,7 @@ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: - Default-Extensions: OverloadedStrings,ScopedTypeVariables,BangPatterns,ViewPatterns - Default-Language: Haskell2010 + Extensions: OverloadedStrings,ScopedTypeVariables,BangPatterns,ViewPatterns Ghc-Options: -threaded @@ -104,5 +104,4 @@ Build-Depends: base Build-Depends: hspec Build-depends: time - Default-Extensions: OverloadedStrings,ScopedTypeVariables,BangPatterns,ViewPatterns - Default-Language: Haskell2010 + Extensions: OverloadedStrings,ScopedTypeVariables,BangPatterns,ViewPatterns