sentry (empty) → 0.1.0

raw patch · 9 files changed

+811/−0 lines, 9 filesdep +ansi-terminaldep +basedep +bytestringsetup-changed

Dependencies added: ansi-terminal, base, bytestring, cereal, cmdargs, directory, filepath, old-locale, old-time, process, safecopy, sentry, time, unix

Files

• LICENSE +27/−0
• Sentry.hs +34/−0
• Sentry/Command.hs +101/−0
• Sentry/Core.hs +472/−0
• Sentry/Types.hs +87/−0
• Setup.hs +3/−0
• bin/sentry-sleep.hs +15/−0
• bin/sentry.hs +10/−0
• sentry.cabal +62/−0

@@ -0,0 +1,27 @@+Copyright: (c) Vo Minh Thu, 2012.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

@@ -0,0 +1,34 @@+-- |+-- Module      : Sentry+-- Copyright   : (c) 2012 Vo Minh Thu,+--+-- License     : BSD-style+-- Maintainer  : thu@hypered.be+-- Stability   : experimental+-- Portability : GHC+--+-- This module re-exports everything one needs to write a Sentry+-- configuration file. A configuration file is actually a (simple) Haskell+-- program. As an example, consider the following code:+--+-- > import Sentry+-- >+-- > main :: IO ()+-- > main = sentry+-- >   [ entry "dummy" "sleep" ["4"] 1000 2+-- >   ]+--+-- When compiled (some features don't work correctly under @ghci@) and run, the+-- above program will maintain two processes, both running @sleep@. Whenever a+-- process exits, Sentry will restart it. Detailed usage information can be+-- found at <https://github.com/noteed/sentry> and by running the program with+-- the @--help@ option.+--+-- See `sentry` and `entry` below for more details on those functions.+module Sentry+  ( sentry+  , entry+  ) where++import Sentry.Command (sentry)+import Sentry.Types (entry)

@@ -0,0 +1,101 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+-- |+-- Module      : Sentry.Command+-- Copyright   : (c) 2012 Vo Minh Thu,+--+-- License     : BSD-style+-- Maintainer  : thu@hypered.be+-- Stability   : experimental+-- Portability : GHC+--+-- This module provides the command-line interface for a Sentry program. It+-- defines data types to represent different subcommands and the corresponding+-- functions.+module Sentry.Command where++import System.Console.CmdArgs.Implicit++import Sentry.Core+import Sentry.Types (Entry(..))++-- | 'sentry' provides the main function of a Sentry configuration file. In+-- particular it provides the command-line interface. It takes a list of+-- configuration entries as its sole argument.+sentry :: [Entry] -> IO ()+sentry entries = (runCmd =<<) $ cmdArgs $+  modes+    [ cmdStart entries+    , cmdContinue entries+    , cmdCompile+    , cmdReload+    ]+  &= summary versionString+  &= program "sentry"++-- | String with the program name, version and copyright.+versionString :: String+versionString =+  "Sentry - Process monitoring. Copyright (c) 2012 Vo Minh Thu."+  -- TODO add the version.++-- | Data type representing the different command-line subcommands.+data Cmd =+    Start { cmdEntries :: [Entry] }+    -- ^ Start Sentry with the provided process specifications.+  | Continue { cmdEntries :: [Entry] }+    -- ^ Resume Sentry with the provided process specifications.+  | Compile+    -- ^ Compile Sentry.+  | Reload+    -- ^ Reload Sentry.+  deriving (Data, Typeable)++-- | Create a 'Start' command.+cmdStart :: [Entry] -> Cmd+cmdStart entries = Start+  { cmdEntries = entries+    &= ignore+  } &= help "Start Sentry."+    &= explicit+    &= name "start"++-- | Create a 'Continue' command.+cmdContinue :: [Entry] -> Cmd+cmdContinue entries = Continue+  { cmdEntries = entries+    &= ignore+  } &= help ("Resume Sentry after a graceful exit or SIGHUP." +++      " This is normally not called explicitely from the command-line.")+    &= explicit+    &= name "continue"++-- | Create a 'Compile' command.+cmdCompile :: Cmd+cmdCompile = Compile+  &= help "Compile the configuration file, replacing this executable."+  &= explicit+  &= name "compile"++-- | Create a 'Reload' command.+cmdReload :: Cmd+cmdReload = Reload+  &= help "Instruct a running Sentry to reload itself by sending it a SIGHUP."+  &= explicit+  &= name "reload"++-- | Run a Sentry sub-command.+runCmd :: Cmd -> IO ()+runCmd Start{..} = startMonitor cmdEntries++runCmd Continue{..} = continueMonitor cmdEntries++runCmd Compile{..} = do+  state <- initializeState []+  _ <- compile state+  return ()++runCmd Reload{..} = do+  state <- initializeState []+  sendSIGHUP state

@@ -0,0 +1,472 @@+{-# LANGUAGE RecordWildCards #-}+-- |+-- Module      : Sentry.Core+-- Copyright   : (c) 2012 Vo Minh Thu,+--+-- License     : BSD-style+-- Maintainer  : thu@hypered.be+-- Stability   : experimental+-- Portability : GHC+--+-- This module is Sentry's core implementation: state initialization, process+-- spawning and monitoring.+module Sentry.Core+  (+  -- * Processes+    spawn+  , follow+  , terminate+  , updateProcess+  , removeProcess+  -- * Application state+  , initializeState+  , saveState+  , readState+  -- * Main entry points+  , startMonitor+  , continueMonitor+  , sendSIGHUP+  , compile+  , reexecute+  ) where++import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent.Chan+import Control.Concurrent.MVar+import Control.Applicative ((<$>))+import Control.Monad (forM_, replicateM, when)+import qualified Data.ByteString as B+import Data.Either (partitionEithers)+import Data.List (foldl')+import Data.Maybe (isJust)+import Data.Serialize (runGet, runPut)+import Data.SafeCopy (safeGet, safePut)+import Data.Time.Clock.POSIX(getPOSIXTime)+import System.Console.ANSI (setSGRCode, ColorIntensity(..), Color(..)+  , ConsoleLayer(..), SGR(..))+import System.Directory (createDirectoryIfMissing, doesFileExist, getHomeDirectory)+import System.Exit (ExitCode(..))+import System.FilePath ((<.>), (</>), takeDirectory)+import System.IO (hGetLine, hIsEOF, hPutStrLn, hReady, hSetBuffering+  , stderr, stdout, withFile+  , BufferMode(..), IOMode(..), Handle)+import System.Locale (defaultTimeLocale)+import System.Posix.Files (readSymbolicLink)+import System.Posix.Process (executeFile, getProcessID)+import System.Posix.Signals (installHandler, sigHUP, sigINT, signalProcess+  , Handler(..))+import System.Process (createProcess, getProcessExitCode, proc+  , runProcess, std_out, terminateProcess, waitForProcess)+import System.Process.Internals+import System.Time (formatCalendarTime, getClockTime, toCalendarTime)++import Sentry.Types++-- | Create a new process, monitored by a new thread. The provided channel+-- is used by the monitoring thread when the process exits to notify the+-- main thread.+spawn :: Chan Command -> Entry -> IO Int -- TODO newtype ProcessID+spawn chan e@Entry{..} = do+  (_, Just hout, Just herr, h) <- createProcess $+    (proc eCommand eArguments)+    { std_out = CreatePipe, std_err = CreatePipe }+  i <- processHandleToInt h+  t1 <- getTime+  logP e i $ "Started at " ++ show t1 ++ "."+  follow chan e i+  _ <- forkIO $ pipeToStdout e i hout herr+  return i++-- | Wait for a process to complete. When it happens, it will notify the main+-- thread using the provided channel. Return without blocking.+follow :: Chan Command -> Entry -> Int -> IO ()+follow chan p@Entry{..} i = do+  _ <- forkIO $ do+    -- After a re-exec, waitForProcess will make an error if the+    -- child has already exited, so use getProcessExitCode at first.+    -- If it returns Nothing, then we have to continue waiting for t+    -- (the handle is valid) otherwise the process has completed.+    h <- intToProcessHandle i+    mCode <- getProcessExitCode h+    case mCode of+      Just _ -> writeChan chan $ ProcessExited eType i+      Nothing -> do+        exitCode <- waitForProcess h+        t <- getTime+        logP p i $ "Exited at " ++ show t ++ " with " ++ show exitCode ++ "."+        threadDelay $ eDelay * 1000+        writeChan chan $ ProcessExited eType i+  return ()++terminate :: MonitoredEntry -> IO ()+terminate MonitoredEntry{..} = do+  putStrLn $ "Process type `" ++ eType mEntry ++ "` removed. Killing "+    ++ "workers."+  mapM_ (\i -> intToProcessHandle i >>= terminateProcess) mHandles++-- | Given a monitored process, adjust the number of worker processes to match+-- the possibly updated spec.+updateProcess :: Chan Command -> MonitoredEntry -> IO MonitoredEntry+updateProcess chan p@MonitoredEntry{..} =+  case length mHandles `compare` eCount mEntry of+    EQ -> return p+    GT -> do+      let n = length mHandles - eCount mEntry+          toTerminate = take n mHandles+          toKeep = drop n mHandles+      -- logP mEntry $ show n ++ " less workers required."+      hs <- mapM intToProcessHandle toTerminate -- TODO make sure eCount always >= 0+      mapM_ terminateProcess hs -- TODO is SIGTERM really what we want?+      return p { mHandles = toKeep }+    LT -> do+      let n = eCount mEntry - length mHandles+      is <- replicateM n $ spawn chan mEntry+      return p { mHandles = is ++ mHandles }++-- | Remove the process handle from the monitored process (if they match,+-- otherwise do nothing).+removeProcess :: ProcessType -> Int -> MonitoredEntry -> MonitoredEntry+removeProcess typ i p@MonitoredEntry{..} =+  if eType mEntry == typ+  then p { mHandles = filter (/= i) mHandles }+  else p++-- | Given a list of process specifications, start to monitor them.+startMonitor :: [Entry] -> IO ()+startMonitor entries = do+  state <- initializeState entries++  home <- getHomeDirectory+  let sentry = home </> ".sentry"+      conf = sentry </> "conf"+      binPath = sExecutablePath state+      pidPath = binPath <.> "pid"++  pid <- fromIntegral <$> getProcessID :: IO Int+  if takeDirectory binPath /= conf+    then putStrLn $ "Sentry started (PID: " ++ show pid ++ ")."+    else do+      putStrLn $ "Sentry started (PID: " ++ show pid ++ " saved in "+        ++ pidPath ++ ")."+      writeFile pidPath $ show pid++  monitor state++-- | Given new process specifications, continue the monitoring.+continueMonitor :: [Entry] -> IO ()+continueMonitor entries = do+  mstate <- readState+  case mstate of+    Nothing -> return ()+    Just state@Sentry{..} -> do+      putStrLn $ "Sentry reexec'd. Initially started at " +++        show sStartTime ++ maybe "." (\r -> " (Previously reexec'd at " +++        show r ++ ").") sReexecTime+      t <- getTime+      let (walkingDeads, kept) = partitionEithers $+            map (continueProcess entries) sProcesses+          state' = state+            { sProcesses = addEntries kept entries+            , sReexecTime = Just t }+      mapM_ terminate walkingDeads+      monitor state'++-- | Monitor the processes from the given application state.+monitor :: Sentry -> IO ()+monitor state = do+  let state' = state { sProcesses = colorize $ sProcesses state }+  hSetBuffering stdout LineBuffering+  hSetBuffering stderr LineBuffering+  chan <- newChan+  setupHUP chan+  setupINT chan+  -- follow existing handles, if any (after a re-exec there can be some).+  forM_ (sProcesses state') $+    \p -> mapM_ (follow chan $ mEntry p) $ mHandles p+  writeChan chan UpdateProcesses+  processChan state' chan++-- | Process the command received on the main channel. This acts as a main+-- event loop.+processChan :: Sentry -> Chan Command -> IO ()+processChan state@Sentry{..} chan = do+  command <- readChan chan+  case command of+    UpdateProcesses -> do+      ps <- mapM (updateProcess chan) sProcesses+      let state' = state { sProcesses = ps }+      processChan state' chan+    ProcessExited typ i -> do+      let ps = map (removeProcess typ i) sProcesses+      ps' <- mapM (updateProcess chan) ps+      let state' = state { sProcesses = ps' }+      processChan state' chan+    Reexec -> do+      -- TODO Compile/Reexec can be splitted:+      -- First start a thread waiting while compiling.+      -- Second push Reexec on the chan.+      -- Or simply let the `sentry reload` command do it+      -- before issuing the SIGHUP signal.+      -- TODO compile only if the file has been modified.+      b <- compile state+      if b+        then reexecute state+        else processChan state chan+    Quit -> do+      putStrLn "Bye."+      -- TODO SIGTERM should be replaced by SIGINT and a small+      -- waiting period?+      mapM_ (mapM_ (\i -> intToProcessHandle i >>=+        terminateProcess) . mHandles) sProcesses++-- | Compile itself.+compile :: Sentry -> IO Bool+compile state = do+  home <- getHomeDirectory+  let sentry = home </> ".sentry"+      conf = sentry </> "conf"+      binPath = sExecutablePath state+      sourcePath = binPath <.> "hs"+      errorPath = binPath <.> "error"++  if takeDirectory binPath /= conf+    then do+      hPutStrLn stderr $ binPath ++ " is not under " ++ conf ++ "."+      return False+    else do+      status <- withFile errorPath WriteMode $ \h -> do+        p <- runProcess "ghc"+          [ "--make", sourcePath, "-fforce-recomp", "-v0", "-threaded",+            "-o", binPath]+          (Just conf)+          Nothing Nothing Nothing (Just h)+        waitForProcess p++      if status == ExitSuccess+        then do+          putStrLn $ sourcePath ++ " successfully compiled."+          return True+        else do+          content <- readFile errorPath+          hPutStrLn stderr $ "Problem encountered while compiling " ++ sourcePath ++ ":"+          hPutStrLn stderr content+          return False++-- | Save the application state then re-exec itself (calling `sentry continue`).+reexecute :: Sentry -> IO a+reexecute state = do+  saveState state+  executeFile (sExecutablePath state) False ["continue"] Nothing++-- | Send a @SIGHUP@ signal to a running Sentry.+sendSIGHUP :: Sentry -> IO ()+sendSIGHUP state = do+  let binPath = sExecutablePath state+      pidPath = binPath <.> "pid"+      -- TODO all these xxxPath could be function on Sentry.+  -- TODO better error messages.+  content <- readFile pidPath+  signalProcess sigHUP $ fromIntegral (read content :: Int)++------------------------------------------------------------------------------+-- State+------------------------------------------------------------------------------++-- | Return the path where to save the application state.+getStatePath :: IO FilePath+getStatePath = do+  home <- getHomeDirectory+  return $ home </> ".sentry" </> "sentry.state"++-- Inspired by the `executale-path` package, which implements+-- a similar function for different OS.+getExecutablePath :: IO FilePath+getExecutablePath = do+  pid <- fromIntegral <$> getProcessID :: IO Int+  readSymbolicLink $ "/proc/" ++ show pid ++ "/exe"++-- | Make sure the directory where the application state is saved exists.+ensureStateDirectory :: IO ()+ensureStateDirectory = do+  home <- getHomeDirectory+  let dir = home </> ".sentry"+      conf = dir </> "conf"+  createDirectoryIfMissing False dir+  createDirectoryIfMissing False conf++-- | Create a initial application state from a list of process specifications.+initializeState :: [Entry] -> IO Sentry+initializeState specs = do+  path <- getExecutablePath+  t <- getTime+  return Sentry+    { sExecutablePath = path+    , sStartTime = t+    , sReexecTime = Nothing+    , sProcesses = map (flip MonitoredEntry []) specs+    }++-- | Save the application state to disk (normally done just before re-exec'ing+-- itself).+saveState :: Sentry -> IO ()+saveState state = do+  ensureStateDirectory+  statePath <- getStatePath+  B.writeFile statePath . runPut $ safePut state++-- | Try to restore the application state (normally saved previously before+-- re-exec'ing itself).+readState :: IO (Maybe Sentry)+readState = do+  statePath <- getStatePath+  b <- doesFileExist statePath+  if b+    then do+      content <- B.readFile statePath+      case runGet safeGet content of+        Left err -> do+          hPutStrLn stderr $ "Can't parse existing state." +++            " Sentry continues with its current state." +++            " The error was: " ++ err+          return Nothing+        Right a -> return $ Just a+    else do+      hPutStrLn stderr $ "The file `" ++ statePath +++        "` doesn't exist. Sentry continues with its current state."+      return Nothing++-- | Given a list of "new" entries, either modify the monitored entry if it+-- must be updated (and return @Right@) or return @Left@ if it must be+-- deleted. @Left@ is used instead of @Nothing@ so the process handles can+-- be terminated if necessary.+continueProcess :: [Entry] -> MonitoredEntry ->+  Either MonitoredEntry MonitoredEntry+continueProcess entries m@MonitoredEntry{..} =+  case lookupProcess mEntry entries of+    Just p -> Right $ MonitoredEntry p mHandles+    Nothing -> Left m++-- | Add entries to a list of monitored entries if they are not already in+-- there.+addEntries :: [MonitoredEntry] -> [Entry] -> [MonitoredEntry]+addEntries = foldl' addEntry++-- | Add an entry to a list of monitored entries if it is not already in+-- there.+addEntry :: [MonitoredEntry] -> Entry -> [MonitoredEntry]+-- Order doesn't matter as it will be a Map anyway.+addEntry es e = if present then es else MonitoredEntry e [] : es+  where present = isJust $ lookupProcess e $ map mEntry es++-- | Try to find a matching process in the given list.+lookupProcess :: Entry -> [Entry] -> Maybe Entry+lookupProcess p entries =+  case filter (sameEntries p) entries of+    [p'] -> Just p'+    [] -> Nothing+    _ -> error "More than one process"+    -- TODO `entries` must be a Map instead of a list.++-- | Compare if two entries are equal, i.e. if they have+-- same type, command and arguments.+sameEntries :: Entry -> Entry -> Bool+sameEntries p1 p2 = eType p1 == eType p2+  && eCommand p1 == eCommand p2+  && eArguments p1 == eArguments p2++------------------------------------------------------------------------------+-- Logging+------------------------------------------------------------------------------++colorize :: [MonitoredEntry] -> [MonitoredEntry]+colorize entries = zipWith f entries $ cycle $ map Just+  [Red, Blue, Green, Yellow, Magenta, Cyan, White]+  where f e c = e { mEntry = (mEntry e) { eColor = c } }++colorized :: Entry -> String -> String+colorized Entry{..} str =+  case eColor of+    Nothing -> pad str+    Just c ->+      setSGRCode [SetColor Foreground Dull c] ++  pad str ++ setSGRCode []++-- TODO non-hardcoded constant+pad :: String -> String+pad s = s ++ replicate (25 - length s) ' '++logP :: Entry -> Int -> String -> IO ()+logP p@Entry{..} i s = do+  ts <- getTimeString+  putStrLn $ colorized p (ts ++ " " ++ eType ++ "." ++ show i) ++ s++------------------------------------------------------------------------------+-- Signals+------------------------------------------------------------------------------++-- | Install the handleHUP function as a SIGHUP handler.+setupHUP :: Chan Command -> IO ()+setupHUP chan = do+  _ <- installHandler sigHUP (Catch $ handleHUP chan) Nothing+  return ()++-- | SIGHUP handler. When the handler is run, it simply instructs the main+-- thread to re-exec the program.+handleHUP :: Chan Command -> IO ()+handleHUP = flip writeChan Reexec++-- | Install the handleINT function as a SIGINT handler.+setupINT :: Chan Command -> IO ()+setupINT chan = do+  _ <- installHandler sigINT (Catch $ handleINT chan) Nothing+  return ()++-- | SIGINT handler. When the handler is run, it simply instructs the main+-- thread to quit the program.+handleINT :: Chan Command -> IO ()+handleINT = flip writeChan Quit++------------------------------------------------------------------------------+-- Utilities+------------------------------------------------------------------------------++-- | Convenience function to turn a ProcessHandle into an Int (used later when+-- saving/restoring the state with SafeCopy).+processHandleToInt :: ProcessHandle -> IO Int+processHandleToInt (ProcessHandle mvar) = do+  OpenHandle i <- readMVar mvar+  return $ fromIntegral i++-- | Convenience function to turn an Int into a ProcessHandle (used later when+-- saving/restoring the state with SafeCopy).+intToProcessHandle :: Int -> IO ProcessHandle+intToProcessHandle i = do+  mvar <- newMVar $ OpenHandle $ fromIntegral i+  return $ ProcessHandle mvar++-- | Convenience function to get a Posix time as an Int.+getTime :: IO Int+getTime = floor <$> getPOSIXTime++getTimeString :: IO String+getTimeString = do+  tm <- getClockTime+  ct <- toCalendarTime tm+  return $ formatCalendarTime defaultTimeLocale "%H:%M:%S" ct++-- | Copy two handles to stout. It is better if the handles are line-buffered.+pipeToStdout :: Entry -> Int -> Handle -> Handle -> IO ()+pipeToStdout p i h1 h2 = do+  eof1 <- hIsEOF h1+  eof2 <- hIsEOF h2+  ready1 <- if eof1 then return False else hReady h1+  ready2 <- if eof2 then return False else hReady h2+  when ready1 $ do+    l <- hGetLine h1+    logP p i l+  when ready2 $ do+    l <- hGetLine h2+    logP p i l+  when (not eof1 || not eof2) $+    pipeToStdout p i h1 h2++

@@ -0,0 +1,87 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+-- |+-- Module      : Sentry.Types+-- Copyright   : (c) 2012 Vo Minh Thu,+--+-- License     : BSD-style+-- Maintainer  : thu@hypered.be+-- Stability   : experimental+-- Portability : GHC+--+-- This module contains the different data types and type synonyms used in+-- Sentry.+module Sentry.Types where++import Data.Data (Data)+import Data.SafeCopy+import Data.Typeable+import System.Console.ANSI (Color(..))++-- | A process type is just a name for a specific command.+type ProcessType = String++-- | An entry in the configuration, i.e. a process specification.+data Entry = Entry+  { eType :: ProcessType -- ^ Process type.+  , eCommand :: String -- ^ Command.+  , eArguments :: [String] -- ^ Command arguments.+  , eDelay :: Int -- ^ Dealy before re-starting a process, in milliseconds.+  , eCount :: Int -- ^ Number of requested processes of this type.+  , eColor :: Maybe Color+  }+  deriving (Data, Typeable)+  -- Data is only needed so we can have [Entry]+  -- inside the Sentry.Command.Start command.++deriving instance Data Color+deriving instance Typeable Color+deriveSafeCopy 0 'base ''Color++-- | 'entry' is used to define configuration entries to be passed to 'sentry'.+-- A sample entry looks like+--+-- > entry "dummy" "sleep" ["3"] 1000 1+--+-- It creates an entry with type \"dummy\". The type is an arbitrary string that+-- will appear in the logs. It is also used to dynamically change the+-- configuration by refering to its type.  It then specifies that the command+-- `sleep 3` will be kept running, restarting it after 1000 milliseconds if+-- necessary. The last value is the number of instances to run, in the example+-- just one.+entry :: ProcessType -> String -> [String] -> Int -> Int -> Entry+entry typ cmd args delay count =+  Entry typ cmd args delay count Nothing++data MonitoredEntry = MonitoredEntry+  { mEntry :: Entry -- ^ Process specification.+  , mHandles :: [Int] -- ^ List of process handles running the process+  -- specification (Int is used instead of ProcessHandle so we can+  -- save/restore them with SafeCopy).+  }+  deriving Typeable++-- | The application state can be serialized and saved to disk then restored+-- when the process is reexec'd.+data Sentry = Sentry+  { sExecutablePath :: FilePath -- ^ Original executable path.+  , sStartTime :: Int -- ^ When the process was started.+  , sReexecTime :: Maybe Int -- ^ When the process was reexec'd for the last time.+  , sProcesses :: [MonitoredEntry] -- ^ List of monitored processes.+  }+  deriving Typeable++deriveSafeCopy 0 'base ''Entry+deriveSafeCopy 0 'base ''MonitoredEntry+deriveSafeCopy 0 'base ''Sentry++-- | The possible commands the main Sentry thread can execute.+data Command =+    UpdateProcesses -- ^ Request to update the monitored processes list (e.g.+                    -- because a process has exited or a process specification+                    -- has been changed, added, or removed.+  | ProcessExited ProcessType Int -- ^ A process has exited. Its type and its+                                  -- ProcessHandle (as an Int) are given.+  | Reexec -- ^ Re-exec the application, usually after a SIGHUP.+  | Quit -- ^ Request the application to terminate, usually after SIGINT.

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,15 @@+-- | Sample program that sleep some amount of time and prints to stdout and+-- stderr.+module Main where++import Control.Concurrent (threadDelay)+import System.IO (hPutStrLn, hSetBuffering, stderr, stdout, BufferMode(..))++main :: IO ()+main = do+  hSetBuffering stdout LineBuffering+  hSetBuffering stderr LineBuffering+  threadDelay $ 5 * 1000 * 1000+  hPutStrLn stdout "Printed on stdout."+  hPutStrLn stderr "Printed on stderr."+  threadDelay $ 5 * 1000 * 1000

@@ -0,0 +1,10 @@+module Main where++import Sentry++main :: IO ()+main = sentry+  [ entry "short" "sleep" ["2"] 1000 1+  , entry "long" "sleep" ["10"] 1000 2+  , entry "verylong" "sleep" ["30"] 1000 1+  ]

@@ -0,0 +1,62 @@+name:                sentry+version:             0.1.0+Cabal-Version:       >= 1.8+synopsis:            Process monitoring tool written and configured in Haskell+description:+  Sentry is a process monitoring tool written and configured in Haskell. Its+  aim is to keep running programs. For each configured program, multiple+  processes can be started. Currently Sentry runs on Linux only.+  .+  Under normal circumstance, the "Sentry" module is enough to write+  configuration files.+category:            Network+license:             BSD3+license-file:        LICENSE+author:              Vo Minh Thu+maintainer:          noteed@gmail.com+homepage:            https://github.com/noteed/sentry+bug-reports:         https://github.com/noteed/sentry/issues+build-type:          Simple++source-repository head+  type: git+  location: https://github.com/noteed/sentry++library+  build-depends:       base == 4.*,+                       ansi-terminal == 0.5.*,+                       bytestring == 0.9.*,+                       cereal == 0.3.*,+                       cmdargs == 0.9.*,+                       directory == 1.1.*,+                       filepath == 1.2.*,+                       old-locale == 1.0.*,+                       old-time == 1.0.*,+                       process == 1.1.*,+                       safecopy == 0.6.*,+                       time == 1.1.*,+                       unix == 2.4.*+  exposed-modules:     Sentry,+                       Sentry.Command,+                       Sentry.Core,+                       Sentry.Types+  ghc-options:         -Wall++executable sentry+  hs-source-dirs:      bin+  main-is:             sentry.hs+  build-depends:       base == 4.*,+                       directory == 1.1.*,+                       filepath == 1.2.*,+                       sentry,+                       unix == 2.4.*+  ghc-options:         -Wall+                       -threaded++executable sentry-sleep+  hs-source-dirs:      bin+  main-is:             sentry-sleep.hs+  build-depends:       base == 4.*+  ghc-options:         -Wall+                       -threaded+  buildable: True