module System.Daemonize (
DaemonOptions(..),
defaultDaemonOptions,
daemonize
)
where
import qualified Control.Exception as Exception
import Foreign
import Foreign.C
import System.IO
import qualified System.Posix as POSIX
data DaemonOptions = DaemonOptions {
daemonShouldChangeDirectory :: Bool,
daemonShouldRedirectStandardStreams :: Bool,
daemonShouldCloseAllStreams :: Bool,
daemonFileDescriptorsToLeaveOpen :: [POSIX.Fd],
daemonShouldIgnoreSignals :: Bool,
daemonUserToChangeTo :: Maybe String,
daemonGroupToChangeTo :: Maybe String
}
defaultDaemonOptions :: DaemonOptions
defaultDaemonOptions = DaemonOptions {
daemonShouldChangeDirectory = True,
daemonShouldRedirectStandardStreams = False,
daemonShouldCloseAllStreams = True,
daemonFileDescriptorsToLeaveOpen = [],
daemonShouldIgnoreSignals = True,
daemonUserToChangeTo = Nothing,
daemonGroupToChangeTo = Nothing
}
foreign import ccall "daemon" c_daemon :: CInt -> CInt -> IO CInt
daemonize :: DaemonOptions -> IO ()
daemonize options = do
case daemonGroupToChangeTo options of
Nothing -> return ()
Just groupName -> do
groupEntry <- POSIX.getGroupEntryForName groupName
POSIX.setGroupID $ POSIX.groupID groupEntry
case daemonUserToChangeTo options of
Nothing -> return ()
Just userName -> do
userEntry <- POSIX.getUserEntryForName userName
POSIX.setUserID $ POSIX.userID userEntry
let c_shouldChangeDirectory
= if daemonShouldChangeDirectory options
then 0
else 1
c_shouldRedirectStandardStreams
= if daemonShouldRedirectStandardStreams options
then 0
else 1
throwErrnoIfMinus1 "daemonize"
$ c_daemon c_shouldChangeDirectory
c_shouldRedirectStandardStreams
if daemonShouldIgnoreSignals options
then do
POSIX.installHandler POSIX.sigTTOU POSIX.Ignore Nothing
POSIX.installHandler POSIX.sigTTIN POSIX.Ignore Nothing
POSIX.installHandler POSIX.sigTSTP POSIX.Ignore Nothing
return ()
else return ()
if daemonShouldCloseAllStreams options
then do
mapM hClose [stdin, stdout, stderr]
let closeLoop i | i == 65536 = return ()
| otherwise = do
if not $ elem (POSIX.Fd i)
$ daemonFileDescriptorsToLeaveOpen options
then Exception.catch (POSIX.closeFd $ POSIX.Fd i)
(\e -> do
return (e :: Exception.SomeException)
return ())
else return ()
closeLoop $ i + 1
closeLoop 0
else return ()