summaryrefslogtreecommitdiff
path: root/Assistant/SanityChecker.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Assistant/SanityChecker.hs')
-rw-r--r--Assistant/SanityChecker.hs49
1 files changed, 37 insertions, 12 deletions
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