mighttpd2 2.5.1 → 2.5.2
raw patch · 9 files changed
+166/−50 lines, 9 filesdep +HUnitdep +test-framework-hunitdep +test-framework-th-primedep ~basedep ~hashmap
Dependencies added: HUnit, test-framework-hunit, test-framework-th-prime, wai-logger
Dependency ranges changed: base, hashmap
Files
- Config/Internal.hs +3/−0
- FileCGIApp.hs +48/−22
- Mighty.hs +36/−11
- Route.hs +3/−2
- Types.hs +3/−2
- mighttpd2.cabal +37/−12
- sample.conf +1/−0
- sample.route +2/−1
- test/Test.hs +33/−0
Config/Internal.hs view
@@ -22,6 +22,7 @@ , opt_log_file_size = 16777216 , opt_log_backup_number = 10 , opt_index_file = "index.html"+ , opt_index_cgi = "index.cgi" , opt_status_file_dir = "/usr/local/share/mighty/status" , opt_connection_timeout = 30 , opt_server_name = programName ++ "/" ++ programVersion@@ -39,6 +40,7 @@ , opt_log_file_size :: !Int , opt_log_backup_number :: !Int , opt_index_file :: !String+ , opt_index_cgi :: !String , opt_status_file_dir :: !String , opt_connection_timeout :: !Int , opt_server_name :: !String@@ -64,6 +66,7 @@ , opt_log_file_size = get "Log_File_Size" opt_log_file_size , opt_log_backup_number = get "Log_Backup_Number" opt_log_backup_number , opt_index_file = get "Index_File" opt_index_file+ , opt_index_cgi = get "Index_Cgi" opt_index_cgi , opt_status_file_dir = get "Status_File_Dir" opt_status_file_dir , opt_connection_timeout = get "Connection_Timeout" opt_connection_timeout , opt_server_name = get "Server_Name" opt_server_name
FileCGIApp.hs view
@@ -2,6 +2,7 @@ module FileCGIApp (fileCgiApp) where +import Control.Monad.IO.Class (liftIO) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import Network.HTTP.Types@@ -9,21 +10,32 @@ import Network.Wai.Application.Classic import Types -fileCgiApp :: ClassicAppSpec -> FileAppSpec -> RevProxyAppSpec -> RouteDB -> Application-fileCgiApp cspec filespec revproxyspec um req = case mmp of- Nothing -> return $ responseLBS statusPreconditionFailed- [("Content-Type", "text/plain")- ,("Server", softwareName cspec)]- "Precondition Failed\r\n"- Just (RouteFile src dst) ->- fileApp cspec filespec (FileRoute (toP src) (toP dst)) req- Just (RouteCGI src dst) ->- cgiApp cspec (CgiRoute (toP src) (toP dst)) req- Just (RouteRevProxy src dst dom prt) ->- revProxyApp cspec revproxyspec (RevProxyRoute (toP src) (toP dst) dom prt) req+data Perhaps a = Found a | Redirect | Fail++fileCgiApp :: ClassicAppSpec -> FileAppSpec -> CgiAppSpec -> RevProxyAppSpec -> RouteDB -> Application+fileCgiApp cspec filespec cgispec revproxyspec um req = case mmp of+ Fail -> do+ let st = statusPreconditionFailed+ liftIO $ logger cspec req st Nothing+ fastResponse st defaultHeader "Precondition Failed\r\n"+ Redirect -> do+ let st = statusMovedPermanently+ hdr = defaultHeader ++ redirectHeader req+ liftIO $ logger cspec req st Nothing+ fastResponse st hdr "Moved Permanently\r\n"+ Found (RouteFile src dst) -> do+ fileApp cspec filespec (FileRoute src dst) req+ Found (RouteCGI src dst) ->+ cgiApp cspec cgispec (CgiRoute src dst) req+ Found (RouteRevProxy src dst dom prt) ->+ revProxyApp cspec revproxyspec (RevProxyRoute src dst dom prt) req where- mmp = getBlock (serverName req) um >>= getRoute (rawPathInfo req)- toP = fromByteString+ mmp = case getBlock (serverName req) um of+ Nothing -> Fail+ Just blk -> getRoute (rawPathInfo req) blk+ fastResponse st hdr body = return $ responseLBS st hdr body+ defaultHeader = [("Content-Type", "text/plain")+ ,("Server", softwareName cspec)] getBlock :: ByteString -> RouteDB -> Maybe [Route] getBlock _ [] = Nothing@@ -31,14 +43,28 @@ | key `elem` doms = Just maps | otherwise = getBlock key ms -getRoute :: ByteString -> [Route] -> Maybe Route-getRoute _ [] = Nothing+getRoute :: ByteString -> [Route] -> Perhaps Route+getRoute _ [] = Fail getRoute key (m@(RouteFile src _):ms)- | src `BS.isPrefixOf` key = Just m- | otherwise = getRoute key ms+ | src `isPrefixOf` key = Found m+ | src `isMountPointOf` key = Redirect+ | otherwise = getRoute key ms getRoute key (m@(RouteCGI src _):ms)- | src `BS.isPrefixOf` key = Just m- | otherwise = getRoute key ms+ | src `isPrefixOf` key = Found m+ | src `isMountPointOf` key = Redirect+ | otherwise = getRoute key ms getRoute key (m@(RouteRevProxy src _ _ _):ms)- | src `BS.isPrefixOf` key = Just m- | otherwise = getRoute key ms+ | src `isPrefixOf` key = Found m+ | otherwise = getRoute key ms++isPrefixOf :: Path -> ByteString -> Bool+isPrefixOf src key = src' `BS.isPrefixOf` key+ where+ src' = pathByteString src++isMountPointOf :: Path -> ByteString -> Bool+isMountPointOf src key = hasTrailingPathSeparator src+ && BS.length src' - BS.length key == 1+ && key `BS.isPrefixOf` src'+ where+ src' = pathByteString src
Mighty.hs view
@@ -3,6 +3,7 @@ module Main where import Config+import Control.Applicative import Control.Concurrent import Control.Exception (catch, handle, SomeException) import Control.Monad@@ -13,30 +14,48 @@ import qualified Network.HTTP.Conduit as H import Network.Wai.Application.Classic import Network.Wai.Handler.Warp+import Network.Wai.Logger import Network.Wai.Logger.Prefork import Prelude hiding (catch) import Route+import System.Directory import System.Environment import System.Exit+import System.FilePath import System.IO import System.Posix import Types main :: IO () main = do- opt <- fileName 0 >>= parseOption- route <- fileName 1 >>= parseRoute+ (opt,route) <- getOptRoute if opt_debug_mode opt then server opt route else daemonize $ server opt route where- fileName n = do- args <- getArgs- when (length args /= 2) $ do- hPutStrLn stderr "Usage: mighty config_file routing_file"- exitFailure- return $ args !! n+ getOptRoute = getArgs >>= eachCase+ eachCase args+ | n == 0 = do+ root <- amIrootUser+ let opt = if root then+ defaultOption { opt_port = 80 }+ else+ defaultOption+ dir <- getCurrentDirectory+ let dst = fromString . addTrailingPathSeparator $ dir+ route = [Block ["localhost"] [RouteFile "/" dst]]+ return (opt, route)+ | n == 2 = do+ opt <- parseOption $ args !! 0+ route <- parseRoute $ args !! 1+ return (opt,route)+ | otherwise = do+ hPutStrLn stderr "Usage: mighty"+ hPutStrLn stderr " mighty config_file routing_file"+ exitFailure+ where+ n = length args ---------------------------------------------------------------- @@ -89,7 +108,7 @@ H.managerConnCount = 1024 } runSettingsSocket setting s $ \req ->- fileCgiApp (cspec lgr) (filespec getInfo) (revproxyspec mgr) route req+ fileCgiApp (cspec lgr) (filespec getInfo) cgispec (revproxyspec mgr) route req where setting = defaultSettings { settingsPort = opt_port opt@@ -108,6 +127,9 @@ , isHTML = \x -> ".html" `isSuffixOf` x || ".htm" `isSuffixOf` x , getFileInfo = getInfo }+ cgispec = CgiAppSpec {+ indexCgi = "index.cgi"+ } revproxyspec mgr = RevProxyAppSpec { revProxyManager = mgr }@@ -135,10 +157,13 @@ ---------------------------------------------------------------- +amIrootUser :: IO Bool+amIrootUser = (== 0) <$> getRealUserID+ setGroupUser :: Option -> IO () setGroupUser opt = do- uid <- getRealUserID- when (uid == 0) $ do+ root <- amIrootUser+ when root $ do getGroupEntryForName (opt_group opt) >>= setGroupID . groupID getUserEntryForName (opt_user opt) >>= setUserID . userID
Route.hs view
@@ -4,6 +4,7 @@ import Control.Applicative hiding (many,(<|>)) import qualified Data.ByteString.Char8 as BS+import Network.Wai.Application.Classic import Parser import Text.Parsec import Text.Parsec.ByteString.Lazy@@ -50,10 +51,10 @@ <|> OpRevProxy <$ string ">>" op = op0 <* spcs -path :: Parser Dst+path :: Parser Path path = do c <- char '/'- BS.pack . (c:) <$> many (noneOf "[], \t\n") <* spcs+ fromByteString . BS.pack . (c:) <$> many (noneOf "[], \t\n") <* spcs -- [host1][:port2]/path2
Types.hs view
@@ -5,10 +5,11 @@ import Data.ByteString import Data.ByteString.Char8 () import Data.Version+import Network.Wai.Application.Classic import Paths_mighttpd2 -type Src = ByteString-type Dst = ByteString+type Src = Path+type Dst = Path type Domain = ByteString type PathInfo = ByteString type Port = Int
mighttpd2.cabal view
@@ -1,5 +1,5 @@ Name: mighttpd2-Version: 2.5.1+Version: 2.5.2 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -9,21 +9,35 @@ Static files and CGI can be handled. Homepage: http://www.mew.org/~kazu/proj/mighttpd/ Category: Network, Web-Cabal-Version: >= 1.6+Cabal-Version: >= 1.8 Build-Type: Simple Data-Files: sample.conf sample.route+ Executable mighty Main-Is: Mighty.hs GHC-Options: -Wall -fno-warn-unused-do-bind -threaded- Build-Depends: base >= 4.0 && < 5, parsec >= 3,- network,- unix, bytestring, unix-bytestring,- warp, old-locale, time,- wai-app-file-cgi, wai >= 1.1, transformers, http-types,- directory, filepath,- http-date, hashmap, deepseq, wai-logger-prefork,- http-conduit- Other-Modules: Config+ Build-Depends: base >= 4.0 && < 5+ , bytestring+ , deepseq+ , directory+ , filepath+ , hashmap >= 1.2 && < 1.3+ , http-conduit+ , http-date+ , http-types+ , network+ , old-locale+ , parsec >= 3+ , time+ , transformers+ , unix+ , unix-bytestring+ , wai >= 1.1+ , wai-app-file-cgi+ , wai-logger+ , wai-logger-prefork+ , warp+ Other-Modules: Config Config.Internal FileCGIApp FileCache@@ -32,10 +46,21 @@ Route Types Paths_mighttpd2+ Executable mkindex Main-Is: mkindex.hs GHC-Options: -Wall -fno-warn-unused-do-bind Build-Depends: base >= 4 && < 5++Test-Suite test+ Main-Is: Test.hs+ Hs-Source-Dirs: test, .+ Type: exitcode-stdio-1.0+ Build-Depends: base >= 4 && < 5+ , HUnit+ , test-framework-hunit+ , test-framework-th-prime+ Source-Repository head Type: git- Location: git://github.com/kazu-yamamoto/mighttpd2.git+ Location: git clone git://github.com/kazu-yamamoto/mighttpd2.git
sample.conf view
@@ -9,6 +9,7 @@ Log_File_Size: 16777216 # bytes Log_Backup_Number: 10 Index_File: index.html+Index_Cgi: index.cgi Status_File_Dir: /usr/local/share/mighty/status Connection_Timeout: 30 # seconds # Server_Name: Mighttpd/2.x.y
sample.route view
@@ -12,7 +12,6 @@ # A path to static files should be specified with "->" /~alice/ -> /home/alice/public_html/ /cgi-bin/ => /export/cgi-bin/-/ -> /export/www/ # Reverse proxy rules should be specified with ">>" # /path >> host:port/path2@@ -21,3 +20,5 @@ # URLs generated by Yesod are absolute. # We cannot re-write pathinfo. /app/wiki >> :8080/app/wiki++/ -> /export/www/
+ test/Test.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}++module Main where++import Config.Internal+import Route+import Test.Framework.Providers.HUnit+import Test.Framework.TH.Prime+import Test.HUnit+import Types++----------------------------------------------------------------++main :: IO ()+main = $(defaultMainGenerator)++----------------------------------------------------------------++case_config :: Assertion+case_config = do+ res <- parseConfig "sample.conf"+ res @?= ans+ where+ ans = [("Port",CV_Int 80),("Debug_Mode",CV_Bool True),("User",CV_String "nobody"),("Group",CV_String "nobody"),("Pid_File",CV_String "/var/run/mighty.pid"),("Logging",CV_Bool True),("Log_File",CV_String "/var/log/mighty"),("Log_File_Size",CV_Int 16777216),("Log_Backup_Number",CV_Int 10),("Index_File",CV_String "index.html"),("Index_Cgi",CV_String "index.cgi"),("Status_File_Dir",CV_String "/usr/local/share/mighty/status"),("Connection_Timeout",CV_Int 30),("Worker_Processes",CV_Int 1)]++case_route :: Assertion+case_route = do+ res <- parseRoute "sample.route"+ res @?= ans+ where+ ans = [Block ["localhost","www.example.com"] [RouteCGI "/~alice/cgi-bin/" "/home/alice/public_html/cgi-bin/",RouteFile "/~alice/" "/home/alice/public_html/",RouteCGI "/cgi-bin/" "/export/cgi-bin/",RouteRevProxy "/app/cal" "/calendar" "example.net" 80,RouteRevProxy "/app/wiki" "/app/wiki" "localhost" 8080,RouteFile "/" "/export/www/"]]++----------------------------------------------------------------