diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-01 16:29:38 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-01 16:30:53 -0400 |
commit | 8181b38ef6060103953ce464d03e9cfd75c45663 (patch) | |
tree | 0ec9cc7219dd80590cff0cdfdac817b72728dc68 /Utility | |
parent | ecc168aba30a0477381bcd2037c8d301368f3449 (diff) |
write pid file even when running in foreground
This prevents multiple runs of the assistant in the foreground, and lets
--stop stop foregrounded runs too.
The webapp firstrun case also now writes a pid file, once it's made the git
repo to put it in.
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/Daemon.hs | 16 |
1 files changed, 8 insertions, 8 deletions
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index 3386ea443..ba2b2c9c3 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -27,7 +27,7 @@ daemonize logfd pidfile changedirectory a = do _ <- forkProcess child2 out child2 = do - maybe noop (lockPidFile alreadyrunning) pidfile + maybe noop lockPidFile pidfile when changedirectory $ setCurrentDirectory "/" nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags @@ -39,28 +39,28 @@ daemonize logfd pidfile changedirectory a = do redir newh h = do closeFd h dupTo newh h - alreadyrunning = error "Daemon is already running." out = exitImmediately ExitSuccess {- Locks the pid file, with an exclusive, non-blocking lock. - - Runs an action on failure. On success, writes the pid to the file, - - fully atomically. -} -lockPidFile :: IO () -> FilePath -> IO () -lockPidFile onfailure file = do + - Writes the pid to the file, fully atomically. + - Fails if the pid file is already locked by another process. -} +lockPidFile :: FilePath -> IO () +lockPidFile file = do fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags { trunc = True } locked' <- catchMaybeIO $ setLock fd' (WriteLock, AbsoluteSeek, 0, 0) case (locked, locked') of - (Nothing, _) -> onfailure - (_, Nothing) -> onfailure + (Nothing, _) -> alreadyrunning + (_, Nothing) -> alreadyrunning _ -> do _ <- fdWrite fd' =<< show <$> getProcessID renameFile newfile file closeFd fd where newfile = file ++ ".new" + alreadyrunning = error "Daemon is already running." {- Checks if the daemon is running, by checking that the pid file - is locked by the same process that is listed in the pid file. |