diff --git a/Config/Internal.hs b/Config/Internal.hs --- a/Config/Internal.hs +++ b/Config/Internal.hs @@ -14,8 +14,8 @@ defaultOption = Option { opt_port = 8080 , opt_debug_mode = True - , opt_user = "nobody" - , opt_group = "nobody" + , opt_user = "root" + , opt_group = "root" , opt_pid_file = "/var/run/mighty.pid" , opt_logging = True , opt_log_file = "/var/log/mighty" diff --git a/FileCache.hs b/FileCache.hs --- a/FileCache.hs +++ b/FileCache.hs @@ -4,6 +4,7 @@ import Control.Concurrent import Control.Exception +import Control.Exception.IOChoice import Control.Monad import Data.ByteString (ByteString) import Data.HashMap.Strict (HashMap) @@ -11,7 +12,6 @@ import Data.IORef import Network.HTTP.Date import Network.Wai.Application.Classic -import System.IO.Unsafe import System.Posix.Files data Entry = Negative | Positive FileInfo @@ -20,45 +20,55 @@ fileInfo :: IORef Cache -> GetInfo fileInfo ref path = do - !mx <- atomicModifyIORef ref (lok path) - case mx of - Nothing -> throwIO (userError "fileInfo") - Just x -> return x + cache <- readIORef ref + case M.lookup bpath cache of + Just Negative -> throwIO (userError "fileInfo") + Just (Positive x) -> return x + Nothing -> register ||> negative ref path + where + bpath = pathByteString path + sfile = pathString path + register = do + fs <- getFileStatus sfile + if not (isDirectory fs) then + positive ref fs path + else + goNext -lok :: Path -> Cache -> (Cache, Maybe FileInfo) -lok path cache = unsafePerformIO $ do - let ment = M.lookup bpath cache - case ment of - Nothing -> handle handler $ do - let sfile = pathString path - fs <- getFileStatus sfile - if doesExist fs then pos fs else neg - Just Negative -> return (cache, Nothing) - Just (Positive x) -> return (cache, Just x) +positive :: IORef Cache -> FileStatus -> GetInfo +positive ref fs path = do + !_ <- atomicModifyIORef ref modify + return info where + info = FileInfo { + fileInfoName = path + , fileInfoSize = size fs + , fileInfoTime = mtime fs + } size = fromIntegral . fileSize mtime = epochTimeToHTTPDate . modificationTime - doesExist = not . isDirectory + entry = Positive info bpath = pathByteString path - pos fs = do - let info = FileInfo { - fileInfoName = path - , fileInfoSize = size fs - , fileInfoTime = mtime fs - } - entry = Positive info - cache' = M.insert bpath entry cache - return (cache', Just info) - neg = do - let cache' = M.insert bpath Negative cache - return (cache', Nothing) - handler :: SomeException -> IO (Cache, Maybe FileInfo) - handler _ = neg + modify cache = (cache', ()) + where + cache' = M.insert bpath entry cache +negative :: IORef Cache -> GetInfo +negative ref path = do + !_ <- atomicModifyIORef ref modify + throwIO (userError "fileInfo") + where + bpath = pathByteString path + modify cache = (cache', ()) + where + cache' = M.insert bpath Negative cache + +---------------------------------------------------------------- + fileCacheInit :: IO GetInfo fileCacheInit = do ref <- newIORef M.empty - forkIO (remover ref) + _ <- forkIO (remover ref) return $ fileInfo ref -- atomicModifyIORef is not necessary here. diff --git a/Mighty.hs b/Mighty.hs --- a/Mighty.hs +++ b/Mighty.hs @@ -45,10 +45,8 @@ eachCase args | n == 0 = do root <- amIrootUser - let opt = if root then - defaultOption { opt_port = 80 } - else - defaultOption + let opt | root = defaultOption { opt_port = 80 } + | otherwise = defaultOption dir <- getCurrentDirectory let dst = fromString . addTrailingPathSeparator $ dir route = [Block ["*"] [RouteFile "/" dst]] @@ -77,7 +75,7 @@ setGroupUser opt logCheck logtype if workers == 1 then do - forkIO $ single opt route s logtype + _ <- forkIO $ single opt route s logtype myid <- getProcessID logController logtype [myid] else do @@ -111,7 +109,7 @@ single :: Option -> RouteDB -> Socket -> LogType -> IO () single opt route s logtype = do - ignoreSigChild + _ <- ignoreSigChild lgr <- logInit FromSocket logtype getInfo <- fileCacheInit mgr <- H.newManager H.def { @@ -121,9 +119,10 @@ runSettingsSocket setting s $ \req -> fileCgiApp (cspec lgr) (filespec getInfo) cgispec (revproxyspec mgr) route req where + debug = opt_debug_mode opt setting = defaultSettings { settingsPort = opt_port opt - , settingsOnException = printStdout + , settingsOnException = if debug then printStdout else ignore , settingsTimeout = opt_connection_timeout opt , settingsHost = HostAny } @@ -147,11 +146,11 @@ multi :: Option -> RouteDB -> Socket -> LogType -> IO [ProcessID] multi opt route s logtype = do - ignoreSigChild + _ <- ignoreSigChild cids <- replicateM workers $ forkProcess (single opt route s logtype) sClose s - initHandler sigTERM $ terminateHandler cids - initHandler sigINT $ terminateHandler cids + _ <- initHandler sigTERM $ terminateHandler cids + _ <- initHandler sigINT $ terminateHandler cids return cids where workers = opt_worker_processes opt @@ -182,18 +181,18 @@ daemonize :: IO () -> IO () daemonize program = ensureDetachTerminalCanWork $ do - detachTerminal + _ <- detachTerminal ensureNeverAttachTerminal $ do changeWorkingDirectory "/" - setFileCreationMask 0 + _ <- setFileCreationMask 0 mapM_ closeFd [stdInput, stdOutput, stdError] program where ensureDetachTerminalCanWork p = do - forkProcess p + _ <- forkProcess p exitImmediately ExitSuccess ensureNeverAttachTerminal p = do - forkProcess p + _ <- forkProcess p exitImmediately ExitSuccess detachTerminal = createSession diff --git a/Route.hs b/Route.hs --- a/Route.hs +++ b/Route.hs @@ -65,5 +65,5 @@ where domain = BS.pack <$> many1 (noneOf ":/[], \t\n") port = do - char ':' + _ <- char ':' read <$> many1 (oneOf ['0'..'9']) diff --git a/example.conf b/example.conf --- a/example.conf +++ b/example.conf @@ -1,8 +1,10 @@ # Example configuration for Mighttpd 2 Port: 80 Debug_Mode: Yes # Yes or No -User: nobody -Group: nobody +# If available, "nobody" is much more secure for User:. +User: root +# If available, "nobody" is much more secure for Group:. +Group: root Pid_File: /var/run/mighty.pid Logging: Yes # Yes or No Log_File: /var/log/mighty # The directory must be writable by User: diff --git a/mighttpd2.cabal b/mighttpd2.cabal --- a/mighttpd2.cabal +++ b/mighttpd2.cabal @@ -1,5 +1,5 @@ Name: mighttpd2 -Version: 2.5.10 +Version: 2.5.11 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -17,8 +17,10 @@ Executable mighty Main-Is: Mighty.hs - GHC-Options: -Wall -fno-warn-unused-do-bind -threaded + GHC-Options: -Wall -threaded Build-Depends: base >= 4.0 && < 5 + -- should be removed someday + , blaze-html >= 0.5 , bytestring , deepseq , directory @@ -26,6 +28,7 @@ , http-conduit , http-date , http-types + , io-choice , network , network-conduit , old-locale @@ -36,8 +39,6 @@ , unix-bytestring , unordered-containers , wai >= 1.1 - -- should be removed someday - , blaze-html >= 0.5 , wai-app-file-cgi , wai-logger , wai-logger-prefork