finish daemon status thread

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
+			liftIO $ a $ do
-			-- The commit thread is started early, so that the user
+				changechan <- newChangeChan
-			-- can immediately begin adding files and having them
+				-- The commit thread is started early,
-			-- committed, even while the startup scan is taking
+				-- so that the user can immediately
-			-- place.
+				-- begin adding files and having them
-			_ <- forkIO $ commitThread st changechan
+				-- committed, even while the startup scan
-			watchThread st dstatus changechan
+				-- is taking place.
+				_ <- forkIO $ commitThread st changechan
+				_ <- forkIO $ daemonStatusThread st dstatus
+				watchThread st dstatus changechan
 
 stopDaemon :: Annex ()
 stopDaemon = liftIO . Utility.Daemon.stopDaemon =<< fromRepo gitAnnexPidFile

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