-- | This module provides 'startDaemon' and 'stopDaemon' to facilitate
-- the creation of daemon programs.
--
-- The problem is as follows: the user starts a program in their
-- terminal, but he wants the program to relinquish control of the
-- terminal immediately, and furthermore, the program (or part of it)
-- should keep running even after said terminal is closed.  Examples
-- of programs that behave like this are @nginx@ and @emacs --daemon@.
--
-- The correct solution is to double-fork a process.  This ensures
-- that the child process is completed separated from the terminal it
-- was started on.
--
module System.Posix.Daemon (
        -- * Daemon control
        startDaemon, stopDaemon,

        -- * Utilities
        becomeGroupUser
    ) where

import Control.Monad ( when )
import System.Directory ( doesFileExist )
import System.Exit ( ExitCode(..) )
import System.IO ( SeekMode(..) )
import System.Posix.Directory ( changeWorkingDirectory )
import System.Posix.Files ( setFileCreationMask
                          , unionFileModes, otherModes, groupWriteMode )
import System.Posix.IO ( openFd, OpenMode(..), defaultFileFlags, closeFd
                       , dupTo, stdInput, stdOutput, stdError, getLock
                       , LockRequest (..), createFile, setLock, fdWrite
                       )
import System.Posix.Process ( getProcessID
                            , forkProcess, exitImmediately, createSession )
import System.Posix.Signals ( installHandler, sigHUP, Handler(..)
                            , signalProcess )
import System.Posix.Types ( ProcessID )
import System.Posix.User ( groupID, setGroupID, getGroupEntryForName
                         , userID, setUserID, getUserEntryForName )

-- | Double-fork to create a well behaved daemon.  If PIDFILE is
-- given, check/set pidfile; if we cannot obtain a lock on the file,
-- another process is already using it, so fail.  The program is
-- started with @SIGHUP@ masked; HANDLER is invoked on @SIGHUP@.
--
-- See: <http://www.enderunix.org/docs/eng/daemon.php>
--
-- Note: All unnecessary fds should be close before calling this.
--
-- HANDLER is meant to allow the daemon to shutdown cleanly.  It could
-- simply be:
--
-- @
--   handler = return ()
-- @
--
-- or something more elaborate like the following, which allows one to
-- perform some actions before re-raising the signal and killing the
-- daemon:
--
-- @
--   handler = do
--     putStrLn "Stopping daemon..."
--     raiseSignal sigTERM
-- @
--
startDaemon :: FilePath         -- ^ PIDFILE
            -> IO ()            -- ^ HANDLER
            -> IO ()            -- ^ PROGRAM
            -> IO ()
startDaemon pidFile handler program = do
  checkRunning
  _ <- forkProcess p            -- fork first child...
  exitImmediately ExitSuccess   -- ...and exit
    where
      p  = do
        _ <- createSession          -- create a new session and make
                                    -- this process its leader; see
                                    -- setsid(2)
        _ <- forkProcess p'         -- fork second child...
        return ()
      p' = do
        remapFds                -- remap standard fds
        -- files created by server should be at most rwxr-x---
        _ <- setFileCreationMask $ unionFileModes otherModes groupWriteMode
        changeWorkingDirectory "/" -- chdir
        _ <- installHandler sigHUP (Catch handler) Nothing
        setRunning              -- lock file
        program                 -- run the daemon

      remapFds = do
        devnull <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
        mapM_ (dupTo devnull) [stdInput, stdOutput, stdError]
        closeFd devnull

      checkRunning = do
        fe <- doesFileExist pidFile
        when fe $ do
          fd <- openFd pidFile WriteOnly Nothing defaultFileFlags
          ml <- getLock fd (ReadLock, AbsoluteSeek, 0, 0)
          closeFd fd
          case ml of
            Just (pid, _) -> fail (show pid ++ " already running")
            Nothing       -> return ()

      setRunning = do
        fd <- createFile pidFile 777
        setLock fd (WriteLock, AbsoluteSeek, 0, 0)
        pid <- getProcessID
        _ <- fdWrite fd (show pid)
        return ()

-- | Stop the daemon identified by PIDFILE by sending it @SIGHUP@.  If
-- the process was daemonized with 'startDaemon', the handler
-- specified there will be invoked first.  Return the pid of the
-- process that was killed; if PIDFILE does not exist, return
-- 'Nothing'.
stopDaemon :: FilePath          -- ^ PIDFILE
           -> IO (Maybe ProcessID)
stopDaemon pidFile = do
  fe <- doesFileExist pidFile
  if fe
     then do
       pid <- return . read =<< readFile pidFile
       signalProcess sigHUP pid
       return (Just pid)
     else
       return Nothing

-- | Make the current process belong to USER and GROUP.
becomeGroupUser :: String       -- ^ GROUP
                -> String       -- ^ USER
                -> IO ()
becomeGroupUser group user = do
  getGroupEntryForName group >>= setGroupID . groupID
  getUserEntryForName user >>= setUserID . userID