hdaemonize-buildfix (empty) → 0.4.5
raw patch · 5 files changed
+486/−0 lines, 5 filesdep +basedep +extensible-exceptionsdep +filepathsetup-changed
Dependencies added: base, extensible-exceptions, filepath, hsyslog, mtl, unix
Files
- LICENSE +28/−0
- README +91/−0
- Setup.lhs +4/−0
- System/Posix/Daemonize.hs +337/−0
- hdaemonize-buildfix.cabal +26/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2009, Anton Tayanovskyy+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * 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.+ * Neither the name of Anton Tayanovskyy nor the names of the+ contributors may be used to endorse or promote products derived + from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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.
+ README view
@@ -0,0 +1,91 @@+`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.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ System/Posix/Daemonize.hs view
@@ -0,0 +1,337 @@+{-# LANGUAGE RankNTypes #-}+module System.Posix.Daemonize (+ -- * Simple daemonization+ 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."++ ) where+ +{- originally based on code from + http://sneakymustard.com/2008/12/11/haskell-daemons -}+++import Control.Monad.Trans+import Control.Exception.Extensible+import qualified Control.Monad as M (forever)+import Prelude hiding (catch)+import System.Exit (ExitCode(..))+import System.Environment (getArgs, getProgName)+import System.Posix+import System.Posix.Syslog (withSyslog,Option(..),Priority(..),Facility(..),syslog)+import System.FilePath.Posix (joinPath)+import Data.Maybe (isNothing, fromMaybe, fromJust)+++-- | 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++ where++ p = do createSession+ forkProcess p'+ exitImmediately ExitSuccess+ + p' = do changeWorkingDirectory "/"+ closeFileDescriptors+ blockSignal sigHUP+ program +++++-- | '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+-- 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.+--+-- @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 :: 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+ where+ + 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++ 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"] = + 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))+ `finally`+ removeLink (pidFile daemon)++ process daemon ["restart"] = do process daemon ["stop"]+ process daemon ["start"]+ process _ _ = + 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 a = CreateDaemon {+ privilegedAction :: IO a, -- ^ An action to be run as root, before+ -- permissions are dropped, e.g., binding+ -- a trusted port.+ program :: a -> IO (), -- ^ The actual guts of the daemon, more or less+ -- the @main@ function. Its argument is the result+ -- of running 'privilegedAction' before dropping+ -- privileges.+ 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 {+-- > privilegedAction = return ()+-- > program = const $ 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 = const $ M.forever $ return (),+ privilegedAction = return ()+}+ ++++{- implementation -}++forever :: IO () -> IO ()+forever program = + program `catch` restart where+ restart :: SomeException -> IO () + restart e = + do syslog Error ("unexpected exception: " ++ show e)+ syslog Error "restarting in 5 seconds"+ usleep (5 * 10^6)+ forever program++closeFileDescriptors :: IO ()+closeFileDescriptors = + do null <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags+ let sendTo fd' fd = closeFd fd >> dupTo fd' fd+ mapM_ (sendTo null) $ [stdInput, stdOutput, stdError]++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+ 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+ f :: Either IOException UserID -> Maybe UserID+ f (Left _) = Nothing+ f (Right uid) = Just uid++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++pidFile:: CreateDaemon a -> String+pidFile daemon = joinPath [dir, (fromJust $ name daemon) ++ ".pid"]+ where dir = fromMaybe "/var/run" (pidfileDirectory daemon)++pidExists :: CreateDaemon a -> IO Bool+pidExists daemon = fileExist (pidFile daemon)++pidRead :: CreateDaemon a -> IO (Maybe CPid)+pidRead daemon = pidExists daemon >>= choose where+ choose True = fmap (Just . read) $ readFile (pidFile daemon)+ choose False = return Nothing++pidWrite :: CreateDaemon a -> IO ()+pidWrite daemon =+ getProcessID >>= \pid ->+ writeFile (pidFile daemon) (show pid)++pidLive :: CPid -> IO Bool+pidLive pid = + (getProcessPriority pid >> return True) `catch` f where+ f :: IOException -> IO Bool+ f _ = return False+ +pass :: IO () +pass = return ()++-- | When you encounter an error where the only sane way to handle it+-- is to write an error to the log and die messily, use fatalError.+-- This is a good candidate for things like not being able to find+-- configuration files on startup.+fatalError :: MonadIO m => String -> m a+fatalError msg = liftIO $ do+ syslog Error $ "Terminating from error: " ++ msg+ exitImmediately (ExitFailure 1)+ undefined -- You will never reach this; it's there to make the type checker happy++-- | Use this function when the daemon should terminate normally. It+-- logs a message, and exits with status 0.+exitCleanly :: MonadIO m => m a+exitCleanly = liftIO $ do+ syslog Notice "Exiting."+ exitImmediately ExitSuccess+ undefined -- You will never reach this; it's there to make the type checker happy
+ hdaemonize-buildfix.cabal view
@@ -0,0 +1,26 @@+Name: hdaemonize-buildfix+Version: 0.4.5+Cabal-Version: >= 1.6+License: BSD3+License-file: LICENSE+Author: Anton Tayanovskyy, Fred Ross+Maintainer: Fred Ross <madhadron at gmail dot com>, Mark Wotton <wotton@gmail.com> (trivial buildfix only)+Homepage: http://github.com/madhadron/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).+Build-Type: Simple+Extra-Source-Files: README++Library+ Build-Depends: base >= 4 && < 5, unix, hsyslog, extensible-exceptions, filepath, mtl+ Exposed-modules: System.Posix.Daemonize+ 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+