on master help sign in
Fix headerLines chunking bug for #239
commitae2b6b247149355a84717db57241f18d13fb2c4e authorMichael Snoyman <michael@snoyman.com> dateSun 30 Mar 2014, 08:44 (13 years ago) parentca3411c
3 files changed+34−10
warp/Network/Wai/Handler/Warp/Request.hs+5−8 warp/test/RequestSpec.hs+28−1 warp/warp.cabal+1−1
warp/Network/Wai/Handler/Warp/Request.hs+5−8
@@ -165,11 +165,12 @@ close :: Sink ByteString IO a
165165close = throwIO IncompleteHeaders
166166
167167push :: THStatus -> ByteString -> Sink ByteString IO (Maybe ByteString, [ByteString])
168−push (THStatus len lines prepend) bs
168+push (THStatus len lines prepend) bs'
169169 -- Too many bytes
170170 | len > maxTotalHeaderLength = throwIO OverLargeHeader
171171 | otherwise = push' mnl
172172 where
173+ bs = prepend bs'
173174 bsLen = S.length bs
174175 mnl = do
175176 nl <- S.elemIndex 10 bs
@@ -191,13 +192,13 @@ push (THStatus len lines prepend) bs
191192 push' Nothing = await >>= maybe close (push status)
192193 where
193194 len' = len + bsLen
194− prepend' = prepend . S.append bs
195+ prepend' = S.append bs
195196 status = THStatus len' lines prepend'
196197 -- Found a newline, but next line continues as a multiline header
197198 push' (Just (end, True)) = push status rest
198199 where
199200 rest = S.drop (end + 1) bs
200− prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs)
201+ prepend' = S.append (SU.unsafeTake (checkCR bs end) bs)
201202 len' = len + end
202203 status = THStatus len' lines prepend'
203204 -- Found a newline at position end.
@@ -222,11 +223,7 @@ push (THStatus len lines prepend) bs
222223 await >>= maybe close (push status)
223224 where
224225 start = end + 1 -- start of next chunk
225− line
226− -- There were some bytes before the newline, get them
227− | end > 0 = prepend $ SU.unsafeTake (checkCR bs end) bs
228− -- No bytes before the newline
229− | otherwise = prepend S.empty
226+ line = SU.unsafeTake (checkCR bs end) bs
230227
231228{-# INLINE checkCR #-}
232229checkCR :: ByteString -> Int -> Int
warp/test/RequestSpec.hs+28−1
@@ -5,12 +5,15 @@
55module RequestSpec (main, spec) where
66
77import Data.Conduit
8−import Data.Conduit.List
8+import qualified Data.Conduit.Binary as CB
9+import Data.Conduit.List (sourceList)
910import Network.Wai.Handler.Warp.Request
1011import Network.Wai.Handler.Warp.RequestHeader (parseByteRanges)
1112import Network.Wai.Handler.Warp.Types
1213import Test.Hspec
14+import Test.Hspec.QuickCheck
1315import qualified Data.ByteString.Char8 as S8
16+import qualified Data.ByteString.Lazy as L
1417import qualified Network.HTTP.Types.Header as HH
1518
1619deriving instance Show HH.ByteRange
@@ -30,6 +33,30 @@ spec = do
3033 tooMany `shouldThrow` overLargeHeader
3134 it "throws OverLargeHeader when too large" $
3235 tooLarge `shouldThrow` overLargeHeader
36+ it "known bad chunking behavior #239" $ do
37+ let chunks =
38+ [ "GET / HTTP/1.1\r\nConnection: Close\r"
39+ , "\n\r\n"
40+ ]
41+ (mleftover, actual) <- mapM_ yield chunks $$ headerLines
42+ mleftover `shouldBe` Nothing
43+ actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
44+ prop "random chunking" $ \breaks extraS -> do
45+ let bsFull = "GET / HTTP/1.1\r\nConnection: Close\r\n\r\n" `S8.append` extra
46+ extra = S8.pack extraS
47+ chunks = loop breaks bsFull
48+ loop [] bs = [bs, undefined]
49+ loop (x:xs) bs =
50+ bs1 : loop xs bs2
51+ where
52+ (bs1, bs2) = S8.splitAt ((x `mod` 10) + 1) bs
53+ (leftover, actual) <- mapM_ yield chunks $$ do
54+ (_, actual) <- headerLines
55+ x' <- CB.take (length extraS)
56+ let x = S8.concat $ L.toChunks x'
57+ return (x, actual)
58+ actual `shouldBe` ["GET / HTTP/1.1", "Connection: Close"]
59+ leftover `shouldBe` extra
3360 describe "parseByteRanges" $ do
3461 let test x y = it x $ parseByteRanges (S8.pack x) `shouldBe` y
3562 test "bytes=0-499" $ Just [HH.ByteRangeFromTo 0 499]
warp/warp.cabal+1−1
@@ -1,5 +1,5 @@
11Name: warp
2−Version: 2.1.3.2
2+Version: 2.1.3.3
33Synopsis: A fast, light-weight web server for WAI applications.
44License: MIT
55License-file: LICENSE