@@ -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,31 +29,24 @@ 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 (..) )
72import Data.CaseInsensitive (mk)
48import Data.CaseInsensitive (mk)
74−import Prelude hiding (lines)
76breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
50breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString)
77breakDiscard w s =
51breakDiscard w s =
78 let (x, y) = S.break (== w) s
52 let (x, y) = S.break (== w) s
@@ -129,9 +103,11 @@ tempFileBackEndOpts :: IO FilePath -- ^ get temporary directory
129 -> ignored2
103 -> ignored2
130 -> IO S.ByteString
104 -> IO S.ByteString
131 -> IO FilePath
105 -> IO FilePath
132−tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
106+tempFileBackEndOpts getTmpDir pattern internalState _ _ popper = do
133− (key, (fp, h)) <- flip runInternalState internalState $ allocate it (hClose . snd)
107+ (key, (fp, h)) <- flip runInternalState internalState $ allocate (do
108+ tempDir <- getTmpDir
109+ openBinaryTempFile tempDir pattern) (\(_, h) -> hClose h)
134− _ <- runInternalState (register $ removeFileQuiet fp) internalState
110+ _ <- runInternalState (register $ removeFile fp) internalState
135 fix $ \loop -> do
111 fix $ \loop -> do
136 bs <- popper
112 bs <- popper
137 unless (S.null bs) $ do
113 unless (S.null bs) $ do
@@ -139,150 +115,6 @@ tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do
140 release key
116 release key
141 return fp
117 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.
119-- | Information on an uploaded file.
288data FileInfo c = FileInfo
120data FileInfo c = FileInfo
@@ -305,16 +137,8 @@ type BackEnd a = S.ByteString -- ^ parameter name
305 -> IO S.ByteString
137 -> 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
140+data RequestBodyType = UrlEncoded | Multipart S.ByteString
317−-- | Get the mimetype of the body of an http request.
318getRequestBodyType :: Request -> Maybe RequestBodyType
142getRequestBodyType :: Request -> Maybe RequestBodyType
319getRequestBodyType req = do
143getRequestBodyType req = do
320 ctype' <- lookup hContentType $ requestHeaders req
144 ctype' <- lookup hContentType $ requestHeaders req
@@ -327,7 +151,7 @@ getRequestBodyType req = do
327-- | Parse a content type value, turning a single @ByteString@ into the actual
151-- | Parse a content type value, turning a single @ByteString@ into the actual
328-- content type and a list of pairs of attributes.
152-- content type and a list of pairs of attributes.
330−-- @since 1.3.2
154+-- Since 1.3.2
331parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
155parseContentType :: S.ByteString -> (S.ByteString, [(S.ByteString, S.ByteString)])
332parseContentType a = do
156parseContentType a = do
333 let (ctype, b) = S.break (== semicolon) a
157 let (ctype, b) = S.break (== semicolon) a
@@ -337,9 +161,6 @@ parseContentType a = do
337 semicolon = 59
161 semicolon = 59
338 equals = 61
162 equals = 61
339 space = 32
163 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
164 goAttrs front bs
344 | S.null bs = front []
165 | S.null bs = front []
345 | otherwise =
166 | otherwise =
@@ -348,140 +169,79 @@ parseContentType a = do
348 goAttr bs =
169 goAttr bs =
349 let (k, v') = S.break (== equals) bs
170 let (k, v') = S.break (== equals) bs
350 v = S.drop 1 v'
171 v = S.drop 1 v'
351− in (strip k, dq $ strip v)
172+ in (strip k, strip v)
352 strip = S.dropWhile (== space) . fst . S.breakEnd (/= space)
173 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
175parseRequestBody :: BackEnd y
361 -> Request
176 -> Request
362 -> IO ([Param], [File y])
177 -> IO ([Param], [File y])
363−parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions
178+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
179 case getRequestBodyType r of
377 Nothing -> return ([], [])
180 Nothing -> return ([], [])
378− Just rbt -> sinkRequestBodyEx o s rbt (requestBody r)
181+ Just rbt -> sinkRequestBody s rbt (requestBody r)
380sinkRequestBody :: BackEnd y
183sinkRequestBody :: BackEnd y
381 -> RequestBodyType
184 -> RequestBodyType
382 -> IO S.ByteString
185 -> IO S.ByteString
383 -> IO ([Param], [File y])
186 -> IO ([Param], [File y])
384−sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions
187+sinkRequestBody s r body = do
389−sinkRequestBodyEx :: ParseRequestBodyOptions
393− -> IO ([Param], [File y])
394−sinkRequestBodyEx o s r body = do
395− ref <- newIORef ([], [])
188+ ref <- newIORef (id, id)
396 let add x = atomicModifyIORef ref $ \(y, z) ->
189 let add x = atomicModifyIORef ref $ \(y, z) ->
397 case x of
190 case x of
398− Left y' -> ((y':y, z), ())
191+ Left y' -> ((y . (y':), z), ())
399− Right z' -> ((y, z':z), ())
192+ Right z' -> ((y, z . (z':)), ())
400− conduitRequestBodyEx o s r body add
193+ conduitRequestBody s r body add
401− (\(a, b) -> (reverse a, reverse b)) <$> readIORef ref
194+ (x, y) <- readIORef ref
402−
195+ return (x [], y [])
403−conduitRequestBodyEx :: ParseRequestBodyOptions
196+
404− -> BackEnd y
197+conduitRequestBody :: BackEnd y
405− -> RequestBodyType
198+ -> RequestBodyType
406− -> IO S.ByteString
199+ -> IO S.ByteString
407− -> (Either Param (File y) -> IO ())
200+ -> (Either Param (File y) -> IO ())
408− -> IO ()
201+ -> IO ()
409−conduitRequestBodyEx o _ UrlEncoded rbody add = do
202+conduitRequestBody _ UrlEncoded rbody add = do
410 -- NOTE: in general, url-encoded data will be in a single chunk.
203 -- NOTE: in general, url-encoded data will be in a single chunk.
411 -- Therefore, I'm optimizing for the usual case by sticking with
204 -- Therefore, I'm optimizing for the usual case by sticking with
412 -- strict byte strings here.
205 -- strict byte strings here.
413− let loop size front = do
206+ let loop front = do
414 bs <- rbody
207 bs <- rbody
415 if S.null bs
208 if S.null bs
416 then return $ S.concat $ front []
209 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:)
210+ else loop $ front . (bs:)
424− bs <- loop 0 id
211+ bs <- loop id
425 mapM_ (add . Left) $ H.parseSimpleQuery bs
212 mapM_ (add . Left) $ H.parseSimpleQuery bs
426−conduitRequestBodyEx o backend (Multipart bound) rbody add =
213+conduitRequestBody backend (Multipart bound) rbody add =
427− parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add
214+ 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)
216+takeLine :: Source -> IO (Maybe S.ByteString)
434−takeLine maxlen src =
217+takeLine src =
437 go front = do
220 go front = do
438 bs <- readSource src
221 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
222 if S.null bs
445 then close front
223 then close front
446 else push front bs
224 else push front bs
448− close front = leftover src front >> return Nothing
226+ close front = leftover src (front S.empty) >> return Nothing
449 push front bs = do
227 push front bs = do
450− let (x, y) = S.break (== 10) bs -- LF
228+ let (x, y) = S.break (== 10) $ front bs -- LF
451 in if S.null y
229 in if S.null y
452− then go $ front `S.append` x
230+ then go $ S.append x
454 when (S.length y > 1) $ leftover src $ S.drop 1 y
232 when (S.length y > 1) $ leftover src $ S.drop 1 y
455− let res = front `S.append` x
233+ 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]
235+takeLines :: Source -> IO [S.ByteString]
464−takeLines' lineLength maxLines source =
236+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
237+ res <- takeLine src
480 case res of
238 case res of
481− Nothing -> return lines
239+ Nothing -> return []
483− | S.null l -> return lines
241+ | S.null l -> return []
484− | otherwise -> takeLines'' (l:lines) lineLength maxLines src
242+ | otherwise -> do
486data Source = Source (IO S.ByteString) (IORef S.ByteString)
246data Source = Source (IO S.ByteString) (IORef S.ByteString)
@@ -500,20 +260,17 @@ readSource (Source f ref) = do
500leftover :: Source -> S.ByteString -> IO ()
260leftover :: Source -> S.ByteString -> IO ()
501leftover (Source _ ref) bs = writeIORef ref bs
261leftover (Source _ ref) bs = writeIORef ref bs
503−parsePiecesEx :: ParseRequestBodyOptions
504− -> BackEnd y
263+parsePieces :: BackEnd y
505− -> S.ByteString
264+ -> S.ByteString
506− -> IO S.ByteString
265+ -> IO S.ByteString
507− -> (Either Param (File y) -> IO ())
266+ -> (Either Param (File y) -> IO ())
508− -> IO ()
267+ -> IO ()
509−parsePiecesEx o sink bound rbody add =
268+parsePieces sink bound rbody add =
510− mkSource rbody >>= loop 0 0 0 0
269+ mkSource rbody >>= loop
512− loop :: Int -> Int -> Int -> Int64 -> Source -> IO ()
271+ loop src = do
513− loop numParms numFiles parmSize filesSize src = do
514− _boundLine <- takeLine (prboMaxHeaderLineLength o) src
272+ _boundLine <- takeLine src
515− res' <- takeLines' (prboMaxHeaderLineLength o)
273+ res' <- takeLines src
516− (prboMaxHeaderLines o) src
517 unless (null res') $ do
274 unless (null res') $ do
518 let ls' = map parsePair res'
275 let ls' = map parsePair res'
519 let x = do
276 let x = do
@@ -524,50 +281,25 @@ parsePiecesEx o sink bound rbody add =
524 return (ct, name, lookup "filename" attrs)
281 return (ct, name, lookup "filename" attrs)
525 case x of
282 case x of
526 Just (mct, name, Just filename) -> do
283 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
284 let ct = fromMaybe "application/octet-stream" mct
537 fi0 = FileInfo filename ct ()
285 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
286+ (wasFound, y) <- sinkTillBound' bound name fi0 sink src
542− let newFilesSize = filesSize + fileSize
543 add $ Right (name, fi0 { fileContent = y })
287 add $ Right (name, fi0 { fileContent = y })
544− when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src
288+ when wasFound (loop src)
545 Just (_ct, name, Nothing) -> do
289 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
290 let seed = id
552 let iter front bs = return $ front . (:) bs
291 let iter front bs = return $ front . (:) bs
553− ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src
292+ (wasFound, front) <- sinkTillBound bound iter seed src
554− (fromIntegral <$> prboMaxParmsSize o)
555 let bs = S.concat $ front []
293 let bs = S.concat $ front []
556 let x' = (name, bs)
294 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'
295 add $ Left x'
563− when wasFound $ loop (numParms + 1) numFiles
296+ when wasFound (loop src)
564− newParmSize filesSize src
566 -- ignore this part
298 -- ignore this part
567 let seed = ()
299 let seed = ()
568 iter () _ = return ()
300 iter () _ = return ()
569− ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing
301+ (wasFound, ()) <- sinkTillBound bound iter seed src
570− when wasFound $ loop numParms numFiles parmSize filesSize src
302+ when wasFound (loop src)
572 contDisp = mk $ S8.pack "Content-Disposition"
304 contDisp = mk $ S8.pack "Content-Disposition"
573 contType = mk $ S8.pack "Content-Type"
305 contType = mk $ S8.pack "Content-Type"
@@ -575,14 +307,13 @@ parsePiecesEx o sink bound rbody add =
575 let (x, y) = breakDiscard 58 s -- colon
307 let (x, y) = breakDiscard 58 s -- colon
576 in (mk $ x, S.dropWhile (== 32) y) -- space
308 in (mk $ x, S.dropWhile (== 32) y) -- space
579data Bound = FoundBound S.ByteString S.ByteString
310data Bound = FoundBound S.ByteString S.ByteString
580 | NoBound
311 | NoBound
581 | PartialBound
312 | PartialBound
582 deriving (Eq, Show)
313 deriving (Eq, Show)
584findBound :: S.ByteString -> S.ByteString -> Bound
315findBound :: S.ByteString -> S.ByteString -> Bound
585−findBound b bs = handleBreak $ S.breakSubstring b bs
316+findBound b bs = handleBreak $ Search.breakOn b bs
587 handleBreak (h, t)
318 handleBreak (h, t)
588 | S.null t = go [lowBound..S.length bs - 1]
319 | S.null t = go [lowBound..S.length bs - 1]
@@ -609,10 +340,9 @@ sinkTillBound' :: S.ByteString
609 -> FileInfo ()
340 -> FileInfo ()
610 -> BackEnd y
341 -> BackEnd y
611 -> Source
342 -> Source
613− -> IO ((Bool, Int64), y)
343+ -> IO (Bool, y)
614−sinkTillBound' bound name fi sink src max' = do
344+sinkTillBound' bound name fi sink src = do
615− (next, final) <- wrapTillBound bound src max'
345+ (next, final) <- wrapTillBound bound src
616 y <- sink name fi next
346 y <- sink name fi next
617 b <- final
347 b <- final
618 return (b, y)
348 return (b, y)
@@ -621,40 +351,30 @@ data WTB = WTBWorking (S.ByteString -> S.ByteString)
621 | WTBDone Bool
351 | WTBDone Bool
622wrapTillBound :: S.ByteString -- ^ bound
352wrapTillBound :: S.ByteString -- ^ bound
623 -> Source
353 -> Source
625− -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found
354+ -> IO (IO S.ByteString, IO Bool) -- ^ Bool indicates if the bound was found
626−wrapTillBound bound src max' = do
355+wrapTillBound bound src = do
627 ref <- newIORef $ WTBWorking id
356 ref <- newIORef $ WTBWorking id
628− sref <- newIORef (0 :: Int64)
629− return (go ref sref, final ref sref)
357+ return (go ref, final ref)
631− final ref sref = do
359+ final ref = do
632 x <- readIORef ref
360 x <- readIORef ref
633 case x of
361 case x of
634 WTBWorking _ -> error "wrapTillBound did not finish"
362 WTBWorking _ -> error "wrapTillBound did not finish"
635− WTBDone y -> do
363+ WTBDone y -> return y
636− siz <- readIORef sref
639− go ref sref = do
365+ go ref = do
640 state <- readIORef ref
366 state <- readIORef ref
641 case state of
367 case state of
642 WTBDone _ -> return S.empty
368 WTBDone _ -> return S.empty
643 WTBWorking front -> do
369 WTBWorking front -> do
644 bs <- readSource src
370 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
371 if S.null bs
653 writeIORef ref $ WTBDone False
373 writeIORef ref $ WTBDone False
654 return $ front bs
374 return $ front bs
655 else push $ front bs
375 else push $ front bs
657− push bs = do
377+ push bs =
658 case findBound bound bs of
378 case findBound bound bs of
659 FoundBound before after -> do
379 FoundBound before after -> do
660 let before' = killCRLF before
380 let before' = killCRLF before
@@ -670,20 +390,19 @@ wrapTillBound bound src max' = do
670 else (bs, id)
390 else (bs, id)
671 writeIORef ref $ WTBWorking front'
391 writeIORef ref $ WTBWorking front'
672 if S.null toEmit
392 if S.null toEmit
673− then go ref sref
393+ then go ref
674 else return toEmit
394 else return toEmit
675 PartialBound -> do
395 PartialBound -> do
676 writeIORef ref $ WTBWorking $ S.append bs
396 writeIORef ref $ WTBWorking $ S.append bs
677− go ref sref
397+ go ref
679sinkTillBound :: S.ByteString
399sinkTillBound :: S.ByteString
680 -> (x -> S.ByteString -> IO x)
400 -> (x -> S.ByteString -> IO x)
682 -> Source
402 -> Source
684− -> IO ((Bool, Int64), x)
403+ -> IO (Bool, x)
685−sinkTillBound bound iter seed0 src max' = do
404+sinkTillBound bound iter seed0 src = do
686− (next, final) <- wrapTillBound bound src max'
405+ (next, final) <- wrapTillBound bound src
687 let loop seed = do
406 let loop seed = do
688 bs <- next
407 bs <- next
689 if S.null bs
408 if S.null bs