mighttpd2 2.3.0 → 2.3.1
raw patch · 12 files changed
+8/−356 lines, 12 filesdep +deepseqdep +wai-logger
Dependencies added: deepseq, wai-logger
Files
- Log.hs +0/−35
- Log/Apache.hs +0/−34
- Log/Check.hs +0/−22
- Log/Date.hs +0/−32
- Log/File.hs +0/−96
- Log/Hput.hs +0/−63
- Log/Rotate.hs +0/−18
- Log/Stdout.hs +0/−19
- Log/Types.hs +0/−23
- Mighty.hs +5/−2
- Types.hs +1/−1
- mighttpd2.cabal +2/−11
− Log.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Log (- logInit- , logController- , logCheck- , module Log.Types- ) where--import Control.Concurrent-import Control.Monad-import Log.Check-import Log.File-import Log.Stdout-import Log.Types--------------------------------------------------------------------logInit :: LogType -> IO Logger-logInit LogNone = noLoggerInit-logInit LogStdout = stdoutLoggerInit-logInit (LogFile spec) = fileLoggerInit spec--noLoggerInit :: IO Logger-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
− Log/Apache.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Log.Apache where--import Data.ByteString (ByteString)-import Data.ByteString.Char8 ()-import Network.HTTP.Types-import Network.Wai-import Network.Wai.Application.Classic-import Log.Types--apacheFormat :: ByteString -> Request -> Status -> Maybe Integer -> [LogStr]-apacheFormat tmstr req st msize = [- LS addr- , LB " - - ["- , LB tmstr- , LB "] \""- , LB $ requestMethod req- , LB " "- , LB $ rawPathInfo req- , LB " "- , LS $ show . httpVersion $ req- , LB "\" "- , LS . show . statusCode $ st- , LB " "- , LS $ maybe "-" show msize- , LB " \""- , LB $ lookupRequestField' "referer" req- , LB "\" \""- , LB $ lookupRequestField' "user-agent" req- , LB "\"\n"- ]- where- addr = showSockAddr (remoteHost req)
− Log/Check.hs
@@ -1,22 +0,0 @@-module Log.Check (logCheck) where--import Control.Monad-import Log.Types-import System.Directory-import System.FilePath--logCheck :: LogType -> IO ()-logCheck LogNone = return ()-logCheck LogStdout = return ()-logCheck (LogFile 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
− Log/Date.hs
@@ -1,32 +0,0 @@-module Log.Date (dateInit, getDate, DateRef) where--import Control.Applicative-import Control.Concurrent-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS-import Data.IORef-import Data.Time-import System.Locale--newtype DateRef = DateRef (IORef ByteString)--getDate :: DateRef -> IO ByteString-getDate (DateRef ref) = readIORef ref--dateInit :: IO DateRef-dateInit = do- ref <- formatDate >>= newIORef- let dateref = DateRef ref- forkIO $ date dateref- return dateref--date :: DateRef -> IO ()-date dateref@(DateRef ref) = do- tmstr <- formatDate- atomicModifyIORef ref (\_ -> (tmstr, ()))- threadDelay 1000000- date dateref--formatDate :: IO ByteString-formatDate =- BS.pack . formatTime defaultTimeLocale "%d/%b/%Y:%T %z" <$> getZonedTime
− Log/File.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE DoAndIfThenElse #-}--module Log.File where--import Control.Applicative-import Control.Concurrent-import Control.Exception (handle, SomeException, catch)-import Control.Monad-import Data.IORef-import Log.Apache-import Log.Date-import Log.Hput-import Log.Rotate-import Log.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 :: FileLogSpec -> IO Logger-fileLoggerInit spec = do- hdl <- open spec- hdlref <- HandleRef <$> newIORef hdl- forkIO $ fileFlusher hdlref- dateref <- dateInit- installHandler sigUSR1 (Catch $ reopen spec hdlref) Nothing- return $ fileLogger 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 :: DateRef -> HandleRef -> Logger-fileLogger dateref hdlref req status msiz = do- date <- getDate dateref- hdl <- getHandle hdlref- hPutByteStrings hdl $ apacheFormat 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 ()
− Log/Hput.hs
@@ -1,63 +0,0 @@-{-# LANGUAGE DoAndIfThenElse, BangPatterns #-}-{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-}--module Log.Hput (hPutByteStrings) where--import qualified Data.ByteString as BS-import Data.ByteString.Internal (ByteString(..), c2w)-import Data.List-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 Log.Types--hPutByteStrings :: Handle -> [LogStr] -> IO ()-hPutByteStrings handle bss =- wantWritableHandle "hPutByteStrings" 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
− Log/Rotate.hs
@@ -1,18 +0,0 @@-module Log.Rotate where--import Control.Monad-import System.Directory-import Log.Types--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
− Log/Stdout.hs
@@ -1,19 +0,0 @@-module Log.Stdout (stdoutLoggerInit) where--import Control.Applicative-import qualified Data.ByteString as BS-import Data.ByteString.Char8 (pack)-import Log.Apache-import Log.Date-import Log.Types--stdoutLoggerInit :: IO Logger-stdoutLoggerInit = stdoutLogger <$> dateInit--stdoutLogger :: DateRef -> Logger-stdoutLogger dateref req status msiz = do- date <- getDate dateref- BS.putStr $ BS.concat $ map toBS $ apacheFormat date req status msiz- where- toBS (LS s) = pack s- toBS (LB s) = s
− Log/Types.hs
@@ -1,23 +0,0 @@-module Log.Types (- Logger- , FileLogSpec(..)- , LogType(..)- , LogController- , LogStr(..)- ) where--import Data.ByteString-import Network.Wai.Application.Classic (Logger)-import System.Posix (ProcessID)--data FileLogSpec = FileLogSpec {- log_file :: String- , log_file_size :: Integer- , log_backup_number :: Int- }--data LogType = LogNone | LogStdout | LogFile FileLogSpec--type LogController = [ProcessID] -> IO ()--data LogStr = LS !String | LB !ByteString
Mighty.hs view
@@ -9,10 +9,10 @@ import qualified Data.ByteString.Char8 as BS import FileCGIApp import FileCache-import Log import Network import Network.Wai.Application.Classic import Network.Wai.Handler.Warp+import Network.Wai.Logger.Prefork import Prelude hiding (catch) import Route import System.Environment@@ -86,7 +86,7 @@ where setting = defaultSettings { settingsPort = opt_port opt- , settingsOnException = ignore+ , settingsOnException = printStdout , settingsTimeout = opt_connection_timeout opt } spec lgr getInfo = AppSpec {@@ -146,3 +146,6 @@ ignore :: SomeException -> IO () ignore = const $ return ()++printStdout :: SomeException -> IO ()+printStdout e = print e
Types.hs view
@@ -15,4 +15,4 @@ programName = "Mighttpd" programVersion :: String-programVersion = "2.3.0"+programVersion = "2.3.1"
mighttpd2.cabal view
@@ -1,5 +1,5 @@ Name: mighttpd2-Version: 2.3.0+Version: 2.3.1 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -21,20 +21,11 @@ warp, old-locale, time, wai-app-file-cgi, wai, transformers, http-types, directory, filepath,- haskell98, http-date, hashmap+ haskell98, http-date, hashmap, deepseq, wai-logger Other-Modules: Config Config.Internal FileCGIApp FileCache- Log- Log.Apache- Log.Check- Log.Date- Log.File- Log.Hput- Log.Rotate- Log.Stdout- Log.Types Mighty Parser Route