wai-logger 0.0.2 → 0.1.0
raw patch · 9 files changed
+24/−348 lines, 9 filesdep +fast-loggerdep −deepseqdep −directorydep −filepath
Dependencies added: fast-logger
Dependencies removed: deepseq, directory, filepath
Files
- Network/Wai/Logger.hs +8/−13
- Network/Wai/Logger/File.hs +0/−42
- Network/Wai/Logger/Format.hs +11/−11
- Network/Wai/Logger/IO.hs +0/−94
- Network/Wai/Logger/Prefork.hs +0/−41
- Network/Wai/Logger/Prefork/File.hs +0/−96
- Network/Wai/Logger/Prefork/Stdout.hs +0/−22
- Network/Wai/Logger/Prefork/Types.hs +0/−17
- wai-logger.cabal +5/−12
Network/Wai/Logger.hs view
@@ -6,6 +6,7 @@ -- -- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where+-- > -- > import Blaze.ByteString.Builder (fromByteString) -- > import Control.Monad.IO.Class (liftIO) -- > import Data.ByteString.Char8@@ -14,6 +15,7 @@ -- > import Network.Wai.Handler.Warp -- > import Network.Wai.Logger -- > import System.IO+-- > import System.Log.FastLogger -- > -- > main :: IO () -- > main = do@@ -25,27 +27,20 @@ -- > date <- liftIO $ getDate dref -- > let status = status200 -- > len = 4--- > liftIO $ hPutLogStr stdout $ apacheFormat date req status (Just len)+-- > liftIO $ hPutLogStr stdout $ apacheFormat FromSocket date req status (Just len) -- > liftIO $ hFlush stdout -- > return $ ResponseBuilder status--- > [("Content-Type", "text/plain")--- > ,("Content-Length", pack (show len))]--- > $ fromByteString "PONG"+-- > [("Content-Type", "text/plain")+-- > ,("Content-Length", pack (show len))]+-- > $ fromByteString "PONG" module Network.Wai.Logger (- -- * Low level modules- module Network.Wai.Logger.Date- , module Network.Wai.Logger.File- , module Network.Wai.Logger.Format+ module Network.Wai.Logger.Format+ , module Network.Wai.Logger.Date , module Network.Wai.Logger.Utils- , module Network.Wai.Logger.IO- -- * High level modules- -- | See "Network.Wai.Logger.Prefork". ) where import Network.Wai.Logger.Date-import Network.Wai.Logger.File import Network.Wai.Logger.Format-import Network.Wai.Logger.IO import Network.Wai.Logger.Utils
− Network/Wai/Logger/File.hs
@@ -1,42 +0,0 @@-module Network.Wai.Logger.File where--import Control.Monad-import System.Directory-import System.FilePath---- | The spec for logging files-data FileLogSpec = FileLogSpec {- log_file :: String- , log_file_size :: Integer- , log_backup_number :: Int- }---- | Checking if a log file can be written.-check :: FileLogSpec -> IO ()-check spec = do- dirExist <- doesDirectoryExist dir- unless dirExist $ fail $ dir ++ " does not exist or is not a directory."- dirPerm <- getPermissions dir- unless (writable dirPerm) $ fail $ dir ++ " is not writable."- exist <- doesFileExist file- when exist $ do- perm <- getPermissions file- unless (writable perm) $ fail $ file ++ " is not writable."- where- file = log_file spec- dir = takeDirectory file---- | Rotating log files.-rotate :: FileLogSpec -> IO ()-rotate spec = mapM_ move srcdsts- where- path = log_file spec- n = log_backup_number spec- dsts' = reverse . ("":) . map (('.':). show) $ [0..n-1]- dsts = map (path++) dsts'- srcs = tail dsts- srcdsts = zip srcs dsts- move (src,dst) = do- exist <- doesFileExist src- when exist $ renameFile src dst-
Network/Wai/Logger/Format.hs view
@@ -11,13 +11,14 @@ import Blaze.ByteString.Builder.Char8 import Data.ByteString.Char8 () import Data.CaseInsensitive+import Data.List import Data.Maybe import Data.Monoid import Network.HTTP.Types import Network.Wai import Network.Wai.Logger.Date-import Network.Wai.Logger.IO import Network.Wai.Logger.Utils+import System.Log.FastLogger {-| Source from which the IP source address of the client is obtained. -}@@ -82,17 +83,16 @@ lookupRequestField' k req = fromMaybe "" . lookup k $ requestHeaders req getSourceIP :: IPAddrSource -> Request -> LogStr-getSourceIP FromSocket req = LS $ showSockAddr (remoteHost req)-getSourceIP FromHeader req = LB addr- where- maddr = lookup "x-real-ip" hdrs >> lookup "x-forwarded-for" hdrs- addr = fromMaybe "" maddr- hdrs = requestHeaders req+getSourceIP FromSocket = LS . showSockAddr . remoteHost+getSourceIP FromHeader = LB . getSource getSourceIP' :: IPAddrSource -> Request -> Builder-getSourceIP' FromSocket req = fromString . showSockAddr . remoteHost $ req-getSourceIP' FromHeader req = fromByteString addr+getSourceIP' FromSocket = fromString . showSockAddr . remoteHost+getSourceIP' FromHeader = fromByteString . getSource++getSource :: Request -> Ascii+getSource req = addr where- maddr = lookup "x-real-ip" hdrs >> lookup "x-forwarded-for" hdrs- addr = fromMaybe "" maddr+ maddr = find (\x -> fst x `elem` ["x-real-ip", "x-forwarded-for"]) hdrs+ addr = maybe "" snd maddr hdrs = requestHeaders req
− Network/Wai/Logger/IO.hs
@@ -1,94 +0,0 @@-{-# LANGUAGE DoAndIfThenElse, BangPatterns #-}-{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-}--module Network.Wai.Logger.IO (- LogStr(..)- , hPutLogStr- -- * Builder- , initHandle, hPutBuilder- ) where--import Blaze.ByteString.Builder-import qualified Data.ByteString as BS-import Data.ByteString.Internal (ByteString(..), c2w)-import Data.List-import Data.Maybe-import Foreign-import GHC.Base-import GHC.IO.Buffer-import qualified GHC.IO.BufferedIO as Buffered-import GHC.IO.Handle.Internals-import GHC.IO.Handle.Text-import GHC.IO.Handle.Types-import GHC.IORef-import GHC.Num-import GHC.Real-import System.IO--{-| A date type to contain 'String' and 'ByteString'.- This data is exported so that format can be defined.- This would be replaced with 'Builder' someday.--}-data LogStr = LS !String | LB !ByteString--{-| The 'hPut' function to copy a list of 'LogStr' to the buffer- of 'Handle' directly.- If 'Handle' is associated with a file, 'AppendMode' must be used.--}-hPutLogStr :: Handle -> [LogStr] -> IO ()-hPutLogStr handle bss =- wantWritableHandle "hPutLogStr" handle $ \h_ -> bufsWrite h_ bss--bufsWrite :: Handle__-> [LogStr] -> IO ()-bufsWrite h_@Handle__{..} bss = do- old_buf@Buffer{- bufRaw = old_raw- , bufR = w- , bufSize = size- } <- readIORef haByteBuffer- if size - w > len then do- withRawBuffer old_raw $ \ptr ->- go (ptr `plusPtr` w) bss- writeIORef haByteBuffer old_buf{ bufR = w + len }- else do- old_buf' <- Buffered.flushWriteBuffer haDevice old_buf- writeIORef haByteBuffer old_buf'- bufsWrite h_ bss- where- len = foldl' (\x y -> x + getLength y) 0 bss- getLength (LB s) = BS.length s- getLength (LS s) = length s- go :: Ptr Word8 -> [LogStr] -> IO ()- go _ [] = return ()- go dst (LB b:bs) = do- dst' <- copy dst b- go dst' bs- go dst (LS s:ss) = do- dst' <- copy' dst s- go dst' ss--copy :: Ptr Word8 -> ByteString -> IO (Ptr Word8)-copy dst (PS ptr off len) = withForeignPtr ptr $ \s -> do- let src = s `plusPtr` off- memcpy dst src (fromIntegral len)- return (dst `plusPtr` len)--copy' :: Ptr Word8 -> String -> IO (Ptr Word8)-copy' dst [] = return dst-copy' dst (x:xs) = do- poke dst (c2w x)- copy' (dst `plusPtr` 1) xs--{-| Setting a proper buffering to 'Handle'.--}-initHandle :: Handle -> IO ()-initHandle hdl = hSetBuffering hdl (BlockBuffering (Just 4096))--{-| The 'hPut' function directory to copy 'Builder' to the buffer.- If 'Handle' is associated with a file, 'AppendMode' must be used.- The current implementation is inefficient at this moment.- 'initHandle' must be called once beforehand if this function is used.- This would replace 'hPutLogStr' someday.--}-hPutBuilder :: Handle -> Builder -> IO ()-hPutBuilder hdl = BS.hPut hdl . toByteString
− Network/Wai/Logger/Prefork.hs
@@ -1,41 +0,0 @@-module Network.Wai.Logger.Prefork (- logCheck- , logInit- , logController- , ApacheLogger- , LogType(..)- , IPAddrSource(..)- , FileLogSpec(..)- , LogController- ) where--import Control.Concurrent-import Control.Monad-import Network.Wai.Logger.File-import Network.Wai.Logger.Format-import Network.Wai.Logger.Prefork.File-import Network.Wai.Logger.Prefork.Stdout-import Network.Wai.Logger.Prefork.Types--logCheck :: LogType -> IO ()-logCheck LogNone = return ()-logCheck LogStdout = return ()-logCheck (LogFile spec) = check spec--logInit :: IPAddrSource -> LogType -> IO ApacheLogger-logInit _ LogNone = noLoggerInit-logInit ipsrc LogStdout = stdoutLoggerInit ipsrc-logInit ipsrc (LogFile spec) = fileLoggerInit ipsrc spec--noLoggerInit :: IO ApacheLogger-noLoggerInit = return noLogger- where- noLogger _ _ _ = return ()--logController :: LogType -> LogController-logController LogNone = noLoggerController-logController LogStdout = noLoggerController-logController (LogFile spec) = fileLoggerController spec--noLoggerController :: LogController-noLoggerController _ = forever $ threadDelay 10000000
− Network/Wai/Logger/Prefork/File.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE DoAndIfThenElse #-}--module Network.Wai.Logger.Prefork.File where--import Control.Applicative-import Control.Concurrent-import Control.Exception (handle, SomeException, catch)-import Control.Monad-import Data.IORef-import Network.Wai.Logger.Date-import Network.Wai.Logger.File-import Network.Wai.Logger.Format-import Network.Wai.Logger.IO-import Network.Wai.Logger.Prefork.Types-import Prelude hiding (catch)-import System.IO-import System.Posix--------------------------------------------------------------------logBufSize :: Int-logBufSize = 4096--------------------------------------------------------------------newtype HandleRef = HandleRef (IORef Handle)--getHandle :: HandleRef -> IO Handle-getHandle (HandleRef ref) = readIORef ref--------------------------------------------------------------------fileLoggerInit :: IPAddrSource -> FileLogSpec -> IO ApacheLogger-fileLoggerInit ipsrc spec = do- hdl <- open spec- hdlref <- HandleRef <$> newIORef hdl- forkIO $ fileFlusher hdlref- dateref <- dateInit- installHandler sigUSR1 (Catch $ reopen spec hdlref) Nothing- return $ fileLogger ipsrc dateref hdlref--{-- For BlockBuffering, hPut flushes the buffer before writing- the target string. In other words, hPut does not split- the target string. So, to implment multiple line buffering,- just use BlockBuffering.--}-open :: FileLogSpec -> IO Handle-open spec = do- hdl <- openFile file AppendMode- hSetBuffering hdl (BlockBuffering (Just logBufSize))- return hdl- where- file = log_file spec--reopen :: FileLogSpec -> HandleRef -> IO ()-reopen spec (HandleRef ref) = do- hdl <- open spec- oldhdl <- atomicModifyIORef ref (\oh -> (hdl,oh))- hClose oldhdl--------------------------------------------------------------------fileLogger :: IPAddrSource -> DateRef -> HandleRef -> ApacheLogger-fileLogger ipsrc dateref hdlref req status msiz = do- date <- getDate dateref- hdl <- getHandle hdlref- hPutLogStr hdl $ apacheFormat ipsrc date req status msiz--fileFlusher :: HandleRef -> IO ()-fileFlusher hdlref = forever $ do- threadDelay 10000000- getHandle hdlref >>= hFlush--------------------------------------------------------------------fileLoggerController :: FileLogSpec -> LogController-fileLoggerController spec pids = forever $ do- isOver <- over- when isOver $ do- rotate spec- mapM_ sendSignal pids- threadDelay 10000000- where- file = log_file spec- over = handle handler $ do- siz <- fromIntegral . fileSize <$> getFileStatus file- if siz > log_file_size spec then- return True- else- return False- sendSignal pid = signalProcess sigUSR1 pid `catch` ignore- handler :: SomeException -> IO Bool- handler _ = return False- ignore :: SomeException -> IO ()- ignore _ = return ()
− Network/Wai/Logger/Prefork/Stdout.hs
@@ -1,22 +0,0 @@-module Network.Wai.Logger.Prefork.Stdout (stdoutLoggerInit) where--import Control.Applicative-import Data.ByteString.Char8 (pack)-import Network.Wai.Logger.Date-import Network.Wai.Logger.Format-import Network.Wai.Logger.IO-import Network.Wai.Logger.Prefork.Types-import qualified Data.ByteString as BS--stdoutLoggerInit :: IPAddrSource -> IO ApacheLogger-stdoutLoggerInit ipsrc = stdoutLogger ipsrc <$> dateInit--stdoutLogger :: IPAddrSource -> DateRef -> ApacheLogger-stdoutLogger ipsrc dateref req status msiz = do- date <- getDate dateref- putToStdout $ logmsg date- where- putToStdout = BS.putStr . BS.concat . map toBS- logmsg date = apacheFormat ipsrc date req status msiz- toBS (LS s) = pack s- toBS (LB s) = s
− Network/Wai/Logger/Prefork/Types.hs
@@ -1,17 +0,0 @@-module Network.Wai.Logger.Prefork.Types (- ApacheLogger- , FileLogSpec(..)- , LogType(..)- , LogController- ) where--import Network.HTTP.Types-import Network.Wai-import Network.Wai.Logger.File-import System.Posix (ProcessID)--data LogType = LogNone | LogStdout | LogFile FileLogSpec--type ApacheLogger = Request -> Status -> Maybe Integer -> IO ()--type LogController = [ProcessID] -> IO ()
wai-logger.cabal view
@@ -1,5 +1,5 @@ Name: wai-logger-Version: 0.0.2+Version: 0.1.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -13,19 +13,12 @@ GHC-Options: -Wall -fno-warn-unused-do-bind Exposed-Modules: Network.Wai.Logger Network.Wai.Logger.Date- Network.Wai.Logger.File Network.Wai.Logger.Format- Network.Wai.Logger.IO Network.Wai.Logger.Utils- Network.Wai.Logger.Prefork- Other-Modules: Network.Wai.Logger.Prefork.File- Network.Wai.Logger.Prefork.Stdout- Network.Wai.Logger.Prefork.Types- Build-Depends: base >= 4 && < 5, wai,- http-types, bytestring, filepath,- directory, old-locale, case-insensitive,- time, deepseq, unix, byteorder, network,- blaze-builder+ Build-Depends: base >= 4 && < 5, time, old-locale,+ unix, bytestring, blaze-builder,+ wai, fast-logger, http-types, case-insensitive,+ network, byteorder Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/wai-logger.git