angel 0.3.4 → 0.4.1
raw patch · 7 files changed
+439/−36 lines, 7 filesdep ~basedep ~processnew-uploader
Dependency ranges changed: base, process
Files
- Angel/Config.hs +65/−7
- Angel/Data.hs +3/−2
- Angel/Job.hs +54/−14
- Angel/Main.hs +21/−2
- Angel/Util.hs +13/−0
- README.md +273/−0
- angel.cabal +10/−11
Angel/Config.hs view
@@ -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
Angel/Data.hs view
@@ -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"
Angel/Job.hs view
@@ -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
Angel/Main.hs view
@@ -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!"
Angel/Util.hs view
@@ -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
+ README.md view
@@ -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: <program-id>`.++`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 <jamie@jamwt.com>++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
angel.cabal view
@@ -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 <michael@michaelxavier.net> -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