mighttpd 0.3.0 → 0.4.0

raw patch · 5 files changed

+46/−30 lines, 5 filesdep ~base

Dependency ranges changed: base

Files

• File.hs +17/−11
• LogMsg.hs +0/−1
• Mighttpd.hs +1/−0
• URLMap.hs +16/−13
• mighttpd.cabal +12/−5

@@ -22,10 +22,10 @@ progName = "Mighttpd"  progVersion :: String-progVersion = "0.3.0"+progVersion = "0.4.0"  progNameVersion :: String-progNameVersion = progName ++ " " ++ progVersion+progNameVersion = progName ++ "/" ++ progVersion  ---------------------------------------------------------------- @@ -45,22 +45,28 @@ lookupFileMap [] _          = None lookupFileMap ((from,to):xs) url     | from `isPrefixOf` url = toPath to $ drop (length from) url-    | otherwise               = lookupFileMap xs url+    | otherwise             = lookupFileMap xs url++toPath :: ConvInfo -> FilePath -> Path+toPath (CIFile dir)   restPath  = File $ dir </> restPath+toPath ci@(CICgi _ _) progParam = PathCGI $ CGI {+    progPath    = prog+    , scriptName  = scriptname+    , pathInfo    = path+    , queryString = query+    }   where-    toPath (File dir) restPath = File $ dir </> restPath-    toPath (CGI dir _ urlPath) progParam = CGI prog param scriptName-      where-        (prog',param) = break (\x -> x == '?' || x == '/') progParam-        prog = dir </> prog'-        scriptName = urlPath </> prog'-    toPath _ _ = error "toPath"+    (progParam',query)  = break (== '?') progParam+    (prog',path)        = break (== '/') progParam'+    prog = progDir ci </> prog'+    scriptname = pathInURL ci </> prog'  fileMapper :: URLMap -> URI -> Path fileMapper umap uri = fileMapper' (lookupFileMap umap url)   where     url = unEscapeString . S.unpack . toURLwoPort $ uri     fileMapper' None                  = None-    fileMapper' cgi@(CGI _ _ _)       = cgi+    fileMapper' cgi@(PathCGI _)       = cgi     fileMapper' (File file)       | hasTrailingPathSeparator file = File $ file </> "index.html"       | otherwise                     = File file

@@ -3,7 +3,6 @@                errorMsg, warnMsg, noticeMsg,                infoMsg, debugMsg) where -import Data.Maybe import System.Log.Logger import System.Log.Handler.Syslog 

@@ -57,6 +57,7 @@   , preforkProcessNumber = opt_prefork_process_number opt   , threadNumberPerProcess = opt_thread_number_per_process opt   , portName = show $ opt_port opt+  , ipAddr = Nothing   , pidFile = opt_pid_file opt   , user = opt_user opt   , group = opt_group opt

@@ -1,25 +1,28 @@ {-# LANGUAGE OverloadedStrings #-} -module URLMap (parseURLMap, URL, URLMap) where+module URLMap (parseURLMap, URL, URLMap, ConvInfo(..)) where  import Control.Applicative ((<$>),(<$),(<*),(<*>),(*>),pure) import qualified Data.ByteString.Char8 as S-import Network.Web.Server.Basic import Network.Web.URI import Text.Parsec import Text.Parsec.String  type URL = String-type URLMap = [(URL,Path)]+data ConvInfo = CIFile String | CICgi { progDir :: String+                                      , pathInURL :: String+                                      }+                deriving Show+type URLMap = [(URL,ConvInfo)]  parseURLMap :: String -> URLMap parseURLMap cs = either (fail . show) (map fixCGI) (parse umap "umap" cs)   where-    fixCGI (k, CGI prog param _) = (k, CGI prog param (scriptDir k))-    fixCGI kv                    = kv-    scriptDir x = maybe "" (S.unpack . uriPath) $ parseURI $ S.pack x+    fixCGI (k, ci@(CICgi _ _)) = (k, ci { pathInURL = scriptPath k})+    fixCGI kv               = kv+    scriptPath x = maybe "" (S.unpack . uriPath) $ parseURI $ S.pack x -umap :: Parser [(URL,Path)]+umap :: Parser URLMap umap =  comments *> many (line <* comments)  comments :: Parser ()@@ -28,20 +31,20 @@ comment :: Parser () comment = () <$ char '#' >> many (noneOf "\n") >> eol -line :: Parser (URL,Path)+line :: Parser (URL,ConvInfo) line = (,) <$> uri <*> (fileOrCGI <* eol)  uri :: Parser URL uri = spcs *> (str <* spcs) -fileOrCGI :: Parser Path+fileOrCGI :: Parser ConvInfo fileOrCGI = file <|> cgi -file :: Parser Path-file = File <$> (arrow *> dir)+file :: Parser ConvInfo+file = CIFile <$> (arrow *> dir) -cgi :: Parser Path-cgi = CGI <$> (darrow *> dir) <*> pure "" <*> pure ""+cgi :: Parser ConvInfo+cgi = CICgi <$> (darrow *> dir) <*> pure ""  arrow :: Parser () arrow = () <$ string "->" >> spcs

@@ -1,5 +1,5 @@ Name:                   mighttpd-Version:                0.3.0+Version:                0.4.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -14,15 +14,22 @@ Extra-Source-Files:     Config.hs LogMsg.hs Setup.hs File.hs URLMap.hs Data-Files:             sample.conf sample.map Executable mighttpd-    Main-Is:            Mighttpd.hs+  Main-Is:              Mighttpd.hs+  if impl(ghc >= 6.12)+    GHC-Options:        -Wall -O2 -fno-warn-unused-do-bind+  else     GHC-Options:        -Wall -O2-    Build-Depends:      base >= 4 && < 10, parsec >= 3,+  Ghc-Prof-Options:     -prof -auto-all -caf-all+  Build-Depends:        base >= 4 && < 5, parsec >= 3,                         c10k, hslogger, webserver, bytestring, filepath,                         haskell98, hdaemonize, directory, unix, time, network Executable mkindex-    Main-Is:            mkindex.hs+  Main-Is:              mkindex.hs+  if impl(ghc >= 6.12)+    GHC-Options:        -Wall -O2 -fno-warn-unused-do-bind+  else     GHC-Options:        -Wall -O2-    Build-Depends:      base >= 4+  Build-Depends:        base >= 4 && < 5 Source-Repository head   Type:                 git   Location:             git://github.com/kazu-yamamoto/mighttpd.git