hdaemonize 0.4.5.0 → 0.5.7
raw patch · 4 files changed
Files
- README +0/−91
- README.md +116/−0
- System/Posix/Daemonize.hs +163/−123
- hdaemonize.cabal +23/−13
− README
@@ -1,91 +0,0 @@-`hdaemonize-0.4.3`-=================--`hdaemonize` is a simple library that hides some of the complexities-of writing UNIX daemons in Haskell. --Obtaining--------------The latest version is available (BSD license) at-[GitHub](https://github.com/madhadron/hdaemonize).--Using----------The synopsis is:-- import System.Posix.Daemonize- main = daemonize $ program--This code will make `program` do what good daemons should do, that is,-detach from the terminal, close file descriptors, create a new process-group, and so on.--If you want more functionality than that, it is available as a-`serviced` function.--Here is an example:-- import Control.Concurrent- import System.Posix.Daemonize-- loop i log = do threadDelay $ 10^6- log (show i)- writeFile "/tmp/counter" $ show i- if i == 5 then undefined else loop (i + 1) log-- main = serviced (loop 0)--Let us say this program is compiled as `mydaemon`. Then:-- # mydaemon start--starts the service. A second call to start will complain that the-program is already running. --During its execution, mydaemon will simply write a new number to-`/tmp/counter` every second, until it reaches 5. Then, an exception-will be thrown. This exception will be caught by `hdaemonize`, and-logged to `/var/log/daemon.log` or similar (this is depends on how-`syslog` works on your platorm). `log (show i)` will leave messages-in the same file.--When the exception is thrown, the program will be restared in 5-seconds, and will start counting from 0 again.--The following commands are also made available:-- # mydaemon stop- # mydaemon restart- -Finally, `mydaemon` drops privileges. By default it changes the-effective user and group ids to those of the `daemon` user, but it-prefers to use those of `mydaemon`, if present.---Changelog------------* 0.4- * added support for a privileged action before dropping privileges--* 0.3- * merged with updates by madhadron--* 0.2- * provided documentation- * backported to older GHC versions, tested on 6.8.1--* 0.1- * initial public release---Authors----------Anton Tayanovskyy <name.surname@gmail.com>, bug reports and feature-requests welcome.--The code is originally based on a public posting by-[Andre Nathan](http://sneakymustard.com/), used by permission.
+ README.md view
@@ -0,0 +1,116 @@+`hdaemonize`+=================+[](https://travis-ci.org/unprolix/hdaemonize)++`hdaemonize` is a simple library that hides some of the complexities+of writing UNIX daemons in Haskell.++Obtaining+-----------++The latest version is available (BSD license) at+[GitHub](https://github.com/unprolix/hdaemonize).++Using+-------++The synopsis is:++ import System.Posix.Daemonize+ main = daemonize $ program++This code will make `program` do what good daemons should do, that is,+detach from the terminal, close file descriptors, create a new process+group, and so on.++If you want more functionality than that, it is available as a+`serviced` function.++Here is an example:++ import Control.Concurrent+ import System.Posix.Daemonize++ loop i log = do threadDelay $ 10^6+ log (show i)+ writeFile "/tmp/counter" $ show i+ if i == 5 then undefined else loop (i + 1) log++ main = serviced (loop 0)++Let us say this program is compiled as `mydaemon`. Then:++ # mydaemon start++starts the service. A second call to start will complain that the+program is already running.++During its execution, mydaemon will simply write a new number to+`/tmp/counter` every second, until it reaches 5. Then, an exception+will be thrown. This exception will be caught by `hdaemonize`, and+logged to `/var/log/daemon.log` or similar (this is depends on how+`syslog` works on your platorm). `log (show i)` will leave messages+in the same file.++When the exception is thrown, the program will be restared in 5+seconds, and will start counting from 0 again.++The following commands are also made available:++ # mydaemon stop+ # mydaemon restart++Finally, if configured to do so, `mydaemon` drops privileges by+changing its effective user/group ID. (If no user/group ID are+specified, it will continue execution as the original user and group.)++Note that if you wish to parse your own commandline arguments, you can+replace invocation of the `serviced` function with `serviced'`. This+requires specification of an `Operation` which indicates whether the+daemon should be started, stopped, restarted, or whether its status+should be queried.++Changelog+---------++* 0.5.6+ * Add `serviced'` function and `Operation` (`Start`, `Stop`, etc.) to allow invocation separated from commandline+ * Only attempt to change effective user/group ID when explicitly specified.+ * Do not attempt to set user or group to the daemon's name in the absence of a specified user or group.++* 0.5.5+ * Fix a bug where hdaemonize fails when user or group "daemon" is absent++* 0.5.4+ * Update to use hsyslog == 5.++* 0.5.2+ * Fix pre-AMP builds.++* 0.5.1+ * Updated to use hsyslog >=4++* 0.4+ * added support for a privileged action before dropping privileges++* 0.3+ * merged with updates by madhadron++* 0.2+ * provided documentation+ * backported to older GHC versions, tested on 6.8.1++* 0.1+ * initial public release+++Authors+-------+Jeremy Bornstein <jeremy@jeremy.org>++Lana Black <lanablack@amok.cc>++Anton Tayanovskyy <name.surname@gmail.com>.++The code is originally based on a public posting by+[Andre Nathan](http://sneakymustard.com/), used by permission.
System/Posix/Daemonize.hs view
@@ -1,50 +1,22 @@-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module System.Posix.Daemonize ( -- * Simple daemonization- daemonize, + daemonize, -- * Building system services- serviced, CreateDaemon(..), simpleDaemon,- -- * Intradaemon utilities - fatalError, exitCleanly- -- * 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."-+ serviced, serviced', CreateDaemon(..), simpleDaemon, Operation(..),+ -- * Intradaemon utilities+ fatalError, exitCleanly,+ -- * Logging utilities+ syslog ) where- -{- originally based on code from ++{- originally based on code from http://sneakymustard.com/2008/12/11/haskell-daemons -} +import Control.Applicative(pure)+import Control.Monad (when) import Control.Monad.Trans import Control.Exception.Extensible import qualified Control.Monad as M (forever)@@ -55,50 +27,61 @@ import Prelude hiding (catch) #endif +#if !(MIN_VERSION_base(4,8,0))+import Control.Applicative ((<$), (<$>))+#endif++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as ByteString+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)++import Data.Foldable (asum)++import Data.Maybe (isNothing, fromMaybe, fromJust) import System.Environment import System.Exit-import System.Posix-import System.Posix.Syslog (withSyslog,Option(..),Priority(..),Facility(..),syslog)+import System.Posix hiding (Start, Stop)+import System.Posix.Syslog (Priority(..), Facility(Daemon), Option, withSyslog)+import qualified System.Posix.Syslog as Log import System.FilePath.Posix (joinPath)-import Data.Maybe (isNothing, fromMaybe, fromJust) +data Operation = Start | Stop | Restart | Status deriving (Eq, Show) +syslog :: Priority -> ByteString -> IO ()+syslog pri msg = unsafeUseAsCStringLen msg (Log.syslog (Just Daemon) pri)+ -- | 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 program = - - do setFileCreationMask 0 - forkProcess p- exitImmediately ExitSuccess-+daemonize :: IO () -> IO ()+daemonize program = do+ setFileCreationMask 0+ forkProcess p+ exitImmediately ExitSuccess where- p = do createSession forkProcess p' exitImmediately ExitSuccess- p' = do changeWorkingDirectory "/" closeFileDescriptors blockSignal sigHUP- program + program @@ -106,9 +89,9 @@ -- | '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 arguments: @start@, -- @stop@, and @restart@. All control the status of a daemon by -- looking for a file containing a text string holding the PID of@@ -124,9 +107,9 @@ -- 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@.@@ -134,51 +117,87 @@ -- 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 :: CreateDaemon a -> 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+serviced daemon = do+ args <- getArgs++ let mOperation :: Maybe Operation+ mOperation = case args of+ ("start" : _) -> Just Start+ ("stop" : _) -> Just Stop+ ("restart" : _) -> Just Restart+ ("status" : _) -> Just Status+ _ -> Nothing++ if isNothing mOperation+ then getProgName >>= \pname -> putStrLn $ "usage: " ++ pname ++ " {start|stop|status|restart}"+ else serviced' daemon $ fromJust mOperation++serviced' :: CreateDaemon a -> Operation -> IO ()+serviced' daemon operation = do+ systemName <- getProgName+ let daemon' = daemon { name = if isNothing (name daemon)+ then Just systemName else name daemon }+ process daemon' operation where- - program' daemon = withSyslog (fromJust $ name daemon) (syslogOptions daemon) DAEMON $+ program' daemon = withSyslog (fromJust (name daemon)) (syslogOptions daemon) Daemon $ do let log = syslog Notice log "starting" pidWrite daemon privVal <- privilegedAction daemon dropPrivileges daemon- forever $ program daemon $ privVal+ forever $ program daemon privVal - process daemon ["start"] = pidExists daemon >>= 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' daemon)- - process daemon ["stop"] = ++ process daemon Stop = do pid <- pidRead daemon- let ifdo x f = x >>= \x -> if x then f else pass case pid of Nothing -> pass- Just pid -> - (do signalProcess sigTERM pid- usleep (10^6)- ifdo (pidLive pid) $ - do usleep (3*10^6)- ifdo (pidLive pid) (signalProcess sigKILL pid))+ Just pid ->+ whenM (pidLive pid)+ (do signalProcess sigTERM pid+ usleep (10^3)+ wait (killWait daemon) pid) `finally` removeLink (pidFile daemon) - process daemon ["restart"] = do process daemon ["stop"]- process daemon ["start"]- process _ _ = - getProgName >>= \pname -> putStrLn $ "usage: " ++ pname ++ " {start|stop|restart}"+ process daemon Restart = do process daemon Stop+ process daemon Start + process daemon Status = pidExists daemon >>= f where+ f True =+ do pid <- pidRead daemon+ case pid of+ Nothing -> putStrLn $ fromJust (name daemon) ++ " is not running."+ Just pid ->+ do res <- pidLive pid+ if res then+ putStrLn $ fromJust (name daemon) ++ " is running."+ else putStrLn $ fromJust (name daemon) ++ " is not running, but pidfile is remaining."+ f False = putStrLn $ fromJust (name daemon) ++ " is not running."++ -- Wait 'secs' seconds for the process to exit, checking+ -- for liveness once a second. If still alive send sigKILL.+ wait :: Maybe Int -> CPid -> IO ()+ wait secs pid =+ whenM (pidLive pid) $+ if maybe True (> 0) secs+ then do usleep (10^6)+ wait (fmap (\x->x-1) secs) pid+ else signalProcess sigKILL pid++-- | A monadic-conditional version of the "when" guard (copied from shelly.)+whenM :: Monad m => m Bool -> m () -> m ()+whenM c a = c >>= \res -> when res a+ -- | 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@@ -213,17 +232,20 @@ -- 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'.+ 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'.+ killWait :: Maybe Int -- ^ How many seconds to wait between sending+ -- sigTERM and sending sigKILL. If Nothing+ -- wait forever. Default 4. } --- | The simplest possible instance of 'CreateDaemon' is --- +-- | The simplest possible instance of 'CreateDaemon' is+-- -- > CreateDaemon { -- > privilegedAction = return () -- > program = const $ forever $ return ()@@ -233,7 +255,7 @@ -- > 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.@@ -246,60 +268,78 @@ syslogOptions = [], pidfileDirectory = Nothing, program = const $ M.forever $ return (),- privilegedAction = return ()+ privilegedAction = return (),+ killWait = Just 4 }- + {- implementation -} forever :: IO () -> IO ()-forever program = +forever program = program `catch` restart where- restart :: SomeException -> IO () - restart e = - do syslog Error ("unexpected exception: " ++ show e)+ restart :: SomeException -> IO ()+ restart e =+ do syslog Error $ ByteString.pack ("unexpected exception: " ++ show e) syslog Error "restarting in 5 seconds" usleep (5 * 10^6) forever program closeFileDescriptors :: IO ()-closeFileDescriptors = +closeFileDescriptors =+#if MIN_VERSION_unix(2,8,0)+ do null <- openFd "/dev/null" ReadWrite defaultFileFlags+#else do null <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags+#endif let sendTo fd' fd = closeFd fd >> dupTo fd' fd- mapM_ (sendTo null) $ [stdInput, stdOutput, stdError]+ mapM_ (sendTo null) [stdInput, stdOutput, stdError] -blockSignal :: Signal -> IO () +blockSignal :: Signal -> IO () blockSignal sig = installHandler sig Ignore Nothing >> pass getGroupID :: String -> IO (Maybe GroupID)-getGroupID group = - try (fmap groupID (getGroupEntryForName group)) >>= return . f where+getGroupID group =+ f <$> try (fmap groupID (getGroupEntryForName group))+ where f :: Either IOException GroupID -> Maybe GroupID f (Left _) = Nothing f (Right gid) = Just gid getUserID :: String -> IO (Maybe UserID)-getUserID user = - try (fmap userID (getUserEntryForName user)) >>= return . f where+getUserID user =+ f <$> try (fmap userID (getUserEntryForName user))+ where f :: Either IOException UserID -> Maybe UserID f (Left _) = Nothing f (Right uid) = Just uid +-- only drop privileges if a user is specified dropPrivileges :: CreateDaemon a -> IO ()-dropPrivileges daemon = - do Just ud <- getUserID "daemon"- Just gd <- getGroupID "daemon"- 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+dropPrivileges daemon = do+ case group daemon of+ Nothing -> pure ()+ Just targetGroup -> do+ mud <- getGroupID targetGroup+ case mud of+ Nothing -> do syslog Error "Privilege drop failure, could not identify specified group."+ exitImmediately (ExitFailure 1)+ undefined+ Just gd -> setGroupID gd+ case user daemon of+ Nothing -> pure ()+ Just targetUser -> do+ mud <- getUserID targetUser+ case mud of+ Nothing -> do syslog Error "Privilege drop failure, could not identify specified user."+ exitImmediately (ExitFailure 1)+ undefined+ Just ud -> setUserID ud pidFile:: CreateDaemon a -> String-pidFile daemon = joinPath [dir, (fromJust $ name daemon) ++ ".pid"]+pidFile daemon = joinPath [dir, fromJust (name daemon) ++ ".pid"] where dir = fromMaybe "/var/run" (pidfileDirectory daemon) pidExists :: CreateDaemon a -> IO Bool@@ -307,7 +347,7 @@ pidRead :: CreateDaemon a -> IO (Maybe CPid) pidRead daemon = pidExists daemon >>= choose where- choose True = fmap (Just . read) $ readFile (pidFile daemon)+ choose True = return . read <$> readFile (pidFile daemon) choose False = return Nothing pidWrite :: CreateDaemon a -> IO ()@@ -316,12 +356,12 @@ writeFile (pidFile daemon) (show pid) pidLive :: CPid -> IO Bool-pidLive pid = +pidLive pid = (getProcessPriority pid >> return True) `catch` f where f :: IOException -> IO Bool f _ = return False- -pass :: IO () ++pass :: IO () pass = return () -- | When you encounter an error where the only sane way to handle it@@ -330,7 +370,7 @@ -- configuration files on startup. fatalError :: MonadIO m => String -> m a fatalError msg = liftIO $ do- syslog Error $ "Terminating from error: " ++ msg+ syslog Error $ ByteString.pack $ "Terminating from error: " ++ msg exitImmediately (ExitFailure 1) undefined -- You will never reach this; it's there to make the type checker happy
hdaemonize.cabal view
@@ -1,27 +1,37 @@ Name: hdaemonize-Version: 0.4.5.0-Cabal-Version: >= 1.6+Version: 0.5.7+Cabal-Version: >= 1.10 License: BSD3 License-file: LICENSE-Author: Anton Tayanovskyy, Fred Ross-Maintainer: Fred Ross <madhadron at gmail dot com>-Homepage: http://github.com/madhadron/hdaemonize+Author: Anton Tayanovskyy, Fred Ross, Lana Black+Maintainer: Jeremy Bornstein <jeremy@jeremy.org>+Homepage: http://github.com/unprolix/hdaemonize Category: System Synopsis: Library to handle the details of writing daemons for UNIX-Description: Provides two functions that help writing better UNIX daemons,- daemonize and serviced: daemonize does what a daemon should do- (forking and closing descriptors), while serviced does that and - more (syslog interface, PID file writing, start-stop-restart - command line handling, dropping privileges).+Description: Provides functions that help writing better UNIX daemons,+ daemonize and serviced/serviced': daemonize does what+ a daemon should do (forking and closing descriptors),+ while serviced does that and more (syslog interface,+ PID file writing, start-stop-restart command line+ handling, dropping privileges). Build-Type: Simple-Extra-Source-Files: README+Extra-Source-Files: README.md Library- Build-Depends: base >= 4 && < 5, unix, hsyslog, extensible-exceptions, filepath, mtl+ Build-Depends: base >= 4 && < 5+ , bytestring+ , unix+ , hsyslog == 5.*+ , extensible-exceptions+ , filepath+ , mtl+ Default-Language: Haskell2010 Exposed-modules: System.Posix.Daemonize- Extensions: CPP if impl(ghc > 6.12) Ghc-Options: -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-name-shadowing else Ghc-Options: -Wall -fno-warn-type-defaults -fno-warn-name-shadowing +source-repository head+ type: git+ location: https://github.com/unprolix/hdaemonize.git