git.iko.soy/typeable/wai
on master help sign in
Merge PR #781.
commit0890255103cd17b79c9997010ddb670a32e4688f authorKazu Yamamoto <kazu@iij.ad.jp> dateTue 21 Jan 2020, 09:30 (7 years ago) parenta3733ae7553bd4
5 files changed+40−24
compare with master
unifiedsplit
warp/ChangeLog.md+5 warp/Network/Wai/Handler/Warp.hs+8 warp/Network/Wai/Handler/Warp/Request.hs+11−17 warp/Network/Wai/Handler/Warp/Settings.hs+5 warp/test/RequestSpec.hs+11−7
warp/ChangeLog.md+5
@@ -1,3 +1,8 @@
1+## 3.3.8
2+
3+* Maximum header size is configurable.
4+ [#781](https://github.com/yesodweb/wai/pull/781)
5+
16## 3.3.7
27
38* InvalidArgument (Bad file descriptor) is ignored in `receive`.
warp/Network/Wai/Handler/Warp.hs+8
@@ -74,6 +74,7 @@ module Network.Wai.Handler.Warp (
7474 , setGracefulShutdownTimeout
7575 , setGracefulCloseTimeout1
7676 , setGracefulCloseTimeout2
77+ , setMaxTotalHeaderLength
7778 -- ** Getters
7879 , getPort
7980 , getHost
@@ -436,6 +437,13 @@ setGracefulShutdownTimeout :: Maybe Int
436437 -> Settings -> Settings
437438setGracefulShutdownTimeout time y = y { settingsGracefulShutdownTimeout = time }
438439
440+-- | Set the maximum header size that Warp will tolerate when using HTTP/1.x.
441+--
442+-- Since 3.3.8
443+setMaxTotalHeaderLength :: Int -> Settings -> Settings
444+setMaxTotalHeaderLength maxTotalHeaderLength settings = settings
445+ { settingsMaxTotalHeaderLength = maxTotalHeaderLength }
446+
439447-- | Explicitly pause the slowloris timeout.
440448--
441449-- This is useful for cases where you partially consume a request body. For
warp/Network/Wai/Handler/Warp/Request.hs+11−17
@@ -38,13 +38,7 @@ import Network.Wai.Handler.Warp.Header
3838import Network.Wai.Handler.Warp.Imports hiding (readInt, lines)
3939import Network.Wai.Handler.Warp.ReadInt
4040import Network.Wai.Handler.Warp.RequestHeader
41−import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath)
42−
43−----------------------------------------------------------------
44−
45−-- FIXME come up with good values here
46−maxTotalHeaderLength :: Int
47−maxTotalHeaderLength = 50 * 1024
41+import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath, settingsMaxTotalHeaderLength)
4842
4943----------------------------------------------------------------
5044
@@ -68,7 +62,7 @@ recvRequest :: Bool -- ^ first request on this connection?
6862 -- Body producing action used for flushing the request body
6963
7064recvRequest firstRequest settings conn ii th addr src transport = do
71− hdrlines <- headerLines firstRequest src
65+ hdrlines <- headerLines (settingsMaxTotalHeaderLength settings) firstRequest src
7266 (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
7367 let idxhdr = indexRequestHeader hdr
7468 expect = idxhdr ! fromEnum ReqExpect
@@ -107,8 +101,8 @@ recvRequest firstRequest settings conn ii th addr src transport = do
107101
108102----------------------------------------------------------------
109103
110−headerLines :: Bool -> Source -> IO [ByteString]
111−headerLines firstRequest src = do
104+headerLines :: Int -> Bool -> Source -> IO [ByteString]
105+headerLines maxTotalHeaderLength firstRequest src = do
112106 bs <- readSource src
113107 if S.null bs
114108 -- When we're working on a keep-alive connection and trying to
@@ -116,7 +110,7 @@ headerLines firstRequest src = do
116110 -- lack of data as a real exception. See the http1 function in
117111 -- the Run module for more details.
118112 then if firstRequest then throwIO ConnectionClosedByPeer else throwIO NoKeepAliveRequest
119− else push src (THStatus 0 id id) bs
113+ else push maxTotalHeaderLength src (THStatus 0 id id) bs
120114
121115data NoKeepAliveRequest = NoKeepAliveRequest
122116 deriving (Show, Typeable)
@@ -226,8 +220,8 @@ close :: Sink ByteString IO a
226220close = throwIO IncompleteHeaders
227221-}
228222
229−push :: Source -> THStatus -> ByteString -> IO [ByteString]
230−push src (THStatus len lines prepend) bs'
223+push :: Int -> Source -> THStatus -> ByteString -> IO [ByteString]
224+push maxTotalHeaderLength src (THStatus len lines prepend) bs'
231225 -- Too many bytes
232226 | len > maxTotalHeaderLength = throwIO OverLargeHeader
233227 | otherwise = push' mnl
@@ -255,13 +249,13 @@ push src (THStatus len lines prepend) bs'
255249 push' Nothing = do
256250 bst <- readSource' src
257251 when (S.null bst) $ throwIO IncompleteHeaders
258− push src status bst
252+ push maxTotalHeaderLength src status bst
259253 where
260254 len' = len + bsLen
261255 prepend' = S.append bs
262256 status = THStatus len' lines prepend'
263257 -- Found a newline, but next line continues as a multiline header
264− push' (Just (end, True)) = push src status rest
258+ push' (Just (end, True)) = push maxTotalHeaderLength src status rest
265259 where
266260 rest = S.drop (end + 1) bs
267261 prepend' = S.append (SU.unsafeTake (checkCR bs end) bs)
@@ -280,12 +274,12 @@ push src (THStatus len lines prepend) bs'
280274 in if start < bsLen then
281275 -- more bytes in this chunk, push again
282276 let bs'' = SU.unsafeDrop start bs
283− in push src status bs''
277+ in push maxTotalHeaderLength src status bs''
284278 else do
285279 -- no more bytes in this chunk, ask for more
286280 bst <- readSource' src
287281 when (S.null bs) $ throwIO IncompleteHeaders
288− push src status bst
282+ push maxTotalHeaderLength src status bst
289283 where
290284 start = end + 1 -- start of next chunk
291285 line = SU.unsafeTake (checkCR bs end) bs
warp/Network/Wai/Handler/Warp/Settings.hs+5
@@ -128,6 +128,10 @@ data Settings = Settings
128128 -- Default: 2000.
129129 --
130130 -- Since 3.3.5
131+ , settingsMaxTotalHeaderLength :: Int
132+ -- ^ Determines the maximum header size that Warp will tolerate when using HTTP/1.x.
133+ --
134+ -- Since 3.3.8
131135 }
132136
133137-- | Specify usage of the PROXY protocol.
@@ -166,6 +170,7 @@ defaultSettings = Settings
166170 , settingsGracefulShutdownTimeout = Nothing
167171 , settingsGracefulCloseTimeout1 = 0
168172 , settingsGracefulCloseTimeout2 = 2000
173+ , settingsMaxTotalHeaderLength = 50 * 1024
169174 }
170175
171176-- | Apply the logic provided by 'defaultOnException' to determine if an
warp/test/RequestSpec.hs+11−7
@@ -7,6 +7,7 @@ module RequestSpec (main, spec) where
77import Network.Wai.Handler.Warp.File (parseByteRanges)
88import Network.Wai.Handler.Warp.Request
99import Network.Wai.Handler.Warp.Types
10+import Network.Wai.Handler.Warp.Settings (settingsMaxTotalHeaderLength, defaultSettings)
1011import Test.Hspec
1112import Test.Hspec.QuickCheck
1213import qualified Data.ByteString as S
@@ -17,6 +18,9 @@ import Data.IORef
1718main :: IO ()
1819main = hspec spec
1920
21+defaultMaxTotalHeaderLength :: Int
22+defaultMaxTotalHeaderLength = settingsMaxTotalHeaderLength defaultSettings
23+
2024spec :: Spec
2125spec = do
2226 describe "headerLines" $ do
@@ -63,29 +67,29 @@ spec = do
6367 describe "headerLines" $ do
6468 it "can handle a nomarl case" $ do
6569 src <- mkSourceFunc ["Status: 200\r\nContent-Type: text/plain\r\n\r\n"] >>= mkSource
66− x <- headerLines True src
70+ x <- headerLines defaultMaxTotalHeaderLength True src
6771 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
6872
6973 it "can handle a nasty case (1)" $ do
7074 src <- mkSourceFunc ["Status: 200", "\r\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource
71− x <- headerLines True src
75+ x <- headerLines defaultMaxTotalHeaderLength True src
7276 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
7377
7478 it "can handle a nasty case (1)" $ do
7579 src <- mkSourceFunc ["Status: 200", "\r", "\nContent-Type: text/plain", "\r", "\n\r\n"] >>= mkSource
76− x <- headerLines True src
80+ x <- headerLines defaultMaxTotalHeaderLength True src
7781 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
7882
7983 it "can handle a nasty case (1)" $ do
8084 src <- mkSourceFunc ["Status: 200", "\r", "\n", "Content-Type: text/plain", "\r", "\n", "\r", "\n"] >>= mkSource
81− x <- headerLines True src
85+ x <- headerLines defaultMaxTotalHeaderLength True src
8286 x `shouldBe` ["Status: 200", "Content-Type: text/plain"]
8387
8488 it "can handle an illegal case (1)" $ do
8589 src <- mkSourceFunc ["\nStatus:", "\n 200", "\nContent-Type: text/plain", "\r\n\r\n"] >>= mkSource
86− x <- headerLines True src
90+ x <- headerLines defaultMaxTotalHeaderLength True src
8791 x `shouldBe` []
88− y <- headerLines True src
92+ y <- headerLines defaultMaxTotalHeaderLength True src
8993 y `shouldBe` ["Status: 200", "Content-Type: text/plain"]
9094
9195 where
@@ -111,7 +115,7 @@ headerLinesList' orig = do
111115 writeIORef ref z
112116 return y
113117 src' <- mkSource src
114− res <- headerLines True src'
118+ res <- headerLines defaultMaxTotalHeaderLength True src'
115119 return (res, src')
116120
117121consumeLen :: Int -> Source -> IO S8.ByteString