Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-wai-logger for openSUSE:Factory
checked in at 2026-11-06 19:50:44
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-wai-logger (Old)
and /work/SRC/openSUSE:Factory/.ghc-wai-logger.new.3759290 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-wai-logger"
Fri Nov 6 19:50:44 2026 rev:8 rq:1395583 version:2.5.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-wai-logger/ghc-wai-logger.changes
2024-12-20 23:12:07.356188434 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-wai-logger.new.3759290/ghc-wai-logger.changes
2026-11-06 19:57:51.542885890 +0100
@@ -1,0 +2,8 @@
+Tue Oct 27 10:51:50 UTC 2026 - Peter Simons <[email protected]>
+
+- Update wai-logger to version 2.5.1.
+ Upstream added a new change log file in this release. With no
+ previous version to compare against, the automatic updater cannot
+ reliable determine the relevante entries for this release.
+
+-------------------------------------------------------------------
Old:
----
wai-logger-2.5.0.tar.gz
New:
----
wai-logger-2.5.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-wai-logger.spec ++++++
--- /var/tmp/diff_new_pack.4DtwvC/_old 2026-11-06 19:57:53.448965680 +0100
+++ /var/tmp/diff_new_pack.4DtwvC/_new 2026-11-06 19:57:53.455965973 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-wai-logger
#
-# Copyright (c) 2024 SUSE LLC
+# Copyright (c) 2026 SUSE LLC
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -18,8 +18,9 @@
%global pkg_name wai-logger
%global pkgver %{pkg_name}-%{version}
+%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.5.0
+Version: 2.5.1
Release: 0
Summary: A logging system for WAI
License: MIT
@@ -42,6 +43,10 @@
BuildRequires: ghc-wai-devel
BuildRequires: ghc-wai-prof
ExcludeArch: %{ix86}
+%if %{with tests}
+BuildRequires: ghc-hspec-devel
+BuildRequires: ghc-hspec-prof
+%endif
%description
A logging system for WAI(Web Application Interface).
@@ -81,6 +86,9 @@
%install
%ghc_lib_install
+%check
+%cabal_test
+
%post devel
%ghc_pkg_recache
@@ -91,6 +99,7 @@
%license LICENSE
%files devel -f %{name}-devel.files
+%doc ChangeLog.md
%files -n ghc-%{pkg_name}-doc -f ghc-%{pkg_name}-doc.files
%license LICENSE
++++++ wai-logger-2.5.0.tar.gz -> wai-logger-2.5.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/ChangeLog.md
new/wai-logger-2.5.1/ChangeLog.md
--- old/wai-logger-2.5.0/ChangeLog.md 1970-01-01 01:00:00.000000000 +0100
+++ new/wai-logger-2.5.1/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/Network/Wai/Logger/Apache.hs
new/wai-logger-2.5.1/Network/Wai/Logger/Apache.hs
--- old/wai-logger-2.5.0/Network/Wai/Logger/Apache.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/wai-logger-2.5.1/Network/Wai/Logger/Apache.hs 2001-09-09
03:46:40.000000000 +0200
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/Network/Wai/Logger/IORef.hs
new/wai-logger-2.5.1/Network/Wai/Logger/IORef.hs
--- old/wai-logger-2.5.0/Network/Wai/Logger/IORef.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/wai-logger-2.5.1/Network/Wai/Logger/IORef.hs 2001-09-09
03:46:40.000000000 +0200
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/Network/Wai/Logger/IP.hs
new/wai-logger-2.5.1/Network/Wai/Logger/IP.hs
--- old/wai-logger-2.5.0/Network/Wai/Logger/IP.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/wai-logger-2.5.1/Network/Wai/Logger/IP.hs 2001-09-09
03:46:40.000000000 +0200
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/Network/Wai/Logger.hs
new/wai-logger-2.5.1/Network/Wai/Logger.hs
--- old/wai-logger-2.5.0/Network/Wai/Logger.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/wai-logger-2.5.1/Network/Wai/Logger.hs 2001-09-09 03:46:40.000000000
+0200
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
-- | Apache style logger for WAI applications.
@@ -30,33 +30,37 @@
-- > 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 ((<$>))
@@ -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
- }
-
-initLogger :: IPAddrSource -> LogType -> IO FormattedTime
- -> IO ApacheLoggerActions
+ 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 = 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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/Setup.hs
new/wai-logger-2.5.1/Setup.hs
--- old/wai-logger-2.5.0/Setup.hs 2001-09-09 03:46:40.000000000 +0200
+++ new/wai-logger-2.5.1/Setup.hs 2001-09-09 03:46:40.000000000 +0200
@@ -1,4 +1,5 @@
{-# OPTIONS_GHC -Wall #-}
+
module Main (main) where
import Distribution.Simple
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/test/ApacheSpec.hs
new/wai-logger-2.5.1/test/ApacheSpec.hs
--- old/wai-logger-2.5.0/test/ApacheSpec.hs 1970-01-01 01:00:00.000000000
+0100
+++ new/wai-logger-2.5.1/test/ApacheSpec.hs 2001-09-09 03:46:40.000000000
+0200
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/test/Spec.hs
new/wai-logger-2.5.1/test/Spec.hs
--- old/wai-logger-2.5.0/test/Spec.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/wai-logger-2.5.1/test/Spec.hs 2001-09-09 03:46:40.000000000 +0200
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/wai-logger-2.5.0/wai-logger.cabal
new/wai-logger-2.5.1/wai-logger.cabal
--- old/wai-logger-2.5.0/wai-logger.cabal 2001-09-09 03:46:40.000000000
+0200
+++ new/wai-logger-2.5.1/wai-logger.cabal 2001-09-09 03:46:40.000000000
+0200
@@ -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 <[email protected]>
@@ -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
