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.
This commit is contained in:
Joey Hess 2013-03-01 13:30:48 -04:00
parent fed56e24a4
commit 1865b28094
5 changed files with 73 additions and 34 deletions

View file

@ -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