on master help sign in
Implement the changes suggested by Michael Snoyman
952f3a8Hans-Christian Esperer
wai-extra/Network/Wai/Parse.hs+178−149
@@ -11,6 +11,7 @@ module Network.Wai.Parse
11 , RequestBodyType (..)
11 , RequestBodyType (..)
12 , getRequestBodyType
12 , getRequestBodyType
13 , sinkRequestBody
13 , sinkRequestBody
14+ , sinkRequestBodyEx
14 , BackEnd
15 , BackEnd
15 , lbsBackEnd
16 , lbsBackEnd
16 , tempFileBackEnd
17 , tempFileBackEnd
@@ -19,8 +20,23 @@ module Network.Wai.Parse
19 , File
20 , File
20 , FileInfo (..)
21 , FileInfo (..)
21 , parseContentType
22 , parseContentType
22− , ParseRequestBodyOptions (..)
23+ , ParseRequestBodyOptions
24+ , defaultParseRequestBodyOptions
23 , parseRequestBodyEx
25 , parseRequestBodyEx
26+ , setMaxRequestKeyLength
27+ , clearMaxRequestKeyLength
28+ , setMaxRequestNumFiles
29+ , clearMaxRequestNumFiles
30+ , setMaxRequestFileSize
31+ , clearMaxRequestFileSize
32+ , setMaxRequestFilesSize
33+ , clearMaxRequestFilesSize
34+ , setMaxRequestParmsSize
35+ , clearMaxRequestParmsSize
36+ , setMaxHeaderLines
37+ , clearMaxHeaderLines
38+ , setMaxHeaderLineLength
39+ , clearMaxHeaderLineLength
24#if TEST
40#if TEST
25 , Bound (..)
41 , Bound (..)
26 , findBound
42 , findBound
@@ -35,7 +51,6 @@ import qualified Data.ByteString.Search as Search
35import qualified Data.ByteString as S
51import qualified Data.ByteString as S
36import qualified Data.ByteString.Lazy as L
52import qualified Data.ByteString.Lazy as L
37import qualified Data.ByteString.Char8 as S8
53import qualified Data.ByteString.Char8 as S8
38−import Data.Default (Default, def)
39import Data.Word (Word8)
54import Data.Word (Word8)
40import Data.Int (Int64)
55import Data.Int (Int64)
41import Data.Maybe (catMaybes, fromMaybe)
56import Data.Maybe (catMaybes, fromMaybe)
@@ -52,6 +67,8 @@ import Data.IORef
52import Network.HTTP.Types (hContentType)
67import Network.HTTP.Types (hContentType)
53import Data.CaseInsensitive (mk)
68import Data.CaseInsensitive (mk)
54
69
70+import Prelude hiding (lines)
71+
55breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
72breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
56breakDiscard w s =
73breakDiscard w s =
57 let (x, y) = S.break (== w) s
74 let (x, y) = S.break (== w) s
@@ -127,26 +144,103 @@ tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
127-- the parseRequestBodyEx function.
144-- the parseRequestBodyEx function.
128data ParseRequestBodyOptions = ParseRequestBodyOptions
145data ParseRequestBodyOptions = ParseRequestBodyOptions
129 { -- | The maximum length of a filename
146 { -- | The maximum length of a filename
130− prboKeyLength :: Int
147+ prboKeyLength :: Maybe Int
131 , -- | The maximum number of files.
148 , -- | The maximum number of files.
132− prboMaxNumFiles :: Int
149+ prboMaxNumFiles :: Maybe Int
133 , -- | The maximum filesize per file.
150 , -- | The maximum filesize per file.
134 prboMaxFileSize :: Maybe Int64
151 prboMaxFileSize :: Maybe Int64
135 , -- | The maximum total filesize.
152 , -- | The maximum total filesize.
136 prboMaxFilesSize :: Maybe Int64
153 prboMaxFilesSize :: Maybe Int64
137− , -- | The maximum size of the sum of all parameters values
154+ , -- | The maximum size of the sum of all parameters
138− prboMaxParmsValueSize :: Int
155+ prboMaxParmsSize :: Maybe Int
156+ , -- | The maximum header lines per mime/multipart entry
157+ prboMaxHeaderLines :: Maybe Int
158+ , -- | The maximum header line length per mime/multipart entry
159+ prboMaxHeaderLineLength :: Maybe Int }
160+
161+-- | Set the maximum length of a filename.
162+setMaxRequestKeyLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
163+setMaxRequestKeyLength l p = p { prboKeyLength=Just l }
164+
165+-- | Do not limit the length of filenames.
166+clearMaxRequestKeyLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
167+clearMaxRequestKeyLength p = p { prboKeyLength=Nothing }
168+
169+-- | Set the maximum number of files per request.
170+setMaxRequestNumFiles :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
171+setMaxRequestNumFiles l p = p { prboMaxNumFiles=Just l }
172+
173+-- | Do not limit the maximum number of files per request.
174+clearMaxRequestNumFiles :: ParseRequestBodyOptions -> ParseRequestBodyOptions
175+clearMaxRequestNumFiles p = p { prboMaxNumFiles=Nothing }
176+
177+-- | Set the maximum filesize per file.
178+setMaxRequestFileSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
179+setMaxRequestFileSize l p = p { prboMaxFileSize=Just l }
180+
181+-- | Do not limit the maximum filesize per file.
182+clearMaxRequestFileSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
183+clearMaxRequestFileSize p = p { prboMaxFileSize=Nothing }
184+
185+-- | Set the maximum size of all files per request.
186+setMaxRequestFilesSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
187+setMaxRequestFilesSize l p = p { prboMaxFilesSize=Just l }
188+
189+-- | Do not limit the maximum size of all files per request.
190+clearMaxRequestFilesSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
191+clearMaxRequestFilesSize p = p { prboMaxFilesSize=Nothing }
192+
193+-- | Set the maximum size of the sum of all parameters.
194+setMaxRequestParmsSize :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
195+setMaxRequestParmsSize l p = p { prboMaxParmsSize=Just l }
196+
197+-- | Do not limit the maximum size of the sum of all parameters.
198+clearMaxRequestParmsSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
199+clearMaxRequestParmsSize p = p { prboMaxParmsSize=Nothing }
200+
201+-- | Set the maximum header lines per mime/multipart entry.
202+setMaxHeaderLines :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
203+setMaxHeaderLines l p = p { prboMaxHeaderLines=Just l }
204+
205+-- | Do not limit the maximum header lines per mime/multipart entry.
206+clearMaxHeaderLines:: ParseRequestBodyOptions -> ParseRequestBodyOptions
207+clearMaxHeaderLines p = p { prboMaxHeaderLines=Nothing }
208+
209+-- | Set the maximum header line length per mime/multipart entry.
210+setMaxHeaderLineLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
211+setMaxHeaderLineLength l p = p { prboMaxHeaderLineLength=Just l }
212+
139− , -- | The maximum header lines per entry
213+-- | Do not limit the maximum header lines per mime/multipart entry.
140− prboMaxHeaderLines :: Int }
214+clearMaxHeaderLineLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
141−
215+clearMaxHeaderLineLength p = p { prboMaxHeaderLineLength=Nothing }
216+
217+-- | A reasonable default set of parsing options.
218+-- Maximum key/filename length: 32 bytes;
219+-- maximum files: 10; filesize unlimited; maximum
220+-- size for parameters: 64kbytes; maximum number of header
221+-- lines: 32 bytes (applies only to headers of a mime/multipart message);
222+-- maximum header line length: 8190 bytes (applies only to headers of
223+-- a mime/multipart message)
142−instance Default ParseRequestBodyOptions where
224+defaultParseRequestBodyOptions :: ParseRequestBodyOptions
143− def = ParseRequestBodyOptions
225+defaultParseRequestBodyOptions = ParseRequestBodyOptions
144− { prboKeyLength=32
226+ { prboKeyLength=Just 32
145− , prboMaxNumFiles=10
227+ , prboMaxNumFiles=Just 10
146− , prboMaxFileSize=Nothing
228+ , prboMaxFileSize=Nothing
147− , prboMaxFilesSize=Nothing
229+ , prboMaxFilesSize=Nothing
148− , prboMaxParmsValueSize=65336
230+ , prboMaxParmsSize=Just 65336
149− , prboMaxHeaderLines=32 }
231+ , prboMaxHeaderLines=Just 32
232+ , prboMaxHeaderLineLength=Just 8190 }
233+
234+-- | Do not impose any memory limits.
235+noLimitParseRequestBodyOptions :: ParseRequestBodyOptions
236+noLimitParseRequestBodyOptions = ParseRequestBodyOptions
237+ { prboKeyLength=Nothing
238+ , prboMaxNumFiles=Nothing
239+ , prboMaxFileSize=Nothing
240+ , prboMaxFilesSize=Nothing
241+ , prboMaxParmsSize=Nothing
242+ , prboMaxHeaderLines=Nothing
243+ , prboMaxHeaderLineLength=Nothing }
150
244
151-- | Information on an uploaded file.
245-- | Information on an uploaded file.
152data FileInfo c = FileInfo
246data FileInfo c = FileInfo
@@ -221,10 +315,7 @@ parseContentType a = do
221parseRequestBody :: BackEnd y
315parseRequestBody :: BackEnd y
222 -> Request
316 -> Request
223 -> IO ([Param], [File y])
317 -> IO ([Param], [File y])
224−parseRequestBody s r =
318+parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions
225− case getRequestBodyType r of
226− Nothing -> return ([], [])
227− Just rbt -> sinkRequestBody s rbt (requestBody r)
228
319
229-- | Parse the body of an HTTP request, limit resource usage.
320-- | Parse the body of an HTTP request, limit resource usage.
230-- The HTTP body can contain both parameters and files.
321-- The HTTP body can contain both parameters and files.
@@ -245,15 +336,7 @@ sinkRequestBody :: BackEnd y
245 -> RequestBodyType
336 -> RequestBodyType
246 -> IO S.ByteString
337 -> IO S.ByteString
247 -> IO ([Param], [File y])
338 -> IO ([Param], [File y])
248−sinkRequestBody s r body = do
339+sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions
249− ref <- newIORef (id, id)
250− let add x = atomicModifyIORef ref $ \(y, z) ->
251− case x of
252− Left y' -> ((y . (y':), z), ())
253− Right z' -> ((y, z . (z':)), ())
254− conduitRequestBody s r body add
255− (x, y) <- readIORef ref
256− return (x [], y [])
257
340
258sinkRequestBodyEx :: ParseRequestBodyOptions
341sinkRequestBodyEx :: ParseRequestBodyOptions
259 -> BackEnd y
342 -> BackEnd y
@@ -267,26 +350,7 @@ sinkRequestBodyEx o s r body = do
267 Left y' -> ((y':y, z), ())
350 Left y' -> ((y':y, z), ())
268 Right z' -> ((y, z':z), ())
351 Right z' -> ((y, z':z), ())
269 conduitRequestBodyEx o s r body add
352 conduitRequestBodyEx o s r body add
270− readIORef ref
353+ (\(a, b) -> (reverse a, reverse b)) <$> readIORef ref
271−
272−conduitRequestBody :: BackEnd y
273− -> RequestBodyType
274− -> IO S.ByteString
275− -> (Either Param (File y) -> IO ())
276− -> IO ()
277−conduitRequestBody _ UrlEncoded rbody add = do
278− -- NOTE: in general, url-encoded data will be in a single chunk.
279− -- Therefore, I'm optimizing for the usual case by sticking with
280− -- strict byte strings here.
281− let loop front = do
282− bs <- rbody
283− if S.null bs
284− then return $ S.concat $ front []
285− else loop $ front . (bs:)
286− bs <- loop id
287− mapM_ (add . Left) $ H.parseSimpleQuery bs
288−conduitRequestBody backend (Multipart bound) rbody add =
289− parsePieces backend (S8.pack "--" `S.append` bound) rbody add
290
354
291conduitRequestBodyEx :: ParseRequestBodyOptions
355conduitRequestBodyEx :: ParseRequestBodyOptions
292 -> BackEnd y
356 -> BackEnd y
@@ -298,18 +362,18 @@ conduitRequestBodyEx o _ UrlEncoded rbody add = do
298 -- NOTE: in general, url-encoded data will be in a single chunk.
362 -- NOTE: in general, url-encoded data will be in a single chunk.
299 -- Therefore, I'm optimizing for the usual case by sticking with
363 -- Therefore, I'm optimizing for the usual case by sticking with
300 -- strict byte strings here.
364 -- strict byte strings here.
301− size <- newIORef 0
302− let loop front = do
365+ let loop size front = do
303 bs <- rbody
366 bs <- rbody
304 if S.null bs
367 if S.null bs
305 then return $ S.concat $ front []
368 then return $ S.concat $ front []
306 else do
369 else do
307− newsize <- atomicModifyIORef size $
308− \cursize -> let newsize = cursize + S.length bs in (newsize, newsize)
370+ let newsize = size + S.length bs
309− when (newsize > prboMaxParmsValueSize o) $
371+ case prboMaxParmsSize o of
372+ Just maxSize -> when (newsize > maxSize) $
310− error "Maximum size of parameters exceeded"
373+ error "Maximum size of parameters exceeded"
374+ Nothing -> return ()
311− loop $ front . (bs:)
375+ loop newsize $ front . (bs:)
312− bs <- loop id
376+ bs <- loop 0 id
313 mapM_ (add . Left) $ H.parseSimpleQuery bs
377 mapM_ (add . Left) $ H.parseSimpleQuery bs
314conduitRequestBodyEx o backend (Multipart bound) rbody add =
378conduitRequestBodyEx o backend (Multipart bound) rbody add =
315 parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
379 parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
@@ -319,13 +383,16 @@ conduitRequestBodyEx o backend (Multipart bound) rbody add =
319-- It makes sense to limit the maximum line length.
383-- It makes sense to limit the maximum line length.
320-- Apache's default is 8190 (http://httpd.apache.org/docs/2.2/mod/core.html#limitrequestline)
384-- Apache's default is 8190 (http://httpd.apache.org/docs/2.2/mod/core.html#limitrequestline)
321-- so we're using that here as well.
385-- so we're using that here as well.
322−takeLine :: Source -> IO (Maybe S.ByteString)
386+takeLine :: Maybe Int -> Source -> IO (Maybe S.ByteString)
323−takeLine src =
387+takeLine maxlen src =
324 go ""
388 go ""
325 where
389 where
326 go front = do
390 go front = do
327 bs <- readSource src
391 bs <- readSource src
392+ case maxlen of
393+ Just maxlen' -> when (S.length front + S.length bs > maxlen') $
328− when (S.length front + S.length bs > 8190) $ error "Header line length exceeds allowed maximum."
394+ error "Header line length exceeds allowed maximum."
395+ Nothing -> return ()
329 if S.null bs
396 if S.null bs
330 then close front
397 then close front
331 else push front bs
398 else push front bs
@@ -339,30 +406,28 @@ takeLine src =
339 when (S.length y > 1) $ leftover src $ S.drop 1 y
406 when (S.length y > 1) $ leftover src $ S.drop 1 y
340 return $ Just $ killCR $ front `S.append` x
407 return $ Just $ killCR $ front `S.append` x
341
408
342−takeLines :: Source -> IO [S.ByteString]
409+takeLines' :: Maybe Int -> Maybe Int -> Source -> IO [S.ByteString]
343−takeLines src = do
410+takeLines' lineLength maxLines source =
411+ reverse <$> takeLines'' [] lineLength maxLines source
412+
413+takeLines''
414+ :: [S.ByteString]
415+ -> Maybe Int
416+ -> Maybe Int
417+ -> Source
418+ -> IO [S.ByteString]
419+takeLines'' lines lineLength maxLines src = do
420+ case maxLines of
421+ Just maxLines' ->
422+ when (length lines > maxLines') $
423+ error "Too many lines in mime/multipart header"
424+ Nothing -> return ()
344− res <- takeLine src
425+ res <- takeLine lineLength src
345 case res of
426 case res of
346− Nothing -> return []
427+ Nothing -> return lines
347 Just l
428 Just l
348− | S.null l -> return []
429+ | S.null l -> return lines
349− | otherwise -> do
350− ls <- takeLines src
351− return $ l : ls
352−
353−takeLines' :: Int -> Source -> IO [S.ByteString]
354−takeLines' a b = reverse <$> takeLines'' [] a b
355−
356−takeLines'' :: [S.ByteString] -> Int -> Source -> IO [S.ByteString]
357−takeLines'' lines maxLines src
358− | length lines > maxLines = error "Too many lines in mime/multipart header"
359− | otherwise = do
360− res <- takeLine src
361− case res of
362− Nothing -> return lines
363− Just l
364− | S.null l -> return lines
365− | otherwise -> takeLines'' (l:lines) maxLines src
430+ | otherwise -> takeLines'' (l:lines) lineLength maxLines src
366
431
367data Source = Source (IO S.ByteString) (IORef S.ByteString)
432data Source = Source (IO S.ByteString) (IORef S.ByteString)
368
433
@@ -381,53 +446,6 @@ readSource (Source f ref) = do
381leftover :: Source -> S.ByteString -> IO ()
446leftover :: Source -> S.ByteString -> IO ()
382leftover (Source _ ref) bs = writeIORef ref bs
447leftover (Source _ ref) bs = writeIORef ref bs
383
448
384−parsePieces :: BackEnd y
385− -> S.ByteString
386− -> IO S.ByteString
387− -> (Either Param (File y) -> IO ())
388− -> IO ()
389−parsePieces sink bound rbody add =
390− mkSource rbody >>= loop
391− where
392− loop src = do
393− _boundLine <- takeLine src
394− res' <- takeLines src
395− unless (null res') $ do
396− let ls' = map parsePair res'
397− let x = do
398− cd <- lookup contDisp ls'
399− let ct = lookup contType ls'
400− let attrs = parseAttrs cd
401− name <- lookup "name" attrs
402− return (ct, name, lookup "filename" attrs)
403− case x of
404− Just (mct, name, Just filename) -> do
405− let ct = fromMaybe "application/octet-stream" mct
406− fi0 = FileInfo filename ct ()
407− ((wasFound, _fileSize), y) <- sinkTillBound' bound name fi0 sink src Nothing
408− add $ Right (name, fi0 { fileContent = y })
409− when wasFound (loop src)
410− Just (_ct, name, Nothing) -> do
411− let seed = id
412− let iter front bs = return $ front . (:) bs
413− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src Nothing
414− let bs = S.concat $ front []
415− let x' = (name, bs)
416− add $ Left x'
417− when wasFound (loop src)
418− _ -> do
419− -- ignore this part
420− let seed = ()
421− iter () _ = return ()
422− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
423− when wasFound (loop src)
424− where
425− contDisp = mk $ S8.pack "Content-Disposition"
426− contType = mk $ S8.pack "Content-Type"
427− parsePair s =
428− let (x, y) = breakDiscard 58 s -- colon
429− in (mk $ x, S.dropWhile (== 32) y) -- space
430−
431parsePiecesEx :: ParseRequestBodyOptions
449parsePiecesEx :: ParseRequestBodyOptions
432 -> BackEnd y
450 -> BackEnd y
433 -> S.ByteString
451 -> S.ByteString
@@ -439,8 +457,9 @@ parsePiecesEx o sink bound rbody add =
439 where
457 where
440 loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
458 loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
441 loop numParms numFiles parmSize filesSize src = do
459 loop numParms numFiles parmSize filesSize src = do
442− _boundLine <- takeLine src
460+ _boundLine <- takeLine (prboMaxHeaderLineLength o) src
461+ res' <- takeLines' (prboMaxHeaderLineLength o)
443− res' <- takeLines' (prboMaxHeaderLines o) src
462+ (prboMaxHeaderLines o) src
444 unless (null res') $ do
463 unless (null res') $ do
445 let ls' = map parsePair res'
464 let ls' = map parsePair res'
446 let x = do
465 let x = do
@@ -451,10 +470,15 @@ parsePiecesEx o sink bound rbody add =
451 return (ct, name, lookup "filename" attrs)
470 return (ct, name, lookup "filename" attrs)
452 case x of
471 case x of
453 Just (mct, name, Just filename) -> do
472 Just (mct, name, Just filename) -> do
473+ case prboKeyLength o of
474+ Just maxKeyLength ->
454− when (S.length name > prboKeyLength o) $
475+ when (S.length name > maxKeyLength) $
455− error "Filename is too long"
476+ error "Filename is too long"
477+ Nothing -> return ()
478+ case prboMaxNumFiles o of
456− when (numFiles >= prboMaxNumFiles o) $
479+ Just maxFiles -> when (numFiles >= maxFiles) $
457− error "Maximum number of files exceeded"
480+ error "Maximum number of files exceeded"
481+ Nothing -> return ()
458 let ct = fromMaybe "application/octet-stream" mct
482 let ct = fromMaybe "application/octet-stream" mct
459 fi0 = FileInfo filename ct ()
483 fi0 = FileInfo filename ct ()
460 fs = catMaybes [ prboMaxFileSize o
484 fs = catMaybes [ prboMaxFileSize o
@@ -465,17 +489,22 @@ parsePiecesEx o sink bound rbody add =
465 add $ Right (name, fi0 { fileContent = y })
489 add $ Right (name, fi0 { fileContent = y })
466 when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
490 when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
467 Just (_ct, name, Nothing) -> do
491 Just (_ct, name, Nothing) -> do
492+ case prboKeyLength o of
493+ Just maxKeyLength ->
468− when (S.length name > prboKeyLength o) $
494+ when (S.length name > maxKeyLength) $
469− error "Parameter name is too long"
495+ error "Parameter name is too long"
496+ Nothing -> return ()
470 let seed = id
497 let seed = id
471 let iter front bs = return $ front . (:) bs
498 let iter front bs = return $ front . (:) bs
472− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src $
499+ ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
473− Just . fromIntegral . prboMaxParmsValueSize $ o
500+ (fromIntegral <$> prboMaxParmsSize o)
474 let bs = S.concat $ front []
501 let bs = S.concat $ front []
475 let x' = (name, bs)
502 let x' = (name, bs)
476 let newParmSize = parmSize + S.length name + S.length bs
503 let newParmSize = parmSize + S.length name + S.length bs
477− when (newParmSize > prboMaxParmsValueSize o) $
504+ case prboMaxParmsSize o of
505+ Just maxParmSize -> when (newParmSize > maxParmSize) $
478− error "Maximum size of parameters exceeded"
506+ error "Maximum size of parameters exceeded"
507+ Nothing -> return ()
479 add $ Left x'
508 add $ Left x'
480 when wasFound $ loop (numParms + 1) numFiles
509 when wasFound $ loop (numParms + 1) numFiles
481 newParmSize filesSize src
510 newParmSize filesSize src
@@ -528,8 +557,8 @@ sinkTillBound' :: S.ByteString
528 -> Source
557 -> Source
529 -> Maybe Int64
558 -> Maybe Int64
530 -> IO ((Bool, Int64), y)
559 -> IO ((Bool, Int64), y)
531−sinkTillBound' bound name fi sink src max = do
560+sinkTillBound' bound name fi sink src max' = do
532− (next, final) <- wrapTillBound bound src max
561+ (next, final) <- wrapTillBound bound src max'
533 y <- sink name fi next
562 y <- sink name fi next
534 b <- final
563 b <- final
535 return (b, y)
564 return (b, y)
@@ -540,7 +569,7 @@ wrapTillBound :: S.ByteString -- ^ bound
540 -> Source
569 -> Source
541 -> Maybe Int64
570 -> Maybe Int64
542 -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
571 -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
543−wrapTillBound bound src max = do
572+wrapTillBound bound src max' = do
544 ref <- newIORef $ WTBWorking id
573 ref <- newIORef $ WTBWorking id
545 sref <- newIORef (0 :: Int64)
574 sref <- newIORef (0 :: Int64)
546 return (go ref sref, final ref sref)
575 return (go ref sref, final ref sref)
@@ -561,8 +590,8 @@ wrapTillBound bound src max = do
561 bs <- readSource src
590 bs <- readSource src
562 cur <- atomicModifyIORef sref $ \ cur ->
591 cur <- atomicModifyIORef sref $ \ cur ->
563 let new = cur + fromIntegral (S.length bs) in (new, new)
592 let new = cur + fromIntegral (S.length bs) in (new, new)
564− case max of
593+ case max' of
565− Just max' | cur > max' -> error "Maximum size exceeded"
594+ Just max'' | cur > max'' -> error "Maximum size exceeded"
566 _ -> return ()
595 _ -> return ()
567 if S.null bs
596 if S.null bs
568 then do
597 then do
@@ -598,8 +627,8 @@ sinkTillBound :: S.ByteString
598 -> Source
627 -> Source
599 -> Maybe Int64
628 -> Maybe Int64
600 -> IO ((Bool, Int64), x)
629 -> IO ((Bool, Int64), x)
601−sinkTillBound bound iter seed0 src max = do
630+sinkTillBound bound iter seed0 src max' = do
602− (next, final) <- wrapTillBound bound src max
631+ (next, final) <- wrapTillBound bound src max'
603 let loop seed = do
632 let loop seed = do
604 bs <- next
633 bs <- next
605 if S.null bs
634 if S.null bs
wai-extra/test/Network/Wai/ParseSpec.hs+13−11
@@ -5,7 +5,6 @@ import Test.Hspec
5import Test.HUnit
5import Test.HUnit
6
6
7import System.IO
7import System.IO
8−import Data.Default (def)
9import Data.Monoid
8import Data.Monoid
10import qualified Data.IORef as I
9import qualified Data.IORef as I
11import qualified Data.ByteString as S
10import qualified Data.ByteString as S
@@ -94,6 +93,8 @@ caseParseRequestBody = do
94 let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")]
93 let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")]
95 let expected3 = (expectedsmap3, expectedfile3)
94 let expected3 = (expectedsmap3, expectedfile3)
96
95
96+
97+ let def = defaultParseRequestBodyOptions
97 it "parsing actual post multipart/form-data" $ do
98 it "parsing actual post multipart/form-data" $ do
98 result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3
99 result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3
99 result3 `shouldBe` expected3
100 result3 `shouldBe` expected3
@@ -104,38 +105,38 @@ caseParseRequestBody = do
104
105
105 it "parsing with memory limit" $ do
106 it "parsing with memory limit" $ do
106 SRequest req4 bod4 <- toRequest'' ctype3 content3
107 SRequest req4 bod4 <- toRequest'' ctype3 content3
107− result4' <- parseRequestBodyEx (def { prboMaxNumFiles = 1, prboKeyLength = 32 } ) lbsBackEnd req4
108+ result4' <- parseRequestBodyEx ( setMaxRequestNumFiles 1 $ setMaxRequestKeyLength 14 def ) lbsBackEnd req4
108 result4' `shouldBe` expected3
109 result4' `shouldBe` expected3
109
110
110 it "exceeding number of files" $ do
111 it "exceeding number of files" $ do
111 SRequest req4 bod4 <- toRequest'' ctype3 content3
112 SRequest req4 bod4 <- toRequest'' ctype3 content3
112− (parseRequestBodyEx (def { prboMaxNumFiles = 0 } ) lbsBackEnd req4) `shouldThrow` anyErrorCall
113+ (parseRequestBodyEx ( setMaxRequestNumFiles 0 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall
113
114
114 it "exceeding parameter length" $ do
115 it "exceeding parameter length" $ do
115 SRequest req4 bod4 <- toRequest'' ctype3 content3
116 SRequest req4 bod4 <- toRequest'' ctype3 content3
116− (parseRequestBodyEx (def { prboKeyLength = 2 } ) lbsBackEnd req4) `shouldThrow` anyErrorCall
117+ (parseRequestBodyEx ( setMaxRequestKeyLength 2 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall
117
118
118 it "exceeding file size" $ do
119 it "exceeding file size" $ do
119 SRequest req4 bod4 <- toRequest'' ctype3 content3
120 SRequest req4 bod4 <- toRequest'' ctype3 content3
120− (parseRequestBodyEx (def { prboMaxFileSize = Just 2 } ) lbsBackEnd req4) `shouldThrow` anyErrorCall
121+ (parseRequestBodyEx ( setMaxRequestFileSize 2 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall
121
122
122 it "exceeding total file size" $ do
123 it "exceeding total file size" $ do
123 SRequest req4 bod4 <- toRequest'' ctype3 content3
124 SRequest req4 bod4 <- toRequest'' ctype3 content3
124− (parseRequestBodyEx (def { prboMaxFilesSize = Just 20 } ) lbsBackEnd req4) `shouldThrow` anyErrorCall
125+ (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall
125 SRequest req5 bod5 <- toRequest'' ctype3 content5
126 SRequest req5 bod5 <- toRequest'' ctype3 content5
126− (parseRequestBodyEx (def { prboMaxFilesSize = Just 20 } ) lbsBackEnd req5) `shouldThrow` anyErrorCall
127+ (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req5) `shouldThrow` anyErrorCall
127
128
128 it "exceeding max parm value size" $ do
129 it "exceeding max parm value size" $ do
129 SRequest req4 bod4 <- toRequest'' ctype2 content2
130 SRequest req4 bod4 <- toRequest'' ctype2 content2
130− (parseRequestBodyEx (def { prboMaxParmsValueSize = 10 } ) lbsBackEnd req4) `shouldThrow` anyErrorCall
131+ (parseRequestBodyEx ( setMaxRequestParmsSize 10 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall
131
132
132 it "exceeding max header lines" $ do
133 it "exceeding max header lines" $ do
133 SRequest req4 bod4 <- toRequest'' ctype2 content2
134 SRequest req4 bod4 <- toRequest'' ctype2 content2
134− (parseRequestBodyEx (def { prboMaxHeaderLines = 1 } ) lbsBackEnd req4) `shouldThrow` anyErrorCall
135+ (parseRequestBodyEx ( setMaxHeaderLines 1 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall
135
136
136 it "exceeding header line size" $ do
137 it "exceeding header line size" $ do
137 SRequest req4 bod4 <- toRequest'' ctype2 content4
138 SRequest req4 bod4 <- toRequest'' ctype2 content4
138− (parseRequestBodyEx def lbsBackEnd req4) `shouldThrow` anyErrorCall
139+ (parseRequestBodyEx ( setMaxHeaderLineLength 8190 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall
139
140
140 it "Testing parseRequestBodyEx with application/x-www-form-urlencoded" $ do
141 it "Testing parseRequestBodyEx with application/x-www-form-urlencoded" $ do
141 let content = "thisisalongparameterkey=andthisbeanevenlongerparametervaluehelloworldhowareyou"
142 let content = "thisisalongparameterkey=andthisbeanevenlongerparametervaluehelloworldhowareyou"
@@ -144,11 +145,12 @@ caseParseRequestBody = do
144 result <- parseRequestBodyEx def lbsBackEnd req
145 result <- parseRequestBodyEx def lbsBackEnd req
145 result `shouldBe` ([( "thisisalongparameterkey"
146 result `shouldBe` ([( "thisisalongparameterkey"
146 , "andthisbeanevenlongerparametervaluehelloworldhowareyou" )], [])
147 , "andthisbeanevenlongerparametervaluehelloworldhowareyou" )], [])
148+
147 it "exceeding max parm value size with x-www-form-urlencoded mimetype" $ do
149 it "exceeding max parm value size with x-www-form-urlencoded mimetype" $ do
148 let content = "thisisalongparameterkey=andthisbeanevenlongerparametervaluehelloworldhowareyou"
150 let content = "thisisalongparameterkey=andthisbeanevenlongerparametervaluehelloworldhowareyou"
149 let ctype = "application/x-www-form-urlencoded"
151 let ctype = "application/x-www-form-urlencoded"
150 SRequest req _bod <- toRequest'' ctype content
152 SRequest req _bod <- toRequest'' ctype content
151− (parseRequestBodyEx (def { prboMaxParmsValueSize = 10 }) lbsBackEnd req) `shouldThrow` anyErrorCall
153+ (parseRequestBodyEx ( setMaxRequestParmsSize 10 def ) lbsBackEnd req) `shouldThrow` anyErrorCall
152
154
153 where
155 where
154 content2 =
156 content2 =
wai-extra/wai-extra.cabal−2
@@ -113,7 +113,6 @@ Library
113 , zlib
113 , zlib
114 , aeson
114 , aeson
115 , iproute
115 , iproute
116− , data-default
117
116
118 if os(windows)
117 if os(windows)
119 cpp-options: -DWINDOWS
118 cpp-options: -DWINDOWS
@@ -183,7 +182,6 @@ test-suite spec
183 , cookie
182 , cookie
184 , time
183 , time
185 , case-insensitive
184 , case-insensitive
186− , data-default
187 ghc-options: -Wall
185 ghc-options: -Wall
188 default-language: Haskell2010
186 default-language: Haskell2010
189
187