diff --git a/wai-extra/ChangeLog.md b/wai-extra/ChangeLog.md index 6f7d4f6a1..c1955b467 100644 --- a/wai-extra/ChangeLog.md +++ b/wai-extra/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog for wai-extra +## 3.1.15 + +* Request parsing throws an exception rather than `error`ing [#964](https://github.com/yesodweb/wai/pull/964): + * Add `RequestParseException` type and expose it from the `Network.Wai.Parse` module. + * Behavior change : `parseRequestBody` and `parseRequestBodyEx` (exported from `Network.Wai.Parse`) throw `RequestParseException` rather than calling `error`. + ## 3.1.14.0 * `defaultGzipSettings` now exported to not depend on `Data.Default` [#959](https://github.com/yesodweb/wai/pull/959) diff --git a/wai-extra/Network/Wai/Parse.hs b/wai-extra/Network/Wai/Parse.hs index c86cce424..6cd20afca 100644 --- a/wai-extra/Network/Wai/Parse.hs +++ b/wai-extra/Network/Wai/Parse.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} +{-# language DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} +{-# language LambdaCase #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} @@ -12,6 +14,7 @@ module Network.Wai.Parse , getRequestBodyType , sinkRequestBody , sinkRequestBodyEx + , RequestParseException(..) , BackEnd , lbsBackEnd , tempFileBackEnd @@ -67,6 +70,7 @@ import Data.IORef import Data.Int (Int64) import Data.List (sortBy) import Data.Maybe (catMaybes, fromMaybe) +import Data.Typeable import Data.Word (Word8) import Network.HTTP.Types (hContentType) import qualified Network.HTTP.Types as H @@ -360,6 +364,8 @@ parseContentType a = do -- 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. +-- +-- since 3.1.15 : throws 'RequestParseException' if something goes wrong parseRequestBody :: BackEnd y -> Request -> IO ([Param], [File y]) @@ -371,6 +377,8 @@ parseRequestBody = parseRequestBodyEx noLimitParseRequestBodyOptions -- 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. +-- +-- since 3.1.15 : throws 'RequestParseException' if something goes wrong parseRequestBodyEx :: ParseRequestBodyOptions -> BackEnd y -> Request @@ -380,15 +388,18 @@ parseRequestBodyEx o s r = Nothing -> return ([], []) Just rbt -> sinkRequestBodyEx o s rbt (getRequestBodyChunk r) +-- | since 3.1.15 : throws 'RequestParseException' if something goes wrong sinkRequestBody :: BackEnd y -> RequestBodyType -> IO S.ByteString -> IO ([Param], [File y]) sinkRequestBody = sinkRequestBodyEx noLimitParseRequestBodyOptions --- | +-- | Throws 'RequestParseException' if something goes wrong -- -- @since 3.0.16.0 +-- +-- since 3.1.15 : throws 'RequestParseException' if something goes wrong sinkRequestBodyEx :: ParseRequestBodyOptions -> BackEnd y -> RequestBodyType @@ -421,7 +432,7 @@ conduitRequestBodyEx o _ UrlEncoded rbody add = do let newsize = size + S.length bs case prboMaxParmsSize o of Just maxSize -> when (newsize > maxSize) $ - error "Maximum size of parameters exceeded" + E.throwIO $ MaxParamSizeExceeded newsize Nothing -> return () loop newsize $ front . (bs:) bs <- loop 0 id @@ -461,10 +472,12 @@ takeLine maxlen src = Nothing -> return () return . Just $ killCR res +-- | @since 3.1.15 : throws 'RequestParseException' if something goes wrong takeLines' :: Maybe Int -> Maybe Int -> Source -> IO [S.ByteString] takeLines' lineLength maxLines source = reverse <$> takeLines'' [] lineLength maxLines source +-- | @since 3.1.15 : throws 'RequestParseException' if something goes wrong takeLines'' :: [S.ByteString] -> Maybe Int @@ -475,7 +488,7 @@ takeLines'' lines lineLength maxLines src = do case maxLines of Just maxLines' -> when (length lines > maxLines') $ - error "Too many lines in mime/multipart header" + E.throwIO $ TooManyHeaderLines (length lines) Nothing -> return () res <- takeLine lineLength src case res of @@ -502,6 +515,7 @@ readSource (Source f ref) = do leftover :: Source -> S.ByteString -> IO () leftover (Source _ ref) = writeIORef ref +-- | @since 3.1.15 : throws 'RequestParseException' if something goes wrong parsePiecesEx :: ParseRequestBodyOptions -> BackEnd y -> S.ByteString @@ -529,11 +543,11 @@ parsePiecesEx o sink bound rbody add = case prboKeyLength o of Just maxKeyLength -> when (S.length name > maxKeyLength) $ - error "Filename is too long" + E.throwIO $ FilenameTooLong name maxKeyLength Nothing -> return () case prboMaxNumFiles o of Just maxFiles -> when (numFiles >= maxFiles) $ - error "Maximum number of files exceeded" + E.throwIO $ MaxFileNumberExceeded numFiles Nothing -> return () let ct = fromMaybe "application/octet-stream" mct fi0 = FileInfo filename ct () @@ -548,7 +562,7 @@ parsePiecesEx o sink bound rbody add = case prboKeyLength o of Just maxKeyLength -> when (S.length name > maxKeyLength) $ - error "Parameter name is too long" + E.throwIO $ ParamNameTooLong name maxKeyLength Nothing -> return () let seed = id let iter front bs = return $ front . (:) bs @@ -559,7 +573,7 @@ parsePiecesEx o sink bound rbody add = let newParmSize = parmSize + S.length name + S.length bs case prboMaxParmsSize o of Just maxParmSize -> when (newParmSize > maxParmSize) $ - error "Maximum size of parameters exceeded" + E.throwIO $ MaxParamSizeExceeded newParmSize Nothing -> return () add $ Left x' when wasFound $ loop (numParms + 1) numFiles @@ -577,6 +591,25 @@ parsePiecesEx o sink bound rbody add = let (x, y) = breakDiscard 58 s -- colon in (mk x, S.dropWhile (== 32) y) -- space +-- | Things that could go wrong while parsing a 'Request' +-- +-- @since 3.1.15 +data RequestParseException = MaxParamSizeExceeded Int + | ParamNameTooLong S.ByteString Int + | MaxFileNumberExceeded Int + | FilenameTooLong S.ByteString Int + | TooManyHeaderLines Int + deriving (Eq, Typeable) +instance E.Exception RequestParseException +instance Show RequestParseException where + show = \case + MaxParamSizeExceeded lmax -> unwords ["maximum parameter size exceeded:", show lmax] + ParamNameTooLong s lmax -> unwords ["parameter name", S8.unpack s, "is too long:", show lmax] + MaxFileNumberExceeded lmax -> unwords ["maximum number of files exceeded:", show lmax] + FilenameTooLong fn lmax -> + unwords ["file name", S8.unpack fn, "too long:", show lmax] + TooManyHeaderLines nmax -> unwords ["Too many lines in mime/multipart header:", show nmax] + data Bound = FoundBound S.ByteString S.ByteString | NoBound diff --git a/wai-extra/test/Network/Wai/ParseSpec.hs b/wai-extra/test/Network/Wai/ParseSpec.hs index 206260889..9c060a38e 100644 --- a/wai-extra/test/Network/Wai/ParseSpec.hs +++ b/wai-extra/test/Network/Wai/ParseSpec.hs @@ -113,11 +113,11 @@ caseParseRequestBody = do it "exceeding number of files" $ do SRequest req4 _bod4 <- toRequest'' ctype3 content3 - (parseRequestBodyEx ( setMaxRequestNumFiles 0 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + (parseRequestBodyEx ( setMaxRequestNumFiles 0 def ) lbsBackEnd req4) `shouldThrow` anyException it "exceeding parameter length" $ do SRequest req4 _bod4 <- toRequest'' ctype3 content3 - (parseRequestBodyEx ( setMaxRequestKeyLength 2 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + (parseRequestBodyEx ( setMaxRequestKeyLength 2 def ) lbsBackEnd req4) `shouldThrow` anyException it "exceeding file size" $ do SRequest req4 _bod4 <- toRequest'' ctype3 content3 @@ -139,7 +139,7 @@ caseParseRequestBody = do it "exceeding max header lines" $ do SRequest req4 _bod4 <- toRequest'' ctype2 content2 - (parseRequestBodyEx ( setMaxHeaderLines 1 def ) lbsBackEnd req4) `shouldThrow` anyErrorCall + (parseRequestBodyEx ( setMaxHeaderLines 1 def ) lbsBackEnd req4) `shouldThrow` anyException it "exceeding header line size" $ do SRequest req4 _bod4 <- toRequest'' ctype3 content4 @@ -158,7 +158,7 @@ caseParseRequestBody = 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 + (parseRequestBodyEx ( setMaxRequestParmsSize 10 def ) lbsBackEnd req) `shouldThrow` anyException where content2 = diff --git a/wai-extra/wai-extra.cabal b/wai-extra/wai-extra.cabal index c27b41584..ba47c3f0f 100644 --- a/wai-extra/wai-extra.cabal +++ b/wai-extra/wai-extra.cabal @@ -1,5 +1,5 @@ Name: wai-extra -Version: 3.1.14.0 +Version: 3.1.15 Synopsis: Provides some basic WAI handlers and middleware. description: Provides basic WAI handler and middleware functionality: