@@ -11,7 +11,6 @@ module Network.Wai.Parse
1111 , RequestBodyType (..)
1212 , getRequestBodyType
1313 , sinkRequestBody
14− , sinkRequestBodyEx
1514 , BackEnd
1615 , lbsBackEnd
1716 , tempFileBackEnd
@@ -20,24 +19,8 @@ module Network.Wai.Parse
2019 , File
2120 , FileInfo (..)
2221 , parseContentType
23− , ParseRequestBodyOptions
24− , defaultParseRequestBodyOptions
25− , noLimitParseRequestBodyOptions
22+ , ParseRequestBodyOptions (..)
2623 , parseRequestBodyEx
27− , setMaxRequestKeyLength
28− , clearMaxRequestKeyLength
29− , setMaxRequestNumFiles
30− , clearMaxRequestNumFiles
31− , setMaxRequestFileSize
32− , clearMaxRequestFileSize
33− , setMaxRequestFilesSize
34− , clearMaxRequestFilesSize
35− , setMaxRequestParmsSize
36− , clearMaxRequestParmsSize
37− , setMaxHeaderLines
38− , clearMaxHeaderLines
39− , setMaxHeaderLineLength
40− , clearMaxHeaderLineLength
4124#if TEST
4225 , Bound (..)
4326 , findBound
@@ -48,30 +31,27 @@ module Network.Wai.Parse
4831#endif
4932 ) where
5033
51−import qualified Control.Exception as E
34+import qualified Data.ByteString.Search as Search
5235import qualified Data.ByteString as S
5336import qualified Data.ByteString.Lazy as L
5437import qualified Data.ByteString.Char8 as S8
38+import Data.Default (Default, def)
5539import Data.Word (Word8)
5640import Data.Int (Int64)
57−import Data.Maybe (catMaybes, fromMaybe)
41+import Data.Maybe (fromMaybe)
5842import Data.List (sortBy)
5943import Data.Function (on, fix)
6044import System.Directory (removeFile, getTemporaryDirectory)
6145import System.IO (hClose, openBinaryTempFile)
62−import System.IO.Error (isDoesNotExistError)
6346import Network.Wai
6447import qualified Network.HTTP.Types as H
65−import Control.Applicative ((<$>))
66−import Control.Exception (catchJust)
67−import Control.Monad (when, unless, guard)
48+import Control.Monad (when, unless)
6849import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
6950import Data.IORef
7051import Network.HTTP.Types (hContentType)
71−import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )
7252import Data.CaseInsensitive (mk)
7353
74−import Prelude hiding (lines)
54+import Debug.Trace
7555
7656breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
7757breakDiscard w s =
@@ -131,7 +111,7 @@ tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
131111 -> IO FilePath
132112tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
133113 (key, (fp, h)) <- flip runInternalState internalState $ allocate it (hClose . snd)
134− _ <- runInternalState (register $ removeFileQuiet fp) internalState
114+ _ <- runInternalState (register $ removeFile fp) internalState
135115 fix $ \loop -> do
136116 bs <- popper
137117 unless (S.null bs) $ do
@@ -143,146 +123,31 @@ tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
143123 it = do
144124 tempDir <- getTmpDir
145125 openBinaryTempFile tempDir pattrn
146− removeFileQuiet fp = catchJust (guard . isDoesNotExistError)
147− (removeFile fp)
148− (const $ return ())
149126
150127-- | A data structure that describes the behavior of
151128-- the parseRequestBodyEx function.
152−--
153−-- @since 3.0.16.0
154129data ParseRequestBodyOptions = ParseRequestBodyOptions
155130 { -- | The maximum length of a filename
156− prboKeyLength :: Maybe Int
131+ prboKeyLength :: Int
157132 , -- | The maximum number of files.
158− prboMaxNumFiles :: Maybe Int
133+ prboMaxNumFiles :: Int
159134 , -- | The maximum filesize per file.
160135 prboMaxFileSize :: Maybe Int64
161136 , -- | The maximum total filesize.
162137 prboMaxFilesSize :: Maybe Int64
163− , -- | The maximum size of the sum of all parameters
164− prboMaxParmsSize :: Maybe Int
165− , -- | The maximum header lines per mime/multipart entry
166− prboMaxHeaderLines :: Maybe Int
167− , -- | The maximum header line length per mime/multipart entry
168− prboMaxHeaderLineLength :: Maybe Int }
169−
170−-- | Set the maximum length of a filename.
171−--
172−-- @since 3.0.16.0
173−setMaxRequestKeyLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
174−setMaxRequestKeyLength l p = p { prboKeyLength=Just l }
175−
176−-- | Do not limit the length of filenames.
177−--
178−-- @since 3.0.16.0
179−clearMaxRequestKeyLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
180−clearMaxRequestKeyLength p = p { prboKeyLength=Nothing }
181−
182−-- | Set the maximum number of files per request.
183−--
184−-- @since 3.0.16.0
185−setMaxRequestNumFiles :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
186−setMaxRequestNumFiles l p = p { prboMaxNumFiles=Just l }
187−
188−-- | Do not limit the maximum number of files per request.
189−--
190−-- @since 3.0.16.0
191−clearMaxRequestNumFiles :: ParseRequestBodyOptions -> ParseRequestBodyOptions
192−clearMaxRequestNumFiles p = p { prboMaxNumFiles=Nothing }
193−
194−-- | Set the maximum filesize per file (in bytes).
195−--
196−-- @since 3.0.16.0
197−setMaxRequestFileSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
198−setMaxRequestFileSize l p = p { prboMaxFileSize=Just l }
199−
200−-- | Do not limit the maximum filesize per file.
201−--
202−-- @since 3.0.16.0
203−clearMaxRequestFileSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
204−clearMaxRequestFileSize p = p { prboMaxFileSize=Nothing }
205−
206−-- | Set the maximum size of all files per request.
207−--
208−-- @since 3.0.16.0
209−setMaxRequestFilesSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
210−setMaxRequestFilesSize l p = p { prboMaxFilesSize=Just l }
211−
212−-- | Do not limit the maximum size of all files per request.
213−--
214−-- @since 3.0.16.0
215−clearMaxRequestFilesSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
216−clearMaxRequestFilesSize p = p { prboMaxFilesSize=Nothing }
217−
218−-- | Set the maximum size of the sum of all parameters.
219−--
220−-- @since 3.0.16.0
221−setMaxRequestParmsSize :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
222−setMaxRequestParmsSize l p = p { prboMaxParmsSize=Just l }
223−
224−-- | Do not limit the maximum size of the sum of all parameters.
225−--
226−-- @since 3.0.16.0
227−clearMaxRequestParmsSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
228−clearMaxRequestParmsSize p = p { prboMaxParmsSize=Nothing }
229−
230−-- | Set the maximum header lines per mime/multipart entry.
231−--
232−-- @since 3.0.16.0
233−setMaxHeaderLines :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
234−setMaxHeaderLines l p = p { prboMaxHeaderLines=Just l }
235−
236−-- | Do not limit the maximum header lines per mime/multipart entry.
237−--
238−-- @since 3.0.16.0
239−clearMaxHeaderLines:: ParseRequestBodyOptions -> ParseRequestBodyOptions
240−clearMaxHeaderLines p = p { prboMaxHeaderLines=Nothing }
241−
242−-- | Set the maximum header line length per mime/multipart entry.
243−--
244−-- @since 3.0.16.0
245−setMaxHeaderLineLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
246−setMaxHeaderLineLength l p = p { prboMaxHeaderLineLength=Just l }
247−
248−-- | Do not limit the maximum header lines per mime/multipart entry.
249−--
250−-- @since 3.0.16.0
251−clearMaxHeaderLineLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
252−clearMaxHeaderLineLength p = p { prboMaxHeaderLineLength=Nothing }
253−
254−-- | A reasonable default set of parsing options.
255−-- Maximum key/filename length: 32 bytes;
256−-- maximum files: 10; filesize unlimited; maximum
257−-- size for parameters: 64kbytes; maximum number of header
258−-- lines: 32 bytes (applies only to headers of a mime/multipart message);
259−-- maximum header line length: Apache's default for that is 8190 bytes
260−-- (http://httpd.apache.org/docs/2.2/mod/core.html#limitrequestline)
261−-- so we're using that here as well.
262−--
263−-- @since 3.0.16.0
264−defaultParseRequestBodyOptions :: ParseRequestBodyOptions
265−defaultParseRequestBodyOptions = ParseRequestBodyOptions
266− { prboKeyLength=Just 32
267− , prboMaxNumFiles=Just 10
268− , prboMaxFileSize=Nothing
269− , prboMaxFilesSize=Nothing
270− , prboMaxParmsSize=Just 65336
271− , prboMaxHeaderLines=Just 32
272− , prboMaxHeaderLineLength=Just 8190 }
273−
274−-- | Do not impose any memory limits.
275−--
276−-- @since 3.0.21.0
277−noLimitParseRequestBodyOptions :: ParseRequestBodyOptions
278−noLimitParseRequestBodyOptions = ParseRequestBodyOptions
279− { prboKeyLength=Nothing
280− , prboMaxNumFiles=Nothing
281− , prboMaxFileSize=Nothing
282− , prboMaxFilesSize=Nothing
283− , prboMaxParmsSize=Nothing
284− , prboMaxHeaderLines=Nothing
285− , prboMaxHeaderLineLength=Nothing }
138+ , -- | The maximum size of the sum of all parameters values
139+ prboMaxParmsValueSize :: Int
140+ , -- | The maximum header lines per entry
141+ prboMaxHeaderLines :: Int }
142+
143+instance Default ParseRequestBodyOptions where
144+ def = ParseRequestBodyOptions
145+ { prboKeyLength=32
146+ , prboMaxNumFiles=10
147+ , prboMaxFileSize=Nothing
148+ , prboMaxFilesSize=Nothing
149+ , prboMaxParmsValueSize=65336
150+ , prboMaxHeaderLines=32 }
286151
287152-- | Information on an uploaded file.
288153data FileInfo c = FileInfo
@@ -305,16 +170,8 @@ type BackEnd a = S.ByteString -- ^ parameter name
305170 -> IO S.ByteString
306171 -> IO a
307172
308−-- | The mimetype of the http body.
309−-- Depending on whether just parameters or parameters and files
310−-- are passed, one or the other mimetype should be used.
311−data RequestBodyType
312− = -- | application/x-www-form-urlencoded (parameters only)
313− UrlEncoded
314− | -- | multipart/form-data (parameters and files)
315− Multipart S.ByteString
173+data RequestBodyType = UrlEncoded | Multipart S.ByteString
316174
317−-- | Get the mimetype of the body of an http request.
318175getRequestBodyType :: Request -> Maybe RequestBodyType
319176getRequestBodyType req = do
320177 ctype' <- lookup hContentType $ requestHeaders req
@@ -327,7 +184,7 @@ getRequestBodyType req = do
327184-- | Parse a content type value, turning a single @ByteString@ into the actual
328185-- content type and a list of pairs of attributes.
329186--
330−-- @since 1.3.2
187+-- Since 1.3.2
331188parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
332189parseContentType a = do
333190 let (ctype, b) = S.break (== semicolon) a
@@ -337,9 +194,6 @@ parseContentType a = do
337194 semicolon = 59
338195 equals = 61
339196 space = 32
340− dq s = if S.length s > 2 && S.head s == 34 && S.last s == 34 -- quote
341− then S.tail $ S.init s
342− else s
343197 goAttrs front bs
344198 | S.null bs = front []
345199 | otherwise =
@@ -348,26 +202,17 @@ parseContentType a = do
348202 goAttr bs =
349203 let (k, v') = S.break (== equals) bs
350204 v = S.drop 1 v'
351− in (strip k, dq $ strip v)
205+ in (strip k, strip v)
352206 strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
353207
354−-- | Parse the body of an HTTP request.
355−-- See parseRequestBodyEx for details.
356−-- Note: This function does not limit the memory it allocates.
357−-- When dealing with untrusted data (as is usually the case when
358−-- receiving input from the internet), it is recommended to
359−-- use the 'parseRequestBodyEx' function instead.
360208parseRequestBody :: BackEnd y
361209 -> Request
362210 -> IO ([Param], [File y])
363−parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions
364−
365−-- | Parse the body of an HTTP request, limit resource usage.
366−-- The HTTP body can contain both parameters and files.
367−-- This function will return a list of key,value pairs
368−-- for all parameters, and a list of key,a pairs
369−-- for filenames. The a depends on the used backend that
370−-- is responsible for storing the received files.
211+parseRequestBody s r =
212+ case getRequestBodyType r of
213+ Nothing -> return ([], [])
214+ Just rbt -> sinkRequestBody s rbt (requestBody r)
215+
371216parseRequestBodyEx :: ParseRequestBodyOptions
372217 -> BackEnd y
373218 -> Request
@@ -381,11 +226,16 @@ sinkRequestBody :: BackEnd y
381226 -> RequestBodyType
382227 -> IO S.ByteString
383228 -> IO ([Param], [File y])
384−sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions
229+sinkRequestBody s r body = do
230+ ref <- newIORef (id, id)
231+ let add x = atomicModifyIORef ref $ \(y, z) ->
232+ case x of
233+ Left y' -> ((y . (y':), z), ())
234+ Right z' -> ((y, z . (z':)), ())
235+ conduitRequestBody s r body add
236+ (x, y) <- readIORef ref
237+ return (x [], y [])
385238
386−-- |
387−--
388−-- @since 3.0.16.0
389239sinkRequestBodyEx :: ParseRequestBodyOptions
390240 -> BackEnd y
391241 -> RequestBodyType
@@ -398,7 +248,26 @@ sinkRequestBodyEx o s r body = do
398248 Left y' -> ((y':y, z), ())
399249 Right z' -> ((y, z':z), ())
400250 conduitRequestBodyEx o s r body add
401− (\(a, b) -> (reverse a, reverse b)) <$> readIORef ref
251+ readIORef ref
252+
253+conduitRequestBody :: BackEnd y
254+ -> RequestBodyType
255+ -> IO S.ByteString
256+ -> (Either Param (File y) -> IO ())
257+ -> IO ()
258+conduitRequestBody _ UrlEncoded rbody add = do
259+ -- NOTE: in general, url-encoded data will be in a single chunk.
260+ -- Therefore, I'm optimizing for the usual case by sticking with
261+ -- strict byte strings here.
262+ let loop front = do
263+ bs <- rbody
264+ if S.null bs
265+ then return $ S.concat $ front []
266+ else loop $ front . (bs:)
267+ bs <- loop id
268+ mapM_ (add . Left) $ H.parseSimpleQuery bs
269+conduitRequestBody backend (Multipart bound) rbody add =
270+ parsePieces backend (S8.pack "--" `S.append` bound) rbody add
402271
403272conduitRequestBodyEx :: ParseRequestBodyOptions
404273 -> BackEnd y
@@ -410,78 +279,60 @@ conduitRequestBodyEx o _ UrlEncoded rbody add = do
410279 -- NOTE: in general, url-encoded data will be in a single chunk.
411280 -- Therefore, I'm optimizing for the usual case by sticking with
412281 -- strict byte strings here.
413− let loop size front = do
282+ let loop front = do
414283 bs <- rbody
415284 if S.null bs
416285 then return $ S.concat $ front []
417− else do
418− let newsize = size + S.length bs
419− case prboMaxParmsSize o of
420− Just maxSize -> when (newsize > maxSize) $
421− error "Maximum size of parameters exceeded"
422− Nothing -> return ()
423− loop newsize $ front . (bs:)
424− bs <- loop 0 id
286+ else loop $ front . (bs:)
287+ bs <- loop id
425288 mapM_ (add . Left) $ H.parseSimpleQuery bs
426289conduitRequestBodyEx o backend (Multipart bound) rbody add =
427290 parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
428291
429292
430−-- | Take one header or subheader line.
431−-- Since: 3.0.26
432−-- Throw 431 if headers too large.
433−takeLine :: Maybe Int -> Source -> IO (Maybe S.ByteString)
434−takeLine maxlen src =
435− go ""
293+takeLine :: Source -> IO (Maybe S.ByteString)
294+takeLine src =
295+ go id
436296 where
437297 go front = do
438298 bs <- readSource src
439− case maxlen of
440− Just maxlen' -> when (S.length front > maxlen') $
441− E.throwIO $ ConnectionError (UnknownErrorCode 431)
442− "Request Header Fields Too Large"
443− Nothing -> return ()
444299 if S.null bs
445300 then close front
446301 else push front bs
447302
448− close front = leftover src front >> return Nothing
303+ close front = leftover src (front S.empty) >> return Nothing
449304 push front bs = do
450− let (x, y) = S.break (== 10) bs -- LF
305+ let (x, y) = S.break (== 10) $ front bs -- LF
451306 in if S.null y
452− then go $ front `S.append` x
307+ then go $ S.append x
453308 else do
454309 when (S.length y > 1) $ leftover src $ S.drop 1 y
455− let res = front `S.append` x
456− case maxlen of
457− Just maxlen' -> when (S.length res > maxlen') $
458− E.throwIO $ ConnectionError (UnknownErrorCode 431)
459− "Request Header Fields Too Large"
460− Nothing -> return ()
461− return $ Just $ killCR $ res
462−
463−takeLines' :: Maybe Int -> Maybe Int -> Source -> IO [S.ByteString]
464−takeLines' lineLength maxLines source =
465− reverse <$> takeLines'' [] lineLength maxLines source
466−
467−takeLines''
468− :: [S.ByteString]
469− -> Maybe Int
470− -> Maybe Int
471− -> Source
472− -> IO [S.ByteString]
473−takeLines'' lines lineLength maxLines src = do
474− case maxLines of
475− Just maxLines' ->
476− when (length lines > maxLines') $
477− error "Too many lines in mime/multipart header"
478− Nothing -> return ()
479− res <- takeLine lineLength src
310+ return $ Just $ killCR x
311+
312+takeLines :: Source -> IO [S.ByteString]
313+takeLines src = do
314+ res <- takeLine src
480315 case res of
481− Nothing -> return lines
316+ Nothing -> return []
482317 Just l
483− | S.null l -> return lines
484− | otherwise -> takeLines'' (l:lines) lineLength maxLines src
318+ | S.null l -> return []
319+ | otherwise -> do
320+ ls <- takeLines src
321+ return $ l : ls
322+
323+takeLines' :: Int -> Source -> IO [S.ByteString]
324+takeLines' a b = reverse <$> takeLines'' [] a b
325+
326+takeLines'' :: [S.ByteString] -> Int -> Source -> IO [S.ByteString]
327+takeLines'' lines maxLines src
328+ | length lines > maxLines = error "Too many lines in mime/multipart header"
329+ | otherwise = do
330+ res <- takeLine src
331+ case res of
332+ Nothing -> return lines
333+ Just l
334+ | S.null l -> return lines
335+ | otherwise -> takeLines'' (l:lines) maxLines src
485336
486337data Source = Source (IO S.ByteString) (IORef S.ByteString)
487338
@@ -500,6 +351,53 @@ readSource (Source f ref) = do
500351leftover :: Source -> S.ByteString -> IO ()
501352leftover (Source _ ref) bs = writeIORef ref bs
502353
354+parsePieces :: BackEnd y
355+ -> S.ByteString
356+ -> IO S.ByteString
357+ -> (Either Param (File y) -> IO ())
358+ -> IO ()
359+parsePieces sink bound rbody add =
360+ mkSource rbody >>= loop
361+ where
362+ loop src = do
363+ _boundLine <- takeLine src
364+ res' <- takeLines src
365+ unless (null res') $ do
366+ let ls' = map parsePair res'
367+ let x = do
368+ cd <- lookup contDisp ls'
369+ let ct = lookup contType ls'
370+ let attrs = parseAttrs cd
371+ name <- lookup "name" attrs
372+ return (ct, name, lookup "filename" attrs)
373+ case x of
374+ Just (mct, name, Just filename) -> do
375+ let ct = fromMaybe "application/octet-stream" mct
376+ fi0 = FileInfo filename ct ()
377+ ((wasFound, _fileSize), y) <- sinkTillBound' bound name fi0 sink src
378+ add $ Right (name, fi0 { fileContent = y })
379+ when wasFound (loop src)
380+ Just (_ct, name, Nothing) -> do
381+ let seed = id
382+ let iter front bs = return $ front . (:) bs
383+ ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
384+ let bs = S.concat $ front []
385+ let x' = (name, bs)
386+ add $ Left x'
387+ when wasFound (loop src)
388+ _ -> do
389+ -- ignore this part
390+ let seed = ()
391+ iter () _ = return ()
392+ ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src
393+ when wasFound (loop src)
394+ where
395+ contDisp = mk $ S8.pack "Content-Disposition"
396+ contType = mk $ S8.pack "Content-Type"
397+ parsePair s =
398+ let (x, y) = breakDiscard 58 s -- colon
399+ in (mk $ x, S.dropWhile (== 32) y) -- space
400+
503401parsePiecesEx :: ParseRequestBodyOptions
504402 -> BackEnd y
505403 -> S.ByteString
@@ -511,9 +409,8 @@ parsePiecesEx o sink bound rbody add =
511409 where
512410 loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
513411 loop numParms numFiles parmSize filesSize src = do
514− _boundLine <- takeLine (prboMaxHeaderLineLength o) src
515− res' <- takeLines' (prboMaxHeaderLineLength o)
516− (prboMaxHeaderLines o) src
412+ _boundLine <- takeLine src
413+ res' <- takeLines' (prboMaxHeaderLines o) src
517414 unless (null res') $ do
518415 let ls' = map parsePair res'
519416 let x = do
@@ -524,41 +421,36 @@ parsePiecesEx o sink bound rbody add =
524421 return (ct, name, lookup "filename" attrs)
525422 case x of
526423 Just (mct, name, Just filename) -> do
527− case prboKeyLength o of
528− Just maxKeyLength ->
529− when (S.length name > maxKeyLength) $
530− error "Filename is too long"
531− Nothing -> return ()
532− case prboMaxNumFiles o of
533− Just maxFiles -> when (numFiles >= maxFiles) $
534− error "Maximum number of files exceeded"
535− Nothing -> return ()
424+ when (S.length name > prboKeyLength o) $
425+ error "Filename is too long"
426+ when (numFiles >= prboMaxNumFiles o) $
427+ error "Maximum number of files exceeded"
536428 let ct = fromMaybe "application/octet-stream" mct
537429 fi0 = FileInfo filename ct ()
538− fs = catMaybes [ prboMaxFileSize o
539− , subtract filesSize <$> prboMaxFilesSize o ]
540− mfs = if fs == [] then Nothing else Just $ minimum fs
541− ((wasFound, fileSize), y) <- sinkTillBound' bound name fi0 sink src mfs
430+ ((wasFound, fileSize), y) <- sinkTillBound' bound name fi0 sink src
431+ case prboMaxFileSize o of
432+ Just maxFileSize -> when (fileSize > maxFileSize ) $
433+ error "Maximum file size exceeded"
434+ Nothing -> return ()
542435 let newFilesSize = filesSize + fileSize
436+ case prboMaxFilesSize o of
437+ Just maxFilesSize ->
438+ when (newFilesSize > maxFilesSize) $
439+ error "Maximum size of uploaded files exceeded"
440+ Nothing -> return ()
543441 add $ Right (name, fi0 { fileContent = y })
544442 when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
545443 Just (_ct, name, Nothing) -> do
546− case prboKeyLength o of
547− Just maxKeyLength ->
548− when (S.length name > maxKeyLength) $
549− error "Parameter name is too long"
550− Nothing -> return ()
444+ when (S.length name > prboKeyLength o) $
445+ error "Parameter name is too long"
551446 let seed = id
552447 let iter front bs = return $ front . (:) bs
553448 ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
554− (fromIntegral <$> prboMaxParmsSize o)
555449 let bs = S.concat $ front []
556450 let x' = (name, bs)
557451 let newParmSize = parmSize + S.length name + S.length bs
558− case prboMaxParmsSize o of
559− Just maxParmSize -> when (newParmSize > maxParmSize) $
560− error "Maximum size of parameters exceeded"
561− Nothing -> return ()
452+ when (newParmSize > prboMaxParmsValueSize o) $
453+ error "Maximum size of parameters exceeded"
562454 add $ Left x'
563455 when wasFound $ loop (numParms + 1) numFiles
564456 newParmSize filesSize src
@@ -566,7 +458,7 @@ parsePiecesEx o sink bound rbody add =
566458 -- ignore this part
567459 let seed = ()
568460 iter () _ = return ()
569− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
461+ ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src
570462 when wasFound $ loop numParms numFiles parmSize filesSize src
571463 where
572464 contDisp = mk $ S8.pack "Content-Disposition"
@@ -582,7 +474,7 @@ data Bound = FoundBound S.ByteString S.ByteString
582474 deriving (Eq, Show)
583475
584476findBound :: S.ByteString -> S.ByteString -> Bound
585−findBound b bs = handleBreak $ S.breakSubstring b bs
477+findBound b bs = handleBreak $ Search.breakOn b bs
586478 where
587479 handleBreak (h, t)
588480 | S.null t = go [lowBound..S.length bs - 1]
@@ -609,10 +501,9 @@ sinkTillBound' :: S.ByteString
609501 -> FileInfo ()
610502 -> BackEnd y
611503 -> Source
612− -> Maybe Int64
613504 -> IO ((Bool, Int64), y)
614−sinkTillBound' bound name fi sink src max' = do
615− (next, final) <- wrapTillBound bound src max'
505+sinkTillBound' bound name fi sink src = do
506+ (next, final) <- wrapTillBound bound src
616507 y <- sink name fi next
617508 b <- final
618509 return (b, y)
@@ -621,9 +512,8 @@ data WTB = WTBWorking (S.ByteString -> S.ByteString)
621512 | WTBDone Bool
622513wrapTillBound :: S.ByteString -- ^ bound
623514 -> Source
624− -> Maybe Int64
625515 -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
626−wrapTillBound bound src max' = do
516+wrapTillBound bound src = do
627517 ref <- newIORef $ WTBWorking id
628518 sref <- newIORef (0 :: Int64)
629519 return (go ref sref, final ref sref)
@@ -642,19 +532,14 @@ wrapTillBound bound src max' = do
642532 WTBDone _ -> return S.empty
643533 WTBWorking front -> do
644534 bs <- readSource src
645− cur <- atomicModifyIORef' sref $ \ cur ->
646− let new = cur + fromIntegral (S.length bs) in (new, new)
647− case max' of
648− Just max'' | cur > max'' ->
649− E.throwIO $ ConnectionError (UnknownErrorCode 413) "Payload Too Large"
650− _ -> return ()
535+ modifyIORef sref $ (+) (fromIntegral $S.length bs)
651536 if S.null bs
652537 then do
653538 writeIORef ref $ WTBDone False
654539 return $ front bs
655540 else push $ front bs
656541 where
657− push bs = do
542+ push bs =
658543 case findBound bound bs of
659544 FoundBound before after -> do
660545 let before' = killCRLF before
@@ -680,10 +565,9 @@ sinkTillBound :: S.ByteString
680565 -> (x -> S.ByteString -> IO x)
681566 -> x
682567 -> Source
683− -> Maybe Int64
684568 -> IO ((Bool, Int64), x)
685−sinkTillBound bound iter seed0 src max' = do
686− (next, final) <- wrapTillBound bound src max'
569+sinkTillBound bound iter seed0 src = do
570+ (next, final) <- wrapTillBound bound src
687571 let loop seed = do
688572 bs <- next
689573 if S.null bs