diff options
| -rw-r--r-- | Assistant.hs | 5 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 54 | ||||
| -rw-r--r-- | Utility/Daemon.hs | 11 | ||||
| -rw-r--r-- | Utility/LogFile.hs | 36 | ||||
| -rw-r--r-- | debian/changelog | 1 |
5 files changed, 73 insertions, 34 deletions
diff --git a/Assistant.hs b/Assistant.hs index 8a3816f4d..63a5dafae 100644 --- a/Assistant.hs +++ b/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 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 diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index 185ea3e68..ff13a3b8a 100644 --- a/Utility/Daemon.hs +++ b/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. -} diff --git a/Utility/LogFile.hs b/Utility/LogFile.hs index 1985b7eda..1ff3006fe 100644 --- a/Utility/LogFile.hs +++ b/Utility/LogFile.hs @@ -13,22 +13,24 @@ 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 - | num > maxLogs = return () - | otherwise = whenM (doesFileExist currfile) $ do - rotateLog logfile (num + 1) - renameFile currfile nextfile +rotateLog :: FilePath -> IO () +rotateLog logfile = go 0 where - currfile = filename num - nextfile = filename (num + 1) - filename n - | n == 0 = logfile - | otherwise = rotatedLog logfile n + go num + | num > maxLogs = return () + | otherwise = whenM (doesFileExist currfile) $ do + go (num + 1) + renameFile currfile nextfile + where + currfile = filename num + nextfile = filename (num + 1) + filename n + | n == 0 = logfile + | otherwise = rotatedLog logfile n rotatedLog :: FilePath -> Int -> FilePath rotatedLog logfile n = logfile ++ "." ++ show n @@ -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 diff --git a/debian/changelog b/debian/changelog index 81e191b55..c6ba63db9 100644 --- a/debian/changelog +++ b/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 |