diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,44 @@ # ChangeLog for http2 +## 5.4.5 + +* Security: frame payload decoders read their fixed-size fields without + checking that the payload holds them, so a truncated frame, or padding + covering a field, read past the end of the buffer -- and an empty payload + is the shared empty `ByteString`, whose pointer is null. An + unauthenticated peer could segfault the process with 33 bytes. + [#182](https://github.com/kazu-yamamoto/http2/pull/182) +* Security: HPACK integer decoding overflowed `Int` silently, so a long + enough encoding decoded to whatever value the sender aimed at and two + different byte strings could decode to the same header. Integers are now + bounded and over-long encodings are a decoding error, as RFC 7541 + section 5.1 requires. + [#181](https://github.com/kazu-yamamoto/http2/pull/181) +* A RST_STREAM gave a stream's concurrency slot back twice, so a peer could + walk `SETTINGS_MAX_CONCURRENT_STREAMS` upwards and hold open as many + streams as it liked. + [#178](https://github.com/kazu-yamamoto/http2/pull/178) +* A stream reset while its response was still being produced left the + worker blocked until the timeout manager killed it, one thread per reset + stream. + [#179](https://github.com/kazu-yamamoto/http2/pull/179) +* Stream errors now reset the stream and the connection carries on, as + RFC 9113 section 5.4.2 requires. A field block abandoned part-way is + still a connection error, since the HPACK tables have diverged by then. + [#183](https://github.com/kazu-yamamoto/http2/pull/183) +* A stream over `SETTINGS_MAX_CONCURRENT_STREAMS` is refused with + RST_STREAM(REFUSED_STREAM) rather than ending the connection. + [#184](https://github.com/kazu-yamamoto/http2/pull/184) +* `DecodeError` has a new constructor, `TooLargeInteger`. Strictly this is + a breaking change -- an exhaustive match on `DecodeError` no longer + compiles -- but it ships as a patch version on purpose: no package on + Hackage names any constructor of that type, while a minor bump would + shut out every dependant carrying a `< 5.5` bound, these security fixes + along with it. +* A malformed request now reaches a client as `StreamResetIsReceived` on + the stream it concerns, where it used to arrive as + `ConnectionErrorIsReceived` on the connection. + ## 5.4.4 * Improvements for dealing with RST_STREAM diff --git a/Network/HPACK/HeaderBlock/Integer.hs b/Network/HPACK/HeaderBlock/Integer.hs --- a/Network/HPACK/HeaderBlock/Integer.hs +++ b/Network/HPACK/HeaderBlock/Integer.hs @@ -3,13 +3,16 @@ encodeInteger, decodeI, decodeInteger, + integerLimit, ) where +import qualified Control.Exception as E import Data.Array (Array, listArray) import Data.Array.Base (unsafeAt) import Network.ByteOrder import Imports +import Network.HPACK.Types (DecodeError (..)) -- $setup -- >>> import qualified Data.ByteString as BS @@ -127,9 +130,36 @@ p = powerArray `unsafeAt` (n - 1) i = fromIntegral w decode :: Int -> Int -> IO Int - decode m j = do - b <- fromIntegral <$> read8 rbuf - let j' = j + (b .&. 0x7f) * 2 ^ m - m' = m + 7 - cont = b `testBit` 7 - if cont then decode m' j' else return j' + decode m j + -- Checked before the shift rather than after: shifting an 'Int' by a + -- word width or more is not defined to give zero, and the value would + -- have wrapped long before there were anything to notice. + | m > maxShift = E.throwIO TooLargeInteger + | otherwise = do + b <- fromIntegral <$> read8 rbuf + let d = b .&. 0x7f + -- d * 2^m > integerLimit - j, without evaluating the product. + when (d > (integerLimit - j) `shiftR` m) $ E.throwIO TooLargeInteger + let j' = j + (d `shiftL` m) + if b `testBit` 7 then decode (m + 7) j' else return j' + +-- | The largest integer 'decodeI' will return. +-- +-- HPACK's integer encoding carries no bound of its own, so a decoder has to +-- impose one. RFC 7541, section 5.1: "Integer encodings that exceed +-- implementation limits -- in value or octet length -- MUST be treated as +-- decoding errors." +-- +-- 2^30 - 1 is far above anything HTTP\/2 can ask for -- a frame payload is at +-- most 2^24 - 1 octets, so no length or index comes near it -- and it still +-- fits in an 'Int' on a platform where that is 32 bits wide. +-- +-- >>> integerLimit +-- 1073741823 +integerLimit :: Int +integerLimit = 1073741823 + +-- | The largest shift that can carry a continuation octet into +-- 'integerLimit'; past it every further octet is an overflow. +maxShift :: Int +maxShift = 28 diff --git a/Network/HPACK/Types.hs b/Network/HPACK/Types.hs --- a/Network/HPACK/Types.hs +++ b/Network/HPACK/Types.hs @@ -76,6 +76,9 @@ IllegalEos | -- | Eos of huffman string is more than 7 bits TooLongEos + | -- | An integer is encoded above the limit this decoder accepts, + -- or in more octets than reaching that limit can take + TooLargeInteger | -- | A peer set the dynamic table size less than 32 TooSmallTableSize | -- | A peer tried to change the dynamic table size over the limit diff --git a/Network/HTTP2/Frame/Decode.hs b/Network/HTTP2/Frame/Decode.hs --- a/Network/HTTP2/Frame/Decode.hs +++ b/Network/HTTP2/Frame/Decode.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -92,6 +93,10 @@ Left $ FrameDecodeError ProtocolError streamId "cannot used in non-zero stream" | otherwise = checkType typ where + checkType FrameData + | testPadded flags && payloadLength < 1 = + Left $ + FrameDecodeError FrameSizeError streamId "insufficient payload for Pad Length" checkType FrameHeaders | testPadded flags && payloadLength < 1 = Left $ @@ -142,6 +147,18 @@ ProtocolError streamId "push promise must be used with an odd stream identifier" + | testPadded flags && payloadLength < 5 = + Left $ + FrameDecodeError + FrameSizeError + streamId + "insufficient payload for Pad Length and promised stream id" + | not (testPadded flags) && payloadLength < 4 = + Left $ + FrameDecodeError + FrameSizeError + streamId + "insufficient payload for promised stream id" checkType FramePing | payloadLength /= 8 = Left $ @@ -206,39 +223,52 @@ decodeFramePayload :: FrameType -> FramePayloadDecoder decodeFramePayload ftyp | ftyp > maxFrameType = checkFrameSize $ decodeUnknownFrame ftyp -decodeFramePayload ftyp = checkFrameSize decoder - where - decoder = payloadDecoders ! ftyp +decodeFramePayload ftyp = payloadDecoders ! ftyp -- each one checks its own size ---------------------------------------------------------------- -- | Frame payload decoder for DATA frame. decodeDataFrame :: FramePayloadDecoder -decodeDataFrame header _bs = decodeWithPadding header _bs DataFrame +decodeDataFrame = checkFrameSize $ \header bs -> + decodeWithPadding header bs $ Right . DataFrame -- | Frame payload decoder for HEADERS frame. decodeHeadersFrame :: FramePayloadDecoder -decodeHeadersFrame header _bs = decodeWithPadding header _bs $ \bs' -> - if hasPriority - then - let (bs0, bs1) = BS.splitAt 5 bs' - p = priority bs0 - in HeadersFrame (Just p) bs1 - else HeadersFrame Nothing bs' - where - hasPriority = testPriority $ flags header +decodeHeadersFrame = checkFrameSize $ \header@FrameHeader{streamId} bs -> + decodeWithPadding header bs $ \bs' -> + if testPriority $ flags header + then + -- The header check knows the payload is long enough to hold + -- the priority fields, but not that the padding leaves them + -- there: Pad Length may cover the lot. + if BS.length bs' < 5 + then + Left $ + FrameDecodeError + FrameSizeError + streamId + "no room for priority fields" + else + let (bs0, bs1) = BS.splitAt 5 bs' + in Right $ HeadersFrame (Just (priority bs0)) bs1 + else Right $ HeadersFrame Nothing bs' -- | Frame payload decoder for PRIORITY frame. decodePriorityFrame :: FramePayloadDecoder -decodePriorityFrame _ bs = Right $ PriorityFrame $ priority bs +decodePriorityFrame = checkFrameSize $ requireBytes 5 $ \_ bs -> + Right $ PriorityFrame $ priority bs -- | Frame payload decoder for RST_STREAM frame. decodeRSTStreamFrame :: FramePayloadDecoder -decodeRSTStreamFrame _ bs = Right $ RSTStreamFrame $ toErrorCode $ N.word32 bs +decodeRSTStreamFrame = checkFrameSize $ requireBytes 4 $ \_ bs -> + Right $ RSTStreamFrame $ toErrorCode $ N.word32 bs -- | Frame payload decoder for SETTINGS frame. decodeSettingsFrame :: FramePayloadDecoder -decodeSettingsFrame FrameHeader{..} (PS fptr off _) +decodeSettingsFrame = checkFrameSize decodeSettingsFrame' + +decodeSettingsFrame' :: FramePayloadDecoder +decodeSettingsFrame' FrameHeader{..} (PS fptr off _) | num > 10 = Left $ FrameDecodeError EnhanceYourCalm streamId "Settings is too large" | otherwise = Right $ SettingsFrame alist @@ -258,20 +288,31 @@ -- | Frame payload decoder for PUSH_PROMISE frame. decodePushPromiseFrame :: FramePayloadDecoder -decodePushPromiseFrame header _bs = decodeWithPadding header _bs $ \bs' -> - let (bs0, bs1) = BS.splitAt 4 bs' - sid = streamIdentifier (N.word32 bs0) - in PushPromiseFrame sid bs1 +decodePushPromiseFrame = checkFrameSize $ \header@FrameHeader{streamId} bs -> + decodeWithPadding header bs $ \bs' -> + -- As in HEADERS: the padding may cover the promised stream id. + if BS.length bs' < 4 + then + Left $ + FrameDecodeError + FrameSizeError + streamId + "no room for the promised stream id" + else + let (bs0, bs1) = BS.splitAt 4 bs' + sid = streamIdentifier (N.word32 bs0) + in Right $ PushPromiseFrame sid bs1 -- | Frame payload decoder for PING frame. decodePingFrame :: FramePayloadDecoder -decodePingFrame _ _bs = Right $ PingFrame bs - where - bs = BS.copy _bs +decodePingFrame = checkFrameSize $ \_ _bs -> Right $ PingFrame $ BS.copy _bs -- | Frame payload decoder for GOAWAY frame. decodeGoAwayFrame :: FramePayloadDecoder -decodeGoAwayFrame _ _bs = Right $ GoAwayFrame sid ecid bs2 +decodeGoAwayFrame = checkFrameSize $ requireBytes 8 decodeGoAwayFrame' + +decodeGoAwayFrame' :: FramePayloadDecoder +decodeGoAwayFrame' _ _bs = Right $ GoAwayFrame sid ecid bs2 where bs = BS.copy _bs (bs0, bs1') = BS.splitAt 4 bs @@ -281,7 +322,10 @@ -- | Frame payload decoder for WINDOW_UPDATE frame. decodeWindowUpdateFrame :: FramePayloadDecoder -decodeWindowUpdateFrame FrameHeader{..} bs +decodeWindowUpdateFrame = checkFrameSize $ requireBytes 4 decodeWindowUpdateFrame' + +decodeWindowUpdateFrame' :: FramePayloadDecoder +decodeWindowUpdateFrame' FrameHeader{..} bs | wsi == 0 = Left $ FrameDecodeError ProtocolError streamId "window update must not be 0" | otherwise = Right $ WindowUpdateFrame wsi @@ -290,9 +334,7 @@ -- | Frame payload decoder for CONTINUATION frame. decodeContinuationFrame :: FramePayloadDecoder -decodeContinuationFrame _ _bs = Right $ ContinuationFrame bs - where - bs = BS.copy _bs +decodeContinuationFrame = checkFrameSize $ \_ _bs -> Right $ ContinuationFrame $ BS.copy _bs decodeUnknownFrame :: FrameType -> FramePayloadDecoder decodeUnknownFrame typ _ _bs = Right $ UnknownFrame typ bs @@ -307,6 +349,22 @@ Left $ FrameDecodeError FrameSizeError streamId "payload is too short" | otherwise = func header body +-- | Require the payload to actually hold the fixed fields about to be read +-- from it. +-- +-- The reads below sit at fixed offsets and never consult the length of the +-- 'ByteString' they read from, so a payload shorter than the field runs off +-- the end of the buffer -- and an empty one is the shared empty +-- 'ByteString', whose pointer is null. 'checkFrameHeader' pins these lengths +-- down, but it is a separate function that a caller of the decoders is free +-- not to have used, and 'checkFrameSize' only compares the payload against +-- the length the frame header claims, which may itself be wrong. +requireBytes :: Int -> FramePayloadDecoder -> FramePayloadDecoder +requireBytes n func header@FrameHeader{streamId} body + | BS.length body < n = + Left $ FrameDecodeError FrameSizeError streamId "payload is too short" + | otherwise = func header body + -- | Helper function to pull off the padding if its there, and will -- eat up the trailing padding automatically. Calls the decoder func -- passed in with the length of the unpadded portion between the @@ -314,17 +372,23 @@ decodeWithPadding :: FrameHeader -> ByteString - -> (ByteString -> FramePayload) + -> (ByteString -> Either FrameDecodeError FramePayload) -> Either FrameDecodeError FramePayload decodeWithPadding FrameHeader{..} bs body - | padded = - let (w8, rest) = fromMaybe (error "decodeWithPadding") $ BS.uncons bs' - padlen = intFromWord8 w8 - bodylen = payloadLength - padlen - 1 - in if bodylen < 0 - then Left $ FrameDecodeError ProtocolError streamId "padding is not enough" - else Right . body $ BS.take bodylen rest - | otherwise = Right $ body bs' + | padded = case BS.uncons bs' of + -- The header checks rule this out for every frame type that can be + -- padded, but the type does not, and the reply to a payload with no + -- room for its Pad Length is an error, never a crash. + Nothing -> + Left $ + FrameDecodeError FrameSizeError streamId "insufficient payload for Pad Length" + Just (w8, rest) + | bodylen < 0 -> + Left $ FrameDecodeError ProtocolError streamId "padding is not enough" + | otherwise -> body $ BS.take bodylen rest + where + bodylen = payloadLength - intFromWord8 w8 - 1 + | otherwise = body bs' where bs' = BS.copy bs padded = testPadded flags diff --git a/Network/HTTP2/H2/Context.hs b/Network/HTTP2/H2/Context.hs --- a/Network/HTTP2/H2/Context.hs +++ b/Network/HTTP2/H2/Context.hs @@ -252,12 +252,13 @@ -- From peer -- Server +-- +-- Note that this does not apply SETTINGS_MAX_CONCURRENT_STREAMS. A stream +-- over the limit still has to be admitted this far, because its field block +-- has to be decoded before it can be refused; 'checkOddConcurrency' does the +-- refusing once that has happened. openOddStreamCheck :: Context -> StreamId -> FrameType -> IO Stream openOddStreamCheck ctx@Context{oddStreamTable, peerSettings, mySettings} sid ftyp = do - -- My SETTINGS_MAX_CONCURRENT_STREAMS - when (ftyp == FrameHeaders) $ do - conc <- getOddConcurrency oddStreamTable - checkMyConcurrency sid mySettings (conc + 1) txws <- initialWindowSize <$> readIORef peerSettings let rxws = initialWindowSize mySettings newstrm <- newOddStream sid txws rxws @@ -275,6 +276,25 @@ let rxws = initialWindowSize mySettings newstrm <- newEvenStream sid txws rxws insertEvenCache evenStreamTable method path newstrm + +-- | Refuse a peer-initiated stream that puts us over the limit we advertised +-- in SETTINGS_MAX_CONCURRENT_STREAMS. +-- +-- Checked once the stream's field block has been decoded, rather than when +-- its HEADERS frame arrived. A block has to be decoded whatever becomes of +-- its stream -- RFC 9113 section 10.5.1, "The field block MUST be processed +-- to ensure a consistent connection state" -- and refusing at arrival meant +-- throwing before the frame's payload had even been read, which left nothing +-- to do but drop the connection. From here the throw lands inside the +-- receiver's per-frame reset handler, so the answer is +-- RST_STREAM(REFUSED_STREAM) and the connection carries on, which is what +-- section 5.1.2 asks for and what section 8.7 lets the peer retry against. +-- +-- The stream is in the table by the time we get here, so it counts itself. +checkOddConcurrency :: Context -> StreamId -> IO () +checkOddConcurrency Context{oddStreamTable, mySettings} sid = do + conc <- getOddConcurrency oddStreamTable + checkMyConcurrency sid mySettings conc checkMyConcurrency :: StreamId -> Settings -> Int -> IO () diff --git a/Network/HTTP2/H2/HPACK.hs b/Network/HTTP2/H2/HPACK.hs --- a/Network/HTTP2/H2/HPACK.hs +++ b/Network/HTTP2/H2/HPACK.hs @@ -73,20 +73,45 @@ hpackDecodeHeader :: HeaderBlockFragment -> StreamId -> Context -> IO TokenHeaderTable hpackDecodeHeader hdrblk sid ctx = do - tbl@(_, vt) <- hpackDecodeTrailer hdrblk sid ctx + tbl@(_, vt) <- hpackDecode "illegal header" hdrblk sid ctx if isClient ctx || checkRequestHeader vt then return tbl else E.throwIO $ StreamErrorIsSent ProtocolError sid "illegal header" hpackDecodeTrailer :: HeaderBlockFragment -> StreamId -> Context -> IO TokenHeaderTable -hpackDecodeTrailer hdrblk sid Context{..} = decodeTokenHeader decodeDynamicTable hdrblk `E.catch` handl +hpackDecodeTrailer = hpackDecode "illegal trailer" + +-- | Decode a field block, reporting a block we could not get through as a +-- connection error. +-- +-- The first argument says which kind of block it was, since the peer reads +-- this in the GOAWAY and "illegal trailer" about a request's headers is a +-- confusing thing to be told. +hpackDecode + :: ReasonPhrase + -> HeaderBlockFragment + -> StreamId + -> Context + -> IO TokenHeaderTable +hpackDecode illegal hdrblk sid Context{..} = + decodeTokenHeader decodeDynamicTable hdrblk `E.catch` handl where + -- Connection errors, both of them, even though a malformed message is a + -- stream error by RFC 9113 section 8.1.1. Either way the field block was + -- abandoned part-way through, so our dynamic table now holds the entries + -- decoded before the throw and nothing after them -- no longer what the + -- peer's encoder believes we have. Section 10.5.1: "The field block MUST + -- be processed to ensure a consistent connection state, unless the + -- connection is closed." We did not, so it must be. + -- + -- A malformed message caught /after/ a complete decode is a different + -- matter, and 'hpackDecodeHeader' reports those as stream errors. handl IllegalHeaderName = - E.throwIO $ StreamErrorIsSent ProtocolError sid "illegal trailer" + E.throwIO $ ConnectionErrorIsSent ProtocolError sid illegal handl e = do let msg = fromString $ show e - E.throwIO $ StreamErrorIsSent CompressionError sid msg + E.throwIO $ ConnectionErrorIsSent CompressionError sid msg {-# INLINE checkRequestHeader #-} checkRequestHeader :: ValueTable -> Bool diff --git a/Network/HTTP2/H2/Receiver.hs b/Network/HTTP2/H2/Receiver.hs --- a/Network/HTTP2/H2/Receiver.hs +++ b/Network/HTTP2/H2/Receiver.hs @@ -50,11 +50,12 @@ frameReceiver :: Context -> Config -> IO E.SomeException frameReceiver ctx@Context{receiverDone} conf@Config{..} = E.mask $ \unmask -> do + -- This catches an asynchronous exception. + -- It is re-thrown by "runH2" mErr <- E.try $ unmask switch case mErr of Left err -> do atomically $ writeTVar receiverDone $ Just err - -- err is re-thrown by "runH2" return err Right x -> do absurd x -- We only terminate due to exceptions @@ -99,13 +100,13 @@ | isServer ctx = E.throwIO $ ConnectionErrorIsSent ProtocolError streamId "push promise is not allowed" -processFrame Context{..} Config{..} (ftyp, FrameHeader{payloadLength, streamId}) +processFrame Context{..} conf (ftyp, FrameHeader{payloadLength, streamId}) | ftyp > maxFrameType = do mx <- readIORef continued case mx of Nothing -> do -- ignoring unknown frame - void $ confReadN payloadLength + void $ readPayload conf payloadLength Just _ -> E.throwIO $ ConnectionErrorIsSent ProtocolError streamId "unknown frame" processFrame ctx@Context{..} conf typhdr@(ftyp, header) = do -- My SETTINGS_MAX_FRAME_SIZE @@ -125,20 +126,37 @@ ---------------------------------------------------------------- +-- | Read a frame payload in full. +-- +-- 'confReadN' answers with an empty string at end of input, so a payload that +-- comes back short means the peer hung up in the middle of the frame. Saying +-- so here keeps every decoder below from being handed fewer bytes than the +-- frame header promised it. +readPayload :: Config -> Int -> IO ByteString +readPayload Config{..} len = do + bs <- confReadN len + when (BS.length bs /= len) $ E.throwIO ConnectionIsClosed + return bs + controlOrStream :: Context -> Config -> FrameType -> FrameHeader -> IO () -controlOrStream ctx@Context{..} Config{..} ftyp header@FrameHeader{streamId, payloadLength} +controlOrStream ctx@Context{..} conf ftyp header@FrameHeader{streamId, payloadLength} | isControl streamId = do - bs <- confReadN payloadLength + bs <- readPayload conf payloadLength control ftyp header bs ctx | ftyp == FramePushPromise = do - bs <- confReadN payloadLength - push header bs ctx + bs <- readPayload conf payloadLength + -- A promised stream can be refused over concurrency too, and by the + -- time 'push' gets that far it has decoded the field block, so the + -- same reasoning as 'resettable' applies: reset the promised stream + -- and read on. There is no 'Stream' to close -- it was refused + -- before one was made -- so this resets by identifier alone. + push header bs ctx `E.catch` resetPromised | otherwise = do checkContinued mstrm <- getStream ctx ftyp streamId - bs <- confReadN payloadLength + bs <- readPayload conf payloadLength case mstrm of - Just strm -> do + Just strm -> resettable strm $ do state0 <- readStreamState strm state <- stream ftyp header bs ctx state0 strm resetContinued @@ -149,10 +167,35 @@ -- for h2spec only PriorityFrame newpri <- guardIt $ decodePriorityFrame header bs checkPriority newpri streamId + | ftyp == FrameData -> + -- Dropped, but still paid for. + informIgnoredData ctx streamId payloadLength | otherwise -> return () where setContinued = writeIORef continued $ Just streamId resetContinued = writeIORef continued Nothing + resetPromised (StreamErrorIsSent err sid _msg) = + enqueueControl controlQ $ CFrames Nothing [resetFrame err sid] + resetPromised e = E.throwIO e + -- Answer a stream error by resetting that stream and reading on, which is + -- what RFC 9113 section 5.4.2 asks for: "an error related to a specific + -- stream that does not affect processing of other streams". + -- + -- Safe only here, after the payload has been read and any field block in + -- it decoded, so that the connection sits at a frame boundary and the + -- HPACK tables still agree with the peer's. Where neither holds -- a + -- field block abandoned part-way, a stream refused before its payload was + -- read -- the error is raised as a connection error where it is detected, + -- and travels straight past this handler. + resettable strm act = act `E.catch` reset + where + reset e@(StreamErrorIsSent err sid _msg) = do + resetContinued + -- 'closed' hands the exception to whoever is reading the stream + -- and takes it out of the stream table. + closed ctx strm $ ResetByMe $ E.toException e + enqueueControl controlQ $ CFrames Nothing [resetFrame err sid] + reset e = E.throwIO e checkContinued = do mx <- readIORef continued case mx of @@ -168,6 +211,8 @@ processState :: StreamState -> Context -> Stream -> StreamId -> IO Bool -- Transition (process1) processState (Open _ (NoBody tbl@(_, reqvt))) ctx@Context{..} strm@Stream{streamInput} streamId = do + -- My SETTINGS_MAX_CONCURRENT_STREAMS + when (isServer ctx) $ checkOddConcurrency ctx streamId let mcl = fst <$> (getFieldValue tokenContentLength reqvt >>= C8.readInt) when (just mcl (/= (0 :: Int))) $ E.throwIO $ @@ -187,6 +232,8 @@ -- Transition (process2) processState (Open hcl (HasBody tbl@(_, reqvt))) ctx@Context{..} strm@Stream{streamInput, streamRxQ} _streamId = do + -- My SETTINGS_MAX_CONCURRENT_STREAMS + when (isServer ctx) $ checkOddConcurrency ctx _streamId let mcl = fst <$> (getFieldValue tokenContentLength reqvt >>= C8.readInt) bodyLength <- newIORef 0 tlr <- newIORef Nothing @@ -263,7 +310,14 @@ csid <- getPeerStreamID ctx if streamId <= csid -- consider the stream closed then - if ftyp `elem` [FrameWindowUpdate, FrameRSTStream, FramePriority] + -- RFC 9113 section 5.1: "An endpoint MUST ignore frames that + -- it receives on closed streams after it has sent a + -- RST_STREAM frame." DATA is in that list because resetting a + -- stream mid-body leaves whatever the peer already put on the + -- wire still to arrive. HEADERS is not: that would be reuse + -- of a stream identifier, which section 5.1.1 makes a + -- connection error. + if ftyp `elem` [FrameData, FrameWindowUpdate, FrameRSTStream, FramePriority] then return Nothing -- will be ignored else E.throwIO $ @@ -583,19 +637,32 @@ -- > Either endpoint can send a RST_STREAM frame from this state, causing it -- > to transition immediately to "closed". -- - -- This justifies the two non-error cases, below. (Section 8.1 of the spec + -- This justifies the non-error cases, below. (Section 8.1 of the spec -- is also relevant, but it is less explicit about the /either endpoint/ -- part.) + -- + -- The error code the peer sent does not enter into it. Receiving a + -- RST_STREAM closes that stream and nothing else, whatever the reason + -- given; the code is for whoever is reading the stream, and reaches them + -- as 'StreamResetIsReceived' by way of 'closed' above. Ending the whole + -- connection over it would punish every other stream on the connection + -- for a peer's complaint about one. case s of - Open _ _ - | isNonCritical err -> - -- Open /or/ half-closed (local) - return (Closed cc) - HalfClosedRemote - | isNonCritical err -> - return (Closed cc) - _otherwise -> do - E.throwIO $ StreamErrorIsReceived err streamId + -- Open /or/ half-closed (local) + Open _ _ -> return (Closed cc) + HalfClosedRemote -> return (Closed cc) + Reserved -> return (Closed cc) + Closed _ -> return (Closed cc) + -- Only an idle stream is left, which a PRIORITY frame can have + -- created. Section 5.1 again, on "idle": "Receiving any frame other + -- than HEADERS or PRIORITY on a stream in this state MUST be treated + -- as a connection error (Section 5.4.1) of type PROTOCOL_ERROR." + Idle -> + E.throwIO $ + ConnectionErrorIsSent + ProtocolError + streamId + "rst_stream on an idle stream" -- (No state transition) stream FramePriority header bs _ s Stream{streamNumber} = do -- ignore @@ -624,17 +691,6 @@ E.throwIO $ StreamErrorIsSent ProtocolError streamId $ fromString ("illegal frame " ++ show x ++ " for " ++ show streamId) - -{- FOURMOLU_DISABLE -} --- Although some stream errors indicate misbehaving peers, such as --- FLOW_CONTROL_ERROR, not all errors do. We will close the connection only --- for critical errors. -isNonCritical :: ErrorCode -> Bool -isNonCritical NoError = True -isNonCritical Cancel = True -isNonCritical InternalError = True -isNonCritical _ = False -{- FOURMOLU_ENABLE -} ---------------------------------------------------------------- diff --git a/Network/HTTP2/H2/Sender.hs b/Network/HTTP2/H2/Sender.hs --- a/Network/HTTP2/H2/Sender.hs +++ b/Network/HTTP2/H2/Sender.hs @@ -79,7 +79,8 @@ ctx@Context{outputQ, controlQ, encodeDynamicTable, outputBufferLimit} Config{..} = do labelMe "H2 sender" - -- err is re-thrown by "runH2" + -- This catches an asynchronous exception. + -- It is re-thrown by "runH2" loop 0 `E.catch` return where ---------------------------------------------------------------- @@ -159,16 +160,28 @@ -- Both the stream window and the connection window are open. ---------------------------------------------------------------- outputAndSync :: Output -> Offset -> IO Offset - outputAndSync out@(Output strm otyp sync) off = E.handle (\e -> resetStream strm InternalError e >> return off) $ do + -- "handler" catches an asynchronous exception and + -- re-throws it. + outputAndSync out@(Output strm otyp sync) off = E.handle (handler strm off) $ do state <- readStreamState strm if isHalfClosedLocal state - then case otyp of - OReset mErr | not (isClosed state) -> do - -- RST_STREAM is the only frame we can still send after half-closing - resetStreamWith strm mErr - return off - _otherwise -> - return off + then do + case otyp of + OReset mErr + | not (isClosed state) -> + -- RST_STREAM is the only frame we can still send + -- after half-closing + resetStreamWith strm mErr + _otherwise -> + return () + -- Nothing more can go out on this stream, but whoever + -- enqueued this output is waiting in 'syncWithSender'' to + -- be told so. Dropping the notification parked that + -- thread on an MVar nothing would ever fill, until the + -- timeout manager killed it -- one stranded worker per + -- stream the peer resets while a response is in flight. + sync Nothing + return off else case otyp of OHeader hdr mnext tlrmkr -> do (off', mout') <- outputHeader strm hdr mnext tlrmkr sync off @@ -187,6 +200,10 @@ return off' ---------------------------------------------------------------- + handler strm off e = do + resetStream strm InternalError e + return off + resetStream :: Stream -> ErrorCode -> E.SomeException -> IO () resetStream strm err e | isAsyncException e = E.throwIO e diff --git a/Network/HTTP2/H2/StreamTable.hs b/Network/HTTP2/H2/StreamTable.hs --- a/Network/HTTP2/H2/StreamTable.hs +++ b/Network/HTTP2/H2/StreamTable.hs @@ -78,6 +78,12 @@ let oddTable' = IntMap.insert k v oddTable in OddStreamTable oddConc oddTable' +-- | Remove a stream and give its concurrency slot back. +-- +-- 'closed' can be called more than once for the same stream -- a RST_STREAM +-- carrying a non-critical error code goes through both 'stream' and +-- 'processState', each of which closes it -- so the count must follow an +-- entry that was really there, not the number of calls. deleteOdd :: TVar OddStreamTable -> IntMap.Key -> E.SomeException -> IO () deleteOdd var k err = do mv <- atomically deleteStream @@ -88,10 +94,13 @@ deleteStream :: STM (Maybe Stream) deleteStream = do OddStreamTable{..} <- readTVar var - let oddConc' = oddConc - 1 - oddTable' = IntMap.delete k oddTable - writeTVar var $ OddStreamTable oddConc' oddTable' - return $ IntMap.lookup k oddTable + case IntMap.lookup k oddTable of + Nothing -> return Nothing + Just v -> do + let oddConc' = oddConc - 1 + oddTable' = IntMap.delete k oddTable + writeTVar var $ OddStreamTable oddConc' oddTable' + return $ Just v lookupOdd :: TVar OddStreamTable -> IntMap.Key -> IO (Maybe Stream) lookupOdd var k = IntMap.lookup k . oddTable <$> readTVarIO var @@ -128,6 +137,8 @@ let evenTable' = IntMap.insert k v evenTable in EvenStreamTable evenConc evenTable' evenCache +-- | Remove a stream and give its concurrency slot back. +-- Idempotent, for the same reason as 'deleteOdd'. deleteEven :: TVar EvenStreamTable -> IntMap.Key -> E.SomeException -> IO () deleteEven var k err = do mv <- atomically deleteStream @@ -138,10 +149,13 @@ deleteStream :: STM (Maybe Stream) deleteStream = do EvenStreamTable{..} <- readTVar var - let evenConc' = evenConc - 1 - evenTable' = IntMap.delete k evenTable - writeTVar var $ EvenStreamTable evenConc' evenTable' evenCache - return $ IntMap.lookup k evenTable + case IntMap.lookup k evenTable of + Nothing -> return Nothing + Just v -> do + let evenConc' = evenConc - 1 + evenTable' = IntMap.delete k evenTable + writeTVar var $ EvenStreamTable evenConc' evenTable' evenCache + return $ Just v lookupEven :: TVar EvenStreamTable -> IntMap.Key -> IO (Maybe Stream) lookupEven var k = IntMap.lookup k . evenTable <$> readTVarIO var diff --git a/Network/HTTP2/H2/Types.hs b/Network/HTTP2/H2/Types.hs --- a/Network/HTTP2/H2/Types.hs +++ b/Network/HTTP2/H2/Types.hs @@ -199,8 +199,12 @@ type ReasonPhrase = ShortByteString -- | The connection error or the stream error. --- Stream errors are treated as connection errors since --- there are no good recovery ways. +-- A stream error resets that stream and the connection carries on, as +-- RFC 9113 section 5.4.2 asks. One kind of trouble is a connection error +-- even though the spec calls it a stream error, because this +-- implementation cannot carry on through it: a field block abandoned +-- part-way leaves the HPACK tables disagreeing with the peer's, and +-- nothing sent afterwards would decode. -- `ErrorCode` in connection errors should be the highest stream identifier -- but in this implementation it identifies the stream that -- caused this error. diff --git a/Network/HTTP2/H2/Window.hs b/Network/HTTP2/H2/Window.hs --- a/Network/HTTP2/H2/Window.hs +++ b/Network/HTTP2/H2/Window.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} module Network.HTTP2.H2.Window where @@ -80,6 +81,28 @@ let frame = windowUpdateFrame streamNumber ws cframe = CFrames Nothing [frame] enqueueControl controlQ cframe + +-- | Account for a DATA frame that is being dropped. +-- +-- Its stream is gone -- reset, or closed and forgotten -- so there is no +-- stream window to adjust. The peer charged these octets against the +-- connection window before sending them, though, and if we say nothing its +-- view of that window shrinks for good; enough dropped frames and the +-- connection stalls with both sides believing the other is at fault. So +-- charge them and give them straight back. +informIgnoredData :: Context -> StreamId -> Int -> IO () +informIgnoredData _ _ 0 = return () +informIgnoredData Context{controlQ, rxFlow} sid len = do + ok <- atomicModifyIORef' rxFlow $ checkRxLimit len + unless ok $ + E.throwIO $ + ConnectionErrorIsSent + EnhanceYourCalm + sid + "exceeds connection flow-control limit" + mxc <- atomicModifyIORef rxFlow $ maybeOpenRxWindow len FCTWindowUpdate + forM_ mxc $ \ws -> + enqueueControl controlQ $ CFrames Nothing [windowUpdateFrame 0 ws] -- This must be called after an application is finished -- to adjust RX window. diff --git a/http2.cabal b/http2.cabal --- a/http2.cabal +++ b/http2.cabal @@ -1,6 +1,6 @@ -cabal-version: >=1.10 +cabal-version: 2.0 name: http2 -version: 5.4.4 +version: 5.4.5 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto @@ -140,7 +140,7 @@ http-types, http2, network, - network-run >= 0.5 && <0.6, + network-run >= 0.6 && <0.7, unix-time if flag(devel) @@ -309,7 +309,7 @@ http-types, http2, network, - network-run >= 0.5 && <0.6, + network-run >= 0.6 && <0.7, random, typed-process @@ -328,7 +328,7 @@ hspec >=1.3, http-types, http2, - network-run >= 0.5 && <0.6, + network-run >= 0.6 && <0.7, typed-process if flag(h2spec) diff --git a/test/HPACK/IntegerSpec.hs b/test/HPACK/IntegerSpec.hs --- a/test/HPACK/IntegerSpec.hs +++ b/test/HPACK/IntegerSpec.hs @@ -2,6 +2,8 @@ import qualified Data.ByteString as BS import Data.Maybe (fromMaybe) +import Data.Word (Word8) +import Network.HPACK (DecodeError (..)) import Network.HPACK.Internal import Test.Hspec import Test.Hspec.QuickCheck @@ -14,8 +16,38 @@ x' <- decodeInteger n w ws x `shouldBe` x' +roundtrip7 :: BS.ByteString -> IO Int +roundtrip7 bs = do + let (w, ws) = fromMaybe (error "roundtrip7") $ BS.uncons bs + decodeInteger 7 w ws + +-- | Decode with a 7-bit prefix that is all ones, so that the continuation +-- octets in 'ws' are what decides the value. +decode7 :: [Word8] -> IO Int +decode7 ws = decodeInteger 7 127 (BS.pack ws) + spec :: Spec spec = do + describe "decodeInteger" $ do + it "rejects an encoding that runs past the limit" $ do + r <- encodeInteger 7 integerLimit >>= roundtrip7 + r `shouldBe` integerLimit + ws <- BS.unpack . BS.tail <$> encodeInteger 7 (integerLimit + 1) + decode7 ws `shouldThrow` (== TooLargeInteger) + + it "rejects an encoding in more octets than the limit can take" $ + -- Continuation octets that each add nothing, so only their number + -- is objectionable. + decode7 (replicate 8 0x80 ++ [0x00]) `shouldThrow` (== TooLargeInteger) + + it "rejects an encoding that would wrap around" $ + -- This used to come back as 2, by overflowing 'Int' until it + -- landed there: the same as the single octet 0x82, ":method: GET". + -- Two byte strings decoding alike is exactly what RFC 7541 + -- section 5.1 asks a decoder to refuse. + decode7 [0x83, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x01] + `shouldThrow` (== TooLargeInteger) + describe "encode and decode" $ do prop "duality" $ dual 1 prop "duality" $ dual 2 diff --git a/test/HTTP2/ClientSpec.hs b/test/HTTP2/ClientSpec.hs --- a/test/HTTP2/ClientSpec.hs +++ b/test/HTTP2/ClientSpec.hs @@ -136,7 +136,13 @@ putMVar resultVar result threadDelay 10000 +-- | A malformed request is a stream error (RFC 9113 section 8.1.1), so the +-- server resets that stream and the connection carries on. The client learns +-- of it through the stream it was waiting on, as 'StreamResetIsReceived'. +-- +-- This used to also admit 'ConnectionErrorIsReceived', from back when the +-- server escalated every stream error to the connection and answered one bad +-- request by hanging up on all of them. streamError :: Selector HTTP2Error -streamError StreamErrorIsReceived{} = True -streamError ConnectionErrorIsReceived{} = True +streamError StreamResetIsReceived{} = True streamError _ = False diff --git a/test/HTTP2/FrameSpec.hs b/test/HTTP2/FrameSpec.hs --- a/test/HTTP2/FrameSpec.hs +++ b/test/HTTP2/FrameSpec.hs @@ -4,12 +4,67 @@ import Test.Hspec +import qualified Data.ByteString as BS import Data.ByteString.Char8 () import Data.Either import Network.HTTP2.Frame +-- | The error a decoder reports, or Nothing when it accepted the payload. +decodeError :: FrameType -> FrameHeader -> BS.ByteString -> Maybe ErrorCode +decodeError typ header body = case decodeFramePayload typ header body of + Left (FrameDecodeError ec _ _) -> Just ec + Right _ -> Nothing + spec :: Spec spec = do + describe "decodeFramePayload" $ do + -- Each of these used to reach a peek at a fixed offset that never + -- consulted the length of the ByteString it was reading from. An + -- empty one is the shared empty ByteString, whose pointer is null, so + -- the result was a segfault rather than an exception -- which is why + -- none of this could be written as a failing assertion before. + it "rejects a padded frame with no room for Pad Length" $ do + let padded = FrameHeader 0 (setPadded defaultFlags) 1 + decodeError FrameData padded "" `shouldBe` Just FrameSizeError + decodeError FramePushPromise padded "" `shouldBe` Just FrameSizeError + + it "rejects a padded HEADERS whose padding covers the priority fields" $ do + -- Six octets is the smallest payload the header check accepts for + -- PADDED and PRIORITY together, and a Pad Length of five leaves + -- none of the five priority octets behind. + let flags = setPadded $ setPriority defaultFlags + header = FrameHeader 6 flags 1 + decodeError FrameHeaders header (BS.pack [5, 0, 0, 0, 0, 0]) + `shouldBe` Just FrameSizeError + + it "rejects a padded PUSH_PROMISE whose padding covers the promised id" $ do + let flags = setPadded defaultFlags + header = FrameHeader 5 flags 1 + decodeError FramePushPromise header (BS.pack [4, 0, 0, 0, 0]) + `shouldBe` Just FrameSizeError + + it "rejects a payload shorter than the frame header promised" $ do + -- What a peer that hangs up mid-frame leaves behind. + decodeError FramePriority (FrameHeader 5 defaultFlags 1) "" + `shouldBe` Just FrameSizeError + decodeError FrameRSTStream (FrameHeader 4 defaultFlags 1) "" + `shouldBe` Just FrameSizeError + decodeError FrameWindowUpdate (FrameHeader 4 defaultFlags 1) "" + `shouldBe` Just FrameSizeError + decodeError FrameSettings (FrameHeader 6 defaultFlags 0) "" + `shouldBe` Just FrameSizeError + + it "rejects a payload too short for the fields it holds" $ do + -- A payloadLength of zero satisfies checkFrameSize against an + -- empty payload, but each of these still has a fixed-size field + -- to read. GOAWAY was a segfault; the other three quietly + -- returned whatever lay past the end of the buffer. + let lying = FrameHeader 0 defaultFlags 1 + decodeError FrameRSTStream lying "" `shouldBe` Just FrameSizeError + decodeError FrameWindowUpdate lying "" `shouldBe` Just FrameSizeError + decodeError FramePriority lying "" `shouldBe` Just FrameSizeError + decodeError FrameGoAway lying "" `shouldBe` Just FrameSizeError + describe "encodeFrameHeader & decodeFrameHeader" $ do it "encode/decodes frames properly" $ do let header = diff --git a/test/HTTP2/ServerSpec.hs b/test/HTTP2/ServerSpec.hs --- a/test/HTTP2/ServerSpec.hs +++ b/test/HTTP2/ServerSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} @@ -24,6 +25,7 @@ import System.IO import System.IO.Unsafe import System.Random +import System.Timeout (timeout) import Test.Hspec import Network.HPACK @@ -69,6 +71,47 @@ preface <- takeMVar prefaceVar preface `shouldBe` connectionPreface + it "refuses one stream over the limit and keeps the connection" $ + E.bracket (forkIO runServerMaxConc1) killThread $ \_ -> do + threadDelay 10000 + -- The server announced room for one concurrent stream. Open + -- one, reset it, then open two more: the second of those is + -- the one over the limit. + -- + -- Two things are on trial. That the reset gives the slot back + -- exactly once -- decrementing the count twice, as it used to, + -- would leave room for both. And that being over the limit + -- costs you that stream and not the connection: no GOAWAY. + frames <- + rawExchange + [ openStreamFrame 1 + , encodeFrame (EncodeInfo defaultFlags 1 Nothing) $ + RSTStreamFrame Cancel + , openStreamFrame 3 + , openStreamFrame 5 + ] + [(sid, ec) | (FrameRSTStream, sid, ec) <- resets frames] + `shouldBe` [(5, RefusedStream)] + [() | (FrameGoAway, _, _) <- resets frames] `shouldBe` [] + + it "releases a worker whose stream the peer reset" $ do + doneVar <- newEmptyMVar + E.bracket (forkIO (runServerCancel doneVar)) killThread $ \_ -> do + threadDelay 10000 + runAttack cancelInFlight + timeout 1000000 (takeMVar doneVar) `shouldReturn` Just () + + it "survives a padded HEADERS whose padding covers the priority fields" $ + E.bracket (forkIO runServer) killThread $ \_ -> do + threadDelay 10000 + runAttack paddingOverPriority + `shouldThrow` connectionError "no room for priority fields" + + it "resets one stream and goes on serving the connection" $ + E.bracket (forkIO runServer) killThread $ \_ -> do + threadDelay 10000 + runStreamErrorClient + it "prevents attacks" $ E.bracket (forkIO runServer) killThread $ \_ -> do threadDelay 10000 @@ -91,6 +134,35 @@ freeSimpleConfig (\conf -> run defaultServerConfig conf server) +-- | Like 'runServer', but announcing room for a single concurrent stream. +runServerMaxConc1 :: IO () +runServerMaxConc1 = runTCPServer (Just host) port runHTTP2Server + where + sconf = + defaultServerConfig + { settings = (settings defaultServerConfig){maxConcurrentStreams = Just 1} + } + runHTTP2Server s = + E.bracket + (allocSimpleConfig s 32768) + freeSimpleConfig + (\conf -> run sconf conf server) + +-- | A server whose handler waits long enough for a RST_STREAM to arrive +-- before it responds, and then signals that 'sendResponse' returned. +runServerCancel :: MVar () -> IO () +runServerCancel doneVar = runTCPServer (Just host) port runHTTP2Server + where + runHTTP2Server s = + E.bracket + (allocSimpleConfig s 32768) + freeSimpleConfig + (\conf -> run defaultServerConfig conf cancelServer) + cancelServer _req _aux sendResponse = do + threadDelay 200000 + sendResponse responseHello [] + putMVar doneVar () + runFakeServer :: MVar ByteString -> IO () runFakeServer prefaceVar = do runTCPServer (Just host) port $ \s -> do @@ -453,6 +525,140 @@ -- Otherwise, a stream error terminates the connection. bsR = encodeFrame einfoR $ RSTStreamFrame NoError cioWriteBytes bsR + +-- | Open a stream, reset it, then open two more. The server announced room +-- for one concurrent stream, so the third one here must be refused. +-- +-- Closing a stream used to give its slot back twice -- a RST_STREAM carrying a +-- non-critical error code is closed by both 'stream' and 'processState' -- so +-- the count drifted down by one on every reset and this sequence went through +-- unchallenged. +-- | A HEADERS frame opening a stream and leaving it open, so that it goes on +-- holding a concurrency slot. +-- +-- Stream identifiers are written out rather than taken from +-- 'C.cioCreateStream': the limit being overrun is the one the server +-- announced, and asking for a stream the proper way would block on that same +-- limit on this side. +openStreamFrame :: StreamId -> ByteString +openStreamFrame sid = encodeFrame einfo $ HeadersFrame Nothing hdr + where + einfo = EncodeInfo (setEndHeader defaultFlags) sid Nothing + hdr = + hpackEncode + [ (":scheme", "http") + , (":authority", "127.0.0.1") + , (":path", "/") + , (":method", "GET") + ] + +-- | Speak raw frames to the server and collect what it says back. +rawExchange :: [ByteString] -> IO [(FrameType, StreamId, ByteString)] +rawExchange out = runTCPClient host port $ \s -> do + sendAll s connectionPreface + sendAll s $ encodeFrame (EncodeInfo defaultFlags 0 Nothing) $ SettingsFrame [] + mapM_ (sendAll s) out + splitFrames <$> collect mempty s + where + collect acc s = do + mbs <- timeout 300000 $ recv s 4096 + case mbs of + Just bs | not (B.null bs) -> collect (acc `B.append` bs) s + _ -> return acc + +splitFrames :: ByteString -> [(FrameType, StreamId, ByteString)] +splitFrames bs + | B.length bs < frameHeaderLength = [] + | otherwise = + let (h, rest) = B.splitAt frameHeaderLength bs + (typ, FrameHeader{payloadLength, streamId}) = decodeFrameHeader h + (body, rest') = B.splitAt payloadLength rest + in (typ, streamId, body) : splitFrames rest' + +-- | The RST_STREAM and GOAWAY frames among them, with their error codes. +resets + :: [(FrameType, StreamId, ByteString)] -> [(FrameType, StreamId, ErrorCode)] +resets frames = + [ (typ, sid, ec) + | (typ, sid, body) <- frames + , typ == FrameRSTStream || typ == FrameGoAway + , Just ec <- [errorCodeOf typ sid body] + ] + where + errorCodeOf FrameRSTStream sid body = + case decodeRSTStreamFrame (FrameHeader (B.length body) defaultFlags sid) body of + Right (RSTStreamFrame ec) -> Just ec + _ -> Nothing + errorCodeOf FrameGoAway sid body = + case decodeGoAwayFrame (FrameHeader (B.length body) defaultFlags sid) body of + Right (GoAwayFrame _ ec _) -> Just ec + _ -> Nothing + errorCodeOf _ _ _ = Nothing + +-- | Open a stream and cancel it straight away, while the server is still +-- working on the response. +-- +-- The sender skips a stream that is already half-closed, and used to return +-- without telling the thread that enqueued the output. That thread sat in +-- 'syncWithSender'' on an MVar nothing would fill, so 'sendResponse' never +-- returned and the worker was only reclaimed when the timeout manager killed +-- it, seconds later. +cancelInFlight :: C.ClientIO -> IO () +cancelInFlight C.ClientIO{..} = do + -- setEndStream for HalfClosedRemote, so that CANCEL is accepted as a + -- stream error rather than taken down the connection. + let einfoH = EncodeInfo (setEndStream $ setEndHeader defaultFlags) 1 Nothing + hdr = + hpackEncode + [ (":scheme", "http") + , (":authority", "127.0.0.1") + , (":path", "/") + , (":method", "GET") + ] + cioWriteBytes $ encodeFrame einfoH $ HeadersFrame Nothing hdr + cioWriteBytes $ + encodeFrame (EncodeInfo defaultFlags 1 Nothing) $ + RSTStreamFrame Cancel + +-- | Send a malformed request, then a good one down the same connection. +-- +-- RFC 9113 section 8.1.1 makes a malformed request a stream error, so the +-- server must reset that one stream and keep serving: the second request is +-- the point of the test. The whole connection used to come down with the +-- first, taking every other stream on it along. +runStreamErrorClient :: IO () +runStreamErrorClient = runTCPClient host port $ \s -> + E.bracket (allocSimpleConfig s 4096) freeSimpleConfig $ \conf -> + C.run cliconf conf $ \sendRequest _aux -> do + -- "te" may only ever be "trailers" (section 8.2.2), and unlike + -- "connection" it is not one of the headers the sender strips. + let bad = C.requestNoBody methodGet "/" [("te", "gzip")] + sendRequest bad (\_ -> return ()) `shouldThrow` streamWasReset + let good = C.requestNoBody methodGet "/" [] + sendRequest good $ \rsp -> + C.responseStatus rsp `shouldBe` Just ok200 + where + cliconf = C.defaultClientConfig{C.authority = host} + +streamWasReset :: Selector C.HTTP2Error +streamWasReset C.StreamResetIsReceived{} = True +streamWasReset _ = False + +-- | A HEADERS frame with PADDED and PRIORITY set, six octets of payload and a +-- Pad Length of five, so that the padding covers the whole of the priority +-- fields the flag promises. +-- +-- Six octets is the smallest payload the frame header check accepts for those +-- two flags together, so this gets through it; the decoder then took the five +-- priority octets out of what padding had left empty, reading off the end of +-- the buffer. The empty ByteString is the shared one, whose pointer is null, +-- so what died was the process rather than the connection. +paddingOverPriority :: C.ClientIO -> IO () +paddingOverPriority C.ClientIO{..} = do + let flags = setPadded $ setPriority $ setEndHeader defaultFlags + header = encodeFrameHeader FrameHeaders $ FrameHeader 6 flags 1 + payload = B.pack [5, 0, 0, 0, 0, 0] -- Pad Length 5, then the padding + cioWriteBytes $ header `B.append` payload connectionError :: C.ReasonPhrase -> C.HTTP2Error -> Bool connectionError phrase (C.ConnectionErrorIsReceived _ _ p)