check for unstaged old symlinks in the sanity checker

2 files changed, 38 insertions, 13 deletions

diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 1bc6031ee..e5ba3d151 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -77,7 +77,7 @@ writeDaemonStatusFile file status =
 			[ "lastRunning:" ++ show now
 			, "scanComplete:" ++ show (scanComplete status)
 			, "sanityCheckRunning:" ++ show (sanityCheckRunning status)
-			, "lastSanityCheck:" ++ show (lastSanityCheck status)
+			, "lastSanityCheck:" ++ maybe "" show (lastSanityCheck status)
 			]
 
 readDaemonStatusFile :: FilePath -> IO DaemonStatus
diff --git a/Assistant/SanityChecker.hs b/Assistant/SanityChecker.hs
index 9567b1188..a5f138024 100644
--- a/Assistant/SanityChecker.hs
+++ b/Assistant/SanityChecker.hs
@@ -8,15 +8,18 @@ module Assistant.SanityChecker (
 ) where
 
 import Common.Annex
+import qualified Git.LsFiles
 import Assistant.DaemonStatus
 import Assistant.ThreadedMonad
+import Assistant.Committer
 import Utility.ThreadScheduler
+import qualified Assistant.Watcher
 
 import Data.Time.Clock.POSIX
 
 {- This thread wakes up occasionally to make sure the tree is in good shape. -}
-sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> IO ()
-sanityCheckerThread st status = forever $ do
+sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO ()
+sanityCheckerThread st status changechan = forever $ do
 	waitForNextCheck st status
 
 	runThreadState st $
@@ -24,15 +27,13 @@ sanityCheckerThread st status = forever $ do
 				{ sanityCheckRunning = True }
 
 	now <- getPOSIXTime -- before check started
-	ok <- catchBoolIO $ runThreadState st check
+	catchIO (check st status changechan)
+		(runThreadState st . warning . show)
 
 	runThreadState st $ do
 		modifyDaemonStatus status $ \s -> s
 			{ sanityCheckRunning = False
-			, lastSanityCheck =
-				if ok
-					then Just now
-					else lastSanityCheck s
+			, lastSanityCheck = Just now
 			}
 
 {- Only run one check per day, from the time of the last check. -}
@@ -45,12 +46,36 @@ waitForNextCheck st status = do
 	where
 		calcdelay _ Nothing = oneDay
 		calcdelay now (Just lastcheck)
-			| lastcheck < now = oneDay - truncate (now - lastcheck)
+			| lastcheck < now = max oneDay $
+				oneDay - truncate (now - lastcheck)
 			| otherwise = oneDay
 
-check  :: Annex Bool
-check = do
-	return True
-
 oneDay :: Int
 oneDay = 24 * 60 * 60
+
+{- It's important to stay out of the Annex monad as much as possible while
+ - running potentially expensive parts of this check, since remaining in it
+ - will block the watcher. -}
+check :: ThreadState -> DaemonStatusHandle -> ChangeChan -> IO () 
+check st status changechan = do
+	g <- runThreadState st $ do
+		showSideAction "Running daily check"
+		fromRepo id
+	-- Find old unstaged symlinks, and add them to git.
+	unstaged <- Git.LsFiles.notInRepo False ["."] g
+	now <- getPOSIXTime
+	forM_ unstaged $ \file -> do
+		ms <- catchMaybeIO $ getSymbolicLinkStatus file
+		case ms of
+			Just s	| toonew (statusChangeTime s) now -> noop
+				| isSymbolicLink s ->
+					addsymlink file ms
+			_ -> noop
+	where
+		toonew timestamp now = now < (realToFrac (timestamp + slop) :: POSIXTime)
+		slop = fromIntegral tenMinutes
+		insanity m = runThreadState st $ warning m
+		addsymlink file s = do
+			insanity $ "found unstaged symlink: " ++ file
+			Assistant.Watcher.runHandler st status changechan
+				Assistant.Watcher.onAddSymlink file s