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.hs

@@ -175,7 +175,7 @@ startDaemon assistant foreground startbrowser = do
 				fdToHandle =<< dup stdOutput
 			origerr <- liftIO $ catchMaybeIO $ 
 				fdToHandle =<< dup stdError
-			liftIO $ Utility.Daemon.redirLog logfd
+			liftIO $ Utility.LogFile.redirLog logfd
 			showStart (if assistant then "assistant" else "watch") "."
 			start id $ 
 				case startbrowser of
@@ -217,7 +217,8 @@ startDaemon assistant foreground startbrowser = do
 			, assist $ transferPollerThread
 			, assist $ transfererThread
 			, assist $ daemonStatusThread
-			, assist $ sanityCheckerThread
+			, assist $ sanityCheckerDailyThread
+			, assist $ sanityCheckerHourlyThread
 			, assist $ mountWatcherThread
 			, assist $ netWatcherThread
 			, assist $ netWatcherFallbackThread

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

Utility/Daemon.hs

@@ -8,6 +8,7 @@
 module Utility.Daemon where
 
 import Common
+import Utility.LogFile
 
 import System.Posix
 
@@ -40,16 +41,6 @@ daemonize logfd pidfile changedirectory a = do
 		out
 	out = exitImmediately ExitSuccess
 
-redirLog :: Fd -> IO ()
-redirLog logfd = do
-	mapM_ (redir logfd) [stdOutput, stdError]
-	closeFd logfd
-
-redir :: Fd -> Fd -> IO ()
-redir newh h = do
-	closeFd h
-	void $ dupTo newh h
-
 {- Locks the pid file, with an exclusive, non-blocking lock.
  - Writes the pid to the file, fully atomically.
  - Fails if the pid file is already locked by another process. -}

Utility/LogFile.hs

@@ -13,15 +13,17 @@ import System.Posix
 
 openLog :: FilePath -> IO Fd
 openLog logfile = do
-	rotateLog logfile 0
+	rotateLog logfile
 	openFd logfile WriteOnly (Just stdFileMode)
 		defaultFileFlags { append = True }
 
-rotateLog :: FilePath -> Int -> IO ()
-rotateLog logfile num
+rotateLog :: FilePath -> IO ()
+rotateLog logfile = go 0
+  where
+	go num
 		| num > maxLogs = return ()
 		| otherwise = whenM (doesFileExist currfile) $ do
-		rotateLog logfile (num + 1)
+			go (num + 1)
 			renameFile currfile nextfile
 	  where
 		currfile = filename num
@@ -40,3 +42,13 @@ listLogs logfile = filterM doesFileExist $ reverse $
 
 maxLogs :: Int
 maxLogs = 9
+
+redirLog :: Fd -> IO ()
+redirLog logfd = do
+	mapM_ (redir logfd) [stdOutput, stdError]
+	closeFd logfd
+
+redir :: Fd -> Fd -> IO ()
+redir newh h = do
+	closeFd h
+	void $ dupTo newh h

debian/changelog

@@ -4,6 +4,7 @@ git-annex (4.20130228) UNRELEASED; urgency=low
   * Android: Enable test suite. 
   * webapp: Only show up to 10 queued transfers.
   * Several improvements to Makefile and cabal file. Thanks, Peter Simmons
+  * assistant: Logs are rotated to avoid them using too much disk space.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 27 Feb 2013 23:20:40 -0400