diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 54 |
1 files changed, 44 insertions, 10 deletions
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 24f4f6b29..ab972e6d8 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -6,7 +6,8 @@ -} module Assistant.Threads.SanityChecker ( - sanityCheckerThread + sanityCheckerDailyThread, + sanityCheckerHourlyThread ) where import Assistant.Common @@ -15,12 +16,19 @@ import Assistant.Alert import qualified Git.LsFiles import Utility.ThreadScheduler import qualified Assistant.Threads.Watcher as Watcher +import Utility.LogFile import Data.Time.Clock.POSIX -{- This thread wakes up occasionally to make sure the tree is in good shape. -} -sanityCheckerThread :: NamedThread -sanityCheckerThread = namedThread "SanityChecker" $ forever $ do +{- This thread wakes up hourly for inxepensive frequent sanity checks. -} +sanityCheckerHourlyThread :: NamedThread +sanityCheckerHourlyThread = namedThread "SanityCheckerHourly" $ forever $ do + liftIO $ threadDelaySeconds $ Seconds oneHour + hourlyCheck + +{- This thread wakes up daily to make sure the tree is in good shape. -} +sanityCheckerDailyThread :: NamedThread +sanityCheckerDailyThread = namedThread "SanityCheckerDaily" $ forever $ do waitForNextCheck debug ["starting sanity check"] @@ -31,7 +39,7 @@ sanityCheckerThread = namedThread "SanityChecker" $ forever $ do modifyDaemonStatus_ $ \s -> s { sanityCheckRunning = True } now <- liftIO $ getPOSIXTime -- before check started - r <- either showerr return =<< tryIO <~> check + r <- either showerr return =<< tryIO <~> dailyCheck modifyDaemonStatus_ $ \s -> s { sanityCheckRunning = False @@ -57,14 +65,11 @@ waitForNextCheck = do oneDay - truncate (now - lastcheck) | otherwise = oneDay -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 :: Assistant Bool -check = do +dailyCheck :: Assistant Bool +dailyCheck = do g <- liftAnnex gitRepo -- Find old unstaged symlinks, and add them to git. (unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g @@ -86,3 +91,32 @@ check = do addsymlink file s = do Watcher.runHandler Watcher.onAddSymlink file s insanity $ "found unstaged symlink: " ++ file + +hourlyCheck :: Assistant () +hourlyCheck = checkLogSize 0 + +{- Rotate logs until log file size is < 1 mb. -} +checkLogSize :: Int -> Assistant () +checkLogSize n = do + f <- liftAnnex $ fromRepo gitAnnexLogFile + logs <- liftIO $ listLogs f + totalsize <- liftIO $ sum <$> mapM filesize logs + when (totalsize > oneMegabyte) $ do + notice ["Rotated logs due to size:", show totalsize] + liftIO $ do + rotateLog f + logfd <- openLog f + redirLog logfd + when (n < maxLogs + 1) $ + checkLogSize $ n + 1 + where + filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f) + +oneMegabyte :: Int +oneMegabyte = 1000000 + +oneHour :: Int +oneHour = 60 * 60 + +oneDay :: Int +oneDay = 24 * oneHour |