summaryrefslogtreecommitdiff
path: root/Utility/Daemon.hs
blob: eeec0bfccdbba1840db3c7a3d4fd06c46fc344c0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
{- daemon support
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Utility.Daemon where

import Common

import System.Posix

{- Run an action as a daemon, with all output sent to a file descriptor.
 -
 - Can write its pid to a file, to guard against multiple instances
 - running and allow easy termination.
 -
 - When successful, does not return. -}
daemonize :: Fd -> Maybe FilePath -> Bool -> IO () -> IO ()
daemonize logfd pidfile changedirectory a = do
	pidfd <- lockpidfile
	_ <- forkProcess $ child1 pidfd
	out
	where
		child1 pidfd = do
			_ <- createSession
			_ <- forkProcess $ child2 pidfd
			out
		child2 pidfd = do
			writepidfile pidfd
			when changedirectory $
				setCurrentDirectory "/"
			nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
			_ <- redir nullfd stdInput
			mapM_ (redir logfd) [stdOutput, stdError]
			closeFd logfd
			a
			out
		lockpidfile = case pidfile of
			Just file -> do
				fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags
				setLock fd (WriteLock, AbsoluteSeek, 0, 0)
				return $ Just fd
			Nothing -> return Nothing
		writepidfile pidfd = 
			case pidfd of
				Just fd -> void $
					fdWrite fd =<< show <$> getProcessID
				Nothing -> return ()
		redir newh h = do
			closeFd h
			dupTo newh h
		out = exitImmediately ExitSuccess