@@ -11,6 +11,7 @@ module Network.Wai.Parse
11 , RequestBodyType (..)
11 , RequestBodyType (..)
12 , getRequestBodyType
12 , getRequestBodyType
13 , sinkRequestBody
13 , sinkRequestBody
15 , lbsBackEnd
16 , lbsBackEnd
16 , tempFileBackEnd
17 , tempFileBackEnd
@@ -19,8 +20,24 @@ module Network.Wai.Parse
20 , FileInfo (..)
21 , FileInfo (..)
21 , parseContentType
22 , parseContentType
22− , ParseRequestBodyOptions (..)
23+ , ParseRequestBodyOptions
24+ , defaultParseRequestBodyOptions
25+ , noLimitParseRequestBodyOptions
23 , parseRequestBodyEx
26 , parseRequestBodyEx
27+ , setMaxRequestKeyLength
28+ , clearMaxRequestKeyLength
29+ , setMaxRequestNumFiles
30+ , clearMaxRequestNumFiles
31+ , setMaxRequestFileSize
32+ , clearMaxRequestFileSize
33+ , setMaxRequestFilesSize
34+ , clearMaxRequestFilesSize
35+ , setMaxRequestParmsSize
36+ , clearMaxRequestParmsSize
38+ , clearMaxHeaderLines
39+ , setMaxHeaderLineLength
40+ , clearMaxHeaderLineLength
25 , Bound (..)
42 , Bound (..)
26 , findBound
43 , findBound
@@ -31,11 +48,10 @@ module Network.Wai.Parse
34−import qualified Data.ByteString.Search as Search
51+import qualified Control.Exception as E
35import qualified Data.ByteString as S
52import qualified Data.ByteString as S
36import qualified Data.ByteString.Lazy as L
53import qualified Data.ByteString.Lazy as L
37import qualified Data.ByteString.Char8 as S8
54import qualified Data.ByteString.Char8 as S8
38−import Data.Default (Default, def)
39import Data.Word (Word8)
55import Data.Word (Word8)
40import Data.Int (Int64)
56import Data.Int (Int64)
41import Data.Maybe (catMaybes, fromMaybe)
57import Data.Maybe (catMaybes, fromMaybe)
@@ -43,15 +59,20 @@ import Data.List (sortBy)
43import Data.Function (on, fix)
59import Data.Function (on, fix)
44import System.Directory (removeFile, getTemporaryDirectory)
60import System.Directory (removeFile, getTemporaryDirectory)
45import System.IO (hClose, openBinaryTempFile)
61import System.IO (hClose, openBinaryTempFile)
62+import System.IO.Error (isDoesNotExistError)
46import Network.Wai
63import Network.Wai
47import qualified Network.HTTP.Types as H
64import qualified Network.HTTP.Types as H
48import Control.Applicative ((<$>))
65import Control.Applicative ((<$>))
66+import Control.Exception (catchJust)
49−import Control.Monad (when, unless)
67+import Control.Monad (when, unless, guard)
50import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
68import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
51import Data.IORef
69import Data.IORef
52import Network.HTTP.Types (hContentType)
70import Network.HTTP.Types (hContentType)
71+import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )
53import Data.CaseInsensitive (mk)
72import Data.CaseInsensitive (mk)
74+import Prelude hiding (lines)
55breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
76breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
56breakDiscard w s =
77breakDiscard w s =
57 let (x, y) = S.break (== w) s
78 let (x, y) = S.break (== w) s
@@ -110,7 +131,7 @@ tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
110 -> IO FilePath
131 -> IO FilePath
111tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
132tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
112 (key, (fp, h)) <- flip runInternalState internalState $ allocate it (hClose . snd)
133 (key, (fp, h)) <- flip runInternalState internalState $ allocate it (hClose . snd)
113− _ <- runInternalState (register $ removeFile fp) internalState
134+ _ <- runInternalState (register $ removeFileQuiet fp) internalState
114 fix $ \loop -> do
135 fix $ \loop -> do
115 bs <- popper
136 bs <- popper
116 unless (S.null bs) $ do
137 unless (S.null bs) $ do
@@ -122,31 +143,146 @@ tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
123 tempDir <- getTmpDir
144 tempDir <- getTmpDir
124 openBinaryTempFile tempDir pattrn
145 openBinaryTempFile tempDir pattrn
146+ removeFileQuiet fp = catchJust (guard . isDoesNotExistError)
126-- | A data structure that describes the behavior of
150-- | A data structure that describes the behavior of
127-- the parseRequestBodyEx function.
151-- the parseRequestBodyEx function.
128data ParseRequestBodyOptions = ParseRequestBodyOptions
154data ParseRequestBodyOptions = ParseRequestBodyOptions
129 { -- | The maximum length of a filename
155 { -- | The maximum length of a filename
130− prboKeyLength :: Int
156+ prboKeyLength :: Maybe Int
131 , -- | The maximum number of files.
157 , -- | The maximum number of files.
132− prboMaxNumFiles :: Int
158+ prboMaxNumFiles :: Maybe Int
133 , -- | The maximum filesize per file.
159 , -- | The maximum filesize per file.
134 prboMaxFileSize :: Maybe Int64
160 prboMaxFileSize :: Maybe Int64
135 , -- | The maximum total filesize.
161 , -- | The maximum total filesize.
136 prboMaxFilesSize :: Maybe Int64
162 prboMaxFilesSize :: Maybe Int64
137− , -- | The maximum size of the sum of all parameters values
163+ , -- | The maximum size of the sum of all parameters
138− prboMaxParmsValueSize :: Int
164+ prboMaxParmsSize :: Maybe Int
139− , -- | The maximum header lines per entry
165+ , -- | The maximum header lines per mime/multipart entry
140− prboMaxHeaderLines :: Int }
166+ prboMaxHeaderLines :: Maybe Int
141−
167+ , -- | The maximum header line length per mime/multipart entry
168+ prboMaxHeaderLineLength :: Maybe Int }
170+-- | Set the maximum length of a filename.
173+setMaxRequestKeyLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
174+setMaxRequestKeyLength l p = p { prboKeyLength=Just l }
176+-- | Do not limit the length of filenames.
179+clearMaxRequestKeyLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
180+clearMaxRequestKeyLength p = p { prboKeyLength=Nothing }
182+-- | Set the maximum number of files per request.
185+setMaxRequestNumFiles :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
186+setMaxRequestNumFiles l p = p { prboMaxNumFiles=Just l }
188+-- | Do not limit the maximum number of files per request.
191+clearMaxRequestNumFiles :: ParseRequestBodyOptions -> ParseRequestBodyOptions
192+clearMaxRequestNumFiles p = p { prboMaxNumFiles=Nothing }
194+-- | Set the maximum filesize per file (in bytes).
197+setMaxRequestFileSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
198+setMaxRequestFileSize l p = p { prboMaxFileSize=Just l }
200+-- | Do not limit the maximum filesize per file.
203+clearMaxRequestFileSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
204+clearMaxRequestFileSize p = p { prboMaxFileSize=Nothing }
206+-- | Set the maximum size of all files per request.
209+setMaxRequestFilesSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions
210+setMaxRequestFilesSize l p = p { prboMaxFilesSize=Just l }
212+-- | Do not limit the maximum size of all files per request.
215+clearMaxRequestFilesSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
216+clearMaxRequestFilesSize p = p { prboMaxFilesSize=Nothing }
218+-- | Set the maximum size of the sum of all parameters.
221+setMaxRequestParmsSize :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
222+setMaxRequestParmsSize l p = p { prboMaxParmsSize=Just l }
224+-- | Do not limit the maximum size of the sum of all parameters.
227+clearMaxRequestParmsSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions
228+clearMaxRequestParmsSize p = p { prboMaxParmsSize=Nothing }
230+-- | Set the maximum header lines per mime/multipart entry.
233+setMaxHeaderLines :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
234+setMaxHeaderLines l p = p { prboMaxHeaderLines=Just l }
236+-- | Do not limit the maximum header lines per mime/multipart entry.
239+clearMaxHeaderLines:: ParseRequestBodyOptions -> ParseRequestBodyOptions
240+clearMaxHeaderLines p = p { prboMaxHeaderLines=Nothing }
242+-- | Set the maximum header line length per mime/multipart entry.
245+setMaxHeaderLineLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions
246+setMaxHeaderLineLength l p = p { prboMaxHeaderLineLength=Just l }
248+-- | Do not limit the maximum header lines per mime/multipart entry.
251+clearMaxHeaderLineLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions
252+clearMaxHeaderLineLength p = p { prboMaxHeaderLineLength=Nothing }
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.
142−instance Default ParseRequestBodyOptions where
264+defaultParseRequestBodyOptions :: ParseRequestBodyOptions
143− def = ParseRequestBodyOptions
265+defaultParseRequestBodyOptions = ParseRequestBodyOptions
144− { prboKeyLength=32
266+ { prboKeyLength=Just 32
145− , prboMaxNumFiles=10
267+ , prboMaxNumFiles=Just 10
146− , prboMaxFileSize=Nothing
268+ , prboMaxFileSize=Nothing
147− , prboMaxFilesSize=Nothing
269+ , prboMaxFilesSize=Nothing
148− , prboMaxParmsValueSize=65336
270+ , prboMaxParmsSize=Just 65336
149− , prboMaxHeaderLines=32 }
271+ , prboMaxHeaderLines=Just 32
272+ , prboMaxHeaderLineLength=Just 8190 }
274+-- | Do not impose any memory limits.
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 }
151-- | Information on an uploaded file.
287-- | Information on an uploaded file.
152data FileInfo c = FileInfo
288data FileInfo c = FileInfo
@@ -169,8 +305,16 @@ type BackEnd a = S.ByteString -- ^ parameter name
169 -> IO S.ByteString
305 -> IO S.ByteString
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.
312+ = -- | application/x-www-form-urlencoded (parameters only)
314+ | -- | multipart/form-data (parameters and files)
172−data RequestBodyType = UrlEncoded | Multipart S.ByteString
315+ Multipart S.ByteString
317+-- | Get the mimetype of the body of an http request.
174getRequestBodyType :: Request -> Maybe RequestBodyType
318getRequestBodyType :: Request -> Maybe RequestBodyType
175getRequestBodyType req = do
319getRequestBodyType req = do
176 ctype' <- lookup hContentType $ requestHeaders req
320 ctype' <- lookup hContentType $ requestHeaders req
@@ -183,7 +327,7 @@ getRequestBodyType req = do
183-- | Parse a content type value, turning a single @ByteString@ into the actual
327-- | Parse a content type value, turning a single @ByteString@ into the actual
184-- content type and a list of pairs of attributes.
328-- content type and a list of pairs of attributes.
186−-- Since 1.3.2
330+-- @since 1.3.2
187parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
331parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
188parseContentType a = do
332parseContentType a = do
189 let (ctype, b) = S.break (== semicolon) a
333 let (ctype, b) = S.break (== semicolon) a
@@ -193,6 +337,9 @@ parseContentType a = do
193 semicolon = 59
337 semicolon = 59
194 equals = 61
338 equals = 61
195 space = 32
339 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
196 goAttrs front bs
343 goAttrs front bs
197 | S.null bs = front []
344 | S.null bs = front []
198 | otherwise =
345 | otherwise =
@@ -201,17 +348,26 @@ parseContentType a = do
201 goAttr bs =
348 goAttr bs =
202 let (k, v') = S.break (== equals) bs
349 let (k, v') = S.break (== equals) bs
203 v = S.drop 1 v'
350 v = S.drop 1 v'
204− in (strip k, strip v)
351+ in (strip k, dq $ strip v)
205 strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
352 strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
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.
207parseRequestBody :: BackEnd y
360parseRequestBody :: BackEnd y
208 -> Request
361 -> Request
209 -> IO ([Param], [File y])
362 -> IO ([Param], [File y])
210−parseRequestBody s r =
363+parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions
211− case getRequestBodyType r of
364+
212− Nothing -> return ([], [])
365+-- | Parse the body of an HTTP request, limit resource usage.
213− Just rbt -> sinkRequestBody s rbt (requestBody r)
366+-- The HTTP body can contain both parameters and files.
214−
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.
215parseRequestBodyEx :: ParseRequestBodyOptions
371parseRequestBodyEx :: ParseRequestBodyOptions
216 -> BackEnd y
372 -> BackEnd y
217 -> Request
373 -> Request
@@ -225,16 +381,11 @@ sinkRequestBody :: BackEnd y
225 -> RequestBodyType
381 -> RequestBodyType
226 -> IO S.ByteString
382 -> IO S.ByteString
227 -> IO ([Param], [File y])
383 -> IO ([Param], [File y])
228−sinkRequestBody s r body = do
384+sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions
229− ref <- newIORef (id, id)
230− let add x = atomicModifyIORef ref $ \(y, z) ->
232− Left y' -> ((y . (y':), z), ())
233− Right z' -> ((y, z . (z':)), ())
234− conduitRequestBody s r body add
235− (x, y) <- readIORef ref
238sinkRequestBodyEx :: ParseRequestBodyOptions
389sinkRequestBodyEx :: ParseRequestBodyOptions
239 -> BackEnd y
390 -> BackEnd y
240 -> RequestBodyType
391 -> RequestBodyType
@@ -247,26 +398,7 @@ sinkRequestBodyEx o s r body = do
247 Left y' -> ((y':y, z), ())
398 Left y' -> ((y':y, z), ())
248 Right z' -> ((y, z':z), ())
399 Right z' -> ((y, z':z), ())
249 conduitRequestBodyEx o s r body add
400 conduitRequestBodyEx o s r body add
250− readIORef ref
401+ (\(a, b) -> (reverse a, reverse b)) <$> readIORef ref
252−conduitRequestBody :: BackEnd y
255− -> (Either Param (File y) -> IO ())
257−conduitRequestBody _ UrlEncoded rbody add = do
258− -- NOTE: in general, url-encoded data will be in a single chunk.
259− -- Therefore, I'm optimizing for the usual case by sticking with
260− -- strict byte strings here.
264− then return $ S.concat $ front []
265− else loop $ front . (bs:)
267− mapM_ (add . Left) $ H.parseSimpleQuery bs
268−conduitRequestBody backend (Multipart bound) rbody add =
269− parsePieces backend (S8.pack "--" `S.append` bound) rbody add
271conduitRequestBodyEx :: ParseRequestBodyOptions
403conduitRequestBodyEx :: ParseRequestBodyOptions
272 -> BackEnd y
404 -> BackEnd y
@@ -278,60 +410,78 @@ conduitRequestBodyEx o _ UrlEncoded rbody add = do
278 -- NOTE: in general, url-encoded data will be in a single chunk.
410 -- NOTE: in general, url-encoded data will be in a single chunk.
279 -- Therefore, I'm optimizing for the usual case by sticking with
411 -- Therefore, I'm optimizing for the usual case by sticking with
280 -- strict byte strings here.
412 -- strict byte strings here.
281− let loop front = do
413+ let loop size front = do
282 bs <- rbody
414 bs <- rbody
283 if S.null bs
415 if S.null bs
284 then return $ S.concat $ front []
416 then return $ S.concat $ front []
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 ()
285− else loop $ front . (bs:)
423+ loop newsize $ front . (bs:)
286− bs <- loop id
424+ bs <- loop 0 id
287 mapM_ (add . Left) $ H.parseSimpleQuery bs
425 mapM_ (add . Left) $ H.parseSimpleQuery bs
288conduitRequestBodyEx o backend (Multipart bound) rbody add =
426conduitRequestBodyEx o backend (Multipart bound) rbody add =
289 parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
427 parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
430+-- | Take one header or subheader line.
432+-- Throw 431 if headers too large.
292−takeLine :: Source -> IO (Maybe S.ByteString)
433+takeLine :: Maybe Int -> Source -> IO (Maybe S.ByteString)
293−takeLine src =
434+takeLine maxlen src =
296 go front = do
437 go front = do
297 bs <- readSource src
438 bs <- readSource src
440+ Just maxlen' -> when (S.length front > maxlen') $
441+ E.throwIO $ ConnectionError (UnknownErrorCode 431)
442+ "Request Header Fields Too Large"
443+ Nothing -> return ()
298 if S.null bs
444 if S.null bs
299 then close front
445 then close front
300 else push front bs
446 else push front bs
302− close front = leftover src (front S.empty) >> return Nothing
448+ close front = leftover src front >> return Nothing
303 push front bs = do
449 push front bs = do
304− let (x, y) = S.break (== 10) $ front bs -- LF
450+ let (x, y) = S.break (== 10) bs -- LF
305 in if S.null y
451 in if S.null y
306− then go $ S.append x
452+ then go $ front `S.append` x
308 when (S.length y > 1) $ leftover src $ S.drop 1 y
454 when (S.length y > 1) $ leftover src $ S.drop 1 y
309− return $ Just $ killCR x
455+ let res = front `S.append` x
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
311−takeLines :: Source -> IO [S.ByteString]
463+takeLines' :: Maybe Int -> Maybe Int -> Source -> IO [S.ByteString]
312−takeLines src = do
464+takeLines' lineLength maxLines source =
465+ reverse <$> takeLines'' [] lineLength maxLines source
472+ -> IO [S.ByteString]
473+takeLines'' lines lineLength maxLines src = do
476+ when (length lines > maxLines') $
477+ error "Too many lines in mime/multipart header"
478+ Nothing -> return ()
313− res <- takeLine src
479+ res <- takeLine lineLength src
314 case res of
480 case res of
315− Nothing -> return []
481+ Nothing -> return lines
317− | S.null l -> return []
483+ | S.null l -> return lines
322−takeLines' :: Int -> Source -> IO [S.ByteString]
323−takeLines' a b = reverse <$> takeLines'' [] a b
325−takeLines'' :: [S.ByteString] -> Int -> Source -> IO [S.ByteString]
326−takeLines'' lines maxLines src
327− | length lines > maxLines = error "Too many lines in mime/multipart header"
331− Nothing -> return lines
333− | S.null l -> return lines
334− | otherwise -> takeLines'' (l:lines) maxLines src
484+ | otherwise -> takeLines'' (l:lines) lineLength maxLines src
336data Source = Source (IO S.ByteString) (IORef S.ByteString)
486data Source = Source (IO S.ByteString) (IORef S.ByteString)
@@ -350,53 +500,6 @@ readSource (Source f ref) = do
350leftover :: Source -> S.ByteString -> IO ()
500leftover :: Source -> S.ByteString -> IO ()
351leftover (Source _ ref) bs = writeIORef ref bs
501leftover (Source _ ref) bs = writeIORef ref bs
353−parsePieces :: BackEnd y
356− -> (Either Param (File y) -> IO ())
358−parsePieces sink bound rbody add =
359− mkSource rbody >>= loop
362− _boundLine <- takeLine src
363− res' <- takeLines src
364− unless (null res') $ do
365− let ls' = map parsePair res'
367− cd <- lookup contDisp ls'
368− let ct = lookup contType ls'
369− let attrs = parseAttrs cd
370− name <- lookup "name" attrs
371− return (ct, name, lookup "filename" attrs)
373− Just (mct, name, Just filename) -> do
374− let ct = fromMaybe "application/octet-stream" mct
375− fi0 = FileInfo filename ct ()
376− ((wasFound, _fileSize), y) <- sinkTillBound' bound name fi0 sink src Nothing
377− add $ Right (name, fi0 { fileContent = y })
378− when wasFound (loop src)
379− Just (_ct, name, Nothing) -> do
381− let iter front bs = return $ front . (:) bs
382− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src Nothing
383− let bs = S.concat $ front []
386− when wasFound (loop src)
390− iter () _ = return ()
391− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
392− when wasFound (loop src)
394− contDisp = mk $ S8.pack "Content-Disposition"
395− contType = mk $ S8.pack "Content-Type"
397− let (x, y) = breakDiscard 58 s -- colon
398− in (mk $ x, S.dropWhile (== 32) y) -- space
400parsePiecesEx :: ParseRequestBodyOptions
503parsePiecesEx :: ParseRequestBodyOptions
401 -> BackEnd y
504 -> BackEnd y
402 -> S.ByteString
505 -> S.ByteString
@@ -408,8 +511,9 @@ parsePiecesEx o sink bound rbody add =
409 loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
512 loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
410 loop numParms numFiles parmSize filesSize src = do
513 loop numParms numFiles parmSize filesSize src = do
411− _boundLine <- takeLine src
514+ _boundLine <- takeLine (prboMaxHeaderLineLength o) src
515+ res' <- takeLines' (prboMaxHeaderLineLength o)
412− res' <- takeLines' (prboMaxHeaderLines o) src
516+ (prboMaxHeaderLines o) src
413 unless (null res') $ do
517 unless (null res') $ do
414 let ls' = map parsePair res'
518 let ls' = map parsePair res'
415 let x = do
519 let x = do
@@ -420,30 +524,41 @@ parsePiecesEx o sink bound rbody add =
420 return (ct, name, lookup "filename" attrs)
524 return (ct, name, lookup "filename" attrs)
421 case x of
525 case x of
422 Just (mct, name, Just filename) -> do
526 Just (mct, name, Just filename) -> do
527+ case prboKeyLength o of
528+ Just maxKeyLength ->
423− when (S.length name > prboKeyLength o) $
529+ when (S.length name > maxKeyLength) $
424− error "Filename is too long"
530+ error "Filename is too long"
531+ Nothing -> return ()
532+ case prboMaxNumFiles o of
425− when (numFiles >= prboMaxNumFiles o) $
533+ Just maxFiles -> when (numFiles >= maxFiles) $
426− error "Maximum number of files exceeded"
534+ error "Maximum number of files exceeded"
535+ Nothing -> return ()
427 let ct = fromMaybe "application/octet-stream" mct
536 let ct = fromMaybe "application/octet-stream" mct
428 fi0 = FileInfo filename ct ()
537 fi0 = FileInfo filename ct ()
429− fs = catMaybes [ prboMaxFileSize o, prboMaxFilesSize o ]
538+ fs = catMaybes [ prboMaxFileSize o
539+ , subtract filesSize <$> prboMaxFilesSize o ]
430 mfs = if fs == [] then Nothing else Just $ minimum fs
540 mfs = if fs == [] then Nothing else Just $ minimum fs
431 ((wasFound, fileSize), y) <- sinkTillBound' bound name fi0 sink src mfs
541 ((wasFound, fileSize), y) <- sinkTillBound' bound name fi0 sink src mfs
432 let newFilesSize = filesSize + fileSize
542 let newFilesSize = filesSize + fileSize
433 add $ Right (name, fi0 { fileContent = y })
543 add $ Right (name, fi0 { fileContent = y })
434 when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
544 when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
435 Just (_ct, name, Nothing) -> do
545 Just (_ct, name, Nothing) -> do
546+ case prboKeyLength o of
547+ Just maxKeyLength ->
436− when (S.length name > prboKeyLength o) $
548+ when (S.length name > maxKeyLength) $
437− error "Parameter name is too long"
549+ error "Parameter name is too long"
550+ Nothing -> return ()
438 let seed = id
551 let seed = id
439 let iter front bs = return $ front . (:) bs
552 let iter front bs = return $ front . (:) bs
440− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src $
553+ ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
441− Just . fromIntegral . prboMaxParmsValueSize $ o
554+ (fromIntegral <$> prboMaxParmsSize o)
442 let bs = S.concat $ front []
555 let bs = S.concat $ front []
443 let x' = (name, bs)
556 let x' = (name, bs)
444 let newParmSize = parmSize + S.length name + S.length bs
557 let newParmSize = parmSize + S.length name + S.length bs
445− when (newParmSize > prboMaxParmsValueSize o) $
558+ case prboMaxParmsSize o of
559+ Just maxParmSize -> when (newParmSize > maxParmSize) $
446− error "Maximum size of parameters exceeded"
560+ error "Maximum size of parameters exceeded"
561+ Nothing -> return ()
447 add $ Left x'
562 add $ Left x'
448 when wasFound $ loop (numParms + 1) numFiles
563 when wasFound $ loop (numParms + 1) numFiles
449 newParmSize filesSize src
564 newParmSize filesSize src
@@ -467,7 +582,7 @@ data Bound = FoundBound S.ByteString S.ByteString
467 deriving (Eq, Show)
582 deriving (Eq, Show)
469findBound :: S.ByteString -> S.ByteString -> Bound
584findBound :: S.ByteString -> S.ByteString -> Bound
470−findBound b bs = handleBreak $ Search.breakOn b bs
585+findBound b bs = handleBreak $ S.breakSubstring b bs
472 handleBreak (h, t)
587 handleBreak (h, t)
473 | S.null t = go [lowBound..S.length bs - 1]
588 | S.null t = go [lowBound..S.length bs - 1]
@@ -496,8 +611,8 @@ sinkTillBound' :: S.ByteString
496 -> Source
611 -> Source
497 -> Maybe Int64
612 -> Maybe Int64
498 -> IO ((Bool, Int64), y)
613 -> IO ((Bool, Int64), y)
499−sinkTillBound' bound name fi sink src max = do
614+sinkTillBound' bound name fi sink src max' = do
500− (next, final) <- wrapTillBound bound src max
615+ (next, final) <- wrapTillBound bound src max'
501 y <- sink name fi next
616 y <- sink name fi next
502 b <- final
617 b <- final
503 return (b, y)
618 return (b, y)
@@ -508,7 +623,7 @@ wrapTillBound :: S.ByteString -- ^ bound
508 -> Source
623 -> Source
509 -> Maybe Int64
624 -> Maybe Int64
510 -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
625 -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
511−wrapTillBound bound src max = do
626+wrapTillBound bound src max' = do
512 ref <- newIORef $ WTBWorking id
627 ref <- newIORef $ WTBWorking id
513 sref <- newIORef (0 :: Int64)
628 sref <- newIORef (0 :: Int64)
514 return (go ref sref, final ref sref)
629 return (go ref sref, final ref sref)
@@ -527,18 +642,19 @@ wrapTillBound bound src max = do
527 WTBDone _ -> return S.empty
642 WTBDone _ -> return S.empty
528 WTBWorking front -> do
643 WTBWorking front -> do
529 bs <- readSource src
644 bs <- readSource src
530− cur <- atomicModifyIORef sref $ \ cur ->
645+ cur <- atomicModifyIORef' sref $ \ cur ->
531 let new = cur + fromIntegral (S.length bs) in (new, new)
646 let new = cur + fromIntegral (S.length bs) in (new, new)
532− case max of
647+ case max' of
533− Just max' | cur > max' -> error "Maximum size exceeded"
648+ Just max'' | cur > max'' ->
649+ E.throwIO $ ConnectionError (UnknownErrorCode 413) "Payload Too Large"
534− _ -> return ()
650+ _ -> return ()
535 if S.null bs
651 if S.null bs
537 writeIORef ref $ WTBDone False
653 writeIORef ref $ WTBDone False
538 return $ front bs
654 return $ front bs
539 else push $ front bs
655 else push $ front bs
541− push bs =
657+ push bs = do
542 case findBound bound bs of
658 case findBound bound bs of
543 FoundBound before after -> do
659 FoundBound before after -> do
544 let before' = killCRLF before
660 let before' = killCRLF before
@@ -566,8 +682,8 @@ sinkTillBound :: S.ByteString
566 -> Source
682 -> Source
567 -> Maybe Int64
683 -> Maybe Int64
568 -> IO ((Bool, Int64), x)
684 -> IO ((Bool, Int64), x)
569−sinkTillBound bound iter seed0 src max = do
685+sinkTillBound bound iter seed0 src max' = do
570− (next, final) <- wrapTillBound bound src max
686+ (next, final) <- wrapTillBound bound src max'
571 let loop seed = do
687 let loop seed = do
572 bs <- next
688 bs <- next
573 if S.null bs
689 if S.null bs