@@ -4,9 +4,13 @@ module Network.Wai.Frontend.MonadCGI
44 ) where
55
66import Network.Wai
7−import Network.Wai.Source
87import Network.CGI.Monad
98import Network.CGI.Protocol
9+import Network.HTTP.Types (Status (..))
10+import Control.Monad.IO.Class (liftIO)
11+import Data.CaseInsensitive (original)
12+
13+import qualified Data.Enumerator.List as EL
1014
1115import qualified Data.Map as Map
1216import qualified Data.ByteString.Lazy as BS
@@ -29,7 +33,10 @@ cgiToAppGeneric :: Monad m
2933 -> CGIT m CGIResult
3034 -> Application
3135cgiToAppGeneric toIO cgi env = do
32− input <- toLBS $ requestBody env
36+ -- Note: the next line will read the entire request body into memory.
37+ -- This is a flaw in enumerator-based WAI. Conduit-based WAI will allow
38+ -- for lazy I/O here.
39+ input <- fmap BS.fromChunks EL.consume
3340 let vars = map (first fixVarName . go) (requestHeaders env)
3441 ++ getCgiVars env
3542 (inputs, body') = decodeInput vars input
@@ -38,7 +45,7 @@ cgiToAppGeneric toIO cgi env = do
3845 , cgiInputs = inputs
3946 , cgiRequestBody = body'
4047 }
41− (headers'', output') <- toIO $ runCGIT cgi req
48+ (headers'', output') <- liftIO $ toIO $ runCGIT cgi req
4249 let output = case output' of
4350 CGIOutput bs -> bs
4451 CGINothing -> BS.empty
@@ -47,9 +54,9 @@ cgiToAppGeneric toIO cgi env = do
4754 let status' = case lookup (fromString "Status") headers' of
4855 Nothing -> 200
4956 Just s -> safeRead 200 $ S8.unpack s
50− return $ Response (Status status' S8.empty) headers' $ ResponseLBS output
57+ return $ responseLBS (Status status' S8.empty) headers' output
5158 where
52− go (x, y) = (S8.unpack $ ciOriginal x, S8.unpack y)
59+ go (x, y) = (S8.unpack $ original x, S8.unpack y)
5360
5461fixVarName :: String -> String
5562fixVarName = ((++) $ "HTTP_") . map fixVarNameChar
@@ -60,9 +67,9 @@ fixVarNameChar c = toUpper c
6067
6168getCgiVars :: Request -> [(String, String)]
6269getCgiVars e =
63− [ ("PATH_INFO", S8.unpack $ pathInfo e)
70+ [ ("PATH_INFO", S8.unpack $ rawPathInfo e)
6471 , ("REQUEST_METHOD", show $ requestMethod e)
65− , ("QUERY_STRING", S8.unpack $ queryString e)
72+ , ("QUERY_STRING", S8.unpack $ rawQueryString e)
6673 , ("SERVER_NAME", S8.unpack $ serverName e)
6774 , ("SERVER_PORT", show $ serverPort e)
6875 ]