@@ -9,6 +9,9 @@ import Network.CGI.Protocol
99import qualified Data.Map as Map
1010import qualified Data.ByteString.Lazy as BS
1111
12+import Control.Arrow (first)
13+import Data.Char (toUpper)
14+
1215safeRead :: Read a => a -> String -> a
1316safeRead d s = case reads s of
1417 ((x, _):_) -> x
@@ -20,7 +23,8 @@ cgiToApp cgi env = do
2023 input = hackInput env
2124 (inputs, body') = decodeInput vars input
2225 req = CGIRequest
23− { cgiVars = Map.fromList vars
26+ { cgiVars = Map.fromList $ map (first fixVarName) vars
27+ ++ getCgiVars env
2428 , cgiInputs = inputs
2529 , cgiRequestBody = body'
2630 }
@@ -33,3 +37,20 @@ cgiToApp cgi env = do
3337 Nothing -> 200
3438 Just s -> safeRead 200 s
3539 return $ Response status' headers' output
40+
41+fixVarName :: String -> String
42+fixVarName = (flip (++) $ "HTTP_") . map fixVarNameChar
43+
44+fixVarNameChar :: Char -> Char
45+fixVarNameChar '-' = '_'
46+fixVarNameChar c = toUpper c
47+
48+getCgiVars :: Env -> [(String, String)]
49+getCgiVars e =
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)
56+ ]