{-# 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  : provisional
   Portability: portable to platforms with POSIX process\/signal tools

Tools for writing daemons\/server processes

Written by John Goerzen, jgoerzen\@complete.org

Please note: Most of this module is not compatible with Hugs.

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

Based on background
from <http://www.erlenstar.demon.co.uk/unix/faq_2.html#SEC16> and

This module is not available on Windows.

module System.Daemon (

#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))

import           System.Directory
import           System.Exit
import           System.Log.Logger
import           System.Posix.IO
import           System.Posix.Process

trap :: IO a -> IO a
trap = traplogging "System.Daemon" ERROR "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

 * 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 = trap $
               do forkProcess child1
                  exitImmediately ExitSuccess

child1 :: IO ()
child1 = trap $
    do createSession
       forkProcess child2
       exitImmediately ExitSuccess

child2 :: IO ()
child2 = trap $
    do setCurrentDirectory "/"
       mapM_ closeFd [stdInput, stdOutput, stdError]
       nullFd <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags
       mapM_ (dupTo nullFd) [stdInput, stdOutput, stdError]
       closeFd nullFd