@@ -11,6 +11,7 @@ module Network.Wai.Parse
1111 , RequestBodyType (..)
1212 , getRequestBodyType
1313 , sinkRequestBody
14+ , sinkRequestBodyEx
1415 , BackEnd
1516 , lbsBackEnd
1617 , tempFileBackEnd
@@ -19,8 +20,24 @@ module Network.Wai.Parse
1920 , File
2021 , FileInfo (..)
2122 , parseContentType
22− , ParseRequestBodyOptions (..)
23+ , ParseRequestBodyOptions
24+ , defaultParseRequestBodyOptions
25+ , noLimitParseRequestBodyOptions
2326 , 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
2441#if TEST
2542 , Bound (..)
2643 , findBound
@@ -31,11 +48,10 @@ module Network.Wai.Parse
3148#endif
3249 ) where
3350
34−import qualified Data.ByteString.Search as Search
51+import qualified Control.Exception as E
3552import qualified Data.ByteString as S
3653import qualified Data.ByteString.Lazy as L
3754import qualified Data.ByteString.Char8 as S8
38−import Data.Default (Default, def)
3955import Data.Word (Word8)
4056import Data.Int (Int64)
4157import Data.Maybe (catMaybes, fromMaybe)
@@ -43,15 +59,20 @@ import Data.List (sortBy)
4359import Data.Function (on, fix)
4460import System.Directory (removeFile, getTemporaryDirectory)
4561import System.IO (hClose, openBinaryTempFile)
62+import System.IO.Error (isDoesNotExistError)
4663import Network.Wai
4764import qualified Network.HTTP.Types as H
4865import Control.Applicative ((<$>))
49−import Control.Monad (when, unless)
66+import Control.Exception (catchJust)
67+import Control.Monad (when, unless, guard)
5068import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
5169import Data.IORef
5270import Network.HTTP.Types (hContentType)
71+import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )
5372import Data.CaseInsensitive (mk)
5473
74+import Prelude hiding (lines)
75+
5576breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
5677breakDiscard w s =
5778 let (x, y) = S.break (== w) s
@@ -110,7 +131,7 @@ tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
110131 -> IO FilePath
111132tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
112133 (key, (fp, h)) <- flip runInternalState internalState $ allocate it (hClose . snd)
113− _ <- runInternalState (register $ removeFile fp) internalState
134+ _ <- runInternalState (register $ removeFileQuiet fp) internalState
114135 fix $ \loop -> do
115136 bs <- popper
116137 unless (S.null bs) $ do
@@ -122,31 +143,146 @@ tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
122143 it = do
123144 tempDir <- getTmpDir
124145 openBinaryTempFile tempDir pattrn
146+ removeFileQuiet fp = catchJust (guard . isDoesNotExistError)
147+ (removeFile fp)
148+ (const $ return ())
125149
126150-- | A data structure that describes the behavior of
127151-- the parseRequestBodyEx function.
152+--
153+-- @since 3.0.16.0
128154data ParseRequestBodyOptions = ParseRequestBodyOptions
129155 { -- | The maximum length of a filename
130− prboKeyLength :: Int
156+ prboKeyLength :: Maybe Int
131157 , -- | The maximum number of files.
132− prboMaxNumFiles :: Int
158+ prboMaxNumFiles :: Maybe Int
133159 , -- | The maximum filesize per file.
134160 prboMaxFileSize :: Maybe Int64
135161 , -- | The maximum total filesize.
136162 prboMaxFilesSize :: Maybe Int64
137− , -- | The maximum size of the sum of all parameters values
138− prboMaxParmsValueSize :: Int
139− , -- | The maximum header lines per entry
140− prboMaxHeaderLines :: Int }
141−
142−instance Default ParseRequestBodyOptions where
143− def = ParseRequestBodyOptions
144− { prboKeyLength=32
145− , prboMaxNumFiles=10
146− , prboMaxFileSize=Nothing
147− , prboMaxFilesSize=Nothing
148− , prboMaxParmsValueSize=65336
149− , prboMaxHeaderLines=32 }
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 }
150286
151287-- | Information on an uploaded file.
152288data FileInfo c = FileInfo
@@ -191,7 +327,7 @@ getRequestBodyType req = do
191327-- | Parse a content type value, turning a single @ByteString@ into the actual
192328-- content type and a list of pairs of attributes.
193329--
194−-- Since 1.3.2
330+-- @since 1.3.2
195331parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
196332parseContentType a = do
197333 let (ctype, b) = S.break (== semicolon) a
@@ -201,6 +337,9 @@ parseContentType a = do
201337 semicolon = 59
202338 equals = 61
203339 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
204343 goAttrs front bs
205344 | S.null bs = front []
206345 | otherwise =
@@ -209,7 +348,7 @@ parseContentType a = do
209348 goAttr bs =
210349 let (k, v') = S.break (== equals) bs
211350 v = S.drop 1 v'
212− in (strip k, strip v)
351+ in (strip k, dq $ strip v)
213352 strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
214353
215354-- | Parse the body of an HTTP request.
@@ -217,14 +356,11 @@ parseContentType a = do
217356-- Note: This function does not limit the memory it allocates.
218357-- When dealing with untrusted data (as is usually the case when
219358-- receiving input from the internet), it is recommended to
220−-- use the parseRequestBodyEx function instead.
359+-- use the 'parseRequestBodyEx' function instead.
221360parseRequestBody :: BackEnd y
222361 -> Request
223362 -> IO ([Param], [File y])
224−parseRequestBody s r =
225− case getRequestBodyType r of
226− Nothing -> return ([], [])
227− Just rbt -> sinkRequestBody s rbt (requestBody r)
363+parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions
228364
229365-- | Parse the body of an HTTP request, limit resource usage.
230366-- The HTTP body can contain both parameters and files.
@@ -245,16 +381,11 @@ sinkRequestBody :: BackEnd y
245381 -> RequestBodyType
246382 -> IO S.ByteString
247383 -> IO ([Param], [File y])
248−sinkRequestBody s r body = do
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 [])
384+sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions
257385
386+-- |
387+--
388+-- @since 3.0.16.0
258389sinkRequestBodyEx :: ParseRequestBodyOptions
259390 -> BackEnd y
260391 -> RequestBodyType
@@ -267,26 +398,7 @@ sinkRequestBodyEx o s r body = do
267398 Left y' -> ((y':y, z), ())
268399 Right z' -> ((y, z':z), ())
269400 conduitRequestBodyEx o s r body add
270− 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
401+ (\(a, b) -> (reverse a, reverse b)) <$> readIORef ref
290402
291403conduitRequestBodyEx :: ParseRequestBodyOptions
292404 -> BackEnd y
@@ -298,34 +410,37 @@ conduitRequestBodyEx o _ UrlEncoded rbody add = do
298410 -- NOTE: in general, url-encoded data will be in a single chunk.
299411 -- Therefore, I'm optimizing for the usual case by sticking with
300412 -- strict byte strings here.
301− size <- newIORef 0
302− let loop front = do
413+ let loop size front = do
303414 bs <- rbody
304415 if S.null bs
305416 then return $ S.concat $ front []
306417 else do
307− newsize <- atomicModifyIORef size $
308− \cursize -> let newsize = cursize + S.length bs in (newsize, newsize)
309− when (newsize > prboMaxParmsValueSize o) $
310− error "Maximum size of parameters exceeded"
311− loop $ front . (bs:)
312− bs <- loop id
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
313425 mapM_ (add . Left) $ H.parseSimpleQuery bs
314426conduitRequestBodyEx o backend (Multipart bound) rbody add =
315427 parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
316428
317429
318430-- | Take one header or subheader line.
319−-- 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)
321−-- so we're using that here as well.
322−takeLine :: Source -> IO (Maybe S.ByteString)
323−takeLine src =
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 =
324435 go ""
325436 where
326437 go front = do
327438 bs <- readSource src
328− when (S.length front + S.length bs > 8190) $ error "Header line length exceeds allowed maximum."
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 ()
329444 if S.null bs
330445 then close front
331446 else push front bs
@@ -337,32 +452,36 @@ takeLine src =
337452 then go $ front `S.append` x
338453 else do
339454 when (S.length y > 1) $ leftover src $ S.drop 1 y
340− return $ Just $ killCR $ front `S.append` x
341−
342−takeLines :: Source -> IO [S.ByteString]
343−takeLines src = do
344− res <- takeLine src
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
345480 case res of
346− Nothing -> return []
481+ Nothing -> return lines
347482 Just l
348− | S.null l -> return []
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
483+ | S.null l -> return lines
484+ | otherwise -> takeLines'' (l:lines) lineLength maxLines src
366485
367486data Source = Source (IO S.ByteString) (IORef S.ByteString)
368487
@@ -381,53 +500,6 @@ readSource (Source f ref) = do
381500leftover :: Source -> S.ByteString -> IO ()
382501leftover (Source _ ref) bs = writeIORef ref bs
383502
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−
431503parsePiecesEx :: ParseRequestBodyOptions
432504 -> BackEnd y
433505 -> S.ByteString
@@ -439,8 +511,9 @@ parsePiecesEx o sink bound rbody add =
439511 where
440512 loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
441513 loop numParms numFiles parmSize filesSize src = do
442− _boundLine <- takeLine src
443− res' <- takeLines' (prboMaxHeaderLines o) src
514+ _boundLine <- takeLine (prboMaxHeaderLineLength o) src
515+ res' <- takeLines' (prboMaxHeaderLineLength o)
516+ (prboMaxHeaderLines o) src
444517 unless (null res') $ do
445518 let ls' = map parsePair res'
446519 let x = do
@@ -451,10 +524,15 @@ parsePiecesEx o sink bound rbody add =
451524 return (ct, name, lookup "filename" attrs)
452525 case x of
453526 Just (mct, name, Just filename) -> do
454− when (S.length name > prboKeyLength o) $
455− error "Filename is too long"
456− when (numFiles >= prboMaxNumFiles o) $
457− error "Maximum number of files exceeded"
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 ()
458536 let ct = fromMaybe "application/octet-stream" mct
459537 fi0 = FileInfo filename ct ()
460538 fs = catMaybes [ prboMaxFileSize o
@@ -465,17 +543,22 @@ parsePiecesEx o sink bound rbody add =
465543 add $ Right (name, fi0 { fileContent = y })
466544 when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
467545 Just (_ct, name, Nothing) -> do
468− when (S.length name > prboKeyLength o) $
469− error "Parameter name is too long"
546+ case prboKeyLength o of
547+ Just maxKeyLength ->
548+ when (S.length name > maxKeyLength) $
549+ error "Parameter name is too long"
550+ Nothing -> return ()
470551 let seed = id
471552 let iter front bs = return $ front . (:) bs
472− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src $
473− Just . fromIntegral . prboMaxParmsValueSize $ o
553+ ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
554+ (fromIntegral <$> prboMaxParmsSize o)
474555 let bs = S.concat $ front []
475556 let x' = (name, bs)
476557 let newParmSize = parmSize + S.length name + S.length bs
477− when (newParmSize > prboMaxParmsValueSize o) $
478− error "Maximum size of parameters exceeded"
558+ case prboMaxParmsSize o of
559+ Just maxParmSize -> when (newParmSize > maxParmSize) $
560+ error "Maximum size of parameters exceeded"
561+ Nothing -> return ()
479562 add $ Left x'
480563 when wasFound $ loop (numParms + 1) numFiles
481564 newParmSize filesSize src
@@ -499,7 +582,7 @@ data Bound = FoundBound S.ByteString S.ByteString
499582 deriving (Eq, Show)
500583
501584findBound :: S.ByteString -> S.ByteString -> Bound
502−findBound b bs = handleBreak $ Search.breakOn b bs
585+findBound b bs = handleBreak $ S.breakSubstring b bs
503586 where
504587 handleBreak (h, t)
505588 | S.null t = go [lowBound..S.length bs - 1]
@@ -528,8 +611,8 @@ sinkTillBound' :: S.ByteString
528611 -> Source
529612 -> Maybe Int64
530613 -> IO ((Bool, Int64), y)
531−sinkTillBound' bound name fi sink src max = do
532− (next, final) <- wrapTillBound bound src max
614+sinkTillBound' bound name fi sink src max' = do
615+ (next, final) <- wrapTillBound bound src max'
533616 y <- sink name fi next
534617 b <- final
535618 return (b, y)
@@ -540,7 +623,7 @@ wrapTillBound :: S.ByteString -- ^ bound
540623 -> Source
541624 -> Maybe Int64
542625 -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
543−wrapTillBound bound src max = do
626+wrapTillBound bound src max' = do
544627 ref <- newIORef $ WTBWorking id
545628 sref <- newIORef (0 :: Int64)
546629 return (go ref sref, final ref sref)
@@ -559,18 +642,19 @@ wrapTillBound bound src max = do
559642 WTBDone _ -> return S.empty
560643 WTBWorking front -> do
561644 bs <- readSource src
562− cur <- atomicModifyIORef sref $ \ cur ->
645+ cur <- atomicModifyIORef' sref $ \ cur ->
563646 let new = cur + fromIntegral (S.length bs) in (new, new)
564− case max of
565− Just max' | cur > max' -> error "Maximum size exceeded"
566− _ -> return ()
647+ case max' of
648+ Just max'' | cur > max'' ->
649+ E.throwIO $ ConnectionError (UnknownErrorCode 413) "Payload Too Large"
650+ _ -> return ()
567651 if S.null bs
568652 then do
569653 writeIORef ref $ WTBDone False
570654 return $ front bs
571655 else push $ front bs
572656 where
573− push bs =
657+ push bs = do
574658 case findBound bound bs of
575659 FoundBound before after -> do
576660 let before' = killCRLF before
@@ -598,8 +682,8 @@ sinkTillBound :: S.ByteString
598682 -> Source
599683 -> Maybe Int64
600684 -> IO ((Bool, Int64), x)
601−sinkTillBound bound iter seed0 src max = do
602− (next, final) <- wrapTillBound bound src max
685+sinkTillBound bound iter seed0 src max' = do
686+ (next, final) <- wrapTillBound bound src max'
603687 let loop seed = do
604688 bs <- next
605689 if S.null bs