    {-# 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  : 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
    <http://www.haskell.org/hawiki/HaskellUnixDaemon>.

    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
    import           System.Exit
    import           System.Log.Logger
    import           System.Posix.IO
    import           System.Posix.Process

    trap :: IO a -> IO a
    trap :: IO a -> IO a
    trap = String -> Priority -> String -> IO a -> IO a
    forall a. String -> Priority -> String -> IO a -> IO a
    traplogging "System.Daemon" Priority
    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
       \/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 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 IO ProcessID
    createSession
           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 "/"
           (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 "/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