mighttpd 0.4.2 → 0.4.3

raw patch · 4 files changed

+46/−35 lines, 4 files

Files

• File.hs +27/−26
• Mighttpd.hs +11/−4
• URLMap.hs +1/−1
• mighttpd.cabal +7/−4

@@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module File (mighty, progName) where+module File (mighty, progName, fileMapper) where -- xxx  import Control.Applicative import qualified Data.ByteString.Char8      as S@@ -22,7 +22,7 @@ progName = "Mighttpd"  progVersion :: String-progVersion = "0.4.2"+progVersion = "0.4.3"  progNameVersion :: String progNameVersion = progName ++ "/" ++ progVersion@@ -41,35 +41,36 @@  ---------------------------------------------------------------- -lookupFileMap :: URLMap -> URL -> Path-lookupFileMap [] _          = None-lookupFileMap ((from,to):xs) url-    | from `isPrefixOf` url = toPath to $ drop (length from) url+lookupFileMap :: URLMap -> URL -> Maybe (URL,ConvInfo)+lookupFileMap [] _          = Nothing+lookupFileMap (ent@(from,_):xs) url+    | from `isPrefixOf` url = Just ent     | 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-    }+fileMapper :: URLMap -> URI -> Path+fileMapper umap uri = case lookupFileMap umap url of+    Nothing           -> None+    Just (curl,cinfo) -> fileMapper' uri url curl cinfo   where-    (progParam',query)  = break (== '?') progParam-    (prog',path)        = break (== '/') progParam'-    prog = progDir ci </> prog'-    scriptname = pathInURL ci </> prog'+    url = unEscapeString . S.unpack . toURLPath $ uri -- without param -fileMapper :: URLMap -> URI -> Path-fileMapper umap uri = fileMapper' (lookupFileMap umap url)+fileMapper' :: URI -> URL -> URL -> ConvInfo -> Path+fileMapper' uri url curl cinfo = case cinfo of+    CIFile dir      -> toFile (dir </> path0)+    CICgi  dir path -> toCGI dir path   where-    url = unEscapeString . S.unpack . toURLwoPort $ uri-    fileMapper' None                  = None-    fileMapper' cgi@(PathCGI _)       = cgi-    fileMapper' (File file)-      | hasTrailingPathSeparator file = File $ file </> "index.html"-      | otherwise                     = File file+    path0 = drop (length curl) url+    toFile path+      | hasTrailingPathSeparator path = File (path </> "index.html")+      | otherwise                     = File path+    toCGI dir path = PathCGI CGI {+        progPath    = dir </> prog+      , scriptName  = path </> prog+      , pathInfo    = pathinfo+      , queryString = unEscapeString . S.unpack $ uriQuery uri+      }+      where+        (prog,pathinfo) = break (== '/') path0  fileGet :: FilePath -> Maybe (Integer,Integer) -> IO L.ByteString fileGet file Nothing = openFile file ReadMode >>= L.hGetContents

@@ -5,13 +5,14 @@ import Config import Control.Monad import File-import IO import LogMsg import Network.C10kServer import Network.Web.Server import System.Environment import System.Exit+import System.IO import System.Posix.Daemonize (daemonize)+import System.Posix.Signals import URLMap  ----------------------------------------------------------------@@ -77,6 +78,12 @@  makeStartedHook :: Option -> IO () makeStartedHook opt =-  if opt_debug_mode opt-  then initLog progName "" (opt_log_level opt) StdErr-  else initLog progName (opt_syslog_facility opt) (opt_log_level opt) SysLog+    if opt_debug_mode opt+    then do+        ignoreSigChild+        initLog progName "" (opt_log_level opt) StdErr+    else do+        ignoreSigChild+        initLog progName (opt_syslog_facility opt) (opt_log_level opt) SysLog+  where+    ignoreSigChild = installHandler sigCHLD Ignore Nothing

@@ -10,7 +10,7 @@ data ConvInfo = CIFile String | CICgi { progDir :: String                                       , pathInURL :: String                                       }-                deriving Show+                deriving (Eq,Show) type URLMap = [(URL,ConvInfo)]  parseURLMap :: String -> URLMap

@@ -1,5 +1,5 @@ Name:                   mighttpd-Version:                0.4.2+Version:                0.4.3 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -15,10 +15,13 @@ Data-Files:             sample.conf sample.map Executable mighttpd   Main-Is:              Mighttpd.hs-  if impl(ghc >= 6.12)-    GHC-Options:        -Wall -O2 -fno-warn-unused-do-bind+  if impl(ghc >= 7)+    GHC-Options:        -Wall -O2 -fno-warn-unused-do-bind -threaded   else-    GHC-Options:        -Wall -O2+    if impl(ghc >= 6.12)+      GHC-Options:        -Wall -O2 -fno-warn-unused-do-bind+    else+      GHC-Options:        -Wall -O2   Ghc-Prof-Options:     -prof -auto-all -caf-all   Build-Depends:        base >= 4 && < 5, parsec,                         c10k, hslogger, webserver, bytestring, filepath,