mighttpd2 2.0.1 → 2.1.0
raw patch · 8 files changed
+52/−23 lines, 8 filesdep +http-types
Dependencies added: http-types
Files
- Config/Internal.hs +3/−0
- FileCGIApp.hs +2/−1
- Log.hs +24/−7
- Mighty.hs +12/−8
- Parser.hs +1/−1
- Types.hs +1/−1
- mighttpd2.cabal +8/−5
- sample.conf +1/−0
Config/Internal.hs view
@@ -17,6 +17,7 @@ , opt_user = "nobody" , opt_group = "nobody" , opt_pid_file = "/var/run/mighty.pid"+ , opt_logging = True , opt_log_file = "/var/log/mighty" , opt_log_file_size = 16777216 , opt_log_backup_number = 10@@ -33,6 +34,7 @@ , opt_user :: !String , opt_group :: !String , opt_pid_file :: !String+ , opt_logging :: !Bool , opt_log_file :: !String , opt_log_file_size :: !Int , opt_log_backup_number :: !Int@@ -57,6 +59,7 @@ , opt_user = get "User" opt_user , opt_group = get "Group" opt_group , opt_pid_file = get "Pid_File" opt_pid_file+ , opt_logging = get "Logging" opt_logging , opt_log_file = get "Log_File" opt_log_file , opt_log_file_size = get "Log_File_Size" opt_log_file_size , opt_log_backup_number = get "Log_Backup_Number" opt_log_backup_number
FileCGIApp.hs view
@@ -4,6 +4,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS+import Network.HTTP.Types import Network.Wai import Network.Wai.Application.Classic import Types@@ -17,7 +18,7 @@ OpFile -> fileApp spec (FileRoute src dst) req OpCGI -> cgiApp spec (CgiRoute src dst) req where- mmp = getBlock (serverName req) um >>= getRoute (pathInfo req)+ mmp = getBlock (serverName req) um >>= getRoute (rawPathInfo req) getBlock :: ByteString -> RouteDB -> Maybe [Route] getBlock _ [] = Nothing
Log.hs view
@@ -8,6 +8,7 @@ import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Char8 as BL import Data.Time+import Network.HTTP.Types import Network.Wai import Network.Wai.Application.Classic import System.Directory@@ -45,8 +46,18 @@ chan <- newChan forkIO $ fileFlusher mvar spec forkIO $ fileSerializer chan mvar+ let handler = fileFlushHandler mvar+ installHandler sigTERM handler Nothing+ installHandler sigKILL handler Nothing return chan +fileFlushHandler :: MVar Handle -> Handler+fileFlushHandler mvar = Catch $ do+ hdl <- takeMVar mvar+ hFlush hdl+ putMVar mvar hdl+ exitImmediately ExitSuccess+ fileFlusher :: MVar Handle -> FileLogSpec -> IO () fileFlusher mvar spec = forever $ do threadDelay $ log_flush_period spec@@ -83,7 +94,7 @@ where path = log_file spec n = log_backup_number spec- dsts' = reverse . ("":) . map ('.':) . map show $ [0..n-1]+ dsts' = reverse . ("":) . map (('.':). show) $ [0..n-1] dsts = map (path++) dsts' srcs = tail dsts srcdsts = zip srcs dsts@@ -93,8 +104,8 @@ ---------------------------------------------------------------- -setoutInit :: IO (Chan ByteString)-setoutInit = do+stdoutInit :: IO (Chan ByteString)+stdoutInit = do chan <- newChan forkIO $ stdoutSerializer chan return chan@@ -104,8 +115,8 @@ ---------------------------------------------------------------- -mightyLogger :: Chan ByteString -> Request -> Status -> IO ()-mightyLogger chan req st = do+mightyLogger :: Chan ByteString -> Request -> Status -> RspBody -> IO ()+mightyLogger chan req st body = do zt <- getZonedTime addr <- getPeerAddr (remoteHost req) writeChan chan $ BL.fromChunks (logmsg addr zt)@@ -117,12 +128,18 @@ , "] \"" , requestMethod req , " "- , pathInfo req+ , rawPathInfo req , "\" " , BS.pack (show . statusCode $ st)- , " - \"" -- size+ , " "+ , BS.pack (size body)+ , " \"" -- size , lookupRequestField' fkReferer req , "\" \"" , lookupRequestField' fkUserAgent req , "\"\n" ]+ size NoBody = "-"+ size (BodyLBS lbs) = show $ BL.length lbs+ size (BodyFile _ (Entire siz)) = show siz+ size (BodyFile _ (Part _ len)) = show len
Mighty.hs view
@@ -1,7 +1,7 @@ module Main where import Config-import Control.Exception (catch, SomeException)+import Control.Exception (handle, SomeException) import Control.Monad import qualified Data.ByteString.Char8 as BS import Data.List (isSuffixOf)@@ -34,23 +34,27 @@ return $ args !! n server :: Option -> RouteDB -> IO ()-server opt route = flip catch handle $ do+server opt route = handle handler $ do s <- sOpen installHandler sigCHLD Ignore Nothing unless debug writePidFile setGroupUser opt- chan <- if debug then setoutInit else fileInit logspec- serveConnections' setting (fileCgiApp (spec chan) route) s+ lgr <- if opt_logging opt+ then do+ chan <- if debug then stdoutInit else fileInit logspec+ return $ mightyLogger chan+ else return (\_ _ _ -> return ())+ runSettingsSocket setting s $ fileCgiApp (spec lgr) route where debug = opt_debug_mode opt port = opt_port opt ignore = const $ return () sOpen = listenOn (PortNumber . fromIntegral $ port)- spec chan = AppSpec {+ spec lgr = AppSpec { softwareName = BS.pack $ opt_server_name opt , indexFile = opt_index_file opt , isHTML = \x -> ".html" `isSuffixOf` x || ".htm" `isSuffixOf` x- , logger = mightyLogger chan+ , logger = lgr } logspec = FileLogSpec { log_file = opt_log_file opt@@ -69,8 +73,8 @@ pid <- getProcessID writeFile pidfile $ show pid ++ "\n" setFileMode pidfile 0o644- handle :: SomeException -> IO ()- handle e+ handler :: SomeException -> IO ()+ handler e | debug = hPutStrLn stderr $ show e | otherwise = writeFile "/tmp/mighty_error" (show e)
Parser.hs view
@@ -13,7 +13,7 @@ spcs1 = () <$ many1 spc spc :: Parser Char-spc = satisfy (\c -> c == ' ' || c == '\t')+spc = satisfy (`elem` " \t") commentLines :: Parser () commentLines = () <$ many commentLine
Types.hs view
@@ -15,4 +15,4 @@ programName = "Mighttpd" programVersion :: String-programVersion = "2.0.1"+programVersion = "2.1.0"
mighttpd2.cabal view
@@ -1,5 +1,5 @@ Name: mighttpd2-Version: 2.0.1+Version: 2.1.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -14,14 +14,17 @@ Data-Files: sample.conf sample.route Executable mighty Main-Is: Mighty.hs- if impl(ghc >= 6.12)- GHC-Options: -Wall -fno-warn-unused-do-bind+ if impl(ghc >= 7)+ GHC-Options: -Wall -fno-warn-unused-do-bind -threaded else- GHC-Options: -Wall+ if impl(ghc >= 6.12)+ GHC-Options: -Wall -fno-warn-unused-do-bind+ else+ GHC-Options: -Wall Build-Depends: base >= 4.0 && < 5, parsec >= 3, network >=2.2 && <2.3, unix, bytestring, warp, old-locale, time,- wai-app-file-cgi, wai, transformers,+ wai-app-file-cgi, wai, transformers, http-types, directory, filepath, haskell98 Other-Modules: Config
sample.conf view
@@ -4,6 +4,7 @@ User: nobody Group: nobody Pid_File: /var/run/mighty.pid+Logging: Yes Log_File: /var/log/mighty # The directory must be writable by Users: Log_File_Size: 16777216 # bytes Log_Backup_Number: 10 # seconds