Hello community, here is the log from the commit of package ghc-wai-extra for openSUSE:Factory checked in at 2016-07-12 23:52:56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-wai-extra (Old) and /work/SRC/openSUSE:Factory/.ghc-wai-extra.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-wai-extra" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-wai-extra/ghc-wai-extra.changes 2016-06-25 02:21:59.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-wai-extra.new/ghc-wai-extra.changes 2016-07-12 23:52:58.000000000 +0200 @@ -1,0 +2,7 @@ +Sun Jul 10 16:05:30 UTC 2016 - [email protected] + +- update to 3.0.16.1 +* Fix the way the header length is checked (for limiting the max header length) +* Add a new function "parseRequestBodyEx" that allows various size limits to be set. + +------------------------------------------------------------------- Old: ---- wai-extra-3.0.15.2.tar.gz New: ---- wai-extra-3.0.16.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-wai-extra.spec ++++++ --- /var/tmp/diff_new_pack.2FWCfy/_old 2016-07-12 23:52:59.000000000 +0200 +++ /var/tmp/diff_new_pack.2FWCfy/_new 2016-07-12 23:52:59.000000000 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-wai-extra # -# Copyright (c) 2015 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-wai-extra -Version: 3.0.15.2 +Version: 3.0.16.1 Release: 0 Summary: Provides some basic WAI handlers and middleware License: MIT ++++++ wai-extra-3.0.15.2.tar.gz -> wai-extra-3.0.16.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.15.2/ChangeLog.md new/wai-extra-3.0.16.1/ChangeLog.md --- old/wai-extra-3.0.15.2/ChangeLog.md 2016-06-16 13:53:10.000000000 +0200 +++ new/wai-extra-3.0.16.1/ChangeLog.md 2016-07-06 11:53:58.000000000 +0200 @@ -1,3 +1,15 @@ +## 3.0.16.1 + +* Fix the way the header length is checked (for limiting the max header length) + +## 3.0.16.0 + +* Add a new function "parseRequestBodyEx" that allows various size limits to be set. + +## 3.0.15.3 + +* Allow wai-logger 2.3 + ## 3.0.15.2 * Doc improvements diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.15.2/Network/Wai/Parse.hs new/wai-extra-3.0.16.1/Network/Wai/Parse.hs --- old/wai-extra-3.0.15.2/Network/Wai/Parse.hs 2016-06-16 13:53:10.000000000 +0200 +++ new/wai-extra-3.0.16.1/Network/Wai/Parse.hs 2016-07-06 11:53:58.000000000 +0200 @@ -11,6 +11,7 @@ , RequestBodyType (..) , getRequestBodyType , sinkRequestBody + , sinkRequestBodyEx , BackEnd , lbsBackEnd , tempFileBackEnd @@ -19,6 +20,23 @@ , File , FileInfo (..) , parseContentType + , ParseRequestBodyOptions + , defaultParseRequestBodyOptions + , parseRequestBodyEx + , setMaxRequestKeyLength + , clearMaxRequestKeyLength + , setMaxRequestNumFiles + , clearMaxRequestNumFiles + , setMaxRequestFileSize + , clearMaxRequestFileSize + , setMaxRequestFilesSize + , clearMaxRequestFilesSize + , setMaxRequestParmsSize + , clearMaxRequestParmsSize + , setMaxHeaderLines + , clearMaxHeaderLines + , setMaxHeaderLineLength + , clearMaxHeaderLineLength #if TEST , Bound (..) , findBound @@ -34,19 +52,23 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Char8 as S8 import Data.Word (Word8) -import Data.Maybe (fromMaybe) +import Data.Int (Int64) +import Data.Maybe (catMaybes, fromMaybe) import Data.List (sortBy) import Data.Function (on, fix) import System.Directory (removeFile, getTemporaryDirectory) import System.IO (hClose, openBinaryTempFile) import Network.Wai import qualified Network.HTTP.Types as H +import Control.Applicative ((<$>)) import Control.Monad (when, unless) import Control.Monad.Trans.Resource (allocate, release, register, InternalState, runInternalState) import Data.IORef import Network.HTTP.Types (hContentType) import Data.CaseInsensitive (mk) +import Prelude hiding (lines) + breakDiscard :: Word8 -> S.ByteString -> (S.ByteString, S.ByteString) breakDiscard w s = let (x, y) = S.break (== w) s @@ -103,10 +125,8 @@ -> ignored2 -> IO S.ByteString -> IO FilePath -tempFileBackEndOpts getTmpDir pattern internalState _ _ popper = do - (key, (fp, h)) <- flip runInternalState internalState $ allocate (do - tempDir <- getTmpDir - openBinaryTempFile tempDir pattern) (\(_, h) -> hClose h) +tempFileBackEndOpts getTmpDir pattrn internalState _ _ popper = do + (key, (fp, h)) <- flip runInternalState internalState $ allocate it (hClose . snd) _ <- runInternalState (register $ removeFile fp) internalState fix $ \loop -> do bs <- popper @@ -115,6 +135,147 @@ loop release key return fp + where + it = do + tempDir <- getTmpDir + openBinaryTempFile tempDir pattrn + +-- | A data structure that describes the behavior of +-- the parseRequestBodyEx function. +-- +-- @since 3.0.16.0 +data ParseRequestBodyOptions = ParseRequestBodyOptions + { -- | The maximum length of a filename + prboKeyLength :: Maybe Int + , -- | The maximum number of files. + prboMaxNumFiles :: Maybe Int + , -- | The maximum filesize per file. + prboMaxFileSize :: Maybe Int64 + , -- | The maximum total filesize. + prboMaxFilesSize :: Maybe Int64 + , -- | The maximum size of the sum of all parameters + prboMaxParmsSize :: Maybe Int + , -- | The maximum header lines per mime/multipart entry + prboMaxHeaderLines :: Maybe Int + , -- | The maximum header line length per mime/multipart entry + prboMaxHeaderLineLength :: Maybe Int } + +-- | Set the maximum length of a filename. +-- +-- @since 3.0.16.0 +setMaxRequestKeyLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions +setMaxRequestKeyLength l p = p { prboKeyLength=Just l } + +-- | Do not limit the length of filenames. +-- +-- @since 3.0.16.0 +clearMaxRequestKeyLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions +clearMaxRequestKeyLength p = p { prboKeyLength=Nothing } + +-- | Set the maximum number of files per request. +-- +-- @since 3.0.16.0 +setMaxRequestNumFiles :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions +setMaxRequestNumFiles l p = p { prboMaxNumFiles=Just l } + +-- | Do not limit the maximum number of files per request. +-- +-- @since 3.0.16.0 +clearMaxRequestNumFiles :: ParseRequestBodyOptions -> ParseRequestBodyOptions +clearMaxRequestNumFiles p = p { prboMaxNumFiles=Nothing } + +-- | Set the maximum filesize per file. +-- +-- @since 3.0.16.0 +setMaxRequestFileSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions +setMaxRequestFileSize l p = p { prboMaxFileSize=Just l } + +-- | Do not limit the maximum filesize per file. +-- +-- @since 3.0.16.0 +clearMaxRequestFileSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions +clearMaxRequestFileSize p = p { prboMaxFileSize=Nothing } + +-- | Set the maximum size of all files per request. +-- +-- @since 3.0.16.0 +setMaxRequestFilesSize :: Int64 -> ParseRequestBodyOptions -> ParseRequestBodyOptions +setMaxRequestFilesSize l p = p { prboMaxFilesSize=Just l } + +-- | Do not limit the maximum size of all files per request. +-- +-- @since 3.0.16.0 +clearMaxRequestFilesSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions +clearMaxRequestFilesSize p = p { prboMaxFilesSize=Nothing } + +-- | Set the maximum size of the sum of all parameters. +-- +-- @since 3.0.16.0 +setMaxRequestParmsSize :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions +setMaxRequestParmsSize l p = p { prboMaxParmsSize=Just l } + +-- | Do not limit the maximum size of the sum of all parameters. +-- +-- @since 3.0.16.0 +clearMaxRequestParmsSize :: ParseRequestBodyOptions -> ParseRequestBodyOptions +clearMaxRequestParmsSize p = p { prboMaxParmsSize=Nothing } + +-- | Set the maximum header lines per mime/multipart entry. +-- +-- @since 3.0.16.0 +setMaxHeaderLines :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions +setMaxHeaderLines l p = p { prboMaxHeaderLines=Just l } + +-- | Do not limit the maximum header lines per mime/multipart entry. +-- +-- @since 3.0.16.0 +clearMaxHeaderLines:: ParseRequestBodyOptions -> ParseRequestBodyOptions +clearMaxHeaderLines p = p { prboMaxHeaderLines=Nothing } + +-- | Set the maximum header line length per mime/multipart entry. +-- +-- @since 3.0.16.0 +setMaxHeaderLineLength :: Int -> ParseRequestBodyOptions -> ParseRequestBodyOptions +setMaxHeaderLineLength l p = p { prboMaxHeaderLineLength=Just l } + +-- | Do not limit the maximum header lines per mime/multipart entry. +-- +-- @since 3.0.16.0 +clearMaxHeaderLineLength :: ParseRequestBodyOptions -> ParseRequestBodyOptions +clearMaxHeaderLineLength p = p { prboMaxHeaderLineLength=Nothing } + +-- | A reasonable default set of parsing options. +-- Maximum key/filename length: 32 bytes; +-- maximum files: 10; filesize unlimited; maximum +-- size for parameters: 64kbytes; maximum number of header +-- lines: 32 bytes (applies only to headers of a mime/multipart message); +-- maximum header line length: Apache's default for that is 8190 bytes +-- (http://httpd.apache.org/docs/2.2/mod/core.html#limitrequestline) +-- so we're using that here as well. +-- +-- @since 3.0.16.0 +defaultParseRequestBodyOptions :: ParseRequestBodyOptions +defaultParseRequestBodyOptions = ParseRequestBodyOptions + { prboKeyLength=Just 32 + , prboMaxNumFiles=Just 10 + , prboMaxFileSize=Nothing + , prboMaxFilesSize=Nothing + , prboMaxParmsSize=Just 65336 + , prboMaxHeaderLines=Just 32 + , prboMaxHeaderLineLength=Just 8190 } + +-- | Do not impose any memory limits. +-- +-- @since 3.0.16.0 +noLimitParseRequestBodyOptions :: ParseRequestBodyOptions +noLimitParseRequestBodyOptions = ParseRequestBodyOptions + { prboKeyLength=Nothing + , prboMaxNumFiles=Nothing + , prboMaxFileSize=Nothing + , prboMaxFilesSize=Nothing + , prboMaxParmsSize=Nothing + , prboMaxHeaderLines=Nothing + , prboMaxHeaderLineLength=Nothing } -- | Information on an uploaded file. data FileInfo c = FileInfo @@ -137,8 +298,16 @@ -> IO S.ByteString -> IO a -data RequestBodyType = UrlEncoded | Multipart S.ByteString +-- | The mimetype of the http body. +-- Depending on whether just parameters or parameters and files +-- are passed, one or the other mimetype should be used. +data RequestBodyType + = -- | application/x-www-form-urlencoded (parameters only) + UrlEncoded + | -- | multipart/form-data (parameters and files) + Multipart S.ByteString +-- | Get the mimetype of the body of an http request. getRequestBodyType :: Request -> Maybe RequestBodyType getRequestBodyType req = do ctype' <- lookup hContentType $ requestHeaders req @@ -172,76 +341,133 @@ in (strip k, strip v) strip = S.dropWhile (== space) . fst . S.breakEnd (/= space) +-- | Parse the body of an HTTP request. +-- See parseRequestBodyEx for details. +-- Note: This function does not limit the memory it allocates. +-- When dealing with untrusted data (as is usually the case when +-- receiving input from the internet), it is recommended to +-- use the parseRequestBodyEx function instead. parseRequestBody :: BackEnd y -> Request -> IO ([Param], [File y]) -parseRequestBody s r = +parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions + +-- | Parse the body of an HTTP request, limit resource usage. +-- The HTTP body can contain both parameters and files. +-- This function will return a list of key,value pairs +-- for all parameters, and a list of key,a pairs +-- for filenames. The a depends on the used backend that +-- is responsible for storing the received files. +parseRequestBodyEx :: ParseRequestBodyOptions + -> BackEnd y + -> Request + -> IO ([Param], [File y]) +parseRequestBodyEx o s r = case getRequestBodyType r of Nothing -> return ([], []) - Just rbt -> sinkRequestBody s rbt (requestBody r) + Just rbt -> sinkRequestBodyEx o s rbt (requestBody r) sinkRequestBody :: BackEnd y -> RequestBodyType -> IO S.ByteString -> IO ([Param], [File y]) -sinkRequestBody s r body = do - ref <- newIORef (id, id) +sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions + +-- | +-- +-- @since 3.0.16.0 +sinkRequestBodyEx :: ParseRequestBodyOptions + -> BackEnd y + -> RequestBodyType + -> IO S.ByteString + -> IO ([Param], [File y]) +sinkRequestBodyEx o s r body = do + ref <- newIORef ([], []) let add x = atomicModifyIORef ref $ \(y, z) -> case x of - Left y' -> ((y . (y':), z), ()) - Right z' -> ((y, z . (z':)), ()) - conduitRequestBody s r body add - (x, y) <- readIORef ref - return (x [], y []) - -conduitRequestBody :: BackEnd y - -> RequestBodyType - -> IO S.ByteString - -> (Either Param (File y) -> IO ()) - -> IO () -conduitRequestBody _ UrlEncoded rbody add = do + Left y' -> ((y':y, z), ()) + Right z' -> ((y, z':z), ()) + conduitRequestBodyEx o s r body add + (\(a, b) -> (reverse a, reverse b)) <$> readIORef ref + +conduitRequestBodyEx :: ParseRequestBodyOptions + -> BackEnd y + -> RequestBodyType + -> IO S.ByteString + -> (Either Param (File y) -> IO ()) + -> IO () +conduitRequestBodyEx o _ UrlEncoded rbody add = do -- NOTE: in general, url-encoded data will be in a single chunk. -- Therefore, I'm optimizing for the usual case by sticking with -- strict byte strings here. - let loop front = do + let loop size front = do bs <- rbody if S.null bs then return $ S.concat $ front [] - else loop $ front . (bs:) - bs <- loop id + else do + let newsize = size + S.length bs + case prboMaxParmsSize o of + Just maxSize -> when (newsize > maxSize) $ + error "Maximum size of parameters exceeded" + Nothing -> return () + loop newsize $ front . (bs:) + bs <- loop 0 id mapM_ (add . Left) $ H.parseSimpleQuery bs -conduitRequestBody backend (Multipart bound) rbody add = - parsePieces backend (S8.pack "--" `S.append` bound) rbody add +conduitRequestBodyEx o backend (Multipart bound) rbody add = + parsePiecesEx o backend (S8.pack "--" `S.append` bound) rbody add + -takeLine :: Source -> IO (Maybe S.ByteString) -takeLine src = - go id +-- | Take one header or subheader line. +takeLine :: Maybe Int -> Source -> IO (Maybe S.ByteString) +takeLine maxlen src = + go "" where go front = do bs <- readSource src + case maxlen of + Just maxlen' -> when (S.length front > maxlen') $ + error "Header line length exceeds allowed maximum." + Nothing -> return () if S.null bs then close front else push front bs - close front = leftover src (front S.empty) >> return Nothing + close front = leftover src front >> return Nothing push front bs = do - let (x, y) = S.break (== 10) $ front bs -- LF + let (x, y) = S.break (== 10) bs -- LF in if S.null y - then go $ S.append x + then go $ front `S.append` x else do when (S.length y > 1) $ leftover src $ S.drop 1 y - return $ Just $ killCR x - -takeLines :: Source -> IO [S.ByteString] -takeLines src = do - res <- takeLine src + let res = front `S.append` x + case maxlen of + Just maxlen' -> when (S.length res > maxlen') $ + error "Header line length exceeds allowed maximum." + Nothing -> return () + return $ Just $ killCR $ res + +takeLines' :: Maybe Int -> Maybe Int -> Source -> IO [S.ByteString] +takeLines' lineLength maxLines source = + reverse <$> takeLines'' [] lineLength maxLines source + +takeLines'' + :: [S.ByteString] + -> Maybe Int + -> Maybe Int + -> Source + -> IO [S.ByteString] +takeLines'' lines lineLength maxLines src = do + case maxLines of + Just maxLines' -> + when (length lines > maxLines') $ + error "Too many lines in mime/multipart header" + Nothing -> return () + res <- takeLine lineLength src case res of - Nothing -> return [] + Nothing -> return lines Just l - | S.null l -> return [] - | otherwise -> do - ls <- takeLines src - return $ l : ls + | S.null l -> return lines + | otherwise -> takeLines'' (l:lines) lineLength maxLines src data Source = Source (IO S.ByteString) (IORef S.ByteString) @@ -260,17 +486,20 @@ leftover :: Source -> S.ByteString -> IO () leftover (Source _ ref) bs = writeIORef ref bs -parsePieces :: BackEnd y - -> S.ByteString - -> IO S.ByteString - -> (Either Param (File y) -> IO ()) - -> IO () -parsePieces sink bound rbody add = - mkSource rbody >>= loop +parsePiecesEx :: ParseRequestBodyOptions + -> BackEnd y + -> S.ByteString + -> IO S.ByteString + -> (Either Param (File y) -> IO ()) + -> IO () +parsePiecesEx o sink bound rbody add = + mkSource rbody >>= loop 0 0 0 0 where - loop src = do - _boundLine <- takeLine src - res' <- takeLines src + loop :: Int -> Int -> Int -> Int64 -> Source -> IO () + loop numParms numFiles parmSize filesSize src = do + _boundLine <- takeLine (prboMaxHeaderLineLength o) src + res' <- takeLines' (prboMaxHeaderLineLength o) + (prboMaxHeaderLines o) src unless (null res') $ do let ls' = map parsePair res' let x = do @@ -281,25 +510,50 @@ return (ct, name, lookup "filename" attrs) case x of Just (mct, name, Just filename) -> do + case prboKeyLength o of + Just maxKeyLength -> + when (S.length name > maxKeyLength) $ + error "Filename is too long" + Nothing -> return () + case prboMaxNumFiles o of + Just maxFiles -> when (numFiles >= maxFiles) $ + error "Maximum number of files exceeded" + Nothing -> return () let ct = fromMaybe "application/octet-stream" mct fi0 = FileInfo filename ct () - (wasFound, y) <- sinkTillBound' bound name fi0 sink src + fs = catMaybes [ prboMaxFileSize o + , subtract filesSize <$> prboMaxFilesSize o ] + mfs = if fs == [] then Nothing else Just $ minimum fs + ((wasFound, fileSize), y) <- sinkTillBound' bound name fi0 sink src mfs + let newFilesSize = filesSize + fileSize add $ Right (name, fi0 { fileContent = y }) - when wasFound (loop src) + when wasFound $ loop numParms (numFiles + 1) parmSize newFilesSize src Just (_ct, name, Nothing) -> do + case prboKeyLength o of + Just maxKeyLength -> + when (S.length name > maxKeyLength) $ + error "Parameter name is too long" + Nothing -> return () let seed = id let iter front bs = return $ front . (:) bs - (wasFound, front) <- sinkTillBound bound iter seed src + ((wasFound, _fileSize), front) <- sinkTillBound bound iter seed src + (fromIntegral <$> prboMaxParmsSize o) let bs = S.concat $ front [] let x' = (name, bs) + let newParmSize = parmSize + S.length name + S.length bs + case prboMaxParmsSize o of + Just maxParmSize -> when (newParmSize > maxParmSize) $ + error "Maximum size of parameters exceeded" + Nothing -> return () add $ Left x' - when wasFound (loop src) + when wasFound $ loop (numParms + 1) numFiles + newParmSize filesSize src _ -> do -- ignore this part let seed = () iter () _ = return () - (wasFound, ()) <- sinkTillBound bound iter seed src - when wasFound (loop src) + ((wasFound, _fileSize), ()) <- sinkTillBound bound iter seed src Nothing + when wasFound $ loop numParms numFiles parmSize filesSize src where contDisp = mk $ S8.pack "Content-Disposition" contType = mk $ S8.pack "Content-Type" @@ -307,6 +561,7 @@ let (x, y) = breakDiscard 58 s -- colon in (mk $ x, S.dropWhile (== 32) y) -- space + data Bound = FoundBound S.ByteString S.ByteString | NoBound | PartialBound @@ -340,9 +595,10 @@ -> FileInfo () -> BackEnd y -> Source - -> IO (Bool, y) -sinkTillBound' bound name fi sink src = do - (next, final) <- wrapTillBound bound src + -> Maybe Int64 + -> IO ((Bool, Int64), y) +sinkTillBound' bound name fi sink src max' = do + (next, final) <- wrapTillBound bound src max' y <- sink name fi next b <- final return (b, y) @@ -351,30 +607,39 @@ | WTBDone Bool wrapTillBound :: S.ByteString -- ^ bound -> Source - -> IO (IO S.ByteString, IO Bool) -- ^ Bool indicates if the bound was found -wrapTillBound bound src = do + -> Maybe Int64 + -> IO (IO S.ByteString, IO (Bool, Int64)) -- ^ Bool indicates if the bound was found +wrapTillBound bound src max' = do ref <- newIORef $ WTBWorking id - return (go ref, final ref) + sref <- newIORef (0 :: Int64) + return (go ref sref, final ref sref) where - final ref = do + final ref sref = do x <- readIORef ref case x of WTBWorking _ -> error "wrapTillBound did not finish" - WTBDone y -> return y + WTBDone y -> do + siz <- readIORef sref + return (y, siz) - go ref = do + go ref sref = do state <- readIORef ref case state of WTBDone _ -> return S.empty WTBWorking front -> do bs <- readSource src + cur <- atomicModifyIORef' sref $ \ cur -> + let new = cur + fromIntegral (S.length bs) in (new, new) + case max' of + Just max'' | cur > max'' -> error "Maximum size exceeded" + _ -> return () if S.null bs then do writeIORef ref $ WTBDone False return $ front bs else push $ front bs where - push bs = + push bs = do case findBound bound bs of FoundBound before after -> do let before' = killCRLF before @@ -390,19 +655,20 @@ else (bs, id) writeIORef ref $ WTBWorking front' if S.null toEmit - then go ref + then go ref sref else return toEmit PartialBound -> do writeIORef ref $ WTBWorking $ S.append bs - go ref + go ref sref sinkTillBound :: S.ByteString -> (x -> S.ByteString -> IO x) -> x -> Source - -> IO (Bool, x) -sinkTillBound bound iter seed0 src = do - (next, final) <- wrapTillBound bound src + -> Maybe Int64 + -> IO ((Bool, Int64), x) +sinkTillBound bound iter seed0 src max' = do + (next, final) <- wrapTillBound bound src max' let loop seed = do bs <- next if S.null bs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.15.2/test/Network/Wai/ParseSpec.hs new/wai-extra-3.0.16.1/test/Network/Wai/ParseSpec.hs --- old/wai-extra-3.0.15.2/test/Network/Wai/ParseSpec.hs 2016-06-16 13:53:10.000000000 +0200 +++ new/wai-extra-3.0.16.1/test/Network/Wai/ParseSpec.hs 2016-07-06 11:53:58.000000000 +0200 @@ -93,6 +93,8 @@ let expectedfile3 = [("yaml", FileInfo "README" "application/octet-stream" "Photo blog using Hack.\n")] let expected3 = (expectedsmap3, expectedfile3) + + let def = defaultParseRequestBodyOptions it "parsing actual post multipart/form-data" $ do result3 <- parseRequestBody' lbsBackEnd $ toRequest ctype3 content3 result3 `shouldBe` expected3 @@ -100,6 +102,56 @@ it "parsing actual post multipart/form-data 2" $ do result3' <- parseRequestBody' lbsBackEnd $ toRequest' ctype3 content3 result3' `shouldBe` expected3 + + it "parsing with memory limit" $ do + SRequest req4 _bod4 <- toRequest'' ctype3 content3 + result4' <- parseRequestBodyEx ( setMaxRequestNumFiles 1 $ setMaxRequestKeyLength 14 def ) lbsBackEnd req4 + result4' `shouldBe` expected3 + + it "exceeding number of files" $ do + SRequest req4 _bod4 <- toRequest'' ctype3 content3 + (parseRequestBodyEx ( setMaxRequestNumFiles 0 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + + it "exceeding parameter length" $ do + SRequest req4 _bod4 <- toRequest'' ctype3 content3 + (parseRequestBodyEx ( setMaxRequestKeyLength 2 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + + it "exceeding file size" $ do + SRequest req4 _bod4 <- toRequest'' ctype3 content3 + (parseRequestBodyEx ( setMaxRequestFileSize 2 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + + it "exceeding total file size" $ do + SRequest req4 _bod4 <- toRequest'' ctype3 content3 + (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + SRequest req5 _bod5 <- toRequest'' ctype3 content5 + (parseRequestBodyEx ( setMaxRequestFilesSize 20 def ) lbsBackEnd req5) `shouldThrow` anyErrorCall + + it "exceeding max parm value size" $ do + SRequest req4 _bod4 <- toRequest'' ctype2 content2 + (parseRequestBodyEx ( setMaxRequestParmsSize 10 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + + it "exceeding max header lines" $ do + SRequest req4 _bod4 <- toRequest'' ctype2 content2 + (parseRequestBodyEx ( setMaxHeaderLines 1 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + + it "exceeding header line size" $ do + SRequest req4 _bod4 <- toRequest'' ctype3 content4 + (parseRequestBodyEx ( setMaxHeaderLineLength 8190 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + + it "Testing parseRequestBodyEx with application/x-www-form-urlencoded" $ do + let content = "thisisalongparameterkey=andthisbeanevenlongerparametervaluehelloworldhowareyou" + let ctype = "application/x-www-form-urlencoded" + SRequest req _bod <- toRequest'' ctype content + result <- parseRequestBodyEx def lbsBackEnd req + result `shouldBe` ([( "thisisalongparameterkey" + , "andthisbeanevenlongerparametervaluehelloworldhowareyou" )], []) + + it "exceeding max parm value size with x-www-form-urlencoded mimetype" $ do + let content = "thisisalongparameterkey=andthisbeanevenlongerparametervaluehelloworldhowareyou" + let ctype = "application/x-www-form-urlencoded" + SRequest req _bod <- toRequest'' ctype content + (parseRequestBodyEx ( setMaxRequestParmsSize 10 def ) lbsBackEnd req) `shouldThrow` anyErrorCall + where content2 = "--AaB03x\n" @@ -123,6 +175,27 @@ <> "Content-Type: application/octet-stream\r\n\r\n" <> "Photo blog using Hack.\n\r\n" <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n" + content4 = + "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n" + <> "Content-Disposition: form-data; name=\"alb\"; filename=\"README\"\r\n" + <> "Content-Type: application/octet-stream\r\n\r\n" + <> "Photo blog using Hack.\r\n\r\n" + <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n" + <> "Content-Disposition: form-data; name=\"bla\"; filename=\"riedmi" + <> S8.replicate 8190 'e' <> "\"\r\n" + <> "Content-Type: application/octet-stream\r\n\r\n" + <> "Photo blog using Hack.\r\n\r\n" + <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n" + content5 = + "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n" + <> "Content-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\n" + <> "Content-Type: application/octet-stream\r\n\r\n" + <> "Photo blog using Hack.\n\r\n" + <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\n" + <> "Content-Disposition: form-data; name=\"yaml2\"; filename=\"MEADRE\"\r\n" + <> "Content-Type: application/octet-stream\r\n\r\n" + <> "Photo blog using Hack.\n\r\n" + <> "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n" caseMultipartPlus :: Assertion caseMultipartPlus = do @@ -198,3 +271,14 @@ toRequest' ctype content = SRequest defaultRequest { requestHeaders = [("Content-Type", ctype)] } (L.fromChunks $ map S.singleton $ S.unpack content) + +toRequest'' :: S8.ByteString -> S8.ByteString -> IO SRequest +toRequest'' ctype content = mkRB content >>= \b -> return $ SRequest defaultRequest + { requestHeaders = [("Content-Type", ctype)], requestBody = b + } (L.fromChunks $ map S.singleton $ S.unpack content) + +mkRB :: S8.ByteString -> IO (IO S8.ByteString) +mkRB content = do + r <- I.newIORef content + return $ + I.atomicModifyIORef r $ \a -> (S8.empty, a) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-extra-3.0.15.2/wai-extra.cabal new/wai-extra-3.0.16.1/wai-extra.cabal --- old/wai-extra-3.0.15.2/wai-extra.cabal 2016-06-16 13:53:10.000000000 +0200 +++ new/wai-extra-3.0.16.1/wai-extra.cabal 2016-07-06 11:53:58.000000000 +0200 @@ -1,5 +1,5 @@ Name: wai-extra -Version: 3.0.15.2 +Version: 3.0.16.1 Synopsis: Provides some basic WAI handlers and middleware. description: Provides basic WAI handler and middleware functionality: @@ -96,7 +96,7 @@ , case-insensitive >= 0.2 , data-default-class , fast-logger >= 2.4.5 && < 2.5 - , wai-logger >= 2.2.6 && < 2.3 + , wai-logger >= 2.2.6 && < 2.4 , ansi-terminal , resourcet >= 0.4.6 && < 1.2 , void >= 0.5
