From b2e496a2cc445200f108eea006e954c64147a476 Mon Sep 17 00:00:00 2001 From: Giorgio Marinelli Date: Sun, 15 Dec 2024 22:54:17 +0100 Subject: [PATCH] Revert some changes; add TooManyHeaders exception; add tests --- http-client/Network/HTTP/Client/Connection.hs | 5 ++-- http-client/Network/HTTP/Client/Headers.hs | 4 +-- http-client/Network/HTTP/Client/Types.hs | 20 ++++++------- http-conduit/test/main.hs | 30 ++++++++++++++++++- 4 files changed, 44 insertions(+), 15 deletions(-) diff --git a/http-client/Network/HTTP/Client/Connection.hs b/http-client/Network/HTTP/Client/Connection.hs index 99a3502e..673b0d61 100644 --- a/http-client/Network/HTTP/Client/Connection.hs +++ b/http-client/Network/HTTP/Client/Connection.hs @@ -50,12 +50,13 @@ connectionReadLineWith mhl conn bs0 = go bs front total = case S.break (== charLF) bs of (_, "") -> do - when (total >= unMaxHeaderLength mhl && total /= 0) $ do + let total' = total + fromIntegral (S.length bs) + when (total > unMaxHeaderLength mhl) $ do -- We reached the maximum length for an header field. throwHttp OverlongHeaders bs' <- connectionRead conn when (S.null bs') $ throwHttp IncompleteHeaders - go bs' (front . (bs:)) (total + fromIntegral (S.length bs)) + go bs' (front . (bs:)) total' (x, S.drop 1 -> y) -> do unless (S.null y) $! connectionUnread conn y return $! killCR $! S.concat $! front [x] diff --git a/http-client/Network/HTTP/Client/Headers.hs b/http-client/Network/HTTP/Client/Headers.hs index 82badf87..7b585838 100644 --- a/http-client/Network/HTTP/Client/Headers.hs +++ b/http-client/Network/HTTP/Client/Headers.hs @@ -93,9 +93,9 @@ parseStatusHeaders mhl mnh conn timeout' onEarlyHintHeaders cont guardMaxNumberHeaders :: Word -> IO () guardMaxNumberHeaders count = - when (count >= unMaxNumberHeaders mnh && count /= 0) $ do + when (count >= unMaxNumberHeaders mnh) $ do -- We reached the maximum number of header fields. - throwHttp OverlongHeaders + throwHttp TooManyHeaders parseHeaders :: Word -> ([Header] -> [Header]) -> IO [Header] parseHeaders count front = do diff --git a/http-client/Network/HTTP/Client/Types.hs b/http-client/Network/HTTP/Client/Types.hs index 0ee47c08..8473bf9e 100644 --- a/http-client/Network/HTTP/Client/Types.hs +++ b/http-client/Network/HTTP/Client/Types.hs @@ -151,12 +151,14 @@ data HttpExceptionContent -- -- @since 0.5.0 | OverlongHeaders - -- ^ Either too many headers, or too many total bytes in a - -- single header, were returned by the server, and the - -- memory exhaustion protection in this library has kicked - -- in. + -- ^ Too many total bytes in a single header field were + -- returned by the server. -- -- @since 0.5.0 + | TooManyHeaders + -- ^ Too many header fields were returned by the server, + -- + -- @since 0.7.18 | ResponseTimeout -- ^ The server took too long to return a response. This can -- be altered via 'responseTimeout' or @@ -826,14 +828,12 @@ data ManagerSettings = ManagerSettings -- Since 0.4.7 , managerMaxHeaderLength :: MaxHeaderLength -- ^ Configure the maximum size, in bytes, of an HTTP header field. - -- Set it to 0 to remove this limit (eg: for debugging purposes). -- -- Default: 4096 -- -- @since 0.7.17 , managerMaxNumberHeaders :: MaxNumberHeaders -- ^ Configure the maximum number of HTTP header fields. - -- Set it to 0 to remove this limit (eg: for debugging purposes). -- -- Default: 100 -- @@ -924,10 +924,10 @@ data StreamFileStatus = StreamFileStatus newtype MaxHeaderLength = MaxHeaderLength { unMaxHeaderLength :: Word } - deriving (Eq, Show, Ord, Num, T.Typeable) + deriving (Eq, Show, Ord, Num, Enum, Bounded, T.Typeable) noMaxHeaderLength :: MaxHeaderLength -noMaxHeaderLength = 0 +noMaxHeaderLength = maxBound -- | The maximum number of header fields. -- @@ -935,7 +935,7 @@ noMaxHeaderLength = 0 newtype MaxNumberHeaders = MaxNumberHeaders { unMaxNumberHeaders :: Word } - deriving (Eq, Show, Ord, Num, T.Typeable) + deriving (Eq, Show, Ord, Num, Enum, Bounded, T.Typeable) noMaxNumberHeaders :: MaxNumberHeaders -noMaxNumberHeaders = 0 +noMaxNumberHeaders = maxBound diff --git a/http-conduit/test/main.hs b/http-conduit/test/main.hs index 632f5f81..43144ee2 100644 --- a/http-conduit/test/main.hs +++ b/http-conduit/test/main.hs @@ -8,7 +8,8 @@ import qualified Data.ByteString.Lazy.Char8 as L8 import Test.HUnit import Network.Wai hiding (requestBody) import Network.Wai.Conduit (responseSource, sourceRequestBody) -import Network.HTTP.Client (streamFile) +import Network.HTTP.Client (streamFile, defaultManagerSettings) +import Network.HTTP.Client.Internal (managerMaxNumberHeaders) import System.IO.Temp (withSystemTempFile) import qualified Network.Wai as Wai import Network.Wai.Handler.Warp (runSettings, defaultSettings, setPort, setBeforeMainLoop, Settings, setTimeout) @@ -261,6 +262,18 @@ main = do let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port _ <- httpLbs req1 manager return () + it "too many header fields" $ tooManyHeaderFields $ \port -> do + manager <- newManager tlsManagerSettings + let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port + res1 <- try $ runResourceT $ http req1 manager + case res1 of + Left e -> show (e :: SomeException) @?= show (HttpExceptionRequest req1 TooManyHeaders) + _ -> error "Shouldn't have worked" + it "not too many header fields" $ notTooManyHeaderFields $ \port -> do + manager <- newManager tlsManagerSettings + let Just req1 = parseUrlThrow $ "http://127.0.0.1:" ++ show port + _ <- httpLbs req1 manager + return () describe "redirects" $ do it "doesn't double escape" $ redir $ \port -> do manager <- newManager tlsManagerSettings @@ -525,6 +538,21 @@ notOverLongHeaders = withCApp $ \app' -> do where src = sourceList $ [S.concat $ "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\nContent-Length: 16384\r\n\r\n" : ( take 16384 $ repeat "x")] +tooManyHeaderFields :: (Int -> IO ()) -> IO () +tooManyHeaderFields = + withCApp $ \app' -> runConduit $ src .| appSink app' + where + limit = fromEnum (managerMaxNumberHeaders defaultManagerSettings) + src = sourceList $ "HTTP/1.0 200 OK\r\n" : replicate limit "foo: bar\r\n" + +notTooManyHeaderFields :: (Int -> IO ()) -> IO () +notTooManyHeaderFields = withCApp $ \app' -> do + runConduit $ appSource app' .| CL.drop 1 + runConduit $ src .| appSink app' + where + limit = fromEnum (managerMaxNumberHeaders defaultManagerSettings) - 1 + src = sourceList $ ["HTTP/1.0 200 OK\r\n"] <> replicate limit "foo: bar\r\n" <> ["\r\n"] + redir :: (Int -> IO ()) -> IO () redir = withApp' redirApp