packages feed

angel 0.4.1 → 0.4.2

raw patch · 5 files changed

+80/−34 lines, 5 filesdep ~basedep ~time

Dependency ranges changed: base, time

Files

Angel/Config.hs view
@@ -70,6 +70,9 @@ modifyProg prog "logger" (String s) = prog{logExec = (Just $ T.unpack s)} modifyProg prog "logger" _ = error "wrong type for field 'logger'; string required" +modifyProg prog "pidfile" (String s) = prog{pidFile = (Just $ T.unpack s)}+modifyProg prog "pidfile" _ = error "wrong type for field 'pidfile'; string required"+ modifyProg prog n _ = prog  @@ -106,12 +109,21 @@                                  expandWithCount                                  (HM.lookup "count" pcfg)           where expandWithCount (Number n)-                  | n >= 0    = [ reflatten (genProgName i) pcfg | i <- [1..n] ]+                  | n >= 0    = [ reflatten (genProgName i) (rewriteConfig 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+                genProgName i     = prog <> "-" <> textNumber i +rewriteConfig :: Rational -> HM.HashMap Name Value -> HM.HashMap Name Value+rewriteConfig n = HM.adjust rewritePidfile "pidfile"+  where rewritePidfile (String path) = String $ rewrittenFilename <> extension+          where rewrittenFilename     = filename <> "-" <> textNumber n+                (filename, extension) = T.breakOn "." path+        rewritePidfile x              = x++textNumber :: Rational -> T.Text+textNumber = T.pack . show . truncate+ 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@@ -150,8 +162,10 @@                              stdout'     <- maybeExpand $ stdout prog                              stderr'     <- maybeExpand $ stderr prog                              workingDir' <- maybeExpand $ workingDir prog+                             pidFile'    <- maybeExpand $ pidFile prog                              return prog { exec       = exec',                                            stdout     = stdout',                                            stderr     = stderr',-                                           workingDir = workingDir'}+                                           workingDir = workingDir',+                                           pidFile    = pidFile' }     where maybeExpand = T.traverse expandPath
Angel/Data.hs view
@@ -29,7 +29,8 @@     stdout :: Maybe String,     stderr :: Maybe String,     workingDir :: Maybe FilePath,-    logExec :: Maybe String+    logExec :: Maybe String,+    pidFile :: Maybe FilePath } deriving (Show, Eq, Ord)  -- |Lower-level atoms in the configuration process@@ -37,7 +38,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 Nothing+defaultProgram = Program "" Nothing Nothing Nothing Nothing Nothing Nothing Nothing defaultDelay = 5 :: Int defaultStdout = "/dev/null" defaultStderr = "/dev/null"
Angel/Job.hs view
@@ -2,7 +2,7 @@  import Control.Exception (finally) import Data.String.Utils (split, strip)-import Data.Maybe (isJust, fromJust, fromMaybe)+import Data.Maybe (isJust, fromJust, fromMaybe, mapMaybe) import System.Process (createProcess, proc, waitForProcess, ProcessHandle) import System.Process (terminateProcess, CreateProcess(..), StdStream(..)) import Control.Concurrent@@ -15,6 +15,7 @@ import Angel.Data import Angel.Util (sleepSecs) import Angel.Files (getFile)+import Angel.PidFile (startMaybeWithPidFile, clearPIDFile)  ifEmpty :: String -> IO () -> IO () -> IO () ifEmpty s ioa iob = if s == "" then ioa else iob@@ -36,18 +37,21 @@             (attachOut, attachErr) <- makeFiles my_spec cfg              let (cmd, args) = cmdSplit $ (fromJust $ exec my_spec)-            -            (_, _, _, p) <- createProcess (proc cmd args){-            std_out = attachOut,-            std_err = attachErr,-            cwd = workingDir my_spec ++            let procSpec = (proc cmd args) {+              std_out = attachOut,+              std_err = attachErr,+              cwd = workingDir my_spec             }+            let mPfile = pidFile my_spec+             -            updateRunningPid my_spec (Just p)-            log "RUNNING"-            waitForProcess p-            log "ENDED"-            updateRunningPid my_spec (Nothing)+            startMaybeWithPidFile procSpec mPfile $ \pHandle -> do+              updateRunningPid my_spec (Just pHandle)+              log "RUNNING"+              waitForProcess pHandle+              log "ENDED"+              updateRunningPid my_spec (Nothing)                          cfg <- atomically $ readTVar sharedGroupConfig             if M.notMember id (spec cfg) @@ -107,6 +111,10 @@ killProcesses :: [ProcessHandle] -> IO () killProcesses pids = mapM_ terminateProcess pids +cleanPidfiles :: [Program] -> IO ()+cleanPidfiles progs = mapM_ clearPIDFile pidfiles+  where pidfiles = mapMaybe pidFile progs+ -- |fire up new supervisors for new program ids startProcesses :: TVar GroupConfig -> [String] -> IO () startProcesses sharedGroupConfig starts = mapM_ spawnWatcher starts@@ -145,25 +153,38 @@ syncSupervisors sharedGroupConfig = do     let log = logger "process-monitor"    cfg <- atomically $ readTVar sharedGroupConfig-   let kills = mustKill cfg+   let (killProgs, killHandles) = mustKill cfg    let starts = mustStart cfg-   when (length kills > 0 || length starts > 0) $ log (-         "Must kill=" ++ (show $ length kills)+   when (nnull killHandles || nnull starts) $ log (+         "Must kill=" ++ (show $ length killHandles)                 ++ ", must start=" ++ (show $ length starts))-   killProcesses kills+   killProcesses killHandles+   cleanPidfiles killProgs    startProcesses sharedGroupConfig starts-                                         -    where-        mustKill cfg = map (fromJust . snd . snd) $ filter (runningAndDifferent $ spec cfg) $ M.assocs (running cfg)-        runningAndDifferent spec (id, (pg, pid)) = (isJust pid && (M.notMember id spec -                                           || M.findWithDefault defaultProgram id spec `cmp` pg))-            where cmp one two = one /= two -        mustStart cfg = map fst $ filter (isNew $ running cfg) $ M.assocs (spec cfg)-        isNew running (id, pg) = M.notMember id running+--TODO: make private+mustStart :: GroupConfig -> [String]+mustStart cfg = map fst $ filter (isNew $ running cfg) $ M.assocs (spec cfg)+  where isNew running (id, pg) = M.notMember id running +--TODO: make private+mustKill :: GroupConfig -> ([Program], [ProcessHandle])+mustKill cfg = unzip targets+  where runningAndDifferent :: (ProgramId, (Program, Maybe ProcessHandle)) -> Maybe (Program, ProcessHandle)+        runningAndDifferent (id, (pg, Nothing))    = Nothing+        runningAndDifferent (id, (pg, (Just pid)))+         | (M.notMember id specMap || M.findWithDefault defaultProgram id specMap /= pg) = Just (pg, pid)+         | otherwise                                                                     = Nothing+        targets = mapMaybe runningAndDifferent allRunning+        specMap = spec cfg+        allRunning = M.assocs $ running cfg+ -- |periodically run the supervisor sync independent of config reload, -- |just in case state gets funky b/c of theoretically possible timing -- |issues on reload pollStale :: TVar GroupConfig -> IO () pollStale sharedGroupConfig = forever $ sleepSecs 10 >> syncSupervisors sharedGroupConfig+++nnull :: [a] -> Bool+nnull = not . null
README.md view
@@ -1,5 +1,6 @@ Angel =====+[![Build Status](https://travis-ci.org/MichaelXavier/Angel.png?branch=master)](https://travis-ci.org/MichaelXavier/Angel)  `angel` is a daemon that runs and monitors other processes.  It is similar to djb's `daemontools` or the Ruby project `god`.@@ -127,6 +128,7 @@         directory = "/path/to/worker"         exec      = "run_worker"         count     = 30+        pidfile   = "/path/to/pidfile.pid"     }  Each program that should be supervised starts a `program-id` block:@@ -155,6 +157,9 @@  * `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.+ * `pidfile` is an optional argument to specify where a pidfile should be+   created. If you don't specify an absolute path, it will use the running+   directory of angel.  Assuming the above configuration was in a file called "example.conf", here's what a shell session might look like:@@ -250,11 +255,15 @@  **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.+Specify a `count` of 0 for the process. That will kill any running processes+but still let you keep it in the config file.  CHANGELOG ---------+### 0.4.2++* Add `pidfile` option to program spec to specify a pidfile location.+ ### 0.4.1  * Add `count` option to program spec to launch multiple instances of a program.@@ -263,11 +272,12 @@ Author ------ -Jamie Turner <jamie@jamwt.com>+Original Author: Jamie Turner <jamie@jamwt.com>+Current Maintainer: Michael Xavier <michael@michaelxavier.net>  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+https://github.com/MichaelXavier/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.4.1+Version:             0.4.2  -- A short (one-line) description of the package. -- Synopsis: