{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}

{-
Copyright (c) 2005-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : System.Daemon
   Copyright  : Copyright (C) 2005-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable to platforms with POSIX process\/signal tools

Tools for writing daemons\/server processes

Written by John Goerzen, jgoerzen\@complete.org

Messages from this module are logged under @System.Daemon@.  See
'System.Log.Logger' for details.

This module is not available on Windows.
-}

module System.Daemon (

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
        detachDaemon
#endif
                   )
                       where
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))

import System.Directory ( setCurrentDirectory )
import System.Exit ( ExitCode(ExitSuccess) )
import System.Log.Logger ( traplogging, Priority(ERROR) )
import System.Posix.IO
    ( openFd,
      closeFd,
      defaultFileFlags,
      dupTo,
      stdError,
      stdInput,
      stdOutput,
      OpenMode(ReadWrite) )
import System.Posix.Process
    ( createSession, exitImmediately, forkProcess )


trap :: IO a -> IO a
trap :: forall a. IO a -> IO a
trap = String -> Priority -> String -> IO a -> IO a
forall a. String -> Priority -> String -> IO a -> IO a
traplogging String
"System.Daemon" Priority
ERROR String
"detachDaemon"

{- | Detach the process from a controlling terminal and run it in the
background, handling it with standard Unix deamon semantics.

After running this, please note the following side-effects:

 * The PID of the running process will change

 * stdin, stdout, and stderr will not work (they'll be set to
   \/dev\/null)

 * CWD will be changed to \/

I /highly/ suggest running this function before starting any threads.

Note that this is not intended for a daemon invoked from inetd(1).
-}
detachDaemon :: IO ()
detachDaemon :: IO ()
detachDaemon = IO () -> IO ()
forall a. IO a -> IO a
trap (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
               do ProcessID
_ <- IO () -> IO ProcessID
forkProcess IO ()
child1
                  ExitCode -> IO ()
exitImmediately ExitCode
ExitSuccess

child1 :: IO ()
child1 :: IO ()
child1 = IO () -> IO ()
forall a. IO a -> IO a
trap (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    do ProcessID
_ <- IO ProcessID
createSession
       ProcessID
_ <- IO () -> IO ProcessID
forkProcess IO ()
child2
       ExitCode -> IO ()
exitImmediately ExitCode
ExitSuccess

child2 :: IO ()
child2 :: IO ()
child2 = IO () -> IO ()
forall a. IO a -> IO a
trap (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    do String -> IO ()
setCurrentDirectory String
"/"
       (Fd -> IO ()) -> [Fd] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Fd -> IO ()
closeFd [Fd
stdInput, Fd
stdOutput, Fd
stdError]
       Fd
nullFd <- String -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd String
"/dev/null" OpenMode
ReadWrite Maybe FileMode
forall a. Maybe a
Nothing OpenFileFlags
defaultFileFlags
       (Fd -> IO Fd) -> [Fd] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Fd -> Fd -> IO Fd
dupTo Fd
nullFd) [Fd
stdInput, Fd
stdOutput, Fd
stdError]
       Fd -> IO ()
closeFd Fd
nullFd
#endif