diff --git a/README b/README --- a/README +++ b/README @@ -67,6 +67,9 @@ Changelog --------- +* 0.3 + * merged with updates by madhadron + * 0.2 * provided documentation * backported to older GHC versions, tested on 6.8.1 diff --git a/System/Posix/Daemonize.hs b/System/Posix/Daemonize.hs --- a/System/Posix/Daemonize.hs +++ b/System/Posix/Daemonize.hs @@ -1,4 +1,43 @@ -module System.Posix.Daemonize (Logger, Program, daemonize, serviced) where +module System.Posix.Daemonize ( + -- * Simple daemonization + daemonize, + -- * Building system services + serviced, CreateDaemon(..), simpleDaemon + + -- * An example + -- + -- | Here is an example of a full program which writes a message to + -- syslog once a second proclaiming its continued existance, and + -- which installs its own SIGHUP handler. Note that you won't + -- actually see the message once a second in the log on most + -- systems. @syslogd@ detects repeated messages and prints the + -- first one, then delays for the rest and eventually writes a line + -- about how many times it has seen it. + -- + -- > module Main where + -- > + -- > import System.Posix.Daemonize (CreateDaemon(..), serviced, simpleDaemon) + -- > import System.Posix.Signals (installHandler, Handler(Catch), sigHUP, fullSignalSet) + -- > import System.Posix.Syslog (syslog, Priority(Notice)) + -- > import Control.Concurrent (threadDelay) + -- > import Control.Monad (forever) + -- > + -- > main :: IO () + -- > main = serviced stillAlive + -- > + -- > stillAlive :: CreateDaemon + -- > stillAlive = simpleDaemon { program = stillAliveMain } + -- > + -- > stillAliveMain :: IO () + -- > stillAliveMain = do + -- > installHandler sigHUP (Catch taunt) (Just fullSignalSet) + -- > forever $ do threadDelay (10^6) + -- > syslog Notice "I'm still alive!" + -- > + -- > taunt :: IO () + -- > taunt = syslog Notice "I sneeze in your general direction, you and your SIGHUP." + + ) where {- originally based on code from http://sneakymustard.com/2008/12/11/haskell-daemons -} @@ -6,32 +45,42 @@ import Control.Concurrent import Control.Exception.Extensible +import qualified Control.Monad as M (forever) import Prelude hiding (catch) import System import System.Exit import System.Posix -import System.Posix.Syslog - - --- | The simplest possible interface to syslog. -type Logger = String -> IO () - - --- | A program is any IO computation. It also accepts a syslog handle. -type Program = Logger -> IO () +import System.Posix.Syslog (withSyslog,Option(..),Priority(..),Facility(..),syslog) +import System.Posix.Types (UserID, GroupID) +import System.FilePath.Posix (FilePath,joinPath) +import Data.Maybe (isNothing, fromMaybe, fromJust) --- | Daemonizes a given IO computation by forking twice, closing --- standard file descriptors, blocking sigHUP, setting file creation --- mask, starting a new session, and changing the working directory --- to root. +-- | Turning a process into a daemon involves a fixed set of +-- operations on unix systems, described in section 13.3 of Stevens +-- and Rago, "Advanced Programming in the Unix Environment." Since +-- they are fixed, they can be written as a single function, +-- 'daemonize' taking an 'IO' action which represents the daemon's +-- actual activity. +-- +-- Briefly, 'daemonize' sets the file creation mask to 0, forks twice, +-- changed the working directory to @/@, closes stdin, stdout, and +-- stderr, blocks 'sigHUP', and runs its argument. Strictly, it +-- should close all open file descriptors, but this is not possible in +-- a sensible way in Haskell. +-- +-- The most trivial daemon would be +-- +-- > daemonize (forever $ return ()) +-- +-- which does nothing until killed. -daemonize :: IO () -> IO () +daemonize :: IO () -> IO () daemonize program = - - do setFileCreationMask 0 - forkProcess p - exitImmediately ExitSuccess + + do setFileCreationMask 0 + forkProcess p + exitImmediately ExitSuccess where @@ -42,50 +91,69 @@ p' = do changeWorkingDirectory "/" closeFileDescriptors blockSignal sigHUP - program + program --- | Turns a program into a UNIX daemon (system service) ready to be --- deployed to /etc/rc.d or similar startup folder. The resulting --- program handles command-line arguments (start, stop, or restart). --- --- With start option it writes out a PID to /var/run/$name.pid where --- $name is the executable name. If PID already exists, it refuses --- to start, guaranteeing there is only one live instance. --- --- With stop option it reads the PID from /var/run/$name.pid and --- terminates the corresponding process (first a soft kill, SIGTERM, --- then a hard kill, SIGKILL). + + +-- | 'serviced' turns a program into a UNIX daemon (system service) +-- ready to be deployed to /etc/rc.d or similar startup folder. It +-- is meant to be used in the @main@ function of a program, such as +-- +-- > serviced simpleDaemon +-- +-- The resulting program takes one of three argments: @start@, +-- @stop@, and @restart@. All control the status of a daemon by +-- looking for a file containing a text string holding the PID of +-- any running instance. Conventionally, this file is in +-- @/var/run/$name.pid@, where $name is the executable's name. For +-- obvious reasons, this file is known as a PID file. -- --- Another addition over the daemonize function is dropping --- privileges. If a system user and group with a name that matches --- the executable name exist, privileges are dropped to that user and --- group. Otherwise, they are dropped to the standard daemon user --- and group. +-- @start@ makes the program write a PID file. If the file already +-- exists, it refuses to start, guaranteeing there is only one +-- instance of the daemon at any time. -- +-- @stop@ read the PID file, and terminates the process whose pid is +-- written therein. First it does a soft kill, SIGTERM, giving the +-- daemon a chance to shut down cleanly, then three seconds later a +-- hard kill which the daemon cannot catch or escape. +-- +-- @restart@ is simple @stop@ followed by @start@. +-- +-- 'serviced' also tries to drop privileges. If you don't specify a +-- user the daemon should run as, it will try to switch to a user +-- with the same name as the daemon, and otherwise to user @daemon@. +-- It goes through the same sequence for group. Just to complicate +-- matters, the name of the daemon is by default the name of the +-- executable file, but can again be set to something else in the +-- 'CreateDaemon' record. +-- -- Finally, exceptions in the program are caught, logged to syslog, -- and the program restarted. -serviced :: Program -> IO () -serviced program = do name <- getProgName - args <- getArgs - process name args +serviced :: CreateDaemon -> IO () +serviced daemon = do + systemName <- getProgName + let daemon' = daemon { name = if isNothing (name daemon) + then Just systemName else name daemon } + args <- getArgs + process daemon' args where - - program' name = withSyslog name [] DAEMON $ + + program' daemon = withSyslog (fromJust $ name daemon) (syslogOptions daemon) DAEMON $ do let log = syslog Notice log "starting" - pidWrite name - dropPrivileges name - forever log program + pidWrite daemon + dropPrivileges daemon + forever (program daemon) - process name ["start"] = pidExists name >>= f where + process daemon ["start"] = pidExists daemon >>= f where f True = do error "PID file exists. Process already running?" exitImmediately (ExitFailure 1) - f False = daemonize (program' name) + f False = daemonize (program' daemon) - process name ["stop"] = - do pid <- pidRead name + process daemon ["stop"] = + do pid <- pidRead daemon let ifdo x f = x >>= \x -> if x then f else pass case pid of Nothing -> pass @@ -96,25 +164,90 @@ do usleep (3*10^6) ifdo (pidLive pid) (signalProcess sigKILL pid)) `finally` - removeLink (pidFile name) + removeLink (pidFile daemon) - process name ["restart"] = do process name ["stop"] - process name ["start"] - process name _ = - putStrLn $ "usage: " ++ name ++ " {start|stop|restart}" + process daemon ["restart"] = do process daemon ["stop"] + process daemon ["start"] + process daemon _ = + getProgName >>= \pname -> putStrLn $ "usage: " ++ pname ++ " {start|stop|restart}" +-- | The details of any given daemon are fixed by the 'CreateDaemon' +-- record passed to 'serviced'. You can also take a predefined form +-- of 'CreateDaemon', such as 'simpleDaemon' below, and set what +-- options you want, rather than defining the whole record yourself. +data CreateDaemon = CreateDaemon { + program :: IO (), -- ^ The actual guts of the daemon, more or less + -- the @main@ function. + name :: Maybe String, -- ^ The name of the daemon, which is used as + -- the name for the PID file, as the name that + -- appears in the system logs, and as the user + -- and group the daemon tries to run as if + -- none are explicitly specified. In general, + -- this should be 'Nothing', in which case the + -- system defaults to the name of the + -- executable file containing the daemon. + user :: Maybe String, -- ^ Most daemons are initially run as root, + -- and try to change to another user so they + -- have fewer privileges and represent less of + -- a security threat. This field specifies + -- which user it should try to run as. If it + -- is 'Nothing', or if the user does not exist + -- on the system, it next tries to become a + -- user with the same name as the daemon, and + -- if that fails, the user @daemon@. + group :: Maybe String, -- ^ 'group' is the group the daemon should + -- try to run as, and works the same way as + -- the user field. + syslogOptions :: [Option], -- ^ The options the daemon should set on + -- syslog. You can safely leave this as @[]@. + pidfileDirectory :: Maybe FilePath -- ^ The directory where the + -- daemon should write and look + -- for the PID file. 'Nothing' + -- means @/var/run@. Unless you + -- have a good reason to do + -- otherwise, leave this as + -- 'Nothing'. +} +-- | The simplest possible instance of 'CreateDaemon' is +-- +-- > CreateDaemon { +-- > program = forever $ return () +-- > name = Nothing, +-- > user = Nothing, +-- > group = Nothing, +-- > syslogOptions = [], +-- > pidfileDirectory = Nothing, +-- > } +-- +-- which does nothing forever with all default settings. We give it a +-- name, 'simpleDaemon', since you may want to use it as a template +-- and modify only the fields that you need. + +simpleDaemon :: CreateDaemon +simpleDaemon = CreateDaemon { + name = Nothing, + user = Nothing, + group = Nothing, + syslogOptions = [], + pidfileDirectory = Nothing, + program = M.forever $ return () +} + + + + {- implementation -} -forever :: Logger -> Program -> IO () -forever log program = - program log `catch` restart where +forever :: IO () -> IO () +forever program = + program `catch` restart where restart :: SomeException -> IO () restart e = - do log ("unexpected exception: " ++ show e) - log "restarting in 5 seconds" + do syslog Error ("unexpected exception: " ++ show e) + syslog Error "restarting in 5 seconds" usleep (5 * 10^6) - forever log program + forever program closeFileDescriptors :: IO () closeFileDescriptors = @@ -139,30 +272,33 @@ f (Left e) = Nothing f (Right uid) = Just uid -dropPrivileges :: String -> IO () -dropPrivileges name = +dropPrivileges :: CreateDaemon -> IO () +dropPrivileges daemon = do Just ud <- getUserID "daemon" Just gd <- getGroupID "daemon" - u <- fmap (maybe ud id) $ getUserID name - g <- fmap (maybe gd id) $ getGroupID name + let targetUser = fromMaybe (fromJust $ name daemon) (user daemon) + targetGroup = fromMaybe (fromJust $ name daemon) (group daemon) + u <- fmap (maybe ud id) $ getUserID targetUser + g <- fmap (maybe gd id) $ getGroupID targetGroup setGroupID g setUserID u -pidFile:: String -> String -pidFile name = "/var/run/" ++ name ++ ".pid" +pidFile:: CreateDaemon -> String +pidFile daemon = joinPath [dir, (fromJust $ name daemon) ++ ".pid"] + where dir = fromMaybe "/var/run" (pidfileDirectory daemon) -pidExists :: String -> IO Bool -pidExists name = fileExist (pidFile name) +pidExists :: CreateDaemon -> IO Bool +pidExists daemon = fileExist (pidFile daemon) -pidRead :: String -> IO (Maybe CPid) -pidRead name = pidExists name >>= choose where - choose True = fmap (Just . read) $ readFile (pidFile name) +pidRead :: CreateDaemon -> IO (Maybe CPid) +pidRead daemon = pidExists daemon >>= choose where + choose True = fmap (Just . read) $ readFile (pidFile daemon) choose False = return Nothing -pidWrite :: String -> IO () -pidWrite name = +pidWrite :: CreateDaemon -> IO () +pidWrite daemon = getProcessID >>= \pid -> - writeFile (pidFile name) (show pid) + writeFile (pidFile daemon) (show pid) pidLive :: CPid -> IO Bool pidLive pid = diff --git a/hdaemonize.cabal b/hdaemonize.cabal --- a/hdaemonize.cabal +++ b/hdaemonize.cabal @@ -1,5 +1,5 @@ Name: hdaemonize -Version: 0.2 +Version: 0.3 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE @@ -16,7 +16,7 @@ Build-Type: Simple Extra-Source-Files: README Library - Build-Depends: base, unix, haskell98, hsyslog, extensible-exceptions + Build-Depends: base >= 4 && < 5, unix, haskell98, hsyslog, extensible-exceptions, filepath Exposed-modules: System.Posix.Daemonize