module Network.Wai.Logger.Prefork.File where
import Control.Applicative
import Control.Concurrent
import Control.Exception (handle, SomeException, catch)
import Control.Monad
import Data.IORef
import Network.Wai.Logger
import Network.Wai.Logger.Prefork.Types
import Prelude hiding (catch)
import System.Date.Cache
import System.IO
import System.Log.FastLogger
import System.Posix
newtype LoggerRef = LoggerRef (IORef Logger)
getLogger :: LoggerRef -> IO Logger
getLogger (LoggerRef ref) = readIORef ref
setLogger :: LoggerRef -> Logger -> IO ()
setLogger (LoggerRef ref) = writeIORef ref
type LogFlusher = IO ()
fileLoggerInit :: IPAddrSource -> FileLogSpec -> Signal
-> IO (ApacheLogger, LogFlusher)
fileLoggerInit ipsrc spec signal = do
hdl <- open spec
dc <- clockDateCacher zonedDateCacheConf
logger <- mkLogger2 False hdl dc
logref <- LoggerRef <$> newIORef logger
void . forkIO $ fileFlusher logref
void $ installHandler signal (Catch $ reopen spec logref) Nothing
return (fileLogger ipsrc logref, fileFlusher' logref)
open :: FileLogSpec -> IO Handle
open spec = openFile (log_file spec) AppendMode
reopen :: FileLogSpec -> LoggerRef -> IO ()
reopen spec logref = do
oldlogger <- getLogger logref
newlogger <- open spec >>= renewLogger oldlogger
setLogger logref newlogger
fileLogger :: IPAddrSource -> LoggerRef -> ApacheLogger
fileLogger ipsrc logref req status msiz = do
logger <- getLogger logref
date <- loggerDate logger
loggerPutStr logger $ apacheFormat ipsrc date req status msiz
fileFlusher :: LoggerRef -> IO ()
fileFlusher logref = forever $ do
threadDelay 10000000
fileFlusher' logref
fileFlusher' :: LoggerRef -> IO ()
fileFlusher' logref = getLogger logref >>= loggerFlush
fileLoggerController :: FileLogSpec -> Signal -> LogController
fileLoggerController spec signal pids = forever $ do
isOver <- over
when isOver $ do
rotate spec
mapM_ sendSignal pids
threadDelay 10000000
where
file = log_file spec
over = handle handler $ do
siz <- fromIntegral . fileSize <$> getFileStatus file
if siz > log_file_size spec then
return True
else
return False
sendSignal pid = signalProcess signal pid `catch` ignore
handler :: SomeException -> IO Bool
handler _ = return False
ignore :: SomeException -> IO ()
ignore _ = return ()