bef6e37 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Draining request body

bef6e37Michael Snoyman16 years ago

Network/Wai/Handler/Warp.hs+24−24

compare with master

unifiedsplit

@@ -52,6 +52,8 @@ import Data.Monoid (mconcat)

52import Control.Monad.IO.Class (liftIO)

53import Data.ByteString.Lazy.Internal (defaultChunkSize)

55+import Data.IORef (IORef, writeIORef, readIORef, newIORef)

56+

55run :: Port -> Application -> IO ()

57run :: Port -> Application -> IO ()

56run port = withSocketsDo .

58run port = withSocketsDo .

57 bracket

59 bracket

@@ -74,10 +76,11 @@ serveConnection port app conn remoteHost' = do

74 (hClose conn))

76 (hClose conn))

75 catchEOFError

77 catchEOFError

76 where serveConnection' = do

78 where serveConnection' = do

77− env <- parseRequest port conn remoteHost'

79+ (ilen, env) <- parseRequest port conn remoteHost'

78 res <- app env

80 res <- app env

81+ remaining <- readIORef ilen

82+ _ <- B.hGet conn remaining -- FIXME just skip, don't read

79 sendResponse (httpVersion env) conn res

83 sendResponse (httpVersion env) conn res

80− -- FIXME drain request body

81 hFlush conn

84 hFlush conn

82 when (isChunked $ httpVersion env) serveConnection'

85 when (isChunked $ httpVersion env) serveConnection'

@@ -87,7 +90,7 @@ serveConnection port app conn remoteHost' = do

87 Nothing -> ioError e

90 Nothing -> ioError e

88 | otherwise = ioError e

91 | otherwise = ioError e

90−parseRequest :: Port -> Handle -> String -> IO Request

93+parseRequest :: Port -> Handle -> String -> IO (IORef Int, Request)

91parseRequest port conn remoteHost' = do

94parseRequest port conn remoteHost' = do

92 headers' <- takeUntilBlank conn id

95 headers' <- takeUntilBlank conn id

93 parseRequest' port headers' conn remoteHost'

96 parseRequest' port headers' conn remoteHost'

@@ -119,7 +122,7 @@ parseRequest' :: Port

119 -> [ByteString]

122 -> [ByteString]

120 -> Handle

123 -> Handle

121 -> String

124 -> String

122− -> IO Request

125+ -> IO (IORef Int, Request)

123parseRequest' port lines' handle remoteHost' = do

126parseRequest' port lines' handle remoteHost' = do

124 (firstLine, otherLines) <-

127 (firstLine, otherLines) <-

125 case lines' of

128 case lines' of

@@ -138,7 +141,8 @@ parseRequest' port lines' handle remoteHost' = do

138 (x, _):_ -> Just x

141 (x, _):_ -> Just x

139 _ -> Nothing

142 _ -> Nothing

140 let (serverName', _) = B.break (== ':') host

143 let (serverName', _) = B.break (== ':') host

144+ ilen <- newIORef len

141− return $ Request

145+ return (ilen, Request

142 { requestMethod = method

146 { requestMethod = method

143 , httpVersion = httpversion

147 , httpVersion = httpversion

144 , pathInfo = B.pack rpath

148 , pathInfo = B.pack rpath

@@ -147,10 +151,10 @@ parseRequest' port lines' handle remoteHost' = do

147 , serverPort = port

151 , serverPort = port

148 , requestHeaders = heads

152 , requestHeaders = heads

149 , isSecure = False

153 , isSecure = False

150− , requestBody = requestBodyHandle handle len

154+ , requestBody = requestBodyHandle handle ilen len

151 , errorHandler = System.IO.hPutStr System.IO.stderr

155 , errorHandler = System.IO.hPutStr System.IO.stderr

152 , remoteHost = B.pack remoteHost'

156 , remoteHost = B.pack remoteHost'

153− }

157+ })

154

158

155parseFirst :: ByteString

159parseFirst :: ByteString

156 -> IO (ByteString, ByteString, ByteString, HttpVersion)

160 -> IO (ByteString, ByteString, ByteString, HttpVersion)

@@ -218,21 +222,17 @@ parseHeaderNoAttr s =

218 else rest

222 else rest

219 in (k, rest')

223 in (k, rest')

220

224

225+requestBodyHandle :: Handle

226+ -> IORef Int

227+ -> Int

221−requestBodyHandle :: Handle -> Int -> E.Enumerator B.ByteString IO a

228+ -> E.Enumerator B.ByteString IO a

222−requestBodyHandle h =

229+requestBodyHandle handle ilen initLen =

223− requestBodyFunc go

230+ go initLen

224 where

231 where

225− go i = Just `fmap` B.hGet h (min i defaultChunkSize)

226−

227−requestBodyFunc :: (Int -> IO (Maybe B.ByteString))

228− -> Int

229− -> E.Enumerator B.ByteString IO a

230−requestBodyFunc _ 0 step = E.returnI step

232+ go 0 step = E.returnI step

231−requestBodyFunc h len (E.Continue k) = do

233+ go len (E.Continue k) = do

232− mbs <- liftIO $ h len

234+ bs <- liftIO $ B.hGet handle (min len defaultChunkSize) -- FIXME play with defaultChunkSize

233− case mbs of

234− Nothing -> E.continue k

235− Just bs -> do

236− let newLen = len - B.length bs

235+ let newLen = len - B.length bs

236+ liftIO $ writeIORef ilen newLen

237− k (E.Chunks [bs]) >>== requestBodyFunc h newLen

237+ k (E.Chunks [bs]) >>== go newLen

238−requestBodyFunc _ _ step = E.returnI step

238+ go _ step = E.returnI step

undrained.hsnew file+9

@@ -0,0 +1,9 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+import Network.Wai

3+import Network.Wai.Handler.Warp

4+import Blaze.ByteString.Builder (fromByteString)

6+main = run 3000 $ const $ return $ responseBuilder

7+ status200

8+ [("Content-Type", "text/html")]

9+ $ fromByteString "<form method='post' enctype='multipart/form-data'><textarea name='foo'></textarea><input type='submit'></form>"