From ba55294acddc83bd8a0a89ff3398c1dec8374a3a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 1 Mar 2013 13:30:48 -0400
Subject: assistant: Logs are rotated to avoid them using too much disk space.

This cannot completely guard against a runaway log event, and only runs
every hour anyway, but it should avoid most problems with very
long-running, active assistants using up too much space.
---
 Assistant/Threads/SanityChecker.hs | 54 +++++++++++++++++++++++++++++++-------
 1 file changed, 44 insertions(+), 10 deletions(-)

(limited to 'Assistant/Threads/SanityChecker.hs')

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
-- 
cgit v1.2.3