1{-# LANGUAGE OverloadedStrings, CPP #-} 2 3module Network.Wai.Logger.Apache ( 4 IPAddrSource(..) 5 , apacheLogStr 6 , serverpushLogStr 7 ) where 8 9#ifndef MIN_VERSION_base 10#define MIN_VERSION_base(x,y,z) 1 11#endif 12#ifndef MIN_VERSION_wai 13#define MIN_VERSION_wai(x,y,z) 1 14#endif 15 16import Data.ByteString.Char8 (ByteString) 17import qualified Data.ByteString.Char8 as BS 18import Data.List (find) 19import Data.Maybe (fromMaybe) 20#if MIN_VERSION_base(4,5,0) 21import Data.Monoid ((<>)) 22#else 23import Data.Monoid (mappend) 24#endif 25import Network.HTTP.Types (Status, statusCode) 26import Network.Wai (Request(..)) 27import Network.Wai.Logger.IP 28import System.Log.FastLogger 29 30-- $setup 31-- >>> :set -XOverloadedStrings 32-- >>> import Network.Wai (defaultRequest) 33 34-- | Source from which the IP source address of the client is obtained. 35data IPAddrSource = 36 -- | From the peer address of the HTTP connection. 37 FromSocket 38 -- | From X-Real-IP: or X-Forwarded-For: in the HTTP header. 39 | FromHeader 40 -- | From the peer address if header is not found. 41 | FromFallback 42 43-- | Apache style log format. 44apacheLogStr :: IPAddrSource -> FormattedTime -> Request -> Status -> Maybe Integer -> LogStr 45apacheLogStr ipsrc tmstr req status msize = 46 toLogStr (getSourceIP ipsrc req) 47 <> " - - [" 48 <> toLogStr tmstr 49 <> "] \"" 50 <> toLogStr (requestMethod req) 51 <> " " 52 <> toLogStr path 53 <> " " 54 <> toLogStr (show (httpVersion req)) 55 <> "\" " 56 <> toLogStr (show (statusCode status)) 57 <> " " 58 <> toLogStr (maybe "-" show msize) 59 <> " \"" 60 <> toLogStr (fromMaybe "" mr) 61 <> "\" \"" 62 <> toLogStr (fromMaybe "" mua) 63 <> "\"\n" 64 where 65 path = rawPathInfo req <> rawQueryString req 66#if !MIN_VERSION_base(4,5,0) 67 (<>) = mappend 68#endif 69#if MIN_VERSION_wai(3,2,0) 70 mr = requestHeaderReferer req 71 mua = requestHeaderUserAgent req 72#else 73 mr = lookup "referer" $ requestHeaders req 74 mua = lookup "user-agent" $ requestHeaders req 75#endif 76 77-- | HTTP/2 Push log format in the Apache style. 78serverpushLogStr :: IPAddrSource -> FormattedTime -> Request -> ByteString -> Integer -> LogStr 79serverpushLogStr ipsrc tmstr req path size = 80 toLogStr (getSourceIP ipsrc req) 81 <> " - - [" 82 <> toLogStr tmstr 83 <> "] \"PUSH " 84 <> toLogStr path 85 <> " HTTP/2\" 200 " 86 <> toLogStr (show size) 87 <> " \"" 88 <> toLogStr ref 89 <> "\" \"" 90 <> toLogStr (fromMaybe "" mua) 91 <> "\"\n" 92 where 93 ref = rawPathInfo req 94#if !MIN_VERSION_base(4,5,0) 95 (<>) = mappend 96#endif 97#if MIN_VERSION_wai(3,2,0) 98 mua = requestHeaderUserAgent req 99#else 100 mua = lookup "user-agent" $ requestHeaders req 101#endif 102 103-- getSourceIP = getSourceIP fromString fromByteString 104 105getSourceIP :: IPAddrSource -> Request -> ByteString 106getSourceIP FromSocket = getSourceFromSocket 107getSourceIP FromHeader = getSourceFromHeader 108getSourceIP FromFallback = getSourceFromFallback 109 110-- | 111-- >>> getSourceFromSocket defaultRequest 112-- "0.0.0.0" 113getSourceFromSocket :: Request -> ByteString 114getSourceFromSocket = BS.pack . showSockAddr . remoteHost 115 116-- | 117-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } 118-- "127.0.0.1" 119-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } 120-- "127.0.0.1" 121-- >>> getSourceFromHeader defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] } 122-- "" 123-- >>> getSourceFromHeader defaultRequest { requestHeaders = [] } 124-- "" 125getSourceFromHeader :: Request -> ByteString 126getSourceFromHeader = fromMaybe "" . getSource 127 128-- | 129-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } 130-- "127.0.0.1" 131-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } 132-- "127.0.0.1" 133-- >>> getSourceFromFallback defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] } 134-- "0.0.0.0" 135-- >>> getSourceFromFallback defaultRequest { requestHeaders = [] } 136-- "0.0.0.0" 137getSourceFromFallback :: Request -> ByteString 138getSourceFromFallback req = fromMaybe (getSourceFromSocket req) $ getSource req 139 140-- | 141-- >>> getSource defaultRequest { requestHeaders = [ ("X-Real-IP", "127.0.0.1") ] } 142-- Just "127.0.0.1" 143-- >>> getSource defaultRequest { requestHeaders = [ ("X-Forwarded-For", "127.0.0.1") ] } 144-- Just "127.0.0.1" 145-- >>> getSource defaultRequest { requestHeaders = [ ("Something", "127.0.0.1") ] } 146-- Nothing 147-- >>> getSource defaultRequest 148-- Nothing 149getSource :: Request -> Maybe ByteString 150getSource req = addr 151 where 152 maddr = find (\x -> fst x `elem` ["x-real-ip", "x-forwarded-for"]) hdrs 153 addr = fmap snd maddr 154 hdrs = requestHeaders req 155