3354148 · typeable/wai

git.iko.soy/typeable/wai

ConnectionClosedByPeer (#52)

commit335414874aae17941e738097c0780a647fecab3e authorMichael Snoyman <michael@snoyman.com> dateSun 25 Mar 2012, 09:53 (15 years ago) parentb408c0c

2 files changed+45−9

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp.hs+17−8 warp/test/main.hs+28−1

warp/Network/Wai/Handler/Warp.hs+17−8

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

227227 serveConnection'' fromClient

228228

229229 serveConnection'' fromClient = do

230− env <- parseRequest conn port remoteHost' fromClient

230+ (env, requireDone) <- parseRequest conn port remoteHost' fromClient

231231 case settingsIntercept settings env of

232232 Nothing -> do

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

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

236236

237237 -- flush the rest of the request body

238238 requestBody env C.$$ CL.sinkNull

239+ liftIO requireDone

239240

240241 liftIO $ T.resume th

241242 keepAlive <- sendResponse th env conn res

@@ -244,9 +245,12 @@ serveConnection settings th onException port app conn remoteHost' =

244245 liftIO $ T.pause th

245246 intercept fromClient conn

246247

248+-- Require that the entire request body has been consumed

249+type RequireDone = IO ()

250+

247251parseRequest :: Connection -> Port -> SockAddr

248252 -> C.BufferedSource (ResourceT IO) S.ByteString

249− -> ResourceT IO Request

253+ -> ResourceT IO (Request, RequireDone)

250254parseRequest conn port remoteHost' src = do

251255 headers' <- src C.$$ takeHeaders

252256 parseRequest' conn port headers' remoteHost' src

@@ -261,6 +265,7 @@ data InvalidRequest =

261265 | BadFirstLine String

262266 | NonHttp

263267 | IncompleteHeaders

268+ | ConnectionClosedByPeer

264269 | OverLargeHeader

265270 deriving (Show, Typeable, Eq)

266271instance Exception InvalidRequest

@@ -285,7 +290,7 @@ parseRequest' :: Connection

285290 -> [ByteString]

286291 -> SockAddr

287292 -> C.BufferedSource (ResourceT IO) S.ByteString

288− -> ResourceT IO Request

293+ -> ResourceT IO (Request, RequireDone)

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

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

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

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

302307 Nothing -> 0

303308 Just bs -> readInt bs

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

305− rbody <-

310+ (rbody, requireDone) <-

306311 if len0 == 0

307− then return mempty

312+ then return (mempty, return ())

308313 else do

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

310315 -- kept in a mutable variable.

@@ -355,8 +360,12 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do

355360 then return C.Closed

356361 else return src')

357362 (return ())

358− return $ wrap $ src C.$= isolate

359− return Request

363+

364+ requireDone = do

365+ len <- liftIO $ I.readIORef lenRef

366+ when (len > 0) $ throwIO ConnectionClosedByPeer

367+ return (wrap $ src C.$= isolate, requireDone)

368+ return (Request

360369 { requestMethod = method

361370 , httpVersion = httpversion

362371 , pathInfo = H.decodePathSegments rpath

@@ -370,7 +379,7 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do

370379 , remoteHost = remoteHost'

371380 , requestBody = rbody

372381 , vault = mempty

373− }

382+ }, requireDone)

374383

375384

376385takeUntil :: Word8 -> ByteString -> ByteString

warp/test/main.hs+28−1

@@ -7,7 +7,7 @@ import Network.HTTP.Types

77import Control.Concurrent (forkIO, killThread, threadDelay)

88import Control.Monad (forM_)

10−import System.IO (hFlush)

10+import System.IO (hFlush, hClose)

1111import System.IO.Unsafe (unsafePerformIO)

1212import Data.ByteString (ByteString, hPutStr, hGetSome)

1313import qualified Data.ByteString as S

@@ -86,6 +86,29 @@ runTest expected app chunks = do

8686 Left s -> error s

8787 Right i -> i @?= expected

8888

89+dummyApp :: Application

90+dummyApp _ = return $ responseLBS status200 [] "foo"

91+

92+runTerminateTest :: InvalidRequest

93+ -> ByteString

94+ -> IO ()

95+runTerminateTest expected input = do

96+ port <- getPort

97+ ref <- I.newIORef Nothing

98+ tid <- forkIO $ runSettings defaultSettings

99+ { settingsOnException = \e -> I.writeIORef ref $ Just e

100+ , settingsPort = port

101+ } dummyApp

102+ threadDelay 1000

103+ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port

104+ hPutStr handle input

105+ hFlush handle

106+ hClose handle

107+ threadDelay 1000

108+ killThread tid

109+ res <- I.readIORef ref

110+ show res @?= show (Just expected)

111+

89112singleGet :: ByteString

90113singleGet = "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"

91114

@@ -119,3 +142,7 @@ main = hspecX $ do

119142 describe "no hanging" $ do

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

121144 it "double connect" $ runTest 1 doubleConnect [singlePostHello]

145+

146+ describe "connection termination" $ do

147+ it "ConnectionClosedByPeer" $ runTerminateTest ConnectionClosedByPeer "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r\nhello"

148+ it "IncompleteHeaders" $ runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n"