summaryrefslogtreecommitdiff
path: root/Utility/Daemon.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-11 01:20:19 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-11 01:20:19 -0400
commit0b3e2bed783ade691baf60a4198aaa1034b28440 (patch)
treeb0709933e47c89dbb6518fc316584538874ccc57 /Utility/Daemon.hs
parentd5884388b09347835df599d8a0dcea77e6795c10 (diff)
add a pid file
Writes pid to a file. Is supposed to take an exclusive lock, but that's not working, and it's too late for me to understand why.
Diffstat (limited to 'Utility/Daemon.hs')
-rw-r--r--Utility/Daemon.hs45
1 files changed, 30 insertions, 15 deletions
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs
index be3df17b7..eeec0bfcc 100644
--- a/Utility/Daemon.hs
+++ b/Utility/Daemon.hs
@@ -1,4 +1,4 @@
-{- daemon functions
+{- daemon support
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
@@ -7,24 +7,28 @@
module Utility.Daemon where
+import Common
+
import System.Posix
-import System.Directory
-import System.Exit
-import Control.Monad
{- Run an action as a daemon, with all output sent to a file descriptor.
-
- - Does not return. -}
-daemonize :: Fd -> Bool -> IO () -> IO ()
-daemonize logfd changedirectory a = do
- _ <- forkProcess child1
- end
+ - 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 = do
+ child1 pidfd = do
_ <- createSession
- _ <- forkProcess child2
- end
- child2 = do
+ _ <- forkProcess $ child2 pidfd
+ out
+ child2 pidfd = do
+ writepidfile pidfd
when changedirectory $
setCurrentDirectory "/"
nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
@@ -32,8 +36,19 @@ daemonize logfd changedirectory a = do
mapM_ (redir logfd) [stdOutput, stdError]
closeFd logfd
a
- end
+ 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
- end = exitImmediately ExitSuccess
+ out = exitImmediately ExitSuccess