http2 5.4.9 → 5.4.10
raw patch · 11 files changed
+150/−32 lines, 11 filesdep ~time-managerPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: time-manager
API changes (from Hackage documentation)
Files
- ChangeLog.md +13/−0
- Network/HTTP2/Client/Run.hs +1/−1
- Network/HTTP2/H2/Context.hs +32/−4
- Network/HTTP2/H2/Receiver.hs +4/−3
- Network/HTTP2/H2/Sender.hs +18/−7
- Network/HTTP2/H2/Sync.hs +4/−3
- Network/HTTP2/H2/Types.hs +2/−1
- Network/HTTP2/Server/Run.hs +1/−2
- Network/HTTP2/Server/Worker.hs +9/−8
- http2.cabal +2/−2
- test/HTTP2/ServerSpec.hs +64/−1
ChangeLog.md view
@@ -1,5 +1,18 @@ # ChangeLog for http2 +## 5.4.10++* `decodeSophisticated` has the type it had before 5.4.9; the header list+ size limit moved to an unexported function.+ [#226](https://github.com/kazu-yamamoto/http2/pull/226)+* A `runIO` connection ends, with a GOAWAY, once the application says it is+ done.+ [#228](https://github.com/kazu-yamamoto/http2/pull/228)+* The threads of a connection are waited for, up to five seconds, before+ its streams are closed and the caller tears the connection down.+ [#228](https://github.com/kazu-yamamoto/http2/pull/228)+* Requires `time-manager` 0.5.+ ## 5.4.9 * Bound the decoded size of a field block (CVE-2026-49975).
Network/HTTP2/Client/Run.hs view
@@ -184,7 +184,7 @@ runH2 :: Config -> Context -> IO a -> IO a runH2 conf ctx runClient = do- T.stopAfter mgr (E.try runAll >>= closureClient conf ctx) $ \res ->+ stopAfterAndWait mgr (E.try runAll >>= closureClient conf ctx) $ \res -> closeAllStreams (oddStreamTable ctx) (evenStreamTable ctx) res where mgr = threadManager ctx
Network/HTTP2/H2/Context.hs view
@@ -12,6 +12,8 @@ import Network.Control import Network.Socket (SockAddr) import qualified System.ThreadManager as T+import qualified System.TimeManager as TM+import System.Timeout (timeout) import Imports hiding (insert) import Network.HPACK@@ -26,6 +28,26 @@ ---------------------------------------------------------------- +-- | Telling a connection's threads to stop and seeing them out before the+-- cleanup, which closes the streams they are still writing to.+--+-- The wait is capped because one of the threads waited for runs the+-- application's handler: an application which swallows the asynchronous+-- exception would otherwise keep this from ever returning.+stopAfterAndWait+ :: T.ThreadManager -> IO a -> (Maybe E.SomeException -> IO ()) -> IO a+stopAfterAndWait mgr action cleanup =+ T.stopAfter mgr action $ \res -> do+ void $ timeout stopTimeout $ T.waitUntilAllGone mgr+ cleanup res++-- | How long the threads are given to end after they have been told to.+-- Unwinding takes milliseconds; this is for one that does not stop.+stopTimeout :: Int+stopTimeout = 5000000++----------------------------------------------------------------+ data RoleInfo = RIS ServerInfo | RIC ClientInfo type Launch = Context -> Stream -> InpObj -> IO ()@@ -88,8 +110,13 @@ , mySockAddr :: SockAddr , peerSockAddr :: SockAddr , threadManager :: T.ThreadManager+ , timeoutManager :: TM.Manager+ -- ^ For the threads that are timed out: owning a thread and+ -- timing it out are separate, so the manager carries no timer. , receiverDone :: TVar (Maybe E.SomeException)- , workersDone :: STM Bool+ , appDone :: STM Bool+ -- ^ Server only: set by 'sioDone' once a 'runIO' application has+ -- nothing more to send. Never for 'run' and clients. , informationalCallback :: StreamId -> TokenHeaderTable -> IO () -- ^ Client only: called when a 1xx informational response (e.g. 103 Early -- Hints) is received, ahead of the final response. Copied from@@ -132,7 +159,7 @@ -> Int -> Int -> Settings- -> T.Manager+ -> TM.Manager -> Maybe (STM Bool) -> IO Context newContext roleInfo Config{..} cacheSiz connRxWS mySettings timmgr mdone = do@@ -172,10 +199,11 @@ rstRate <- newRate let mySockAddr = confMySockAddr let peerSockAddr = confPeerSockAddr- threadManager <- T.newThreadManager timmgr+ threadManager <- T.newThreadManager+ let timeoutManager = timmgr receiverDone <- newTVarIO Nothing let informationalCallback = confOnInformational- let workersDone = fromMaybe (T.isAllGone threadManager) mdone+ let appDone = fromMaybe (return False) mdone peerGoAway <- newTVarIO Nothing activeRequests <- newTVarIO 0 resetByMe <- newIORef IntSet.empty
Network/HTTP2/H2/Receiver.hs view
@@ -25,6 +25,7 @@ import Network.HTTP.Semantics import qualified System.IO.Error as E import qualified System.ThreadManager as T+import qualified System.TimeManager as TM import Imports hiding (delete, insert) import Network.HTTP2.Frame@@ -69,7 +70,7 @@ then loop1 else- T.withHandle (threadManager ctx) (E.throwTo tid ConnectionIsTimeout) loop2+ TM.withHandle (timeoutManager ctx) (E.throwTo tid ConnectionIsTimeout) loop2 loop1 :: IO Void loop1 = do@@ -79,14 +80,14 @@ processFrame ctx conf $ decodeFrameHeader hd loop1 - loop2 :: T.Handle -> IO Void+ loop2 :: TM.Handle -> IO Void loop2 th = do -- If 'confReadN' is timeouted, 'ConnectionIsTimeout' is thrown -- to destroy the thread trees. So it is if the peer does not -- read what we send, and we wait here for ever. atomically $ waitControlQ $ controlQ ctx hd <- confReadN frameHeaderLength- T.tickle th+ TM.tickle th when (BS.null hd) $ E.throwIO ConnectionIsClosed processFrame ctx conf $ decodeFrameHeader hd loop2 th
Network/HTTP2/H2/Sender.hs view
@@ -18,6 +18,7 @@ import Network.ByteOrder import Network.HTTP.Semantics.Client import Network.HTTP.Semantics.IO+import qualified System.ThreadManager as T import Imports import Network.HPACK (setLimitForEncoding, toTokenHeaderTable)@@ -69,8 +70,12 @@ connectionError e = E.throwIO e -- | Whether the sender is done: nothing left to send, and the receiver--- done. Otherwise it waits for something to send.+-- done or the application done. Otherwise it waits for something to send. --+-- The application is done once outputs waiting for their stream windows,+-- each in a thread of its own, are gone too. Workers are not waited for+-- when the receiver is done: they wait on streams closed only after this.+-- -- DATA parked for the connection window is something to send once the -- window opens. Left out, a sender with nothing else queued waited here -- for the control or output queue, and a WINDOW_UPDATE opening the window@@ -87,12 +92,18 @@ then return Nothing else do- recv <- readTVar receiverDone- case recv of- Just done ->- return $ Just done- _otherwise ->- retry+ app <- appDone+ gone <- T.isAllGone threadManager+ if app && gone && null ps+ then+ return $ Just $ E.toException ConnectionIsClosed+ else do+ recv <- readTVar receiverDone+ case recv of+ Just done ->+ return $ Just done+ _otherwise ->+ retry checkDone _ _ _ = return Nothing frameSender :: Context -> Config -> IO E.SomeException
Network/HTTP2/H2/Sync.hs view
@@ -18,6 +18,7 @@ import Network.Control import Network.HTTP.Semantics.IO import qualified System.ThreadManager as T+import qualified System.TimeManager as TM import Network.HTTP2.H2.Context import Network.HTTP2.H2.Queue@@ -108,14 +109,14 @@ case s of Done -> return () Cont newout -> do- mapM_ T.tickle (lcTimeHandle lc)+ mapM_ TM.tickle (lcTimeHandle lc) cont <- checkLoop lc when cont $ do enqueueOutput outputQ newout loop newLoopCheck- :: Stream -> Maybe (TBQueue StreamingChunk) -> Maybe T.Handle -> IO LoopCheck+ :: Stream -> Maybe (TBQueue StreamingChunk) -> Maybe TM.Handle -> IO LoopCheck newLoopCheck strm mtbq mth = do tovar <- newTVarIO False return $@@ -132,7 +133,7 @@ , lcTBQ :: Maybe (TBQueue StreamingChunk) , lcTimeout :: TVar Bool , lcWindow :: TVar TxFlow- , lcTimeHandle :: Maybe T.Handle+ , lcTimeHandle :: Maybe TM.Handle } checkLoop :: LoopCheck -> IO Bool
Network/HTTP2/H2/Types.hs view
@@ -8,6 +8,7 @@ import Control.Concurrent import Control.Concurrent.STM import qualified Control.Exception as E+import qualified System.TimeManager as TM import Data.IORef import Foreign.Ptr (nullPtr) import Network.Control@@ -267,7 +268,7 @@ , confSendAll :: ByteString -> IO () , confReadN :: Int -> IO ByteString , confPositionReadMaker :: PositionReadMaker- , confTimeoutManager :: T.Manager+ , confTimeoutManager :: TM.Manager , confMySockAddr :: SockAddr -- ^ This is copied into 'Aux', if exist, on server. , confPeerSockAddr :: SockAddr
Network/HTTP2/Server/Run.hs view
@@ -11,7 +11,6 @@ import Network.HTTP.Semantics.Server import Network.HTTP.Semantics.Server.Internal import Network.Socket (SockAddr)-import qualified System.ThreadManager as T import Network.HTTP2.Frame import Network.HTTP2.H2@@ -142,7 +141,7 @@ -- are closed with it. Right e -> return e closureServer conf ctx e- T.stopAfter mgr runBackgroundThreads $ \res ->+ stopAfterAndWait mgr runBackgroundThreads $ \res -> closeAllStreams (oddStreamTable ctx) (evenStreamTable ctx) res -- connClose must not be called here since Run:fork calls it
Network/HTTP2/Server/Worker.hs view
@@ -15,6 +15,7 @@ import Network.HTTP.Semantics.Server.Internal import Network.HTTP.Types import qualified System.ThreadManager as T+import qualified System.TimeManager as TM import Imports hiding (insert) import Network.HTTP2.Frame@@ -29,7 +30,7 @@ runServer :: Config -> Server -> Launch runServer conf server ctx@Context{..} strm req =- T.forkManagedTimeout threadManager label $ \th -> do+ T.forkManagedTimeout threadManager timeoutManager label $ \th -> do let req' = pauseRequestBody th aux = defaultAux@@ -53,9 +54,9 @@ where readBody = inpObjBody req readBody' = do- T.pause th+ TM.pause th bs <- readBody- T.resume th -- this is the same as 'tickle'+ TM.resume th -- this is the same as 'tickle' return bs -- | Called once the handler has returned: nobody reads the request body@@ -278,18 +279,18 @@ -> IO (TBQueue StreamingChunk) sendStreaming ctx@Context{..} strm strmbdy = do tbq <- newTBQueueIO 10 -- fixme: hard coding: 10- T.forkManagedTimeout threadManager label $ \th ->+ T.forkManagedTimeout threadManager timeoutManager label $ \th -> withOutBodyIface ctx strm tbq id $ \iface -> do let iface' = iface { outBodyPush = \b -> do- T.pause th+ TM.pause th outBodyPush iface b- T.resume th -- this is the same as 'tickle'+ TM.resume th -- this is the same as 'tickle' , outBodyPushFinal = \b -> do- T.pause th+ TM.pause th outBodyPushFinal iface b- T.resume th -- this is the same as 'tickle'+ TM.resume th -- this is the same as 'tickle' } strmbdy iface' return tbq
http2.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: http2-version: 5.4.9+version: 5.4.10 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto <kazu@iij.ad.jp>@@ -122,7 +122,7 @@ network-byte-order >=0.1.7 && <0.2, network-control >=0.1 && <0.2, stm >=2.5 && <2.6,- time-manager >=0.3.0 && <0.5,+ time-manager >=0.5 && <0.6, unix-time >=0.4.11 && <0.6, utf8-string >=1.0 && <1.1
test/HTTP2/ServerSpec.hs view
@@ -44,6 +44,7 @@ import qualified Network.HTTP2.Client.Internal as C import Network.HTTP2.Frame import Network.HTTP2.Server+import qualified Network.HTTP2.Server.Internal as S port :: String port = show $ unsafePerformIO (randomPort <$> getStdGen)@@ -432,6 +433,30 @@ Just (Left e) -> expectationFailure $ show (e :: C.HTTP2Error) Nothing -> expectationFailure "timed out" + it "closes the connection once a runIO application is done" $+ -- 'sioDone' set a flag that nothing read, so the connection+ -- stayed open until the client closed it.+ E.bracket (forkIO runServerIO) killThread $ \_ -> do+ threadDelay 10000+ timeout 5000000 (requestAndCollect [] (\_ -> return ()))+ `shouldReturn` Just ["HEADERS 1", "DATA 1 END_STREAM", "GOAWAY NoError"]++ it "sends a runIO body waiting for its window before closing" $+ -- The rest of the body waits in a thread of the thread manager.+ -- The queues are empty meanwhile, but the application is not+ -- done until it is gone.+ E.bracket (forkIO runServerIO) killThread $ \_ -> do+ threadDelay 10000+ let openWindow s =+ threadDelay 100000+ >> sendAll+ s+ (encodeFrame (EncodeInfo defaultFlags 1 Nothing) $ WindowUpdateFrame 100000)+ timeout+ 5000000+ (requestAndCollect [(SettingsInitialWindowSize, 1000)] openWindow)+ `shouldReturn` Just ["HEADERS 1", "DATA 1 END_STREAM", "GOAWAY NoError"]+ it "answers the requests it has after the client's GOAWAY" $ -- A client's GOAWAY speaks of the server's own streams, and -- the requests it has already sent are still to be answered.@@ -815,6 +840,40 @@ status (Left C.ConnectionIsClosed) = "closed" status (Left e) = C8.pack $ show e +-- | A 'S.runIO' server answering a single request, then done.+runServerIO :: IO ()+runServerIO = runTCPServer (Just host) port $ \s ->+ E.bracket (allocSimpleConfig s 32768) freeSimpleConfig $ \conf ->+ E.handle ignoreHTTP2Error $ S.runIO defaultServerConfig conf (return . app)+ where+ app S.ServerIO{..} = do+ (strm, _) <- sioReadRequest+ sioWriteResponse strm $+ responseBuilder ok200 [] $+ byteString $+ B.replicate 30000 0x61+ sioDone++-- | A request for / with these settings, then the action, and what the+-- server sends until it closes the connection.+requestAndCollect :: SettingsList -> (Socket -> IO ()) -> IO [String]+requestAndCollect settings action = runTCPClient host port $ \s -> do+ sendAll s connectionPreface+ sendAll s $+ encodeFrame (EncodeInfo defaultFlags 0 Nothing) $+ SettingsFrame settings+ sendAll s $+ encodeFrame (EncodeInfo (setEndStream $ setEndHeader defaultFlags) 1 Nothing) $+ HeadersFrame Nothing $+ hpackEncode+ [ (":scheme", "http")+ , (":authority", "127.0.0.1")+ , (":path", "/")+ , (":method", "GET")+ ]+ _ <- E.try (action s) :: IO (Either E.IOException ())+ collectFrames s+ -- | A request for /slow, then GOAWAY(NO_ERROR) at once. What the server -- sends from then on until it closes the connection. goAwayFromClient :: IO [String]@@ -833,7 +892,11 @@ sendAll s $ encodeFrame (EncodeInfo defaultFlags 0 Nothing) $ GoAwayFrame 0 NoError "going"- collect s+ collectFrames s++-- | What the server sends until it closes the connection.+collectFrames :: Socket -> IO [String]+collectFrames = collect where collect s = do mf <- recvFrame s