@@ -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,6 @@ module Network.Wai.Parse
21 , FileInfo (..)
20 , FileInfo (..)
22 , parseContentType
21 , parseContentType
23− , ParseRequestBodyOptions
24− , defaultParseRequestBodyOptions
25− , noLimitParseRequestBodyOptions
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 (..)
23 , Bound (..)
43 , findBound
24 , findBound
@@ -48,30 +29,22 @@ module Network.Wai.Parse
51−import qualified Control.Exception as E
32+import qualified Data.ByteString.Search as Search
52import qualified Data.ByteString as S
33import qualified Data.ByteString as S
53import qualified Data.ByteString.Lazy as L
34import qualified Data.ByteString.Lazy as L
54import qualified Data.ByteString.Char8 as S8
35import qualified Data.ByteString.Char8 as S8
55import Data.Word (Word8)
36import Data.Word (Word8)
56−import Data.Int (Int64)
57−import Data.Maybe (catMaybes, fromMaybe)
37+import Data.Maybe (fromMaybe)
58import Data.List (sortBy)
38import Data.List (sortBy)
59import Data.Function (on, fix)
39import Data.Function (on, fix)
60import System.Directory (removeFile, getTemporaryDirectory)
40import System.Directory (removeFile, getTemporaryDirectory)
61import System.IO (hClose, openBinaryTempFile)
41import System.IO (hClose, openBinaryTempFile)
62−import System.IO.Error (isDoesNotExistError)
63import Network.Wai
42import Network.Wai
64import qualified Network.HTTP.Types as H
43import qualified Network.HTTP.Types as H
65−import Control.Applicative ((<$>))
44+import Control.Monad (when, unless)
66−import Control.Exception (catchJust)
67−import Control.Monad (when, unless, guard)
68import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
45import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState)
69import Data.IORef
46import Data.IORef
70import Network.HTTP.Types (hContentType)
47import Network.HTTP.Types (hContentType)
71−import Network.HTTP2( HTTP2Error (..), ErrorCodeId (..) )
72−import Data.CaseInsensitive (mk)
74−import Prelude hiding (lines)
76breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
49breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
77breakDiscard w s =
50breakDiscard w s =
@@ -121,7 +94,7 @@ lbsBackEnd _ _ popper =
121tempFileBackEnd :: InternalState -> ignored1 -> ignored2 -> IO S.ByteString -> IO FilePath
94tempFileBackEnd :: InternalState -> ignored1 -> ignored2 -> IO S.ByteString -> IO FilePath
122tempFileBackEnd = tempFileBackEndOpts getTemporaryDirectory "webenc.buf"
95tempFileBackEnd = tempFileBackEndOpts getTemporaryDirectory "webenc.buf"
124−-- | Same as 'tempFileBackEnd', but use configurable temp folders and patterns.
97+-- | Same as 'tempFileSink', but use configurable temp folders and patterns.
125tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
98tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
126 -> String -- ^ filename pattern
99 -> String -- ^ filename pattern
127 -> InternalState
100 -> InternalState
@@ -129,9 +102,11 @@ tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
129 -> ignored2
102 -> ignored2
130 -> IO S.ByteString
103 -> IO S.ByteString
131 -> IO FilePath
104 -> IO FilePath
132−tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
105+tempFileBackEndOpts getTmpDir pattern internalState _ _ popper = do
133− (key, (fp, h)) <- flip runInternalState internalState $ allocate it (hClose . snd)
106+ (key, (fp, h)) <- flip runInternalState internalState $ allocate (do
107+ tempDir <- getTmpDir
108+ openBinaryTempFile tempDir pattern) (\(_, h) -> hClose h)
134− _ <- runInternalState (register $ removeFileQuiet fp) internalState
109+ _ <- runInternalState (register $ removeFile fp) internalState
135 fix $ \loop -> do
110 fix $ \loop -> do
136 bs <- popper
111 bs <- popper
137 unless (S.null bs) $ do
112 unless (S.null bs) $ do
@@ -139,150 +114,6 @@ tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
140 release key
115 release key
141 return fp
116 return fp
144− tempDir <- getTmpDir
145− openBinaryTempFile tempDir pattrn
146− removeFileQuiet fp = catchJust (guard . isDoesNotExistError)
150−-- | A data structure that describes the behavior of
151−-- the parseRequestBodyEx function.
154−data ParseRequestBodyOptions = ParseRequestBodyOptions
155− { -- | The maximum length of a filename
156− prboKeyLength :: Maybe Int
157− , -- | The maximum number of files.
158− prboMaxNumFiles :: Maybe Int
159− , -- | The maximum filesize per file.
160− prboMaxFileSize :: Maybe Int64
161− , -- | The maximum total filesize.
162− 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 }
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
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 }
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.
118-- | Information on an uploaded file.
288data FileInfo c = FileInfo
119data FileInfo c = FileInfo
@@ -305,16 +136,8 @@ type BackEnd a = S.ByteString -- ^ parameter name
305 -> IO S.ByteString
136 -> 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
139+data RequestBodyType = UrlEncoded | Multipart S.ByteString
317−-- | Get the mimetype of the body of an http request.
318getRequestBodyType :: Request -> Maybe RequestBodyType
141getRequestBodyType :: Request -> Maybe RequestBodyType
319getRequestBodyType req = do
142getRequestBodyType req = do
320 ctype' <- lookup hContentType $ requestHeaders req
143 ctype' <- lookup hContentType $ requestHeaders req
@@ -327,7 +150,7 @@ getRequestBodyType req = do
327-- | Parse a content type value, turning a single @ByteString@ into the actual
150-- | Parse a content type value, turning a single @ByteString@ into the actual
328-- content type and a list of pairs of attributes.
151-- content type and a list of pairs of attributes.
330−-- @since 1.3.2
153+-- Since 1.3.2
331parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
154parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
332parseContentType a = do
155parseContentType a = do
333 let (ctype, b) = S.break (== semicolon) a
156 let (ctype, b) = S.break (== semicolon) a
@@ -337,9 +160,6 @@ parseContentType a = do
337 semicolon = 59
160 semicolon = 59
338 equals = 61
161 equals = 61
339 space = 32
162 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
163 goAttrs front bs
344 | S.null bs = front []
164 | S.null bs = front []
345 | otherwise =
165 | otherwise =
@@ -348,140 +168,79 @@ parseContentType a = do
348 goAttr bs =
168 goAttr bs =
349 let (k, v') = S.break (== equals) bs
169 let (k, v') = S.break (== equals) bs
350 v = S.drop 1 v'
170 v = S.drop 1 v'
351− in (strip k, dq $ strip v)
171+ in (strip k, strip v)
352 strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
172 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
174parseRequestBody :: BackEnd y
361 -> Request
175 -> Request
362 -> IO ([Param], [File y])
176 -> IO ([Param], [File y])
363−parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions
177+parseRequestBody s r =
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.
371−parseRequestBodyEx :: ParseRequestBodyOptions
374− -> IO ([Param], [File y])
375−parseRequestBodyEx o s r =
376 case getRequestBodyType r of
178 case getRequestBodyType r of
377 Nothing -> return ([], [])
179 Nothing -> return ([], [])
378− Just rbt -> sinkRequestBodyEx o s rbt (requestBody r)
180+ Just rbt -> sinkRequestBody s rbt (requestBody r)
380sinkRequestBody :: BackEnd y
182sinkRequestBody :: BackEnd y
381 -> RequestBodyType
183 -> RequestBodyType
382 -> IO S.ByteString
184 -> IO S.ByteString
383 -> IO ([Param], [File y])
185 -> IO ([Param], [File y])
384−sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions
186+sinkRequestBody s r body = do
389−sinkRequestBodyEx :: ParseRequestBodyOptions
393− -> IO ([Param], [File y])
394−sinkRequestBodyEx o s r body = do
395− ref <- newIORef ([], [])
187+ ref <- newIORef (id, id)
396 let add x = atomicModifyIORef ref $ \(y, z) ->
188 let add x = atomicModifyIORef ref $ \(y, z) ->
397 case x of
189 case x of
398− Left y' -> ((y':y, z), ())
190+ Left y' -> ((y . (y':), z), ())
399− Right z' -> ((y, z':z), ())
191+ Right z' -> ((y, z . (z':)), ())
400− conduitRequestBodyEx o s r body add
192+ conduitRequestBody s r body add
401− (\(a, b) -> (reverse a, reverse b)) <$> readIORef ref
193+ (x, y) <- readIORef ref
402−
194+ return (x [], y [])
403−conduitRequestBodyEx :: ParseRequestBodyOptions
195+
404− -> BackEnd y
196+conduitRequestBody :: BackEnd y
405− -> RequestBodyType
197+ -> RequestBodyType
406− -> IO S.ByteString
198+ -> IO S.ByteString
407− -> (Either Param (File y) -> IO ())
199+ -> (Either Param (File y) -> IO ())
408− -> IO ()
200+ -> IO ()
409−conduitRequestBodyEx o _ UrlEncoded rbody add = do
201+conduitRequestBody _ UrlEncoded rbody add = do
410 -- NOTE: in general, url-encoded data will be in a single chunk.
202 -- NOTE: in general, url-encoded data will be in a single chunk.
411 -- Therefore, I'm optimizing for the usual case by sticking with
203 -- Therefore, I'm optimizing for the usual case by sticking with
412 -- strict byte strings here.
204 -- strict byte strings here.
413− let loop size front = do
205+ let loop front = do
414 bs <- rbody
206 bs <- rbody
415 if S.null bs
207 if S.null bs
416 then return $ S.concat $ front []
208 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:)
209+ else loop $ front . (bs:)
424− bs <- loop 0 id
210+ bs <- loop id
425 mapM_ (add . Left) $ H.parseSimpleQuery bs
211 mapM_ (add . Left) $ H.parseSimpleQuery bs
426−conduitRequestBodyEx o backend (Multipart bound) rbody add =
212+conduitRequestBody backend (Multipart bound) rbody add =
427− parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
213+ parsePieces backend (S8.pack "--" `S.append` bound) rbody add
430−-- | Take one header or subheader line.
432−-- Throw 431 if headers too large.
433−takeLine :: Maybe Int -> Source -> IO (Maybe S.ByteString)
215+takeLine :: Source -> IO (Maybe S.ByteString)
434−takeLine maxlen src =
216+takeLine src =
437 go front = do
219 go front = do
438 bs <- readSource src
220 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 ()
444 if S.null bs
221 if S.null bs
445 then close front
222 then close front
446 else push front bs
223 else push front bs
448− close front = leftover src front >> return Nothing
225+ close front = leftover src (front S.empty) >> return Nothing
449 push front bs = do
226 push front bs = do
450− let (x, y) = S.break (== 10) bs -- LF
227+ let (x, y) = S.break (== 10) $ front bs -- LF
451 in if S.null y
228 in if S.null y
452− then go $ front `S.append` x
229+ then go $ S.append x
454 when (S.length y > 1) $ leftover src $ S.drop 1 y
231 when (S.length y > 1) $ leftover src $ S.drop 1 y
455− let res = front `S.append` x
232+ return $ Just $ killCR 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]
234+takeLines :: Source -> IO [S.ByteString]
464−takeLines' lineLength maxLines source =
235+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
236+ res <- takeLine src
480 case res of
237 case res of
481− Nothing -> return lines
238+ Nothing -> return []
483− | S.null l -> return lines
240+ | S.null l -> return []
484− | otherwise -> takeLines'' (l:lines) lineLength maxLines src
241+ | otherwise -> do
486data Source = Source (IO S.ByteString) (IORef S.ByteString)
245data Source = Source (IO S.ByteString) (IORef S.ByteString)
@@ -500,20 +259,17 @@ readSource (Source f ref) = do
500leftover :: Source -> S.ByteString -> IO ()
259leftover :: Source -> S.ByteString -> IO ()
501leftover (Source _ ref) bs = writeIORef ref bs
260leftover (Source _ ref) bs = writeIORef ref bs
503−parsePiecesEx :: ParseRequestBodyOptions
504− -> BackEnd y
262+parsePieces :: BackEnd y
505− -> S.ByteString
263+ -> S.ByteString
506− -> IO S.ByteString
264+ -> IO S.ByteString
507− -> (Either Param (File y) -> IO ())
265+ -> (Either Param (File y) -> IO ())
508− -> IO ()
266+ -> IO ()
509−parsePiecesEx o sink bound rbody add =
267+parsePieces sink bound rbody add =
510− mkSource rbody >>= loop 0 0 0 0
268+ mkSource rbody >>= loop
512− loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
270+ loop src = do
513− loop numParms numFiles parmSize filesSize src = do
514− _boundLine <- takeLine (prboMaxHeaderLineLength o) src
271+ _boundLine <- takeLine src
515− res' <- takeLines' (prboMaxHeaderLineLength o)
272+ res' <- takeLines src
516− (prboMaxHeaderLines o) src
517 unless (null res') $ do
273 unless (null res') $ do
518 let ls' = map parsePair res'
274 let ls' = map parsePair res'
519 let x = do
275 let x = do
@@ -524,57 +280,31 @@ parsePiecesEx o sink bound rbody add =
524 return (ct, name, lookup "filename" attrs)
280 return (ct, name, lookup "filename" attrs)
525 case x of
281 case x of
526 Just (mct, name, Just filename) -> do
282 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 ()
536 let ct = fromMaybe "application/octet-stream" mct
283 let ct = fromMaybe "application/octet-stream" mct
537 fi0 = FileInfo filename ct ()
284 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
285+ (wasFound, y) <- sinkTillBound' bound name fi0 sink src
542− let newFilesSize = filesSize + fileSize
543 add $ Right (name, fi0 { fileContent = y })
286 add $ Right (name, fi0 { fileContent = y })
544− when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
287+ when wasFound (loop src)
545 Just (_ct, name, Nothing) -> do
288 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 ()
551 let seed = id
289 let seed = id
552 let iter front bs = return $ front . (:) bs
290 let iter front bs = return $ front . (:) bs
553− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
291+ (wasFound, front) <- sinkTillBound bound iter seed src
554− (fromIntegral <$> prboMaxParmsSize o)
555 let bs = S.concat $ front []
292 let bs = S.concat $ front []
556 let x' = (name, bs)
293 let x' = (name, bs)
557− 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 ()
562 add $ Left x'
294 add $ Left x'
563− when wasFound $ loop (numParms + 1) numFiles
295+ when wasFound (loop src)
564− newParmSize filesSize src
566 -- ignore this part
297 -- ignore this part
567 let seed = ()
298 let seed = ()
568 iter () _ = return ()
299 iter () _ = return ()
569− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
300+ (wasFound, ()) <- sinkTillBound bound iter seed src
570− when wasFound $ loop numParms numFiles parmSize filesSize src
301+ when wasFound (loop src)
572− contDisp = mk $ S8.pack "Content-Disposition"
303+ contDisp = S8.pack "Content-Disposition"
573− contType = mk $ S8.pack "Content-Type"
304+ contType = S8.pack "Content-Type"
574 parsePair s =
305 parsePair s =
575 let (x, y) = breakDiscard 58 s -- colon
306 let (x, y) = breakDiscard 58 s -- colon
576− in (mk $ x, S.dropWhile (== 32) y) -- space
307+ in (x, S.dropWhile (== 32) y) -- space
579data Bound = FoundBound S.ByteString S.ByteString
309data Bound = FoundBound S.ByteString S.ByteString
580 | NoBound
310 | NoBound
@@ -582,7 +312,7 @@ data Bound = FoundBound S.ByteString S.ByteString
582 deriving (Eq, Show)
312 deriving (Eq, Show)
584findBound :: S.ByteString -> S.ByteString -> Bound
314findBound :: S.ByteString -> S.ByteString -> Bound
585−findBound b bs = handleBreak $ S.breakSubstring b bs
315+findBound b bs = handleBreak $ Search.breakOn b bs
587 handleBreak (h, t)
317 handleBreak (h, t)
588 | S.null t = go [lowBound..S.length bs - 1]
318 | S.null t = go [lowBound..S.length bs - 1]
@@ -609,10 +339,9 @@ sinkTillBound' :: S.ByteString
609 -> FileInfo ()
339 -> FileInfo ()
610 -> BackEnd y
340 -> BackEnd y
611 -> Source
341 -> Source
613− -> IO ((Bool, Int64), y)
342+ -> IO (Bool, y)
614−sinkTillBound' bound name fi sink src max' = do
343+sinkTillBound' bound name fi sink src = do
615− (next, final) <- wrapTillBound bound src max'
344+ (next, final) <- wrapTillBound bound src
616 y <- sink name fi next
345 y <- sink name fi next
617 b <- final
346 b <- final
618 return (b, y)
347 return (b, y)
@@ -621,40 +350,30 @@ data WTB = WTBWorking (S.ByteString -> S.ByteString)
621 | WTBDone Bool
350 | WTBDone Bool
622wrapTillBound :: S.ByteString -- ^ bound
351wrapTillBound :: S.ByteString -- ^ bound
623 -> Source
352 -> Source
625− -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
353+ -> IO (IO S.ByteString, IO Bool) -- ^ Bool indicates if the bound was found
626−wrapTillBound bound src max' = do
354+wrapTillBound bound src = do
627 ref <- newIORef $ WTBWorking id
355 ref <- newIORef $ WTBWorking id
628− sref <- newIORef (0 :: Int64)
629− return (go ref sref, final ref sref)
356+ return (go ref, final ref)
631− final ref sref = do
358+ final ref = do
632 x <- readIORef ref
359 x <- readIORef ref
633 case x of
360 case x of
634 WTBWorking _ -> error "wrapTillBound did not finish"
361 WTBWorking _ -> error "wrapTillBound did not finish"
635− WTBDone y -> do
362+ WTBDone y -> return y
636− siz <- readIORef sref
639− go ref sref = do
364+ go ref = do
640 state <- readIORef ref
365 state <- readIORef ref
641 case state of
366 case state of
642 WTBDone _ -> return S.empty
367 WTBDone _ -> return S.empty
643 WTBWorking front -> do
368 WTBWorking front -> do
644 bs <- readSource src
369 bs <- readSource src
645− cur <- atomicModifyIORef' sref $ \ cur ->
646− let new = cur + fromIntegral (S.length bs) in (new, new)
648− Just max'' | cur > max'' ->
649− E.throwIO $ ConnectionError (UnknownErrorCode 413) "Payload Too Large"
651 if S.null bs
370 if S.null bs
653 writeIORef ref $ WTBDone False
372 writeIORef ref $ WTBDone False
654 return $ front bs
373 return $ front bs
655 else push $ front bs
374 else push $ front bs
657− push bs = do
376+ push bs =
658 case findBound bound bs of
377 case findBound bound bs of
659 FoundBound before after -> do
378 FoundBound before after -> do
660 let before' = killCRLF before
379 let before' = killCRLF before
@@ -670,20 +389,19 @@ wrapTillBound bound src max' = do
670 else (bs, id)
389 else (bs, id)
671 writeIORef ref $ WTBWorking front'
390 writeIORef ref $ WTBWorking front'
672 if S.null toEmit
391 if S.null toEmit
673− then go ref sref
392+ then go ref
674 else return toEmit
393 else return toEmit
675 PartialBound -> do
394 PartialBound -> do
676 writeIORef ref $ WTBWorking $ S.append bs
395 writeIORef ref $ WTBWorking $ S.append bs
677− go ref sref
396+ go ref
679sinkTillBound :: S.ByteString
398sinkTillBound :: S.ByteString
680 -> (x -> S.ByteString -> IO x)
399 -> (x -> S.ByteString -> IO x)
682 -> Source
401 -> Source
684− -> IO ((Bool, Int64), x)
402+ -> IO (Bool, x)
685−sinkTillBound bound iter seed0 src max' = do
403+sinkTillBound bound iter seed0 src = do
686− (next, final) <- wrapTillBound bound src max'
404+ (next, final) <- wrapTillBound bound src
687 let loop seed = do
405 let loop seed = do
688 bs <- next
406 bs <- next
689 if S.null bs
407 if S.null bs