diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,9 @@ +# ChangeLog for wai-logger + +## 2.5.1 + +* Security: request-derived fields (IP from headers, user, method, + path, Referer, User-Agent) are now escaped like Apache's + `ap_escape_logitem` to prevent log injection. +* The IP taken from X-Real-IP or X-Forwarded-For is now the first + token only. diff --git a/Network/Wai/Logger.hs b/Network/Wai/Logger.hs --- a/Network/Wai/Logger.hs +++ b/Network/Wai/Logger.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} -- | Apache style logger for WAI applications. @@ -30,34 +30,38 @@ -- > pong = "PONG" -- > msg = byteString pong -- > len = fromIntegral $ BS.length pong - module Network.Wai.Logger ( - -- * High level functions - ApacheLogger - , withStdoutLogger - , ServerPushLogger - -- * Creating a logger - , ApacheLoggerActions - , apacheLogger - , serverpushLogger - , logRotator - , logRemover - , initLoggerUser - , initLogger - -- * Types - , IPAddrSource(..) - , LogType'(..), LogType - , FileLogSpec(..) - -- * Utilities - , showSockAddr - , logCheck - -- * Backward compability - , clockDateCacher - , ZonedDate - , DateCacheGetter - , DateCacheUpdater - ) where + -- * High level functions + ApacheLogger, + withStdoutLogger, + ServerPushLogger, + -- * Creating a logger + ApacheLoggerActions, + apacheLogger, + serverpushLogger, + logRotator, + logRemover, + initLoggerUser, + initLogger, + + -- * Types + IPAddrSource (..), + LogType' (..), + LogType, + FileLogSpec (..), + + -- * Utilities + showSockAddr, + logCheck, + + -- * Backward compability + clockDateCacher, + ZonedDate, + DateCacheGetter, + DateCacheUpdater, +) where + #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) #endif @@ -97,35 +101,44 @@ 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. +data ApacheLoggerActions = ApacheLoggerActions + { apacheLogger :: ApacheLogger + -- ^ The Apache logger. + , serverpushLogger :: ServerPushLogger + -- ^ The HTTP/2 server push logger. + , logRotator :: IO () + -- ^ This is obsoleted. Rotation is done on-demand. -- So, this is now an empty action. - , logRotator :: IO () - -- | Removing resources relating to Apache logger. + , logRemover :: IO () + -- ^ Removing resources relating to Apache logger. -- E.g. flushing and deallocating internal buffers. - , logRemover :: IO () - } + } ---------------------------------------------------------------- -- | Creating 'ApacheLogger' according to 'LogType'. -initLoggerUser :: ToLogStr user => Maybe (Request -> Maybe user) -> IPAddrSource -> LogType -> IO FormattedTime - -> IO ApacheLoggerActions +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 - } + 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 + :: IPAddrSource + -> LogType + -> IO FormattedTime + -> IO ApacheLoggerActions initLogger = initLoggerUser nouser where nouser :: Maybe (Request -> Maybe ByteString) @@ -133,22 +146,34 @@ --- | 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 LogNone = return () +logCheck (LogStdout _) = return () +logCheck (LogStderr _) = return () +logCheck (LogFileNoRotate fp _) = check fp +logCheck (LogFile spec _) = check (log_file spec) logCheck (LogFileTimedRotate spec _) = check (timed_log_file spec) logCheck (LogCallback _ _) = return () ---------------------------------------------------------------- -apache :: ToLogStr user => (LogStr -> IO ()) -> IPAddrSource -> Maybe (Request -> Maybe user) -> IO FormattedTime -> ApacheLogger +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 (justGetUser userget) zdata req st mlen) -serverpush :: ToLogStr user => (LogStr -> IO ()) -> IPAddrSource -> Maybe (Request -> Maybe user) -> IO FormattedTime -> ServerPushLogger +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) @@ -178,4 +203,4 @@ justGetUser :: Maybe (Request -> Maybe user) -> (Request -> Maybe user) justGetUser (Just getter) = getter -justGetUser Nothing = \_ -> Nothing +justGetUser Nothing = \_ -> Nothing diff --git a/Network/Wai/Logger/Apache.hs b/Network/Wai/Logger/Apache.hs --- a/Network/Wai/Logger/Apache.hs +++ b/Network/Wai/Logger/Apache.hs @@ -1,10 +1,12 @@ -{-# LANGUAGE OverloadedStrings, CPP, TupleSections #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} module Network.Wai.Logger.Apache ( - IPAddrSource(..) - , apacheLogStr - , serverpushLogStr - ) where + IPAddrSource (..), + apacheLogStr, + serverpushLogStr, +) where #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 @@ -13,10 +15,17 @@ #define MIN_VERSION_wai(x,y,z) 1 #endif +import qualified Data.ByteString as B import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Internal as BI +import qualified Data.ByteString.Unsafe as BU +import Data.Char (isSpace) import Data.List (find) import Data.Maybe (fromMaybe) +import Data.Word (Word8) +import Foreign.Ptr (Ptr) +import Foreign.Storable (pokeByteOff) #if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>), First (..)) #else @@ -24,7 +33,7 @@ #endif import Network.HTTP.Types (Status, statusCode) import Network.HTTP.Types.Header (HeaderName) -import Network.Wai (Request(..)) +import Network.Wai (Request (..)) import Network.Wai.Logger.IP import System.Log.FastLogger @@ -33,57 +42,65 @@ -- >>> 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. - -- - -- 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 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) +data IPAddrSource + = -- | From the peer address of the HTTP connection. + FromSocket + | -- | 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 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 :: ToLogStr user => IPAddrSource -> (Request -> Maybe user) -> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr +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 path - <> " " - <> toLogStr (show (httpVersion req)) - <> "\" " - <> toLogStr (show (statusCode status)) - <> " " - <> toLogStr (maybe "-" show msize) - <> " \"" - <> toLogStr (fromMaybe "" mr) - <> "\" \"" - <> toLogStr (fromMaybe "" mua) - <> "\"\n" + toLogStr (escapeLogItem (getSourceIP ipsrc req)) + <> " - " + <> maybe "-" escapeUser (userget req) + <> " [" + <> toLogStr tmstr + <> "] \"" + <> toLogStr (escapeLogItem (requestMethod req)) + <> " " + <> toLogStr (escapeLogItem path) + <> " " + <> toLogStr (show (httpVersion req)) + <> "\" " + <> toLogStr (show (statusCode status)) + <> " " + <> toLogStr (maybe "-" show msize) + <> " \"" + <> toLogStr (escapeLogItem (fromMaybe "" mr)) + <> "\" \"" + <> toLogStr (escapeLogItem (fromMaybe "" mua)) + <> "\"\n" where path = rawPathInfo req <> rawQueryString req #if !MIN_VERSION_base(4,5,0) @@ -98,24 +115,32 @@ #endif -- | HTTP/2 Push log format in the Apache style. -serverpushLogStr :: ToLogStr user => IPAddrSource -> (Request -> Maybe user) -> FormattedTime -> Request -> ByteString -> Integer -> LogStr +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" + toLogStr (escapeLogItem (getSourceIP ipsrc req)) + <> " - " + <> maybe "-" escapeUser (userget req) + <> " [" + <> toLogStr tmstr + <> "] \"PUSH " + <> toLogStr (escapeLogItem path) + <> " HTTP/2\" 200 " + <> toLogStr (show size) + <> " \"" + <> toLogStr (escapeLogItem ref) + <> "\" \"" + <> toLogStr (escapeLogItem (fromMaybe "" mua)) + <> "\"\n" where - ref = rawPathInfo req + ref = rawPathInfo req #if !MIN_VERSION_base(4,5,0) (<>) = mappend #endif @@ -125,6 +150,64 @@ mua = lookup "user-agent" $ requestHeaders req #endif +escapeUser :: ToLogStr user => user -> LogStr +escapeUser = toLogStr . escapeLogItem . fromLogStr . toLogStr + +-- | Escaping a request-derived field as Apache's @ap_escape_logitem@ does. +-- No copy is made if nothing needs to be escaped. +-- +-- >>> escapeLogItem "Mozilla/5.0" +-- "Mozilla/5.0" +-- >>> escapeLogItem "a\"b\\c\r\n\x01\x7f\xe3" +-- "a\\\"b\\\\c\\r\\n\\x01\\x7f\\xe3" +escapeLogItem :: ByteString -> ByteString +escapeLogItem bs + | extra == 0 = bs + | otherwise = BI.unsafeCreate (len + extra) $ \p -> fill p 0 0 + where + len = B.length bs + extra = B.foldl' (\n w -> n + escapeLen w) 0 bs + fill :: Ptr Word8 -> Int -> Int -> IO () + fill p i j + | i >= len = return () + | otherwise = do + let w = BU.unsafeIndex bs i + case escapeLen w of + 0 -> do + pokeByteOff p j w + fill p (i + 1) (j + 1) + 1 -> do + pokeByteOff p j backslash + pokeByteOff p (j + 1) (escapeChar w) + fill p (i + 1) (j + 2) + _ -> do + pokeByteOff p j backslash + pokeByteOff p (j + 1) (0x78 :: Word8) -- 'x' + pokeByteOff p (j + 2) (hex (w `div` 16)) + pokeByteOff p (j + 3) (hex (w `mod` 16)) + fill p (i + 1) (j + 4) + backslash = 0x5c :: Word8 + hex :: Word8 -> Word8 + hex n + | n < 10 = 0x30 + n + | otherwise = 0x57 + n -- lower case as Apache + +-- Number of extra bytes needed to escape a byte. +escapeLen :: Word8 -> Int +escapeLen w + | w == 0x22 || w == 0x5c = 1 -- '"' and '\\' + | w >= 0x20 && w < 0x7f = 0 + | w >= 0x08 && w <= 0x0d && w /= 0x0c = 1 -- \b \t \n \v \r + | otherwise = 3 + +escapeChar :: Word8 -> Word8 +escapeChar 0x08 = 0x62 -- b +escapeChar 0x09 = 0x74 -- t +escapeChar 0x0a = 0x6e -- n +escapeChar 0x0b = 0x76 -- v +escapeChar 0x0d = 0x72 -- r +escapeChar w = w -- '"' and '\\' + getSourceIP :: IPAddrSource -> Request -> ByteString getSourceIP FromSocket = getSourceFromSocket getSourceIP FromHeader = getSourceFromHeader @@ -214,14 +297,19 @@ -- >>> 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 = getSourceFromHeaders [("x-real-ip", id), ("x-forwarded-for", firstIpInXFF)] +getSource = + getSourceFromHeaders + [("x-real-ip", firstIpInXFF), ("x-forwarded-for", firstIpInXFF)] -- | Pull out the first IP in a comma-separated list of X-Forwarded-For IPs. +-- Leading white spaces are skipped and the IP ends at a white space. -- -- >>> firstIpInXFF "1.2.3.4, 5.6.7.8, 10.11.12.13" -- "1.2.3.4" +-- >>> firstIpInXFF " 1.2.3.4 , 5.6.7.8" +-- "1.2.3.4" -- --- If there are no commas, just return the whole input ByteString: +-- If there are no commas or white spaces, just return the whole input ByteString: -- -- >>> firstIpInXFF "5.6.7.8" -- "5.6.7.8" @@ -231,9 +319,10 @@ -- >>> firstIpInXFF "hello, world" -- "hello" firstIpInXFF :: ByteString -> ByteString -firstIpInXFF = BS.takeWhile (/= ',') +firstIpInXFF = BS.takeWhile (\c -> c /= ',' && not (isSpace c)) . BS.dropWhile isSpace -getSourceFromHeaders :: [(HeaderName, ByteString -> ByteString)] -> Request -> Maybe ByteString +getSourceFromHeaders + :: [(HeaderName, ByteString -> ByteString)] -> Request -> Maybe ByteString getSourceFromHeaders headerNamesAndPostProc req = getFirst $ foldMap f $ requestHeaders req where -- Take a header name and value from the request, and try match it against @@ -242,8 +331,11 @@ -- 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 + 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") ] } diff --git a/Network/Wai/Logger/IORef.hs b/Network/Wai/Logger/IORef.hs --- a/Network/Wai/Logger/IORef.hs +++ b/Network/Wai/Logger/IORef.hs @@ -1,12 +1,12 @@ {-# LANGUAGE CPP #-} module Network.Wai.Logger.IORef ( - IORef - , newIORef - , readIORef - , writeIORef - , atomicModifyIORef' - ) where + IORef, + newIORef, + readIORef, + writeIORef, + atomicModifyIORef', +) where import Data.IORef diff --git a/Network/Wai/Logger/IP.hs b/Network/Wai/Logger/IP.hs --- a/Network/Wai/Logger/IP.hs +++ b/Network/Wai/Logger/IP.hs @@ -1,11 +1,12 @@ module Network.Wai.Logger.IP ( - NumericAddress, showSockAddr - ) where + NumericAddress, + showSockAddr, +) where import Data.Bits (shift, (.&.)) import Data.Word (Word32) -import Network.Socket (SockAddr(..)) -import System.ByteOrder (ByteOrder(..), byteOrder) +import Network.Socket (SockAddr (..)) +import System.ByteOrder (ByteOrder (..), byteOrder) import Text.Printf (printf) -- | A type for IP address in numeric string representation. @@ -13,7 +14,7 @@ showIPv4 :: Word32 -> Bool -> NumericAddress showIPv4 w32 little - | little = show b1 ++ "." ++ show b2 ++ "." ++ show b3 ++ "." ++ show b4 + | little = show b1 ++ "." ++ show b2 ++ "." ++ show b3 ++ "." ++ show b4 | otherwise = show b4 ++ "." ++ show b3 ++ "." ++ show b2 ++ "." ++ show b1 where t1 = w32 @@ -25,25 +26,26 @@ b3 = t3 .&. 0x000000ff b4 = t4 .&. 0x000000ff -showIPv6 :: (Word32,Word32,Word32,Word32) -> String -showIPv6 (w1,w2,w3,w4) = +showIPv6 :: (Word32, Word32, Word32, Word32) -> String +showIPv6 (w1, w2, w3, w4) = printf "%x:%x:%x:%x:%x:%x:%x:%x" s1 s2 s3 s4 s5 s6 s7 s8 where - (s1,s2) = split16 w1 - (s3,s4) = split16 w2 - (s5,s6) = split16 w3 - (s7,s8) = split16 w4 - split16 w = (h1,h2) + (s1, s2) = split16 w1 + (s3, s4) = split16 w2 + (s5, s6) = split16 w3 + (s7, s8) = split16 w4 + split16 w = (h1, h2) where h1 = shift w (-16) .&. 0x0000ffff h2 = w .&. 0x0000ffff + -- | Convert 'SockAddr' to 'NumericAddress'. If the address is -- IPv4-embedded IPv6 address, the IPv4 is extracted. showSockAddr :: SockAddr -> NumericAddress -- HostAddr is network byte order. -showSockAddr (SockAddrInet _ addr4) = showIPv4 addr4 (byteOrder == LittleEndian) +showSockAddr (SockAddrInet _ addr4) = showIPv4 addr4 (byteOrder == LittleEndian) -- HostAddr6 is host byte order. -showSockAddr (SockAddrInet6 _ _ (0,0,0x0000ffff,addr4) _) = showIPv4 addr4 False -showSockAddr (SockAddrInet6 _ _ (0,0,0,1) _) = "::1" -showSockAddr (SockAddrInet6 _ _ addr6 _) = showIPv6 addr6 -showSockAddr (SockAddrUnix _) = "-" +showSockAddr (SockAddrInet6 _ _ (0, 0, 0x0000ffff, addr4) _) = showIPv4 addr4 False +showSockAddr (SockAddrInet6 _ _ (0, 0, 0, 1) _) = "::1" +showSockAddr (SockAddrInet6 _ _ addr6 _) = showIPv6 addr6 +showSockAddr (SockAddrUnix _) = "-" diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wall #-} + module Main (main) where import Distribution.Simple diff --git a/test/ApacheSpec.hs b/test/ApacheSpec.hs new file mode 100644 --- /dev/null +++ b/test/ApacheSpec.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ApacheSpec (spec) where + +import qualified Data.ByteString.Char8 as BS +import Data.IORef +import Network.HTTP.Types (status200) +import Network.Wai +import Network.Wai.Logger +import System.Log.FastLogger + +import Test.Hspec + +spec :: Spec +spec = describe "apacheLogger" $ do + it "escapes request-derived fields" $ do + let req = + defaultRequest + { rawPathInfo = "/a\"b" + , requestHeaders = [("X-Forwarded-For", " 1.2.3.4 \"x\"\n, 5.6.7.8")] + , requestHeaderUserAgent = Just "evil\" \"injected\r\nfoo\\" + , requestHeaderReferer = Just "\x01\x7f" + } + logLine FromHeader req + `shouldReturn` "1.2.3.4 - - [date] \"GET /a\\\"b HTTP/1.0\" 200 4 \"\\x01\\x7f\" \"evil\\\" \\\"injected\\r\\nfoo\\\\\"\n" + it "does not change ordinary fields" $ do + let req = + defaultRequest + { rawPathInfo = "/index.html" + , rawQueryString = "?q=1" + , requestHeaders = [("X-Real-IP", "9.8.7.6")] + , requestHeaderUserAgent = Just "Mozilla/5.0 (X11)" + } + logLine FromHeader req + `shouldReturn` "9.8.7.6 - - [date] \"GET /index.html?q=1 HTTP/1.0\" 200 4 \"\" \"Mozilla/5.0 (X11)\"\n" + +logLine :: IPAddrSource -> Request -> IO BS.ByteString +logLine ipsrc req = do + ref <- newIORef "" + let cb s = modifyIORef ref (<> fromLogStr s) + lgr <- initLogger ipsrc (LogCallback cb (return ())) (return "date") + apacheLogger lgr req status200 (Just 4) + readIORef ref diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/wai-logger.cabal b/wai-logger.cabal --- a/wai-logger.cabal +++ b/wai-logger.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: wai-logger -version: 2.5.0 +version: 2.5.1 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto @@ -12,6 +12,7 @@ description: A logging system for WAI(Web Application Interface) category: Web, Yesod build-type: Simple +extra-source-files: ChangeLog.md source-repository head type: git @@ -37,3 +38,20 @@ if impl(ghc >=8) default-extensions: Strict StrictData + +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-tools: hspec-discover >=2.6 + hs-source-dirs: test + other-modules: ApacheSpec + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base >=4 && <5, + bytestring, + fast-logger, + hspec, + http-types, + wai, + wai-logger