wai-logger 0.0.1 → 0.0.2
raw patch · 6 files changed
+74/−34 lines, 6 files
Files
- Network/Wai/Logger/Format.hs +39/−14
- Network/Wai/Logger/IO.hs +15/−4
- Network/Wai/Logger/Prefork.hs +6/−4
- Network/Wai/Logger/Prefork/File.hs +6/−6
- Network/Wai/Logger/Prefork/Stdout.hs +7/−5
- wai-logger.cabal +1/−1
Network/Wai/Logger/Format.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Wai.Logger.Format (- apacheFormat+ IPAddrSource(..)+ , apacheFormat+ -- * Builder , apacheFormatBuilder ) where @@ -17,10 +19,18 @@ import Network.Wai.Logger.IO import Network.Wai.Logger.Utils +{-| Source from which the IP source address of the client is obtained.+-}+data IPAddrSource =+ -- | From the peer address of the HTTP connection.+ FromSocket+ -- | From X-Real-IP: or X-Forwarded-For: in the HTTP header.+ | FromHeader+ -- | Apache style log format.-apacheFormat :: ZonedDate -> Request -> Status -> Maybe Integer -> [LogStr]-apacheFormat tmstr req st msize = [- LS addr+apacheFormat :: IPAddrSource -> ZonedDate -> Request -> Status -> Maybe Integer -> [LogStr]+apacheFormat ipsrc tmstr req st msize = [+ getSourceIP ipsrc req , LB " - - [" , LB tmstr , LB "] \""@@ -39,16 +49,13 @@ , LB $ lookupRequestField' "user-agent" req , LB "\"\n" ]- where- addr = showSockAddr (remoteHost req) -lookupRequestField' :: CI Ascii -> Request -> Ascii-lookupRequestField' k req = fromMaybe "" . lookup k $ requestHeaders req---- | Apache style log format with 'Builder'. This is experimental.-apacheFormatBuilder :: ZonedDate -> Request -> Status -> Maybe Integer -> Builder-apacheFormatBuilder tmstr req status msize =- st addr+{-| Apache style log format with 'Builder'. This is experimental.+ This would replace 'apacheFormat' someday.+-}+apacheFormatBuilder :: IPAddrSource -> ZonedDate -> Request -> Status -> Maybe Integer -> Builder+apacheFormatBuilder ipsrc tmstr req status msize =+ getSourceIP' ipsrc req +++ bs " - - [" +++ bs tmstr +++ bs "] \""@@ -67,7 +74,25 @@ +++ bs (lookupRequestField' "user-agent" req) +++ bs "\"\n" where- addr = showSockAddr (remoteHost req) st = fromString bs = fromByteString (+++) = mappend++lookupRequestField' :: CI Ascii -> Request -> Ascii+lookupRequestField' k req = fromMaybe "" . lookup k $ requestHeaders req++getSourceIP :: IPAddrSource -> Request -> LogStr+getSourceIP FromSocket req = LS $ showSockAddr (remoteHost req)+getSourceIP FromHeader req = LB addr+ where+ maddr = lookup "x-real-ip" hdrs >> lookup "x-forwarded-for" hdrs+ addr = fromMaybe "" maddr+ hdrs = requestHeaders req++getSourceIP' :: IPAddrSource -> Request -> Builder+getSourceIP' FromSocket req = fromString . showSockAddr . remoteHost $ req+getSourceIP' FromHeader req = fromByteString addr+ where+ maddr = lookup "x-real-ip" hdrs >> lookup "x-forwarded-for" hdrs+ addr = fromMaybe "" maddr+ hdrs = requestHeaders req
Network/Wai/Logger/IO.hs view
@@ -3,7 +3,9 @@ module Network.Wai.Logger.IO ( LogStr(..)- , hPutLogStr, hPutBuilder, initHandle+ , hPutLogStr+ -- * Builder+ , initHandle, hPutBuilder ) where import Blaze.ByteString.Builder@@ -23,10 +25,16 @@ import GHC.Real import System.IO --- | A date type to contain 'String' and 'ByteString'.+{-| A date type to contain 'String' and 'ByteString'.+ This data is exported so that format can be defined.+ This would be replaced with 'Builder' someday.+-} data LogStr = LS !String | LB !ByteString --- | The 'hPut' function directory to copy a lift of 'LogStr' to the buffer.+{-| The 'hPut' function to copy a list of 'LogStr' to the buffer+ of 'Handle' directly.+ If 'Handle' is associated with a file, 'AppendMode' must be used.+-} hPutLogStr :: Handle -> [LogStr] -> IO () hPutLogStr handle bss = wantWritableHandle "hPutLogStr" handle $ \h_ -> bufsWrite h_ bss@@ -71,13 +79,16 @@ poke dst (c2w x) copy' (dst `plusPtr` 1) xs --- | Setting a proper buffering to 'Handle'.+{-| Setting a proper buffering to 'Handle'.+-} initHandle :: Handle -> IO () initHandle hdl = hSetBuffering hdl (BlockBuffering (Just 4096)) {-| The 'hPut' function directory to copy 'Builder' to the buffer.+ If 'Handle' is associated with a file, 'AppendMode' must be used. The current implementation is inefficient at this moment. 'initHandle' must be called once beforehand if this function is used.+ This would replace 'hPutLogStr' someday. -} hPutBuilder :: Handle -> Builder -> IO () hPutBuilder hdl = BS.hPut hdl . toByteString
Network/Wai/Logger/Prefork.hs view
@@ -4,6 +4,7 @@ , logController , ApacheLogger , LogType(..)+ , IPAddrSource(..) , FileLogSpec(..) , LogController ) where@@ -11,6 +12,7 @@ import Control.Concurrent import Control.Monad import Network.Wai.Logger.File+import Network.Wai.Logger.Format import Network.Wai.Logger.Prefork.File import Network.Wai.Logger.Prefork.Stdout import Network.Wai.Logger.Prefork.Types@@ -20,10 +22,10 @@ logCheck LogStdout = return () logCheck (LogFile spec) = check spec -logInit :: LogType -> IO ApacheLogger-logInit LogNone = noLoggerInit-logInit LogStdout = stdoutLoggerInit-logInit (LogFile spec) = fileLoggerInit spec+logInit :: IPAddrSource -> LogType -> IO ApacheLogger+logInit _ LogNone = noLoggerInit+logInit ipsrc LogStdout = stdoutLoggerInit ipsrc+logInit ipsrc (LogFile spec) = fileLoggerInit ipsrc spec noLoggerInit :: IO ApacheLogger noLoggerInit = return noLogger
Network/Wai/Logger/Prefork/File.hs view
@@ -30,14 +30,14 @@ ---------------------------------------------------------------- -fileLoggerInit :: FileLogSpec -> IO ApacheLogger-fileLoggerInit spec = do+fileLoggerInit :: IPAddrSource -> FileLogSpec -> IO ApacheLogger+fileLoggerInit ipsrc spec = do hdl <- open spec hdlref <- HandleRef <$> newIORef hdl forkIO $ fileFlusher hdlref dateref <- dateInit installHandler sigUSR1 (Catch $ reopen spec hdlref) Nothing- return $ fileLogger dateref hdlref+ return $ fileLogger ipsrc dateref hdlref {- For BlockBuffering, hPut flushes the buffer before writing@@ -61,11 +61,11 @@ ---------------------------------------------------------------- -fileLogger :: DateRef -> HandleRef -> ApacheLogger-fileLogger dateref hdlref req status msiz = do+fileLogger :: IPAddrSource -> DateRef -> HandleRef -> ApacheLogger+fileLogger ipsrc dateref hdlref req status msiz = do date <- getDate dateref hdl <- getHandle hdlref- hPutLogStr hdl $ apacheFormat date req status msiz+ hPutLogStr hdl $ apacheFormat ipsrc date req status msiz fileFlusher :: HandleRef -> IO () fileFlusher hdlref = forever $ do
Network/Wai/Logger/Prefork/Stdout.hs view
@@ -8,13 +8,15 @@ import Network.Wai.Logger.Prefork.Types import qualified Data.ByteString as BS -stdoutLoggerInit :: IO ApacheLogger-stdoutLoggerInit = stdoutLogger <$> dateInit+stdoutLoggerInit :: IPAddrSource -> IO ApacheLogger+stdoutLoggerInit ipsrc = stdoutLogger ipsrc <$> dateInit -stdoutLogger :: DateRef -> ApacheLogger-stdoutLogger dateref req status msiz = do+stdoutLogger :: IPAddrSource -> DateRef -> ApacheLogger+stdoutLogger ipsrc dateref req status msiz = do date <- getDate dateref- BS.putStr $ BS.concat $ map toBS $ apacheFormat date req status msiz+ putToStdout $ logmsg date where+ putToStdout = BS.putStr . BS.concat . map toBS+ logmsg date = apacheFormat ipsrc date req status msiz toBS (LS s) = pack s toBS (LB s) = s
wai-logger.cabal view
@@ -1,5 +1,5 @@ Name: wai-logger-Version: 0.0.1+Version: 0.0.2 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3