summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-11 01:37:25 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-11 01:37:25 -0400
commit8539a7bde8e20758b7f7d70af93fe92aa4be1e7f (patch)
treed28339da1db2d72fc654a821239c16c054fa6bee
parent0b3e2bed783ade691baf60a4198aaa1034b28440 (diff)
fix pid file locking
Ok, that's odd.. opening it before fork breaks the locking. I don't understand why.
-rw-r--r--Utility/Daemon.hs30
1 files changed, 13 insertions, 17 deletions
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs
index eeec0bfcc..b41ebe228 100644
--- a/Utility/Daemon.hs
+++ b/Utility/Daemon.hs
@@ -19,16 +19,15 @@ import System.Posix
- When successful, does not return. -}
daemonize :: Fd -> Maybe FilePath -> Bool -> IO () -> IO ()
daemonize logfd pidfile changedirectory a = do
- pidfd <- lockpidfile
- _ <- forkProcess $ child1 pidfd
+ _ <- forkProcess child1
out
where
- child1 pidfd = do
+ child1 = do
_ <- createSession
- _ <- forkProcess $ child2 pidfd
+ _ <- forkProcess child2
out
- child2 pidfd = do
- writepidfile pidfd
+ child2 = do
+ maybe noop lockPidFile pidfile
when changedirectory $
setCurrentDirectory "/"
nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
@@ -37,18 +36,15 @@ daemonize logfd pidfile changedirectory a = do
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
+
+lockPidFile :: FilePath -> IO ()
+lockPidFile file = void $ do
+ fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags
+ catchIO
+ (setLock fd (WriteLock, AbsoluteSeek, 0, 0))
+ (const $ error "Daemon is already running.")
+ fdWrite fd =<< show <$> getProcessID