diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/Daemon.hs | 43 |
1 files changed, 26 insertions, 17 deletions
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index f36a761d0..8aa70d155 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -62,24 +62,33 @@ lockPidFile onfailure file = do where newfile = file ++ ".new" -{- Stops the daemon. +{- 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. - - - The pid file is used to get the daemon's pid. - - - - To guard against a stale pid, check the lock of the pid file, - - and compare the process that has it locked with the file content. - -} -stopDaemon :: FilePath -> IO () -stopDaemon pidfile = do - fd <- openFd pidfile ReadOnly (Just stdFileMode) defaultFileFlags - locked <- getLock fd (ReadLock, AbsoluteSeek, 0, 0) - p <- readish <$> readFile pidfile - case (locked, p) of - (Nothing, _) -> noop - (_, Nothing) -> noop - (Just (pid, _), Just pid') - | pid == pid' -> signalProcess sigTERM pid - | otherwise -> error $ + - If it's running, returns its pid. -} +checkDaemon :: FilePath -> IO (Maybe ProcessID) +checkDaemon pidfile = do + v <- catchMaybeIO $ + openFd pidfile ReadOnly (Just stdFileMode) defaultFileFlags + case v of + Just fd -> do + locked <- getLock fd (ReadLock, AbsoluteSeek, 0, 0) + p <- readish <$> readFile pidfile + return $ check locked p + Nothing -> return Nothing + where + check Nothing _ = Nothing + check _ Nothing = Nothing + check (Just (pid, _)) (Just pid') + | pid == pid' = Just pid + | otherwise = error $ "stale pid in " ++ pidfile ++ " (got " ++ show pid' ++ "; expected" ++ show pid ++ " )" + +{- Stops the daemon, safely. -} +stopDaemon :: FilePath -> IO () +stopDaemon pidfile = go =<< checkDaemon pidfile + where + go Nothing = noop + go (Just pid) = signalProcess sigTERM pid |