@@ -38,7 +38,7 @@ import qualified Data.ByteString.Char8 as S8
3838import Data.Default (Default, def)
3939import Data.Word (Word8)
4040import Data.Int (Int64)
41−import Data.Maybe (fromMaybe)
41+import Data.Maybe (catMaybes, fromMaybe)
4242import Data.List (sortBy)
4343import Data.Function (on, fix)
4444import System.Directory (removeFile, getTemporaryDirectory)
@@ -373,13 +373,13 @@ parsePieces sink bound rbody add =
373373 Just (mct, name, Just filename) -> do
374374 let ct = fromMaybe "application/octet-stream" mct
375375 fi0 = FileInfo filename ct ()
376− ((wasFound, _fileSize), y) <- sinkTillBound' bound name fi0 sink src
376+ ((wasFound, _fileSize), y) <- sinkTillBound' bound name fi0 sink src Nothing
377377 add $ Right (name, fi0 { fileContent = y })
378378 when wasFound (loop src)
379379 Just (_ct, name, Nothing) -> do
380380 let seed = id
381381 let iter front bs = return $ front . (:) bs
382− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
382+ ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src Nothing
383383 let bs = S.concat $ front []
384384 let x' = (name, bs)
385385 add $ Left x'
@@ -388,7 +388,7 @@ parsePieces sink bound rbody add =
388388 -- ignore this part
389389 let seed = ()
390390 iter () _ = return ()
391− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src
391+ ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
392392 when wasFound (loop src)
393393 where
394394 contDisp = mk $ S8.pack "Content-Disposition"
@@ -426,17 +426,10 @@ parsePiecesEx o sink bound rbody add =
426426 error "Maximum number of files exceeded"
427427 let ct = fromMaybe "application/octet-stream" mct
428428 fi0 = FileInfo filename ct ()
429− ((wasFound, fileSize), y) <- sinkTillBound' bound name fi0 sink src
430− case prboMaxFileSize o of
431− Just maxFileSize -> when (fileSize > maxFileSize ) $
432− error "Maximum file size exceeded"
433− Nothing -> return ()
429+ fs = catMaybes [ prboMaxFileSize o, prboMaxFilesSize o ]
430+ mfs = if fs == [] then Nothing else Just $ minimum fs
431+ ((wasFound, fileSize), y) <- sinkTillBound' bound name fi0 sink src mfs
434432 let newFilesSize = filesSize + fileSize
435− case prboMaxFilesSize o of
436− Just maxFilesSize ->
437− when (newFilesSize > maxFilesSize) $
438− error "Maximum size of uploaded files exceeded"
439− Nothing -> return ()
440433 add $ Right (name, fi0 { fileContent = y })
441434 when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
442435 Just (_ct, name, Nothing) -> do
@@ -444,7 +437,8 @@ parsePiecesEx o sink bound rbody add =
444437 error "Parameter name is too long"
445438 let seed = id
446439 let iter front bs = return $ front . (:) bs
447− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
440+ ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src $
441+ Just . fromIntegral . prboMaxParmsValueSize $ o
448442 let bs = S.concat $ front []
449443 let x' = (name, bs)
450444 let newParmSize = parmSize + S.length name + S.length bs
@@ -457,7 +451,7 @@ parsePiecesEx o sink bound rbody add =
457451 -- ignore this part
458452 let seed = ()
459453 iter () _ = return ()
460− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src
454+ ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
461455 when wasFound $ loop numParms numFiles parmSize filesSize src
462456 where
463457 contDisp = mk $ S8.pack "Content-Disposition"
@@ -500,9 +494,10 @@ sinkTillBound' :: S.ByteString
500494 -> FileInfo ()
501495 -> BackEnd y
502496 -> Source
497+ -> Maybe Int64
503498 -> IO ((Bool, Int64), y)
504−sinkTillBound' bound name fi sink src = do
505− (next, final) <- wrapTillBound bound src
499+sinkTillBound' bound name fi sink src max = do
500+ (next, final) <- wrapTillBound bound src max
506501 y <- sink name fi next
507502 b <- final
508503 return (b, y)
@@ -511,8 +506,9 @@ data WTB = WTBWorking (S.ByteString -> S.ByteString)
511506 | WTBDone Bool
512507wrapTillBound :: S.ByteString -- ^ bound
513508 -> Source
509+ -> Maybe Int64
514510 -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
515−wrapTillBound bound src = do
511+wrapTillBound bound src max = do
516512 ref <- newIORef $ WTBWorking id
517513 sref <- newIORef (0 :: Int64)
518514 return (go ref sref, final ref sref)
@@ -531,7 +527,11 @@ wrapTillBound bound src = do
531527 WTBDone _ -> return S.empty
532528 WTBWorking front -> do
533529 bs <- readSource src
534− modifyIORef sref $ (+) (fromIntegral $S.length bs)
530+ cur <- atomicModifyIORef sref $ \ cur ->
531+ let new = cur + fromIntegral (S.length bs) in (new, new)
532+ case max of
533+ Just max' | cur > max' -> error "Maximum size exceeded"
534+ _ -> return ()
535535 if S.null bs
536536 then do
537537 writeIORef ref $ WTBDone False
@@ -564,9 +564,10 @@ sinkTillBound :: S.ByteString
564564 -> (x -> S.ByteString -> IO x)
565565 -> x
566566 -> Source
567+ -> Maybe Int64
567568 -> IO ((Bool, Int64), x)
568−sinkTillBound bound iter seed0 src = do
569− (next, final) <- wrapTillBound bound src
569+sinkTillBound bound iter seed0 src max = do
570+ (next, final) <- wrapTillBound bound src max
570571 let loop seed = do
571572 bs <- next
572573 if S.null bs