wai-logger-2.2.4.1/0000755000000000000000000000000012535456646012121 5ustar0000000000000000wai-logger-2.2.4.1/LICENSE0000644000000000000000000000276512535456646013140 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.2.4.1/Setup.hs0000644000000000000000000000005612535456646013556 0ustar0000000000000000import Distribution.Simple main = defaultMain wai-logger-2.2.4.1/wai-logger.cabal0000644000000000000000000000327512535456646015151 0ustar0000000000000000Name: wai-logger Version: 2.2.4.1 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.Date Network.Wai.Logger.IP Network.Wai.Logger.IORef Build-Depends: base >= 4 && < 5 , auto-update , blaze-builder , byteorder , bytestring , case-insensitive , easy-file >= 0.2 , fast-logger >= 2.2 , 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 Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/logger.git wai-logger-2.2.4.1/Network/0000755000000000000000000000000012535456646013552 5ustar0000000000000000wai-logger-2.2.4.1/Network/Wai/0000755000000000000000000000000012535456646014272 5ustar0000000000000000wai-logger-2.2.4.1/Network/Wai/Logger.hs0000644000000000000000000001766312535456646016062 0ustar0000000000000000-- | 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 -- * Creating a logger , ApacheLoggerActions(..) , initLogger -- * Types , IPAddrSource(..) , LogType(..) , FileLogSpec(..) -- * Date cacher , clockDateCacher , ZonedDate , DateCacheGetter , DateCacheUpdater -- * Utilities , logCheck , showSockAddr ) where import Control.Applicative ((<$>)) import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction) import Control.Concurrent (MVar, newMVar, tryTakeMVar, putMVar) import Control.Exception (handle, SomeException(..), bracket) import Control.Monad (when, void) import Network.HTTP.Types (Status) import Network.Wai (Request) import System.EasyFile (getFileSize) import System.Log.FastLogger import Network.Wai.Logger.Apache import Network.Wai.Logger.Date import Network.Wai.Logger.IORef 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 (getter, _updater) <- clockDateCacher apf <- initLogger FromFallback (LogStdout 4096) getter let aplogger = apacheLogger apf remover = logRemover apf return (aplogger, remover) teardown (_, remover) = void remover ---------------------------------------------------------------- -- | Apache style logger. type ApacheLogger = Request -> Status -> Maybe Integer -> IO () data ApacheLoggerActions = ApacheLoggerActions { apacheLogger :: ApacheLogger -- | This is obsoleted. Rotation is done on-demand. -- So, this is now an empty action. , logRotator :: IO () -- | Removing resources relating Apache logger. -- E.g. flushing and deallocating internal buffers. , logRemover :: IO () } -- | Logger Type. data LogType = LogNone -- ^ No logging. | LogStdout BufSize -- ^ Logging to stdout. -- 'BufSize' is a buffer size -- for each capability. | LogFile FileLogSpec BufSize -- ^ Logging to a file. -- 'BufSize' is a buffer size -- for each capability. -- File rotation is done on-demand. | LogCallback (LogStr -> IO ()) (IO ()) ---------------------------------------------------------------- -- | -- Creating 'ApacheLogger' according to 'LogType'. initLogger :: IPAddrSource -> LogType -> DateCacheGetter -> IO ApacheLoggerActions initLogger _ LogNone _ = noLoggerInit initLogger ipsrc (LogStdout size) dateget = stdoutLoggerInit ipsrc size dateget initLogger ipsrc (LogFile spec size) dateget = fileLoggerInit ipsrc spec size dateget initLogger ipsrc (LogCallback cb flush) dateget = callbackLoggerInit ipsrc cb flush dateget ---------------------------------------------------------------- noLoggerInit :: IO ApacheLoggerActions noLoggerInit = return ApacheLoggerActions { apacheLogger = noLogger , logRotator = noRotator , logRemover = noRemover } where noLogger _ _ _ = return () noRotator = return () noRemover = return () stdoutLoggerInit :: IPAddrSource -> BufSize -> DateCacheGetter -> IO ApacheLoggerActions stdoutLoggerInit ipsrc size dateget = do lgrset <- newStdoutLoggerSet size let logger = apache (pushLogStr lgrset) ipsrc dateget noRotator = return () remover = rmLoggerSet lgrset return ApacheLoggerActions { apacheLogger = logger , logRotator = noRotator , logRemover = remover } fileLoggerInit :: IPAddrSource -> FileLogSpec -> BufSize -> DateCacheGetter -> IO ApacheLoggerActions fileLoggerInit ipsrc spec size dateget = do lgrset <- newFileLoggerSet size $ log_file spec ref <- newIORef (0 :: Int) mvar <- newMVar () let logger a b c = do cnt <- decrease ref apache (pushLogStr lgrset) ipsrc dateget a b c when (cnt <= 0) $ tryRotate lgrset spec ref mvar noRotator = return () remover = rmLoggerSet lgrset return ApacheLoggerActions { apacheLogger = logger , logRotator = noRotator , logRemover = remover } decrease :: IORef Int -> IO Int decrease ref = atomicModifyIORef' ref (\x -> (x - 1, x - 1)) callbackLoggerInit :: IPAddrSource -> (LogStr -> IO ()) -> IO () -> DateCacheGetter -> IO ApacheLoggerActions callbackLoggerInit ipsrc cb flush dateget = do flush' <- mkAutoUpdate defaultUpdateSettings { updateAction = flush } let logger a b c = apache cb ipsrc dateget a b c >> flush' noRotator = return () remover = return () return ApacheLoggerActions { apacheLogger = logger , logRotator = noRotator , logRemover = remover } ---------------------------------------------------------------- apache :: (LogStr -> IO ()) -> IPAddrSource -> DateCacheGetter -> ApacheLogger apache cb ipsrc dateget req st mlen = do zdata <- dateget cb (apacheLogStr ipsrc zdata req st mlen) ---------------------------------------------------------------- tryRotate :: LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO () tryRotate lgrset spec ref mvar = bracket lock unlock rotateFiles where lock = tryTakeMVar mvar unlock Nothing = return () unlock _ = putMVar mvar () rotateFiles Nothing = return () rotateFiles _ = do msiz <- getSize case msiz of -- A file is not available. -- So, let's set a big value to the counter so that -- this function is not called frequently. Nothing -> writeIORef ref 1000000 Just siz | siz > limit -> do rotate spec renewLoggerSet lgrset writeIORef ref $ estimate limit | otherwise -> do writeIORef ref $ estimate (limit - siz) file = log_file spec limit = log_file_size spec getSize = handle (\(SomeException _) -> return Nothing) $ do -- The log file is locked by GHC. -- We need to get its file size by the way not using locks. Just . fromIntegral <$> getFileSize file -- 200 is an ad-hoc value for the length of log line. estimate x = fromInteger (x `div` 200) ---------------------------------------------------------------- -- | -- Checking if a log file can be written if 'LogType' is 'LogFile'. logCheck :: LogType -> IO () logCheck LogNone = return () logCheck (LogStdout _) = return () logCheck (LogFile spec _) = check spec logCheck (LogCallback _ _) = return () wai-logger-2.2.4.1/Network/Wai/Logger/0000755000000000000000000000000012535456646015511 5ustar0000000000000000wai-logger-2.2.4.1/Network/Wai/Logger/Apache.hs0000644000000000000000000000740512535456646017234 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, CPP #-} module Network.Wai.Logger.Apache ( IPAddrSource(..) , apacheLogStr ) where #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS import Data.CaseInsensitive (CI) 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.Date 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 -> ZonedDate -> 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 (lookupRequestField' "referer" req) <> "\" \"" <> toLogStr (lookupRequestField' "user-agent" req) <> "\"\n" where #if !MIN_VERSION_base(4,5,0) (<>) = mappend #endif lookupRequestField' :: CI ByteString -> Request -> ByteString lookupRequestField' k req = fromMaybe "" . lookup k $ requestHeaders req -- 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.2.4.1/Network/Wai/Logger/Date.hs0000644000000000000000000000515612535456646016731 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} -- | -- Formatting time is slow. -- This package provides mechanisms to cache formatted date. module Network.Wai.Logger.Date ( -- * Types DateCacheGetter , DateCacheUpdater , ZonedDate -- * Cache configuration , DateCacheConf(..) , zonedDateCacheConf -- * Date cacher , clockDateCacher ) where import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction) import Data.ByteString (ByteString) #if WINDOWS import qualified Data.ByteString.Char8 as BS import Data.Time (UTCTime, formatTime, getCurrentTime, utcToLocalZonedTime) # if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale) # else import System.Locale (defaultTimeLocale) # endif #else import Data.UnixTime (formatUnixTime, fromEpochTime) import System.Posix (EpochTime, epochTime) #endif ---------------------------------------------------------------- -- | 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 = ByteString ---------------------------------------------------------------- data DateCacheConf t = DateCacheConf { -- | A function to get a time. E.g 'epochTime' and 'getCurrentTime'. getTime :: IO t -- | A function to format a time. , formatDate :: t -> IO ByteString } #if WINDOWS -- | Zoned date cacher using UTC. zonedDateCacheConf :: DateCacheConf UTCTime zonedDateCacheConf = DateCacheConf { getTime = getCurrentTime , formatDate = \ut -> do zt <- utcToLocalZonedTime ut return $ BS.pack $ formatTime defaultTimeLocale "%d/%b/%Y:%T %z" zt } #else -- | Zoned date cacher using UnixTime. zonedDateCacheConf :: DateCacheConf EpochTime zonedDateCacheConf = DateCacheConf { getTime = epochTime , formatDate = formatUnixTime "%d/%b/%Y:%T %z" . fromEpochTime } #endif ---------------------------------------------------------------- -- | -- 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 getter <- mkAutoUpdate defaultUpdateSettings { updateAction = getTime zonedDateCacheConf >>= formatDate zonedDateCacheConf } return (getter, return ()) wai-logger-2.2.4.1/Network/Wai/Logger/IORef.hs0000644000000000000000000000065412535456646017016 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.2.4.1/Network/Wai/Logger/IP.hs0000644000000000000000000000332712535456646016362 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.2.4.1/test/0000755000000000000000000000000012535456646013100 5ustar0000000000000000wai-logger-2.2.4.1/test/doctests.hs0000644000000000000000000000030412535456646015261 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest [ "-idist/build/autogen/" , "-optP-include" , "-optPdist/build/autogen/cabal_macros.h" , "Network/Wai/Logger.hs" ]