packages feed

wai-logger 2.2.7 → 2.5.0

raw patch · 6 files changed

Files

Network/Wai/Logger.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP   #-}+{-# LANGUAGE GADTs #-}  -- | Apache style logger for WAI applications. --@@ -7,7 +8,7 @@ -- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where -- >--- > import Blaze.ByteString.Builder (fromByteString)+-- > import Data.ByteString.Builder (byteString) -- > import Control.Monad.IO.Class (liftIO) -- > import qualified Data.ByteString.Char8 as BS -- > import Network.HTTP.Types (status200)@@ -27,19 +28,25 @@ -- >     status = status200 -- >     hdr = [("Content-Type", "text/plain")] -- >     pong = "PONG"--- >     msg = fromByteString pong+-- >     msg = byteString pong -- >     len = fromIntegral $ BS.length pong  module Network.Wai.Logger (   -- * High level functions     ApacheLogger   , withStdoutLogger+  , ServerPushLogger   -- * Creating a logger-  , ApacheLoggerActions(..)+  , ApacheLoggerActions+  , apacheLogger+  , serverpushLogger+  , logRotator+  , logRemover+  , initLoggerUser   , initLogger   -- * Types   , IPAddrSource(..)-  , LogType(..)+  , LogType'(..), LogType   , FileLogSpec(..)   -- * Utilities   , showSockAddr@@ -56,6 +63,7 @@ #endif import Control.Exception (bracket) import Control.Monad (void)+import Data.ByteString (ByteString) import Network.HTTP.Types (Status) import Network.Wai (Request) import System.Log.FastLogger@@ -85,12 +93,19 @@ -- | Apache style logger. type ApacheLogger = Request -> Status -> Maybe Integer -> IO () +-- | HTTP/2 server push logger in Apache style.+type ServerPushLogger = Request -> ByteString -> Integer -> IO ()++-- | Function set of Apache style logger. data ApacheLoggerActions = ApacheLoggerActions {+    -- | The Apache logger.     apacheLogger :: ApacheLogger+    -- | The HTTP/2 server push logger.+  , serverpushLogger :: ServerPushLogger     -- | This is obsoleted. Rotation is done on-demand.     --   So, this is now an empty action.   , logRotator :: IO ()-    -- | Removing resources relating Apache logger.+    -- | Removing resources relating to Apache logger.     --   E.g. flushing and deallocating internal buffers.   , logRemover :: IO ()   }@@ -98,28 +113,46 @@ ----------------------------------------------------------------  -- | Creating 'ApacheLogger' according to 'LogType'.+initLoggerUser :: ToLogStr user => Maybe (Request -> Maybe user) -> IPAddrSource -> LogType -> IO FormattedTime+               -> IO ApacheLoggerActions+initLoggerUser ugetter ipsrc typ tgetter = do+    (fl, cleanUp) <- newFastLogger typ+    return $ ApacheLoggerActions {+        apacheLogger     = apache fl ipsrc ugetter tgetter+      , serverpushLogger = serverpush fl ipsrc ugetter tgetter+      , logRotator       = return ()+      , logRemover       = cleanUp+      }+ initLogger :: IPAddrSource -> LogType -> IO FormattedTime            -> IO ApacheLoggerActions-initLogger ipsrc typ tgetter = do-    (fl, cleanUp) <- newFastLogger typ-    return $ ApacheLoggerActions (apache fl ipsrc tgetter) (return ()) cleanUp+initLogger = initLoggerUser nouser+  where+    nouser :: Maybe (Request -> Maybe ByteString)+    nouser = Nothing  --- | Checking if a log file can be written if 'LogType' is 'LogFileNoRotate' or 'LogFile'. logCheck :: LogType -> IO () logCheck LogNone          = return () logCheck (LogStdout _)    = return () logCheck (LogStderr _)    = return ()-logCheck (LogFileNoRotate fp _)  = check fp-logCheck (LogFile spec _)        = check (log_file spec)+logCheck (LogFileNoRotate fp _)      = check fp+logCheck (LogFile spec _)            = check (log_file spec)+logCheck (LogFileTimedRotate spec _) = check (timed_log_file spec) logCheck (LogCallback _ _) = return ()  ---------------------------------------------------------------- -apache :: (LogStr -> IO ()) -> IPAddrSource -> IO FormattedTime -> ApacheLogger-apache cb ipsrc dateget req st mlen = do+apache :: ToLogStr user => (LogStr -> IO ()) -> IPAddrSource -> Maybe (Request -> Maybe user) -> IO FormattedTime -> ApacheLogger+apache cb ipsrc userget dateget req st mlen = do     zdata <- dateget-    cb (apacheLogStr ipsrc zdata req st mlen)+    cb (apacheLogStr ipsrc (justGetUser userget) zdata req st mlen) +serverpush :: ToLogStr user => (LogStr -> IO ()) -> IPAddrSource -> Maybe (Request -> Maybe user) -> IO FormattedTime -> ServerPushLogger+serverpush cb ipsrc userget dateget req path size = do+    zdata <- dateget+    cb (serverpushLogStr ipsrc (justGetUser userget) zdata req path size)+ ---------------------------------------------------------------  -- | Getting cached 'ZonedDate'.@@ -142,3 +175,7 @@ clockDateCacher = do     tgetter <- newTimeCache simpleTimeFormat     return (tgetter, return ())++justGetUser :: Maybe (Request -> Maybe user) -> (Request -> Maybe user)+justGetUser (Just getter) = getter+justGetUser Nothing       = \_ -> Nothing
Network/Wai/Logger/Apache.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE OverloadedStrings, CPP #-}+{-# LANGUAGE OverloadedStrings, CPP, TupleSections #-}  module Network.Wai.Logger.Apache (     IPAddrSource(..)   , apacheLogStr+  , serverpushLogStr   ) where  #ifndef MIN_VERSION_base@@ -17,38 +18,61 @@ import Data.List (find) import Data.Maybe (fromMaybe) #if MIN_VERSION_base(4,5,0)-import Data.Monoid ((<>))+import Data.Monoid ((<>), First (..)) #else import Data.Monoid (mappend) #endif import Network.HTTP.Types (Status, statusCode)+import Network.HTTP.Types.Header (HeaderName) import Network.Wai (Request(..)) import Network.Wai.Logger.IP import System.Log.FastLogger  -- $setup -- >>> :set -XOverloadedStrings--- >>> import Network.Wai.Test+-- >>> import Network.Wai (defaultRequest)  -- | 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.+  -- | From @X-Real-IP@ or @X-Forwarded-For@ in the HTTP header.+  --+  -- This picks either @X-Real-IP@ or @X-Forwarded-For@ depending on which of these+  -- headers comes first in the ordered list of request headers.+  --+  -- If the @X-Forwarded-For@ header is picked, the value will be assumed to be a+  -- comma-separated list of IP addresses.  The value will be parsed, and the+  -- left-most IP address will be used (which is mostly likely to be the actual+  -- client IP address).   | FromHeader-  -- | From the peer address if header is not found.+  -- | From a custom HTTP header, useful in proxied environment.+  --+  -- The header value will be assumed to be a comma-separated list of IP+  -- addresses.  The value will be parsed, and the left-most IP address will be+  -- used (which is mostly likely to be the actual client IP address).+  --+  -- Note that this still works as expected for a single IP address.+  | FromHeaderCustom [HeaderName]+  -- | Just like 'FromHeader', but falls back on the peer address if header is not found.   | FromFallback+  -- | This gives you the most flexibility to figure out the IP source address+  -- from the 'Request'.  The returned 'ByteString' is used as the IP source+  -- address.+  | FromRequest (Request -> ByteString)  -- | Apache style log format.-apacheLogStr :: IPAddrSource -> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr-apacheLogStr ipsrc tmstr req status msize =+apacheLogStr :: ToLogStr user => IPAddrSource -> (Request -> Maybe user) -> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr+apacheLogStr ipsrc userget tmstr req status msize =       toLogStr (getSourceIP ipsrc req)-  <> " - - ["+  <> " - "+  <> maybe "-" toLogStr (userget req)+  <> " ["   <> toLogStr tmstr   <> "] \""   <> toLogStr (requestMethod req)   <> " "-  <> toLogStr (rawPathInfo req)+  <> toLogStr path   <> " "   <> toLogStr (show (httpVersion req))   <> "\" "@@ -61,6 +85,7 @@   <> toLogStr (fromMaybe "" mua)   <> "\"\n"   where+    path = rawPathInfo req <> rawQueryString req #if !MIN_VERSION_base(4,5,0)     (<>) = mappend #endif@@ -72,12 +97,40 @@     mua = lookup "user-agent" $ requestHeaders req #endif --- getSourceIP = getSourceIP fromString fromByteString+-- | HTTP/2 Push log format in the Apache style.+serverpushLogStr :: ToLogStr user => IPAddrSource -> (Request -> Maybe user) -> FormattedTime -> Request -> ByteString -> Integer -> LogStr+serverpushLogStr ipsrc userget tmstr req path size =+      toLogStr (getSourceIP ipsrc req)+  <> " - "+  <> maybe "-" toLogStr (userget req)+  <> " ["+  <> toLogStr tmstr+  <> "] \"PUSH "+  <> toLogStr path+  <> " HTTP/2\" 200 "+  <> toLogStr (show size)+  <> " \""+  <> toLogStr ref+  <> "\" \""+  <> toLogStr (fromMaybe "" mua)+  <> "\"\n"+  where+    ref  = rawPathInfo req+#if !MIN_VERSION_base(4,5,0)+    (<>) = mappend+#endif+#if MIN_VERSION_wai(3,2,0)+    mua = requestHeaderUserAgent req+#else+    mua = lookup "user-agent" $ requestHeaders req+#endif  getSourceIP :: IPAddrSource -> Request -> ByteString-getSourceIP FromSocket   = getSourceFromSocket-getSourceIP FromHeader   = getSourceFromHeader+getSourceIP FromSocket = getSourceFromSocket+getSourceIP FromHeader = getSourceFromHeader getSourceIP FromFallback = getSourceFromFallback+getSourceIP (FromHeaderCustom hs) = fromMaybe "-" . getSourceFromHeaderCustom hs+getSourceIP (FromRequest fromReq) = fromReq  -- | -- >>> getSourceFromSocket defaultRequest@@ -91,11 +144,25 @@ -- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } -- "127.0.0.1" -- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] }--- ""+-- "-" -- >>> getSourceFromHeader defaultRequest { requestHeaders = [] }--- ""+-- "-"+--+-- 'getSourceFromHeader' uses the first instance of either @"X-Real-IP"@ or+-- @"X-Forwarded-For"@ that it finds in the ordered header list:+--+-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Real-IP", "1.2.3.4"), ("X-Forwarded-For", "5.6.7.8") ] }+-- "1.2.3.4"+-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8"), ("X-Real-IP", "1.2.3.4") ] }+-- "5.6.7.8"+--+-- 'getSourceFromHeader' handles pulling out the first IP in the+-- comma-separated IP list in X-Forwarded-For:+--+-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8, 10.11.12.13, 1.2.3.4") ] }+-- "5.6.7.8" getSourceFromHeader :: Request -> ByteString-getSourceFromHeader = fromMaybe "" . getSource+getSourceFromHeader = fromMaybe "-" . getSource  -- | -- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] }@@ -106,6 +173,20 @@ -- "0.0.0.0" -- >>> getSourceFromFallback defaultRequest { requestHeaders = [] } -- "0.0.0.0"+--+-- 'getSourceFromFallback' uses the first instance of either @"X-Real-IP"@ or+-- @"X-Forwarded-For"@ that it finds in the ordered header list:+--+-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Real-IP", "1.2.3.4"), ("X-Forwarded-For", "5.6.7.8") ] }+-- "1.2.3.4"+-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8"), ("X-Real-IP", "1.2.3.4") ] }+-- "5.6.7.8"+--+-- 'getSourceFromFallback' handles pulling out the first IP in the+-- comma-separated IP list in X-Forwarded-For:+--+-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8, 10.11.12.13, 1.2.3.4") ] }+-- "5.6.7.8" getSourceFromFallback :: Request -> ByteString getSourceFromFallback req = fromMaybe (getSourceFromSocket req) $ getSource req @@ -118,9 +199,73 @@ -- Nothing -- >>> getSource defaultRequest -- Nothing+--+-- 'getSource' uses the first instance of either @"X-Real-IP"@ or+-- @"X-Forwarded-For"@ that it finds in the ordered header list:+--+-- >>> getSource defaultRequest { requestHeaders = [ ("X-Real-IP", "1.2.3.4"), ("X-Forwarded-For", "5.6.7.8") ] }+-- Just "1.2.3.4"+-- >>> getSource defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8"), ("X-Real-IP", "1.2.3.4") ] }+-- Just "5.6.7.8"+--+-- 'getSource' handles pulling out the first IP in the comma-separated IP list+-- in X-Forwarded-For:+--+-- >>> getSource defaultRequest { requestHeaders = [ ("X-Forwarded-For", "5.6.7.8, 10.11.12.13, 1.2.3.4") ] }+-- Just "5.6.7.8" getSource :: Request -> Maybe ByteString-getSource req = addr+getSource = getSourceFromHeaders [("x-real-ip", id), ("x-forwarded-for", firstIpInXFF)]++-- | Pull out the first IP in a comma-separated list of X-Forwarded-For IPs.+--+-- >>> firstIpInXFF "1.2.3.4, 5.6.7.8, 10.11.12.13"+-- "1.2.3.4"+--+-- If there are no commas, just return the whole input ByteString:+--+-- >>> firstIpInXFF "5.6.7.8"+-- "5.6.7.8"+--+-- Note that this function doesn't make sure the input is actually an IP address:+--+-- >>> firstIpInXFF "hello, world"+-- "hello"+firstIpInXFF :: ByteString -> ByteString+firstIpInXFF = BS.takeWhile (/= ',')++getSourceFromHeaders :: [(HeaderName, ByteString -> ByteString)] -> Request -> Maybe ByteString+getSourceFromHeaders headerNamesAndPostProc req = getFirst $ foldMap f $ requestHeaders req   where-    maddr = find (\x -> fst x `elem` ["x-real-ip", "x-forwarded-for"]) hdrs-    addr = fmap snd maddr-    hdrs = requestHeaders req+    -- Take a header name and value from the request, and try match it against+    -- the list of headers and post-processing functions.  If it matches,+    -- return the ByteString resulting from applying the post-processing function+    -- to the header value.+    f :: (HeaderName, ByteString) -> First ByteString+    f (headerNameFromReq, headerValFromReq) =+      let maybePostProc = find (\(headerNameFromPostProc, _) -> headerNameFromReq == headerNameFromPostProc) headerNamesAndPostProc+      in First $ fmap (\(_, postProc) -> postProc headerValFromReq) maybePostProc++-- |+-- >>> getSourceFromHeaderCustom ["x-foobar"] defaultRequest { requestHeaders = [ ("X-catdog", "1.2.3.4"), ("X-Foobar", "5.6.7.8"), ("Other", "1.1.1.1") ] }+-- Just "5.6.7.8"+--+-- If none of the headers in the passed-in list are in the 'Request', then return 'Nothing':+--+-- >>> getSourceFromHeaderCustom ["x-foobar", "baz"] defaultRequest { requestHeaders = [ ("abb", "1.2.3.4"), ("xyz", "5.6.7.8") ] }+-- Nothing+--+-- 'getSourceFromHeaderCustom' uses the first instance of any header in the+-- passed in list that it finds in the ordered header list from the request:+--+-- >>> getSourceFromHeaderCustom ["x-foobar", "baz"] defaultRequest { requestHeaders = [ ("baz", "1.2.3.4"), ("x-foobar", "5.6.7.8") ] }+-- Just "1.2.3.4"+--+-- 'getSourceFromHeaderCustom' splits the value of the header it finds by @,@+-- and uses the first item. This makes it easy to use with headers like+-- @X-Forwarded-For@, which are expected to have a comma-separated list of IP+-- addresses:+--+-- >>> getSourceFromHeaderCustom ["x-foobar"] defaultRequest { requestHeaders = [ ("X-Foobar", "5.6.7.8, 10.11.12.13, 1.2.3.4") ] }+-- Just "5.6.7.8"+getSourceFromHeaderCustom :: [HeaderName] -> Request -> Maybe ByteString+getSourceFromHeaderCustom hs = getSourceFromHeaders (fmap (,firstIpInXFF) hs)
Network/Wai/Logger/IP.hs view
@@ -46,4 +46,4 @@ showSockAddr (SockAddrInet6 _ _ (0,0,0x0000ffff,addr4) _) = showIPv4 addr4 False showSockAddr (SockAddrInet6 _ _ (0,0,0,1) _)              = "::1" showSockAddr (SockAddrInet6 _ _ addr6 _)                  = showIPv6 addr6-showSockAddr _                                            = "unknownSocket"+showSockAddr (SockAddrUnix _)                             = "-"
Setup.hs view
@@ -1,2 +1,7 @@+{-# OPTIONS_GHC -Wall #-}+module Main (main) where+ import Distribution.Simple++main :: IO () main = defaultMain
− test/doctests.hs 
@@ -1,6 +0,0 @@-module Main where--import Test.DocTest--main :: IO ()-main = doctest ["Network"]
wai-logger.cabal view
@@ -1,48 +1,39 @@-Name:                   wai-logger-Version:                2.2.7-Author:                 Kazu Yamamoto <kazu@iij.ad.jp>-Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>-License:                BSD3-License-File:           LICENSE-Synopsis:               A logging system for WAI-Description:            A logging system for WAI-Category:               Web, Yesod-Cabal-Version:          >= 1.10-Build-Type:             Simple+cabal-version: >=1.10+name:          wai-logger+version:       2.5.0+license:       BSD3+license-file:  LICENSE+maintainer:    Kazu Yamamoto <kazu@iij.ad.jp>+author:        Kazu Yamamoto <kazu@iij.ad.jp>+tested-with:+    ghc ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.3 -Library-  Default-Language:     Haskell2010-  GHC-Options:          -Wall-  Exposed-Modules:      Network.Wai.Logger-  Other-Modules:        Network.Wai.Logger.Apache-                        Network.Wai.Logger.IP-                        Network.Wai.Logger.IORef-  Build-Depends:        base >= 4 && < 5-                      , blaze-builder-                      , byteorder-                      , bytestring-                      , case-insensitive-                      , fast-logger >= 2.4.5-                      , http-types-                      , network-                      , wai >= 2.0.0-  if os(windows)-      Cpp-Options:      -DWINDOWS-      Build-Depends:    time-                      , old-locale-  else-      Build-Depends:    unix-                      , unix-time >= 0.2.2+synopsis:      A logging system for WAI+description:   A logging system for WAI(Web Application Interface)+category:      Web, Yesod+build-type:    Simple -Test-Suite doctest-  Type:                 exitcode-stdio-1.0-  Default-Language:     Haskell2010-  HS-Source-Dirs:       test-  Ghc-Options:          -Wall-  Main-Is:              doctests.hs-  Build-Depends:        base-                      , doctest >= 0.10.1+source-repository head+    type:     git+    location: https://github.com/kazu-yamamoto/logger.git -Source-Repository head-  Type:                 git-  Location:             git://github.com/kazu-yamamoto/logger.git+library+    exposed-modules:  Network.Wai.Logger+    other-modules:+        Network.Wai.Logger.Apache+        Network.Wai.Logger.IP+        Network.Wai.Logger.IORef++    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base >=4 && <5,+        byteorder,+        bytestring,+        fast-logger >=3,+        http-types,+        network,+        wai >=2.0.0++    if impl(ghc >=8)+        default-extensions: Strict StrictData