http2 5.4.13 → 5.4.14

raw patch · 8 files changed

+140/−26 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Network/HTTP2/H2/HPACK.hs +8/−3
• Network/HTTP2/H2/Receiver.hs +17/−0
• Network/HTTP2/H2/Types.hs +1/−0
• Network/HTTP2/Server/Worker.hs +6/−7
• http2.cabal +4/−4
• test/HTTP2/ClientSpec.hs +37/−1
• test/HTTP2/ServerSpec.hs +62/−11

@@ -1,5 +1,10 @@ # ChangeLog for http2 +## 5.4.14++* Validate CONNECT requests like the others.+* Do not push on a request with no :scheme or authority.+ ## 5.4.13  * `Config` gains `confSendAllWith` and `confReadNWith`, a send and a read

@@ -163,14 +163,19 @@ {-# INLINE checkRequestHeader #-} checkRequestHeader :: ValueTable -> Bool checkRequestHeader reqvt-    | just mMethod (== "CONNECT") = isNothing mPath && isNothing mScheme     | isJust mStatus = False     | isNothing mMethod = False+    | isJust mConnection = False+    | just mTE (/= "trailers") = False+    -- RFC 9113 Section 8.5: :authority only, no :scheme nor :path.+    | mMethod == Just "CONNECT" =+        isNothing mPath+            && isNothing mScheme+            && isJust mAuthority+            && checkAuth mAuthority mHost     | isNothing mScheme = False     | isNothing mPath = False     | mPath == Just "" = False-    | isJust mConnection = False-    | just mTE (/= "trailers") = False     | otherwise = checkAuth mAuthority mHost   where     mStatus = getFieldValue tokenStatus reqvt

@@ -21,8 +21,13 @@ import qualified Data.ByteString.UTF8 as UTF8 import Data.IORef import Data.Void+import GHC.IO.Exception (+    IOErrorType (ResourceVanished),+    IOException (ioe_errno),+ ) import Network.Control import Network.HTTP.Semantics+import System.IO.Error (ioeGetErrorType) import qualified System.ThreadManager as T import qualified System.TimeManager as TM @@ -947,7 +952,19 @@         sendGoaway conf frame         E.throwIO e     | Just (_ :: HTTP2Error) <- E.fromException se = E.throwIO se+    -- Nothing can be sent once the peer has reset the connection.+    | Just ioe <- E.fromException se+    , isReset ioe =+        E.throwIO ConnectionIsReset     | otherwise = E.throwIO $ BadThingHappen se++-- | A reset is 'ResourceVanished', except on Windows: there network+--   reports every error as another, WSAECONNRESET and WSAECONNABORTED+--   among them, and keeps the Winsock code in 'ioe_errno'.+isReset :: E.IOException -> Bool+isReset ioe =+    ioeGetErrorType ioe == ResourceVanished+        || ioe_errno ioe `elem` [Just 10053, Just 10054]  goaway :: Context -> ErrorCode -> ByteString -> IO ByteString goaway ctx err msg = do

@@ -213,6 +213,7 @@ data HTTP2Error     = ConnectionIsClosed -- NoError     | ConnectionIsTimeout+    | ConnectionIsReset -- The peer reset the connection.     | ConnectionErrorIsReceived ErrorCode StreamId ReasonPhrase     | ConnectionErrorIsSent ErrorCode StreamId ReasonPhrase     | StreamErrorIsReceived ErrorCode StreamId

@@ -164,6 +164,8 @@ pushStream _ _ _ _ [] = return Nothing pushStream conf ctx@Context{..} pstrm reqvt pps0     | len == 0 = return Nothing+    -- Nothing to promise with, as for CONNECT which has no :scheme.+    | isNothing mScheme || isNothing mAuth = return Nothing     | otherwise = do         pushable <- enablePush <$> readIORef peerSettings         if pushable@@ -176,6 +178,8 @@             else return Nothing   where     len = length pps0+    mScheme = getFieldValue tokenScheme reqvt+    mAuth = getFieldValue tokenAuthority reqvt <|> getFieldValue tokenHost reqvt     increment tvar = atomically $ modifyTVar' tvar (+ 1)     -- Checking if all push are done.     waiter lim tvar = atomically $ do@@ -203,13 +207,8 @@         mstrm <- makePushStream ctx pstrm         forM mstrm $ \(pid, newstrm) -> promiseOn pp pid newstrm     promiseOn pp pid newstrm = do-        let scheme = fromJust $ getFieldValue tokenScheme reqvt-            -- fixme: this value can be Nothing-            auth =-                fromJust-                    ( getFieldValue tokenAuthority reqvt-                        <|> getFieldValue tokenHost reqvt-                    )+        let scheme = fromJust mScheme+            auth = fromJust mAuth             path = promiseRequestPath pp             promiseRequest =                 [ (tokenMethod, methodGet)

@@ -1,6 +1,6 @@ cabal-version:      2.0 name:               http2-version:            5.4.13+version:            5.4.14 license:            BSD3 license-file:       LICENSE maintainer:         Kazu Yamamoto <kazu@iij.ad.jp>@@ -140,7 +140,7 @@         http-types,         http2,         network,-        network-run >= 0.7 && <0.8,+        network-run >= 0.7 && <0.9,         unix-time      if flag(devel)@@ -311,7 +311,7 @@         http2,         network,         network-byte-order,-        network-run >= 0.7 && <0.8,+        network-run >= 0.7 && <0.9,         random,         stm,         time-manager >=0.5 && <0.6,@@ -332,7 +332,7 @@         hspec >=1.3,         http-types,         http2,-        network-run >= 0.7 && <0.8,+        network-run >= 0.7 && <0.9,         typed-process      if flag(h2spec)

@@ -14,6 +14,8 @@ import Network.HTTP.Semantics import Network.HTTP.Types import Network.Run.TCP hiding (defaultSettings)+import qualified Network.Socket as NS+import qualified Network.Socket.ByteString as NSB import System.IO.Unsafe (unsafePerformIO) import System.Random import System.Timeout (timeout)@@ -61,6 +63,13 @@                     Just (Left err) -> expectationFailure $ "Raise unexpected exception " ++ show err                     Just (Right ()) -> expectationFailure "Unexpected client termination" +        it "reports a connection the server resets as ConnectionIsReset" $+            withResettingServer $ \p -> do+                r <- E.try $ runClientTo p (defaultClient [])+                case r of+                    Left ConnectionIsReset -> return ()+                    _ -> expectationFailure $ "Unexpected result: " ++ show r+         it "respects max concurrent streams setting" $             withServer (runServer irresponsiveServer) $ do                 threadDelay 10000@@ -110,7 +119,13 @@     body = byteString "Hello, world!\n"  runClient :: Scheme -> Authority -> Client a -> IO a-runClient sc au client = runTCPClient host port runHTTP2Client+runClient = runClientWith port++runClientTo :: String -> Client a -> IO a+runClientTo p = runClientWith p "http" "localhost"++runClientWith :: String -> Scheme -> Authority -> Client a -> IO a+runClientWith p sc au client = runTCPClient host p runHTTP2Client   where     cliconf = defaultClientConfig{scheme = sc, authority = au}     runHTTP2Client s =@@ -146,6 +161,27 @@ streamError :: Selector HTTP2Error streamError StreamResetIsReceived{} = True streamError _ = False++-- | A server which answers the client's SETTINGS and then resets the+--   connection, as one killed in the middle of a request does.+withResettingServer :: (String -> IO a) -> IO a+withResettingServer action =+    E.bracket listenLocal NS.close $ \ls -> do+        p <- NS.socketPort ls+        _ <- forkIO $ do+            (s, _) <- NS.accept ls+            _ <- NSB.recv s 4096+            NSB.sendAll s "\0\0\0\4\0\0\0\0\0" -- an empty SETTINGS+            threadDelay 100000+            NS.setSockOpt s NS.Linger (NS.StructLinger 1 0)+            NS.close s+        action $ show p+  where+    listenLocal = do+        ls <- NS.socket NS.AF_INET NS.Stream NS.defaultProtocol+        NS.bind ls $ NS.SockAddrInet 0 $ NS.tupleToHostAddress (127, 0, 0, 1)+        NS.listen ls 1+        return ls  -- | Running a test server for the duration of the action, then telling it --   to stop.  'killThread' is no good here: it does not reach a thread

@@ -545,6 +545,29 @@                 timeout 5000000 malformedRequest                     `shouldReturn` Just ["RST_STREAM 1 ProtocolError", "HEADERS 3"] +        it "resets a CONNECT request without :authority" $+            withServer runServer $ do+                threadDelay 10000+                timeout 5000000 (malformedRequestWith [(":method", "CONNECT")])+                    `shouldReturn` Just ["RST_STREAM 1 ProtocolError", "HEADERS 3"]++        it "resets a CONNECT request whose host differs from its :authority" $+            withServer runServer $ do+                threadDelay 10000+                let req =+                        [ (":method", "CONNECT")+                        , (":authority", "a.example:443")+                        , ("host", "b.example:443")+                        ]+                timeout 5000000 (malformedRequestWith req)+                    `shouldReturn` Just ["RST_STREAM 1 ProtocolError", "HEADERS 3"]++        it "answers a CONNECT request without the push its handler asks for" $+            withServer runServer $ do+                threadDelay 10000+                let req = [(":method", "CONNECT"), (":authority", "127.0.0.1:443")]+                timeout 5000000 (connectWithPush req) `shouldReturn` Just "HEADERS"+         it "resets a request whose decoded headers are too large and goes on" $             -- The HTTP/2 Bomb (CVE-2026-49975): a field inserted into the             -- dynamic table once and referred to again and again is cheap@@ -1146,6 +1169,10 @@             let pp = pushPromise "/push-big-pp" responsePushBig 0             sendResponse responseHello [pp]         _ -> sendResponse response404 []+    -- A handler pushing whatever it is asked: nothing to promise with.+    Just "CONNECT" -> do+        let pp = pushPromise "/push-pp" responsePP 0+        sendResponse responseHello [pp]     Just "POST" -> case requestPath req of         Just "/echo" -> sendResponse (responseEcho req) []         -- How many octets of body arrived.@@ -1803,6 +1830,24 @@ -- | A request for /push, which comes with a push, from a peer that has -- announced room for no streams of the server's.  What the server answers -- it with first.+-- | The first frame the server sends on stream 1 or a PUSH_PROMISE.+connectWithPush :: [(ByteString, ByteString)] -> IO String+connectWithPush hdr = runTCPClient host port $ \s -> do+    sendAll s connectionPreface+    sendAll s $ encodeFrame (EncodeInfo defaultFlags 0 Nothing) $ SettingsFrame []+    let einfo = EncodeInfo (setEndStream $ setEndHeader defaultFlags) 1 Nothing+    sendAll s $ encodeFrame einfo $ HeadersFrame Nothing $ hpackEncode hdr+    answer s+  where+    answer s = do+        mf <- recvFrame s+        case mf of+            Nothing -> return "closed"+            Just (FrameHeaders, fh, _) | streamId fh == 1 -> return "HEADERS"+            Just (FramePushPromise, _, _) -> return "PUSH_PROMISE"+            Just (FrameRSTStream, fh, _) | streamId fh == 1 -> return "RST_STREAM"+            Just _ -> answer s+ pushNoRoom :: IO (Maybe String) pushNoRoom = runTCPClient host port $ \s -> do     sendAll s connectionPreface@@ -1881,21 +1926,27 @@ -- | A request with an upper-case field name on stream 1, then a good one -- on stream 3.  What the server sends on them, up to the answer on 3. malformedRequest :: IO [String]-malformedRequest = runTCPClient host port $ \s -> do+malformedRequest = malformedRequestWith $ getRequest ++ [("X-Upper", "1")]++getRequest :: [(ByteString, ByteString)]+getRequest =+    [ (":scheme", "http")+    , (":authority", "127.0.0.1")+    , (":path", "/")+    , (":method", "GET")+    ]++-- | Stream 1 with the given fields, then a valid request on stream 3.+malformedRequestWith :: [(ByteString, ByteString)] -> IO [String]+malformedRequestWith bad = runTCPClient host port $ \s -> do     sendAll s connectionPreface     sendAll s $ encodeFrame (EncodeInfo defaultFlags 0 Nothing) $ SettingsFrame []-    let request sid extra =+    let request sid hdr =             encodeFrame (EncodeInfo (setEndStream $ setEndHeader defaultFlags) sid Nothing) $                 HeadersFrame Nothing $-                    hpackEncode $-                        [ (":scheme", "http")-                        , (":authority", "127.0.0.1")-                        , (":path", "/")-                        , (":method", "GET")-                        ]-                            ++ extra-    sendAll s $ request 1 [("X-Upper", "1")]-    sendAll s $ request 3 []+                    hpackEncode hdr+    sendAll s $ request 1 bad+    sendAll s $ request 3 getRequest     collect s   where     collect s = do