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