diff options
| -rw-r--r-- | Assistant.hs | 19 | ||||
| -rw-r--r-- | Assistant/DaemonStatus.hs | 29 |
2 files changed, 36 insertions, 12 deletions
diff --git a/Assistant.hs b/Assistant.hs index bc394bd99..eb8fd7054 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -60,15 +60,18 @@ startDaemon foreground pidfile <- fromRepo gitAnnexPidFile go $ Utility.Daemon.daemonize logfd (Just pidfile) False where - go a = withThreadState $ \st -> liftIO $ a $ do + go a = withThreadState $ \st -> do dstatus <- startDaemonStatus - changechan <- newChangeChan - -- The commit thread is started early, so that the user - -- can immediately begin adding files and having them - -- committed, even while the startup scan is taking - -- place. - _ <- forkIO $ commitThread st changechan - watchThread st dstatus changechan + liftIO $ a $ do + changechan <- newChangeChan + -- The commit thread is started early, + -- so that the user can immediately + -- begin adding files and having them + -- committed, even while the startup scan + -- is taking place. + _ <- forkIO $ commitThread st changechan + _ <- forkIO $ daemonStatusThread st dstatus + watchThread st dstatus changechan stopDaemon :: Annex () stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 3615d0e5c..eb8ff256b 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -7,6 +7,7 @@ module Assistant.DaemonStatus where import Common.Annex import Utility.TempFile +import Assistant.ThreadedMonad import Control.Concurrent import System.Posix.Types @@ -30,15 +31,35 @@ newDaemonStatus = DaemonStatus , lastRunning = Nothing } -startDaemonStatus :: IO DaemonStatusHandle -startDaemonStatus = newMVar newDaemonStatus - getDaemonStatus :: DaemonStatusHandle -> Annex DaemonStatus getDaemonStatus = liftIO . readMVar modifyDaemonStatus :: DaemonStatusHandle -> (DaemonStatus -> DaemonStatus) -> Annex () modifyDaemonStatus handle a = liftIO $ modifyMVar_ handle (return . a) +{- Load any previous daemon status file, and store it in the MVar for this + - process to use as its DaemonStatus. -} +startDaemonStatus :: Annex DaemonStatusHandle +startDaemonStatus = do + file <- fromRepo gitAnnexDaemonStatusFile + status <- liftIO $ + catchDefaultIO (readDaemonStatusFile file) newDaemonStatus + liftIO $ newMVar status { scanComplete = False } + +{- This thread wakes up periodically and writes the daemon status to disk. -} +daemonStatusThread :: ThreadState -> DaemonStatusHandle -> IO () +daemonStatusThread st handle = do + checkpoint + forever $ do + threadDelay tenMinutes + checkpoint + where + checkpoint = runThreadState st $ do + file <- fromRepo gitAnnexDaemonStatusFile + status <- getDaemonStatus handle + liftIO $ writeDaemonStatusFile file status + tenMinutes = 10 * 60 * 1000000 -- microseconds + {- Don't just dump out the structure, because it will change over time, - and parts of it are not relevant. -} writeDaemonStatusFile :: FilePath -> DaemonStatus -> IO () @@ -76,7 +97,7 @@ readDaemonStatusFile file = parse <$> readFile file - If the daemon has never ran before, this always returns False. -} afterLastDaemonRun :: EpochTime -> DaemonStatus -> Bool -afterLastDaemonRun timestamp status = maybe True (< t) (lastRunning status) +afterLastDaemonRun timestamp status = maybe False (< t) (lastRunning status) where t = realToFrac (timestamp + slop) :: POSIXTime slop = 10 * 60 |