module Pakej.Daemon.Daemonize (daemonize) where
import Control.Applicative
import Control.Lens
import Control.Monad
import System.Directory (getAppUserDataDirectory)
import System.Exit (exitFailure, exitSuccess)
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)
import System.IO.Error (tryIOError)
import System.Posix hiding (Ignore)
import Text.Read (readMaybe)
import Text.Printf (printf)
import Pakej.Conf (PakejConf, Policy(..), policy, foreground)
daemonize :: PakejConf -> IO a -> IO a
daemonize conf ioa =
case view foreground conf of
False -> do
forkProcess (void (prepareChild conf *> ioa))
exitSuccess
True ->
ioa
prepareChild :: PakejConf -> IO ()
prepareChild conf = do
changeWorkingDirectory "/"
pidfile <- appDirectory "pakej" "pakej.pid"
killPakej pidfile conf
savePakej pidfile
setFileCreationMask 0o027
close [stdInput, stdOutput, stdError]
close :: [Fd] -> IO ()
close fds = do
devNull <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags
mapM_ (redirect devNull) fds
where
redirect fd' fd = do
closeFd fd
dupTo fd' fd
killPakej :: FilePath -> PakejConf -> IO (Either IOError ())
killPakej pidfile conf = tryIOError $ do
Just pid <- readMaybe <$> readFile pidfile
pingProcess pid
case view policy conf of
Replace -> terminateProcess pid
Respect -> die (printf "Can't proceed, found running instance: %s" (show pid))
die :: String -> IO a
die msg = do
hPutStrLn stderr msg
exitFailure
pingProcess, terminateProcess :: ProcessID -> IO ()
pingProcess = signalProcess nullSignal
terminateProcess = signalProcess sigTERM
savePakej :: FilePath -> IO ()
savePakej pidfile = getProcessID >>= writeFile pidfile . show
appDirectory :: String -> FilePath -> IO FilePath
appDirectory app filename = do
dir <- getAppUserDataDirectory app
return (dir </> filename)