|
| 1 | +{-# LANGUAGE RecordWildCards #-} |
| 2 | + |
| 3 | +-- | monitor log files for max age and max size |
| 4 | + |
| 5 | +module Pos.Util.Log.Rotator |
| 6 | + ( cleanupRotator |
| 7 | + , evalRotator |
| 8 | + , initializeRotator |
| 9 | + ) where |
| 10 | + |
| 11 | +import Universum |
| 12 | + |
| 13 | +import Control.Exception.Safe (Exception (..), catchIO) |
| 14 | + |
| 15 | +import qualified Data.List.NonEmpty as NE |
| 16 | +import Data.Time (UTCTime, addUTCTime, diffUTCTime, getCurrentTime, |
| 17 | + parseTimeM) |
| 18 | +import Data.Time.Format (defaultTimeLocale, formatTime) |
| 19 | + |
| 20 | +import Pos.Util.Log.Internal (FileDescription (..)) |
| 21 | +import Pos.Util.Log.LoggerConfig |
| 22 | + |
| 23 | +import System.Directory (listDirectory, removeFile) |
| 24 | +import System.FilePath ((</>)) |
| 25 | +import System.IO (BufferMode (LineBuffering), Handle, |
| 26 | + IOMode (WriteMode), hFileSize, hSetBuffering, stdout) |
| 27 | + |
| 28 | + |
| 29 | +-- | format of a timestamp |
| 30 | +tsformat :: String |
| 31 | +tsformat = "%Y%m%d%H%M%S" |
| 32 | + |
| 33 | +-- | get file path to a log file with current time |
| 34 | +nameLogFile :: FileDescription -> IO FilePath |
| 35 | +nameLogFile FileDescription{..} = do |
| 36 | + now <- getCurrentTime |
| 37 | + let tsnow = formatTime defaultTimeLocale tsformat now |
| 38 | + return $ prefixpath </> filename ++ "-" ++ tsnow |
| 39 | + |
| 40 | +-- | open a new log file |
| 41 | +evalRotator :: RotationParameters -> FileDescription -> IO (Handle, Integer, UTCTime) |
| 42 | +evalRotator rotation fdesc = do |
| 43 | + let maxAge = toInteger $ rotation ^. rpMaxAgeHours |
| 44 | + maxSize = toInteger $ rotation ^. rpLogLimitBytes |
| 45 | + |
| 46 | + -- open new log file |
| 47 | + fpath <- nameLogFile fdesc |
| 48 | + hdl <- catchIO (openFile fpath WriteMode) $ |
| 49 | + \e -> do |
| 50 | + prtoutException fpath e |
| 51 | + return stdout -- fallback to standard output in case of exception |
| 52 | + hSetBuffering hdl LineBuffering |
| 53 | + |
| 54 | + -- compute next rotation time |
| 55 | + now <- getCurrentTime |
| 56 | + let rottime = addUTCTime (fromInteger $ maxAge * 3600) now |
| 57 | + |
| 58 | + return (hdl, maxSize, rottime) |
| 59 | + |
| 60 | +prtoutException :: Exception e => FilePath -> e -> IO () |
| 61 | +prtoutException fp e = do |
| 62 | + putStrLn $ "error while opening log @ " ++ fp |
| 63 | + putStrLn $ "exception: " ++ displayException e |
| 64 | + |
| 65 | +-- | list filenames in prefix dir which match 'filename' |
| 66 | +listLogFiles :: FileDescription -> IO (Maybe (NonEmpty FilePath)) |
| 67 | +listLogFiles FileDescription{..} = do |
| 68 | + -- find files in bp which begin with fp |
| 69 | + files <- listDirectory $ prefixpath |
| 70 | + return $ nonEmpty $ sort $ filter fpredicate files |
| 71 | + where |
| 72 | + tslen = 14 -- length of a timestamp |
| 73 | + fplen = length filename |
| 74 | + fpredicate path = take fplen path == filename |
| 75 | + && take 1 (drop fplen path) == "-" |
| 76 | + && length (drop (fplen + 1) path) == tslen |
| 77 | + |
| 78 | +-- | latest log file in prefix dir which matches 'filename' |
| 79 | +latestLogFile :: FileDescription -> IO (Maybe FilePath) |
| 80 | +latestLogFile fdesc = |
| 81 | + listLogFiles fdesc >>= \fs -> return $ latestLogFile' fs |
| 82 | + where |
| 83 | + latestLogFile' :: Maybe (NonEmpty FilePath) -> Maybe FilePath |
| 84 | + latestLogFile' Nothing = Nothing |
| 85 | + latestLogFile' (Just flist) = Just $ last flist |
| 86 | + |
| 87 | +-- | initialize log file at startup |
| 88 | +-- may append to existing file |
| 89 | +initializeRotator :: RotationParameters -> FileDescription -> IO (Handle, Integer, UTCTime) |
| 90 | +initializeRotator rotation fdesc = do |
| 91 | + let maxAge = toInteger $ rotation ^. rpMaxAgeHours |
| 92 | + maxSize = toInteger $ rotation ^. rpLogLimitBytes |
| 93 | + |
| 94 | + latest <- latestLogFile fdesc |
| 95 | + case latest of |
| 96 | + Nothing -> -- no file to append, return new |
| 97 | + evalRotator rotation fdesc |
| 98 | + Just fname -> do |
| 99 | + -- check date |
| 100 | + now <- getCurrentTime |
| 101 | + tsfp <- parseTimeM True defaultTimeLocale tsformat $ drop (fplen + 1) fname |
| 102 | + if (round $ diffUTCTime now tsfp) > (3600 * maxAge) |
| 103 | + then do -- file is too old, return new |
| 104 | + evalRotator rotation fdesc |
| 105 | + else do |
| 106 | + hdl <- catchIO (openFile (prefixpath fdesc </> fname) AppendMode) $ |
| 107 | + \e -> do |
| 108 | + prtoutException fname e |
| 109 | + return stdout -- fallback to standard output in case of exception |
| 110 | + hSetBuffering hdl LineBuffering |
| 111 | + cursize <- hFileSize hdl |
| 112 | + let rottime = addUTCTime (fromInteger $ maxAge * 3600) now |
| 113 | + return (hdl, (maxSize - cursize), rottime) |
| 114 | + where |
| 115 | + fplen = length $ filename fdesc |
| 116 | + |
| 117 | +-- | remove old files; count them and only keep n (from config) |
| 118 | +cleanupRotator :: RotationParameters -> FileDescription -> IO () |
| 119 | +cleanupRotator rotation fdesc = do |
| 120 | + let keepN0 = fromIntegral (rotation ^. rpKeepFilesNum) :: Int |
| 121 | + keepN = max 1 $ min keepN0 99 |
| 122 | + listLogFiles fdesc >>= removeOldFiles keepN |
| 123 | + where |
| 124 | + removeOldFiles :: Int -> Maybe (NonEmpty FilePath) -> IO () |
| 125 | + removeOldFiles _ Nothing = return () |
| 126 | + removeOldFiles n (Just flist) = do |
| 127 | + putStrLn $ "dropping " ++ (show n) ++ " from " ++ (show flist) |
| 128 | + removeFiles $ reverse $ NE.drop n $ NE.reverse flist |
| 129 | + removeFiles [] = return () |
| 130 | + removeFiles (fp : fps) = do |
| 131 | + let bp = prefixpath fdesc |
| 132 | + filepath = bp </> fp |
| 133 | + putStrLn $ "removing file " ++ filepath |
| 134 | + removeFile filepath -- destructive |
| 135 | + removeFiles fps |
| 136 | + |
| 137 | +{- |
| 138 | +
|
| 139 | + testing: |
| 140 | +
|
| 141 | + lc0 <- parseLoggerConfig "../log-configs/testing.yaml" |
| 142 | + lc <- setLogPrefix (Just "/tmp/testlog/") lc0 |
| 143 | + lh <- setupLogging lc |
| 144 | +
|
| 145 | + usingLoggerName lh "testing" $ do { forM_ [1..299] (\n -> logDebug $ T.pack $ "hello world " ++ (show n)) } |
| 146 | +-} |
0 commit comments