implement daemon status serialization to a file
Also afterLastDaemonRun, with 10 minute slop to handle majority of clock skew issues.
This commit is contained in:
parent
ccc5005245
commit
ff2414427b
3 changed files with 55 additions and 5 deletions
|
@ -6,16 +6,21 @@
|
|||
module Assistant.DaemonStatus where
|
||||
|
||||
import Common.Annex
|
||||
import Utility.TempFile
|
||||
|
||||
import Control.Concurrent
|
||||
import System.Posix.Types
|
||||
import Data.Time.Clock.POSIX
|
||||
import Data.Time
|
||||
import System.Locale
|
||||
|
||||
data DaemonStatus = DaemonStatus
|
||||
-- False when the daemon is performing its startup scan
|
||||
{ scanComplete :: Bool
|
||||
-- Time when a previous process of the daemon was running ok
|
||||
, lastRunning :: Maybe EpochTime
|
||||
, lastRunning :: Maybe POSIXTime
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
type DaemonStatusHandle = MVar DaemonStatus
|
||||
|
||||
|
@ -32,4 +37,46 @@ getDaemonStatus :: DaemonStatusHandle -> Annex DaemonStatus
|
|||
getDaemonStatus = liftIO . readMVar
|
||||
|
||||
modifyDaemonStatus :: DaemonStatusHandle -> (DaemonStatus -> DaemonStatus) -> Annex ()
|
||||
modifyDaemonStatus status a = liftIO $ modifyMVar_ status (return . a)
|
||||
modifyDaemonStatus handle a = liftIO $ modifyMVar_ handle (return . a)
|
||||
|
||||
{- Don't just dump out the structure, because it will change over time,
|
||||
- and parts of it are not relevant. -}
|
||||
writeDaemonStatusFile :: FilePath -> DaemonStatus -> IO ()
|
||||
writeDaemonStatusFile file status =
|
||||
viaTmp writeFile file =<< serialized <$> getPOSIXTime
|
||||
where
|
||||
serialized now = unlines
|
||||
[ "lastRunning:" ++ show now
|
||||
, "scanComplete:" ++ show (scanComplete status)
|
||||
]
|
||||
|
||||
readDaemonStatusFile :: FilePath -> IO DaemonStatus
|
||||
readDaemonStatusFile file = parse <$> readFile file
|
||||
where
|
||||
parse = foldr parseline newDaemonStatus . lines
|
||||
parseline line status
|
||||
| key == "lastRunning" = parseval readtime $ \v ->
|
||||
status { lastRunning = Just v }
|
||||
| key == "scanComplete" = parseval readish $ \v ->
|
||||
status { scanComplete = v }
|
||||
| otherwise = status -- unparsable line
|
||||
where
|
||||
(key, value) = separate (== ':') line
|
||||
parseval parser a = maybe status a (parser value)
|
||||
readtime s = do
|
||||
d <- parseTime defaultTimeLocale "%s%Qs" s
|
||||
Just $ utcTimeToPOSIXSeconds d
|
||||
|
||||
{- Checks if a time stamp was made after the daemon was lastRunning.
|
||||
-
|
||||
- Some slop is built in; this really checks if the time stamp was made
|
||||
- at least ten minutes after the daemon was lastRunning. This is to
|
||||
- ensure the daemon shut down cleanly, and deal with minor clock skew.
|
||||
-
|
||||
- If the daemon has never ran before, this always returns False.
|
||||
-}
|
||||
afterLastDaemonRun :: EpochTime -> DaemonStatus -> Bool
|
||||
afterLastDaemonRun timestamp status = maybe True (< t) (lastRunning status)
|
||||
where
|
||||
t = realToFrac (timestamp + slop) :: POSIXTime
|
||||
slop = 10 * 60
|
||||
|
|
|
@ -154,10 +154,8 @@ onAddSymlink file filestatus dstatus = go =<< Backend.lookupFile file
|
|||
| scanComplete daemonstatus = addlink link
|
||||
| otherwise = case filestatus of
|
||||
Just s
|
||||
| safe (statusChangeTime s) -> noChange
|
||||
| not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange
|
||||
_ -> addlink link
|
||||
where
|
||||
safe t = maybe True (> t) (lastRunning daemonstatus)
|
||||
|
||||
{- For speed, tries to reuse the existing blob for
|
||||
- the symlink target. -}
|
||||
|
|
|
@ -24,6 +24,7 @@ module Locations (
|
|||
gitAnnexIndexLock,
|
||||
gitAnnexIndexDirty,
|
||||
gitAnnexPidFile,
|
||||
gitAnnexDaemonStatusFile,
|
||||
gitAnnexLogFile,
|
||||
gitAnnexSshDir,
|
||||
gitAnnexRemotesDir,
|
||||
|
@ -151,6 +152,10 @@ gitAnnexIndexDirty r = gitAnnexDir r </> "index.dirty"
|
|||
gitAnnexPidFile :: Git.Repo -> FilePath
|
||||
gitAnnexPidFile r = gitAnnexDir r </> "daemon.pid"
|
||||
|
||||
{- Status file for daemon mode. -}
|
||||
gitAnnexDaemonStatusFile :: Git.Repo -> FilePath
|
||||
gitAnnexDaemonStatusFile r = gitAnnexDir r </> "daemon.status"
|
||||
|
||||
{- Log file for daemon mode. -}
|
||||
gitAnnexLogFile :: Git.Repo -> FilePath
|
||||
gitAnnexLogFile r = gitAnnexDir r </> "daemon.log"
|
||||
|
|
Loading…
Reference in a new issue