@@ -9,6 +9,9 @@ import Network.CGI.Protocol
9import qualified Data.Map as Map
9import qualified Data.Map as Map
10import qualified Data.ByteString.Lazy as BS
10import qualified Data.ByteString.Lazy as BS
12+import Control.Arrow (first)
13+import Data.Char (toUpper)
12safeRead :: Read a => a -> String -> a
15safeRead :: Read a => a -> String -> a
13safeRead d s = case reads s of
16safeRead d s = case reads s of
14 ((x, _):_) -> x
17 ((x, _):_) -> x
@@ -20,7 +23,8 @@ cgiToApp cgi env = do
20 input = hackInput env
23 input = hackInput env
21 (inputs, body') = decodeInput vars input
24 (inputs, body') = decodeInput vars input
22 req = CGIRequest
25 req = CGIRequest
23− { cgiVars = Map.fromList vars
26+ { cgiVars = Map.fromList $ map (first fixVarName) vars
24 , cgiInputs = inputs
28 , cgiInputs = inputs
25 , cgiRequestBody = body'
29 , cgiRequestBody = body'
@@ -33,3 +37,20 @@ cgiToApp cgi env = do
33 Nothing -> 200
37 Nothing -> 200
34 Just s -> safeRead 200 s
38 Just s -> safeRead 200 s
35 return $ Response status' headers' output
39 return $ Response status' headers' output
41+fixVarName :: String -> String
42+fixVarName = (flip (++) $ "HTTP_") . map fixVarNameChar
44+fixVarNameChar :: Char -> Char
45+fixVarNameChar '-' = '_'
46+fixVarNameChar c = toUpper c
48+getCgiVars :: Env -> [(String, String)]
50+ [ ("PATH_INFO", pathInfo e)
51+ , ("REQUEST_METHOD", show $ requestMethod e)
52+ , ("SCRIPT_NAME", scriptName e)
53+ , ("QUERY_STRING", queryString e)
54+ , ("SERVER_NAME", serverName e)
55+ , ("SERVER_PORT", show $ serverPort e)