finish daemon status thread

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