22cfa80 · typeable/wai

git.iko.soy/typeable/wai

Prevent a call to requestBody from ever hanging. (yesodweb/yesod#248)

Here's the issue: we fuse our buffered request body with an isolate conduit which ensures no more than X bytes are read. Suppose we read all X bytes, and then we call requestBody again. What happens? Previously, we would try to read one more chunk from the buffered source. This is inherent to conduit: we wouldn't know that the isolate Conduit isn't accepting more data until after we've pushed some data to it. This results in hanging, since there's no data available on the wire. Instead, we add a wrapper that checks if the request body has already been depleted before making that first pull. Possible optimization: do away with the Conduit entirely. However, this may be less efficient overall, as we'd now have to check the BufferedSource status on each call. Worth looking into.

commit22cfa8008852f3b3e0cb2dd15b452b08a278ac73 authorMichael Snoyman <michael@snoyman.com> dateTue 31 Jan 2012, 23:36 (15 years ago) parentc2595d5

2 files changed+27−23

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp.hs+19−23 warp/test/main.hs+8

warp/Network/Wai/Handler/Warp.hs+19−23

@@ -268,7 +268,7 @@ serveConnection settings th onException port app conn remoteHost' =

268268 serveConnection'' fromClient

269269

270270 serveConnection'' fromClient = do

271− (flushBody, env) <- parseRequest port remoteHost' fromClient

271+ env <- parseRequest port remoteHost' fromClient

272272 case settingsIntercept settings env of

273273 Nothing -> do

274274 -- Let the application run for as long as it wants

@@ -276,7 +276,7 @@ serveConnection settings th onException port app conn remoteHost' =

276276 res <- app env

277277

278278 -- flush the rest of the request body

279− flushBody

279+ requestBody env C.$$ CL.sinkNull

280280

281281 liftIO $ T.resume th

282282 keepAlive <- sendResponse th env conn res

@@ -287,7 +287,7 @@ serveConnection settings th onException port app conn remoteHost' =

287287

288288parseRequest :: Port -> SockAddr

289289 -> C.BufferedSource IO S.ByteString

290− -> ResourceT IO (ResourceT IO (), Request)

290+ -> ResourceT IO Request

291291parseRequest port remoteHost' src = do

292292 headers' <- src C.$$ takeHeaders

293293 parseRequest' port headers' remoteHost' src

@@ -311,7 +311,7 @@ parseRequest' :: Port

311311 -> [ByteString]

312312 -> SockAddr

313313 -> C.BufferedSource IO S.ByteString

314− -> ResourceT IO (ResourceT IO (), Request)

314+ -> ResourceT IO Request

315315parseRequest' _ [] _ _ = throwIO $ NotEnoughLines []

316316parseRequest' port (firstLine:otherLines) remoteHost' src = do

317317 (method, rpath', gets, httpversion) <- parseFirst firstLine

@@ -326,9 +326,9 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do

326326 Nothing -> 0

327327 Just bs -> readInt bs

328328 let serverName' = takeUntil 58 host -- ':'

329− (flush', rbody) <-

329+ rbody <-

330330 if len0 == 0

331− then return (return (), mempty)

331+ then return mempty

332332 else do

333333 -- We can't use the standard isolate, as its counter is not

334334 -- kept in a mutable variable.

@@ -344,22 +344,18 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do

344344 else C.Producing isolate [a]

345345 close = return []

346346

347− binDrop i0 = C.sinkState i0 pushS closeS

348− pushS i bs

349− | S.length bs > i =

350− return $ C.StateDone (Just $ S.drop i bs) ()

351− | S.length bs == 0 =

352− return $ C.StateDone Nothing ()

353− | otherwise =

354− return $ C.StateProcessing $ i - S.length bs

355− closeS _ = return ()

356− flush' = do

357− len <- liftIO $ I.readIORef lenRef

358− if len > 0

359− then src C.$$ binDrop len

360− else return ()

361− return (flush', src C.$= isolate)

362− return (flush', Request

347+ -- Make sure that we don't connect to the source after the

348+ -- isolate conduit closes.

349+ wrap src' = C.Source

350+ { C.sourcePull = do

351+ len <- liftIO $ I.readIORef lenRef

352+ if len <= 0

353+ then return C.Closed

354+ else C.sourcePull src'

355+ , C.sourceClose = return ()

356+ }

357+ return $ wrap $ src C.$= isolate

358+ return Request

363359 { requestMethod = method

364360 , httpVersion = httpversion

365361 , pathInfo = H.decodePathSegments rpath

@@ -373,7 +369,7 @@ parseRequest' port (firstLine:otherLines) remoteHost' src = do

373369 , remoteHost = remoteHost'

374370 , requestBody = rbody

375371 , vault = mempty

376− })

372+ }

377373

378374

379375takeUntil :: Word8 -> ByteString -> ByteString

warp/test/main.hs+8

@@ -54,6 +54,13 @@ ignoreBody icount req = do

5454 else err icount ("Invalid request method" :: String, requestMethod req)

5555 return $ responseLBS status200 [] "Ignored the body"

5656

57+doubleConnect :: CounterApplication

58+doubleConnect icount req = do

59+ _ <- requestBody req $$ Data.Conduit.List.consume

60+ _ <- requestBody req $$ Data.Conduit.List.consume

61+ incr icount

62+ return $ responseLBS status200 [] "double connect"

63+

5764nextPort :: I.IORef Int

5865nextPort = unsafePerformIO $ I.newIORef 5000

5966

@@ -111,3 +118,4 @@ main = hspecX $ do

111118 ]

112119 describe "no hanging" $ do

113120 it "has body, read" $ runTest 1 readBody $ map S.singleton $ S.unpack singlePostHello

121+ it "double connect" $ runTest 1 doubleConnect [singlePostHello]