wai-logger-prefork 0.2.0 → 0.2.1

raw patch · 4 files changed

+49/−33 lines, 4 files

Files

• Network/Wai/Logger/Prefork.hs +27/−14
• Network/Wai/Logger/Prefork/File.hs +16/−16
• Network/Wai/Logger/Prefork/Types.hs +5/−2
• wai-logger-prefork.cabal +1/−1

@@ -2,9 +2,10 @@     logCheck   , logInit   , logController+  , LogController   , LogType(..)   , FileLogSpec(..)-  , LogController+  , LogFlusher   ) where  import Control.Concurrent@@ -14,25 +15,37 @@ import Network.Wai.Logger.Prefork.Types import System.Log.FastLogger +-- |+-- Checking if a log file can be written if 'LogType' is 'LogFile'. logCheck :: LogType -> IO ()-logCheck LogNone   = return ()-logCheck LogStdout = return ()-logCheck (LogFile spec) = check spec+logCheck LogNone          = return ()+logCheck LogStdout        = return ()+logCheck (LogFile spec _) = check spec -logInit :: IPAddrSource -> LogType -> IO ApacheLogger-logInit _ LogNone            = noLoggerInit-logInit ipsrc LogStdout      = stdoutApacheLoggerInit ipsrc True-logInit ipsrc (LogFile spec) = fileLoggerInit ipsrc spec+-- |+-- Creating 'ApacheLogger' according to 'LogType'.+logInit :: IPAddrSource -> LogType -> IO (ApacheLogger, LogFlusher)+logInit _     LogNone               = noLoggerInit+logInit ipsrc LogStdout             = stdoutLoggerInit ipsrc+logInit ipsrc (LogFile spec signal) = fileLoggerInit ipsrc spec signal -noLoggerInit :: IO ApacheLogger-noLoggerInit = return noLogger+noLoggerInit :: IO (ApacheLogger, LogFlusher)+noLoggerInit = return (noLogger, noFlusher)   where     noLogger _ _ _ = return ()+    noFlusher = return () +stdoutLoggerInit :: IPAddrSource -> IO (ApacheLogger, LogFlusher)+stdoutLoggerInit ipsrc = do+    lgr <- stdoutApacheLoggerInit ipsrc True+    return (lgr, return ())++-- |+-- Creating a log controller against child processes. logController :: LogType -> LogController-logController LogNone        = noLoggerController-logController LogStdout      = noLoggerController-logController (LogFile spec) = fileLoggerController spec+logController LogNone               = noLoggerController+logController LogStdout             = noLoggerController+logController (LogFile spec signal) = fileLoggerController spec signal  noLoggerController :: LogController-noLoggerController _ = forever $ threadDelay 10000000+noLoggerController _ = forever $ threadDelay maxBound

@@ -20,25 +20,22 @@ getLogger (LoggerRef ref) = readIORef ref  setLogger :: LoggerRef -> Logger -> IO ()-setLogger (LoggerRef ref) logger = writeIORef ref logger+setLogger (LoggerRef ref) = writeIORef ref  ---------------------------------------------------------------- -fileLoggerInit :: IPAddrSource -> FileLogSpec -> IO ApacheLogger-fileLoggerInit ipsrc spec = do+type LogFlusher = IO ()++fileLoggerInit :: IPAddrSource -> FileLogSpec -> Signal+               -> IO (ApacheLogger, LogFlusher)+fileLoggerInit ipsrc spec signal = do     hdl <- open spec     logger <- mkLogger False hdl     logref <- LoggerRef <$> newIORef logger-    _ <- forkIO $ fileFlusher logref-    _ <- installHandler sigUSR1 (Catch $ reopen spec logref) Nothing-    return $ fileLogger ipsrc logref+    void . forkIO $ fileFlusher logref+    void $ installHandler signal (Catch $ reopen spec logref) Nothing+    return (fileLogger ipsrc logref, fileFlusher' logref) -{-- For BlockBuffering, hPut flushes the buffer before writing- the target string. In other words, hPut does not split- the target string. So, to implment multiple line buffering,- just use BlockBuffering.--} open :: FileLogSpec -> IO Handle open spec = openFile (log_file spec) AppendMode @@ -59,12 +56,15 @@ fileFlusher :: LoggerRef -> IO () fileFlusher logref = forever $ do     threadDelay 10000000-    getLogger logref >>= loggerFlush+    fileFlusher' logref +fileFlusher' :: LoggerRef -> IO ()+fileFlusher' logref = getLogger logref >>= loggerFlush+ ---------------------------------------------------------------- -fileLoggerController :: FileLogSpec -> LogController-fileLoggerController spec pids = forever $ do+fileLoggerController :: FileLogSpec -> Signal -> LogController+fileLoggerController spec signal pids = forever $ do     isOver <- over     when isOver $ do         rotate spec@@ -78,7 +78,7 @@             return True           else             return False-    sendSignal pid = signalProcess sigUSR1 pid `catch` ignore+    sendSignal pid = signalProcess signal pid `catch` ignore     handler :: SomeException -> IO Bool     handler _ = return False     ignore :: SomeException -> IO ()

@@ -5,8 +5,11 @@   ) where  import System.Log.FastLogger-import System.Posix (ProcessID)+import System.Posix (ProcessID, Signal) -data LogType = LogNone | LogStdout | LogFile FileLogSpec+data LogType = LogNone+             | LogStdout+               -- | 'Signal' is used to tell child processes to reopen a log file.+             | LogFile FileLogSpec Signal  type LogController = [ProcessID] -> IO ()

@@ -1,5 +1,5 @@ Name:                   wai-logger-prefork-Version:                0.2.0+Version:                0.2.1 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3