diff --git a/Config/Internal.hs b/Config/Internal.hs --- a/Config/Internal.hs +++ b/Config/Internal.hs @@ -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 diff --git a/FileCGIApp.hs b/FileCGIApp.hs --- a/FileCGIApp.hs +++ b/FileCGIApp.hs @@ -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 diff --git a/Log.hs b/Log.hs --- a/Log.hs +++ b/Log.hs @@ -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 diff --git a/Mighty.hs b/Mighty.hs --- a/Mighty.hs +++ b/Mighty.hs @@ -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) diff --git a/Parser.hs b/Parser.hs --- a/Parser.hs +++ b/Parser.hs @@ -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 diff --git a/Types.hs b/Types.hs --- a/Types.hs +++ b/Types.hs @@ -15,4 +15,4 @@ programName = "Mighttpd" programVersion :: String -programVersion = "2.0.1" +programVersion = "2.1.0" diff --git a/mighttpd2.cabal b/mighttpd2.cabal --- a/mighttpd2.cabal +++ b/mighttpd2.cabal @@ -1,5 +1,5 @@ Name: mighttpd2 -Version: 2.0.1 +Version: 2.1.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto 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 diff --git a/sample.conf b/sample.conf --- a/sample.conf +++ b/sample.conf @@ -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