diff --git a/Angel/Config.hs b/Angel/Config.hs --- a/Angel/Config.hs +++ b/Angel/Config.hs @@ -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 diff --git a/Angel/Data.hs b/Angel/Data.hs --- a/Angel/Data.hs +++ b/Angel/Data.hs @@ -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" diff --git a/Angel/Job.hs b/Angel/Job.hs --- a/Angel/Job.hs +++ b/Angel/Job.hs @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 +Original Author: Jamie Turner +Current Maintainer: Michael Xavier 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 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.4.1 +Version: 0.4.2 -- A short (one-line) description of the package. -- Synopsis: