mighttpd 0.2.0 → 0.3.0
raw patch · 5 files changed
+35/−43 lines, 5 files
Files
- Config.hs +10/−20
- File.hs +16/−17
- Mighttpd.hs +2/−2
- URLMap.hs +6/−3
- mighttpd.cabal +1/−1
Config.hs view
@@ -2,8 +2,9 @@ module Config (Option(..), parseOption, defaultOption) where -import Text.ParserCombinators.Parsec+import Control.Applicative ((<$>),(<$),(<*),(<*>),(*>)) import Data.List (isPrefixOf)+import Text.ParserCombinators.Parsec ---------------------------------------------------------------- @@ -58,9 +59,7 @@ , opt_pid_file = get "Pid_File" opt_pid_file } where- get key func = case lookup key conf of- Nothing -> func def- Just x -> fromConf x+ get key func = maybe (func def) fromConf $ lookup key conf ---------------------------------------------------------------- @@ -86,9 +85,9 @@ ---------------------------------------------------------------- parseConfig :: String -> [Conf]-parseConfig cs = let css = filter (not.isPrefixOf "#") $ lines cs- in map parseConf css+parseConfig cs = map parseConf css where+ css = filter (not.isPrefixOf "#") . lines $ cs parseConf xs = case parse config "config" xs of Right cnf -> cnf Left err -> error $ "parseConfig " ++ show err@@ -96,12 +95,7 @@ ---------------------------------------------------------------- config :: Parser Conf-config = do nm <- name- spaces- char ':'- spaces- vl <- value- return (nm,vl)+config = (,) <$> name <*> (spaces >> char ':' >> spaces *> value) name :: Parser String name = many1.oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_"@@ -110,15 +104,11 @@ value = choice [try cv_int, try cv_bool, cv_string] cv_int :: Parser ConfValue-cv_int = do ns <- many1 digit- spaces- eof- return $ CV_Int $ read ns+cv_int = CV_Int . read <$> (many1 digit <* (spaces >> eof)) cv_bool :: Parser ConfValue-cv_bool = do { string "Yes"; spaces; eof; return (CV_Bool True) } <|>- do { string "No"; spaces; eof; return (CV_Bool False) }+cv_bool = CV_Bool True <$ (string "Yes" >> spaces >> eof) <|>+ CV_Bool False <$ (string "No" >> spaces >> eof) cv_string :: Parser ConfValue-cv_string = do ss <- many1 (noneOf " \t\n")- return $ CV_String ss+cv_string = CV_String <$> many1 (noneOf " \t\n")
File.hs view
@@ -1,19 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}+ module File (mighty, progName) where import Control.Applicative-import Data.ByteString.Lazy.Char8 (ByteString)-import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L import Data.List import Data.Time import Data.Time.Clock.POSIX-import IO-import Network.Socket-import Network.URI+import Network.TCPInfo import Network.Web.Server import Network.Web.Server.Basic-import Network.Web.Utils+import Network.Web.URI import System.Directory import System.FilePath+import System.IO import System.Posix.Files import URLMap @@ -21,21 +22,19 @@ progName = "Mighttpd" progVersion :: String-progVersion = "0.2.0"+progVersion = "0.3.0" progNameVersion :: String progNameVersion = progName ++ " " ++ progVersion ---------------------------------------------------------------- -mighty :: WebConfig -> URLMap -> Socket -> IO ()-mighty wcnf umap s = do- tcpinfo <- getTCPInfo s- hdl <- socketToHandle s ReadWriteMode+mighty :: WebConfig -> URLMap -> Handle -> TCPInfo -> IO ()+mighty wcnf umap hdl tcpinfo = do let bcnf = BasicConfig { obtain = fileGet , info = fileInfo , mapper = fileMapper umap- , serverName = progNameVersion+ , serverName = S.pack progNameVersion , tcpInfo = tcpinfo } connection hdl (basicServer bcnf) wcnf@@ -46,7 +45,7 @@ lookupFileMap [] _ = None lookupFileMap ((from,to):xs) url | from `isPrefixOf` url = toPath to $ drop (length from) url- | otherwise = lookupFileMap xs url+ | otherwise = lookupFileMap xs url where toPath (File dir) restPath = File $ dir </> restPath toPath (CGI dir _ urlPath) progParam = CGI prog param scriptName@@ -59,19 +58,19 @@ fileMapper :: URLMap -> URI -> Path fileMapper umap uri = fileMapper' (lookupFileMap umap url) where- url = unEscapeString $ toURLwoPort uri+ url = unEscapeString . S.unpack . toURLwoPort $ uri fileMapper' None = None fileMapper' cgi@(CGI _ _ _) = cgi fileMapper' (File file) | hasTrailingPathSeparator file = File $ file </> "index.html" | otherwise = File file -fileGet :: FilePath -> Maybe (Integer,Integer) -> IO ByteString-fileGet file Nothing = openFile file ReadMode >>= LBS.hGetContents+fileGet :: FilePath -> Maybe (Integer,Integer) -> IO L.ByteString+fileGet file Nothing = openFile file ReadMode >>= L.hGetContents fileGet file (Just (skip,len)) = do h <- openFile file ReadMode hSeek h AbsoluteSeek skip- LBS.take (fromIntegral len) <$> LBS.hGetContents h+ L.take (fromIntegral len) <$> L.hGetContents h fileInfo :: FilePath -> IO (Maybe (Integer, UTCTime)) fileInfo file = do
Mighttpd.hs view
@@ -26,8 +26,8 @@ !uriMap = parseURLMap mapf !prog = mighty webConfig uriMap if opt_debug_mode opt- then runC10kServer prog c10kConfig- else daemonize $ runC10kServer prog c10kConfig+ then runC10kServerH prog c10kConfig+ else daemonize $ runC10kServerH prog c10kConfig where fileName n = do args <- getArgs
URLMap.hs view
@@ -1,8 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+ module URLMap (parseURLMap, URL, URLMap) where import Control.Applicative ((<$>),(<$),(<*),(<*>),(*>),pure)-import Network.URI+import qualified Data.ByteString.Char8 as S import Network.Web.Server.Basic+import Network.Web.URI import Text.Parsec import Text.Parsec.String @@ -13,8 +16,8 @@ parseURLMap cs = either (fail . show) (map fixCGI) (parse umap "umap" cs) where fixCGI (k, CGI prog param _) = (k, CGI prog param (scriptDir k))- fixCGI x = x- scriptDir x = maybe "" uriPath (parseURI x)+ fixCGI kv = kv+ scriptDir x = maybe "" (S.unpack . uriPath) $ parseURI $ S.pack x umap :: Parser [(URL,Path)] umap = comments *> many (line <* comments)
mighttpd.cabal view
@@ -1,5 +1,5 @@ Name: mighttpd-Version: 0.2.0+Version: 0.3.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3