From 31c09c88469140fde3616502e842098681d4c440 Mon Sep 17 00:00:00 2001 From: hallgren Date: Fri, 17 Dec 2010 16:33:54 +0000 Subject: [PATCH] RunHTTP.hs: remove hardcoded document root The document root is now part of the arguments passed to runHTTP. --- src/server/RunHTTP.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/server/RunHTTP.hs b/src/server/RunHTTP.hs index 46758fac6..95c6ac2f2 100644 --- a/src/server/RunHTTP.hs +++ b/src/server/RunHTTP.hs @@ -1,4 +1,4 @@ -module RunHTTP(runHTTP) where +module RunHTTP(runHTTP,Options(..)) where import Network.URI(uriPath,uriQuery) import Network.CGI(ContentType(..)) import Network.CGI.Protocol(CGIResult(..),CGIRequest(..),Input(..), @@ -8,11 +8,11 @@ import Network.Shed.Httpd(initServer,Request(..),Response(..),queryToArguments) import qualified Data.ByteString.Lazy.Char8 as BS(pack,unpack) import qualified Data.Map as M(fromList) -documentRoot = "www" +data Options = Options { documentRoot :: String, port :: Int } deriving Show -runHTTP port = initServer port . cgiHandler +runHTTP (Options root port) = initServer port . cgiHandler root -cgiHandler h = fmap httpResp . runCGIT h . cgiReq +cgiHandler root h = fmap httpResp . runCGIT h . cgiReq root httpResp :: (Headers,CGIResult) -> Response httpResp (hdrs,r) = Response code (map name hdrs) (body r) @@ -23,12 +23,12 @@ httpResp (hdrs,r) = Response code (map name hdrs) (body r) name (HeaderName n,v) = (n,v) -cgiReq :: Request -> CGIRequest -cgiReq (Request method uri hdrs body) = CGIRequest vars inputs body' +cgiReq :: String -> Request -> CGIRequest +cgiReq root (Request method uri hdrs body) = CGIRequest vars inputs body' where vars = M.fromList [("REQUEST_METHOD",method), ("REQUEST_URI",show uri), - ("SCRIPT_FILENAME",documentRoot++uriPath uri), + ("SCRIPT_FILENAME",root++uriPath uri), ("QUERY_STRING",qs), ("HTTP_ACCEPT_LANGUAGE",al)] qs = case uriQuery uri of