wai-logger-2.3.0/0000755000000000000000000000000012736407710011746 5ustar0000000000000000wai-logger-2.3.0/LICENSE0000644000000000000000000000276512736407710012765 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. wai-logger-2.3.0/Setup.hs0000644000000000000000000000005612736407710013403 0ustar0000000000000000import Distribution.Simple main = defaultMain wai-logger-2.3.0/wai-logger.cabal0000644000000000000000000000311212736407710014764 0ustar0000000000000000Name: wai-logger Version: 2.3.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto 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 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 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: git://github.com/kazu-yamamoto/logger.git wai-logger-2.3.0/Network/0000755000000000000000000000000012736407710013377 5ustar0000000000000000wai-logger-2.3.0/Network/Wai/0000755000000000000000000000000012736407710014117 5ustar0000000000000000wai-logger-2.3.0/Network/Wai/Logger.hs0000644000000000000000000001236612736407710015702 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | Apache style logger for WAI applications. -- -- An example: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where -- > -- > import Blaze.ByteString.Builder (fromByteString) -- > import Control.Monad.IO.Class (liftIO) -- > import qualified Data.ByteString.Char8 as BS -- > import Network.HTTP.Types (status200) -- > import Network.Wai (Application, responseBuilder) -- > import Network.Wai.Handler.Warp (run) -- > import Network.Wai.Logger (withStdoutLogger, ApacheLogger) -- > -- > main :: IO () -- > main = withStdoutLogger $ \aplogger -> -- > run 3000 $ logApp aplogger -- > -- > logApp :: ApacheLogger -> Application -- > logApp aplogger req response = do -- > liftIO $ aplogger req status (Just len) -- > response $ responseBuilder status hdr msg -- > where -- > status = status200 -- > hdr = [("Content-Type", "text/plain")] -- > pong = "PONG" -- > msg = fromByteString pong -- > len = fromIntegral $ BS.length pong module Network.Wai.Logger ( -- * High level functions ApacheLogger , withStdoutLogger , ServerPushLogger -- * Creating a logger , ApacheLoggerActions , apacheLogger , serverpushLogger , logRotator , logRemover , initLogger -- * Types , IPAddrSource(..) , LogType(..) , FileLogSpec(..) -- * Utilities , showSockAddr , logCheck -- * Backward compability , clockDateCacher , ZonedDate , DateCacheGetter , DateCacheUpdater ) where #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) #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 import Network.Wai.Logger.Apache import Network.Wai.Logger.IP (showSockAddr) ---------------------------------------------------------------- -- | Executing a function which takes 'ApacheLogger'. -- This 'ApacheLogger' writes log message to stdout. -- Each buffer (4K bytes) is flushed every second. withStdoutLogger :: (ApacheLogger -> IO a) -> IO a withStdoutLogger app = bracket setup teardown $ \(aplogger, _) -> app aplogger where setup = do tgetter <- newTimeCache simpleTimeFormat apf <- initLogger FromFallback (LogStdout 4096) tgetter let aplogger = apacheLogger apf remover = logRemover apf return (aplogger, remover) teardown (_, remover) = void remover ---------------------------------------------------------------- -- | 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 to Apache logger. -- E.g. flushing and deallocating internal buffers. , logRemover :: IO () } ---------------------------------------------------------------- -- | Creating 'ApacheLogger' according to 'LogType'. initLogger :: IPAddrSource -> LogType -> IO FormattedTime -> IO ApacheLoggerActions initLogger ipsrc typ tgetter = do (fl, cleanUp) <- newFastLogger typ return $ ApacheLoggerActions { apacheLogger = apache fl ipsrc tgetter , serverpushLogger = serverpush fl ipsrc tgetter , logRotator = return () , logRemover = cleanUp } --- | 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 (LogCallback _ _) = return () ---------------------------------------------------------------- apache :: (LogStr -> IO ()) -> IPAddrSource -> IO FormattedTime -> ApacheLogger apache cb ipsrc dateget req st mlen = do zdata <- dateget cb (apacheLogStr ipsrc zdata req st mlen) serverpush :: (LogStr -> IO ()) -> IPAddrSource -> IO FormattedTime -> ServerPushLogger serverpush cb ipsrc dateget req path size = do zdata <- dateget cb (serverpushLogStr ipsrc zdata req path size) --------------------------------------------------------------- -- | Getting cached 'ZonedDate'. type DateCacheGetter = IO ZonedDate -- | Updateing cached 'ZonedDate'. This should be called every second. -- See the source code of 'withStdoutLogger'. type DateCacheUpdater = IO () -- | A type for zoned date. type ZonedDate = FormattedTime -- | -- Returning 'DateCacheGetter' and 'DateCacheUpdater'. -- -- Note: Since version 2.1.2, this function uses the auto-update package -- internally, and therefore the @DateCacheUpdater@ value returned need -- not be called. To wit, the return value is in fact an empty action. clockDateCacher :: IO (DateCacheGetter, DateCacheUpdater) clockDateCacher = do tgetter <- newTimeCache simpleTimeFormat return (tgetter, return ()) wai-logger-2.3.0/Network/Wai/Logger/0000755000000000000000000000000012736407710015336 5ustar0000000000000000wai-logger-2.3.0/Network/Wai/Logger/Apache.hs0000644000000000000000000001072012736407710017053 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, CPP #-} module Network.Wai.Logger.Apache ( IPAddrSource(..) , apacheLogStr , serverpushLogStr ) where #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif #ifndef MIN_VERSION_wai #define MIN_VERSION_wai(x,y,z) 1 #endif import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS import Data.List (find) import Data.Maybe (fromMaybe) #if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>)) #else import Data.Monoid (mappend) #endif import Network.HTTP.Types (Status, statusCode) import Network.Wai (Request(..)) import Network.Wai.Logger.IP import System.Log.FastLogger -- $setup -- >>> :set -XOverloadedStrings -- >>> import Network.Wai.Test -- | 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 -- | From the peer address if header is not found. | FromFallback -- | Apache style log format. apacheLogStr :: IPAddrSource -> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr apacheLogStr ipsrc tmstr req status msize = toLogStr (getSourceIP ipsrc req) <> " - - [" <> toLogStr tmstr <> "] \"" <> toLogStr (requestMethod req) <> " " <> toLogStr (rawPathInfo req) <> " " <> toLogStr (show (httpVersion req)) <> "\" " <> toLogStr (show (statusCode status)) <> " " <> toLogStr (maybe "-" show msize) <> " \"" <> toLogStr (fromMaybe "" mr) <> "\" \"" <> toLogStr (fromMaybe "" mua) <> "\"\n" where #if !MIN_VERSION_base(4,5,0) (<>) = mappend #endif #if MIN_VERSION_wai(3,2,0) mr = requestHeaderReferer req mua = requestHeaderUserAgent req #else mr = lookup "referer" $ requestHeaders req mua = lookup "user-agent" $ requestHeaders req #endif -- | HTTP/2 Push log format in the Apache style. serverpushLogStr :: IPAddrSource -> FormattedTime -> Request -> ByteString -> Integer -> LogStr serverpushLogStr ipsrc tmstr req path size = toLogStr (getSourceIP ipsrc 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 = getSourceIP fromString fromByteString getSourceIP :: IPAddrSource -> Request -> ByteString getSourceIP FromSocket = getSourceFromSocket getSourceIP FromHeader = getSourceFromHeader getSourceIP FromFallback = getSourceFromFallback -- | -- >>> getSourceFromSocket defaultRequest -- "0.0.0.0" getSourceFromSocket :: Request -> ByteString getSourceFromSocket = BS.pack . showSockAddr . remoteHost -- | -- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } -- "127.0.0.1" -- >>> 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 :: Request -> ByteString getSourceFromHeader = fromMaybe "" . getSource -- | -- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } -- "127.0.0.1" -- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } -- "127.0.0.1" -- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] } -- "0.0.0.0" -- >>> getSourceFromFallback defaultRequest { requestHeaders = [] } -- "0.0.0.0" getSourceFromFallback :: Request -> ByteString getSourceFromFallback req = fromMaybe (getSourceFromSocket req) $ getSource req -- | -- >>> getSource defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } -- Just "127.0.0.1" -- >>> getSource defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } -- Just "127.0.0.1" -- >>> getSource defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] } -- Nothing -- >>> getSource defaultRequest -- Nothing getSource :: Request -> Maybe ByteString getSource req = addr where maddr = find (\x -> fst x `elem` ["x-real-ip", "x-forwarded-for"]) hdrs addr = fmap snd maddr hdrs = requestHeaders req wai-logger-2.3.0/Network/Wai/Logger/IORef.hs0000644000000000000000000000065412736407710016643 0ustar0000000000000000{-# LANGUAGE CPP #-} module Network.Wai.Logger.IORef ( IORef , newIORef , readIORef , writeIORef , atomicModifyIORef' ) where import Data.IORef #if !MIN_VERSION_base(4, 6, 0) atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef' ref f = do b <- atomicModifyIORef ref (\x -> let (a, b) = f x in (a, a `seq` b)) b `seq` return b #endif wai-logger-2.3.0/Network/Wai/Logger/IP.hs0000644000000000000000000000332712736407710016207 0ustar0000000000000000module Network.Wai.Logger.IP ( NumericAddress, showSockAddr ) where import Data.Bits (shift, (.&.)) import Data.Word (Word32) import Network.Socket (SockAddr(..)) import System.ByteOrder (ByteOrder(..), byteOrder) import Text.Printf (printf) -- | A type for IP address in numeric string representation. type NumericAddress = String showIPv4 :: Word32 -> Bool -> NumericAddress showIPv4 w32 little | little = show b1 ++ "." ++ show b2 ++ "." ++ show b3 ++ "." ++ show b4 | otherwise = show b4 ++ "." ++ show b3 ++ "." ++ show b2 ++ "." ++ show b1 where t1 = w32 t2 = shift t1 (-8) t3 = shift t2 (-8) t4 = shift t3 (-8) b1 = t1 .&. 0x000000ff b2 = t2 .&. 0x000000ff b3 = t3 .&. 0x000000ff b4 = t4 .&. 0x000000ff 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) 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) -- 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 _ = "unknownSocket" wai-logger-2.3.0/test/0000755000000000000000000000000012736407710012725 5ustar0000000000000000wai-logger-2.3.0/test/doctests.hs0000644000000000000000000000012112736407710015103 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["Network"]