diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,22 @@ # Revision history for http3 +## 0.1.5 + +* Security fixes. Requiring http2 v5.4.5, whose HPACK integer decoder is + bounded; QPACK decodes its integers with it. +* Refusing a QPACK index that names nothing, at both ends of both tables. +* Putting a ceiling on the frame payload we will hold. +* Sizing the Huffman scratch buffer to what it has to hold. +* Reading a unidirectional stream type as the variable-length integer it is. +* Not handing the application a request we have already rejected. +* Checking a message against the content-length it declared. +* Reading the whole SETTINGS frame, noticing a repeated identifier, and + refusing one that stops mid-parameter. +* Giving the application the peer's address, not our own. +* This is a patch release, but `Network.HTTP3.Internal` and + `Network.QPACK.Internal` changed: `parseH3Frame` takes the payload limit, + `IFrame` has `ITooLong`, and `DecodeError` has `IllegalDynamicIndex`. + ## 0.1.4 * adding ecUseHuffman to defaultQEncoderConfig diff --git a/Network/HTTP3/Client.hs b/Network/HTTP3/Client.hs --- a/Network/HTTP3/Client.hs +++ b/Network/HTTP3/Client.hs @@ -48,7 +48,6 @@ import Network.HTTP3.Config import Network.HTTP3.Context import Network.HTTP3.Error -import Network.HTTP3.Frame import Network.HTTP3.Recv import Network.HTTP3.Send import Network.QPACK @@ -112,11 +111,9 @@ threadDelay 100000 -- just for type inference E.throwIO $ QUIC.ApplicationProtocolErrorIsSent H3MessageError "" - Just vt -> do - refI <- newIORef IInit - refH <- newIORef Nothing - let readB = recvBody ctx sid src refI refH - rsp = Response $ InpObj vt Nothing readB refH + Just vt@(_, valtbl) -> do + (readB, refH) <- newBodyReader ctx sid src valtbl + let rsp = Response $ InpObj vt Nothing readB refH processResponse rsp where hdr = outObjHeaders outobj diff --git a/Network/HTTP3/Context.hs b/Network/HTTP3/Context.hs --- a/Network/HTTP3/Context.hs +++ b/Network/HTTP3/Context.hs @@ -19,6 +19,7 @@ Hooks (..), -- re-export getMySockAddr, getPeerSockAddr, + getMaxFieldSectionSize, forkManaged, forkManagedTimeout, forkManagedTimeoutFinally, @@ -27,7 +28,6 @@ import qualified Control.Exception as E import Control.Monad (void) -import qualified Data.ByteString as BS import Data.IORef import Network.HTTP.Semantics.Client import Network.QUIC @@ -52,6 +52,9 @@ , ctxHooks :: Hooks , ctxMySockAddr :: SockAddr , ctxPeerSockAddr :: SockAddr + , ctxMaxFieldSectionSize :: Int + -- ^ What we told the peer we would accept, and so the most of any one + -- frame we are willing to hold in memory while it arrives. } withContext :: Connection -> Config -> (Context -> IO a) -> IO a @@ -65,7 +68,8 @@ (ctxQEncoder, handleDI, dyntblE) <- newQEncoder (confQEncoderConfig conf) sendEI -- newQDecoder passes dyntbl for decoder to handleEI internally (ctxQDecoder, handleEI) <- newQDecoder (confQDecoderConfig conf) sendDI - ctl <- controlStream conn dyntblE <$> newIORef IInit + let ctxMaxFieldSectionSize = dcMaxFieldSectionSize $ confQDecoderConfig conf + ctl <- controlStream conn ctxMaxFieldSectionSize dyntblE <$> newIORef IInit info <- getConnectionInfo conn let handleDI' recv = handleDI recv `E.catch` abortWith QpackDecoderStreamError handleEI' recv = handleEI recv `E.catch` abortWith QpackEncoderStreamError @@ -119,9 +123,17 @@ unidirectional :: Context -> Stream -> IO () unidirectional Context{..} strm = do - w8 : _ <- BS.unpack <$> recvStream strm 1 -- fixme: variable length - let typ = toH3StreamType $ fromIntegral w8 - ctxUniSwitch typ (recvStream strm) + -- The type is a variable-length integer (RFC 9114, section 6.2), so one, + -- two, four or eight octets -- not the single one it used to be read as, + -- which cut anything from 0x40 up in half and handed the tail of the type + -- to a handler as though it were the stream's contents. + mtyp <- recvQInt (recvStream strm) + case mtyp of + -- The peer opened a unidirectional stream and closed it without + -- saying what it was for. Nothing to dispatch to; this used to be a + -- pattern match failure. + Nothing -> return () + Just i -> ctxUniSwitch (toH3StreamType i) (recvStream strm) withHandle :: Context -> (T.Handle -> IO ()) -> IO () withHandle Context{..} action = void $ T.withHandle ctxThreadManager (return ()) action @@ -154,4 +166,7 @@ getMySockAddr = ctxMySockAddr getPeerSockAddr :: Context -> SockAddr -getPeerSockAddr = ctxMySockAddr +getPeerSockAddr = ctxPeerSockAddr + +getMaxFieldSectionSize :: Context -> Int +getMaxFieldSectionSize = ctxMaxFieldSectionSize diff --git a/Network/HTTP3/Control.hs b/Network/HTTP3/Control.hs --- a/Network/HTTP3/Control.hs +++ b/Network/HTTP3/Control.hs @@ -8,6 +8,8 @@ import qualified Data.ByteString as BS import Data.IORef +import Data.IntSet (IntSet) +import qualified Data.IntSet as IntSet import Network.QUIC import Imports @@ -54,8 +56,8 @@ -- DynamicTable for Encoder controlStream - :: Connection -> TableOperation -> IORef IFrame -> InstructionHandler -controlStream conn tblop ref recv = loop0 + :: Connection -> Int -> TableOperation -> IORef IFrame -> InstructionHandler +controlStream conn lim tblop ref recv = loop0 where loop0 = do bs <- recv 1024 @@ -73,7 +75,17 @@ readIORef ref >>= parse bs >>= writeIORef ref loop parse0 bs st0 = do - case parseH3Frame st0 bs of + case parseH3Frame lim st0 bs of + st1' + -- DATA is the one frame the cap does not cover, and it has no + -- business on a control stream, so refuse it before any of it + -- is buffered rather than after. + | Just H3FrameData <- frameTypeOf st1' -> do + abortConnection conn H3FrameUnexpected "" + return (False, IInit) + ITooLong _ _ -> do + abortConnection conn H3ExcessiveLoad "" + return (False, IInit) IDone typ payload leftover -> do case typ of H3FrameSettings -> checkSettings conn tblop payload @@ -83,7 +95,14 @@ st1 -> return (False, st1) parse bs st0 = do - case parseH3Frame st0 bs of + case parseH3Frame lim st0 bs of + st1' + | Just H3FrameData <- frameTypeOf st1' -> do + abortConnection conn H3FrameUnexpected "" + return IInit + ITooLong _ _ -> do + abortConnection conn H3ExcessiveLoad "" + return IInit IDone typ _payload leftover -> do case typ of H3FrameCancelPush -> return () @@ -98,18 +117,28 @@ checkSettings :: Connection -> TableOperation -> ByteString -> IO () checkSettings conn tblop payload = do - h3settings <- decodeH3Settings payload - loop (0 :: Int) h3settings + mh3settings <- decodeH3Settings payload + case mh3settings of + -- RFC 9114 section 7.1: a payload that "terminates before the end of + -- the identified fields MUST be treated as a connection error of type + -- H3_FRAME_ERROR". + Nothing -> abortConnection conn H3FrameError "" + Just h3settings -> loop IntSet.empty h3settings where + loop :: IntSet -> H3Settings -> IO () loop _ [] = return () - loop flags ((k@(H3SettingsKey i), v) : ss) - | flags `testBit` i = abortConnection conn H3SettingsError "" + loop seen ((k@(H3SettingsKey i), v) : ss) + -- RFC 9114 section 7.2.4.1 lets a receiver refuse a repeated setting + -- identifier, and this does. A set rather than bits in an Int: + -- identifiers are variable-length integers, so everything from 64 up + -- fell off the end of the word and could repeat unnoticed. + | i `IntSet.member` seen = abortConnection conn H3SettingsError "" | otherwise = do - let flags' = flags `setBit` i + let seen' = IntSet.insert i seen case k of SettingsQpackMaxTableCapacity -> do setCapacity tblop v - loop flags' ss + loop seen' ss -- This value is not used yet. -- RFC 9114: "A server that receives a larger field -- section than it is willing to handle can send an @@ -117,11 +146,15 @@ -- code ([RFC6585])." SettingsMaxFieldSectionSize -> do setHeaderSize tblop v - loop flags' ss + loop seen' ss SettingsQpackBlockedStreams -> do setBlockedStreams tblop v - loop flags' ss + loop seen' ss _ -- HTTP/2 settings | i <= 0x6 -> abortConnection conn H3SettingsError "" - | otherwise -> return () + -- Unknown, so ignored -- but the rest of the frame is + -- not. This used to stop here, which meant a peer + -- following section 7.2.4.1's advice to send a reserved + -- identifier had every setting after it dropped. + | otherwise -> loop seen' ss diff --git a/Network/HTTP3/Error.hs b/Network/HTTP3/Error.hs --- a/Network/HTTP3/Error.hs +++ b/Network/HTTP3/Error.hs @@ -1,6 +1,7 @@ {-# LANGUAGE PatternSynonyms #-} module Network.HTTP3.Error ( + ContentLengthMismatch (..), ApplicationProtocolError ( H3NoError, H3GeneralProtocolError, @@ -22,7 +23,23 @@ ), ) where +import qualified Control.Exception as E import Network.QUIC + +-- | A message whose content does not match the content-length it declared. +-- +-- RFC 9114 section 4.1.2 makes such a message malformed. The body reader +-- raises this rather than resetting anything itself: it has no stream to hand, +-- and the handler that wraps the application turns it into the +-- H3_MESSAGE_ERROR reset the spec asks for -- which also stops the application +-- working on a message the receiver has already rejected. +data ContentLengthMismatch = ContentLengthMismatch + { declaredLength :: Int + , actualLength :: Int + } + deriving (Eq, Show) + +instance E.Exception ContentLengthMismatch {- FOURMOLU_DISABLE -} pattern H3NoError :: ApplicationProtocolError diff --git a/Network/HTTP3/Frame.hs b/Network/HTTP3/Frame.hs --- a/Network/HTTP3/Frame.hs +++ b/Network/HTTP3/Frame.hs @@ -11,8 +11,10 @@ decodeH3Frame, IFrame (..), parseH3Frame, + frameTypeOf, QInt (..), parseQInt, + recvQInt, permittedInControlStream, permittedInRequestStream, permittedInPushStream, @@ -161,6 +163,26 @@ toLen :: Word8 -> ByteString -> Int64 toLen w0 bs = BS.foldl (\n w -> n * 256 + fromIntegral w) (fromIntegral w0) bs +-- | Read one variable-length integer from a byte source. +-- +-- The source is asked for a byte at a time and answers with an empty string at +-- end of input, which is 'recvStream'\'s contract. 'Nothing' means the input +-- ended before a whole integer arrived. +-- +-- A unidirectional stream announces its type this way (RFC 9114, section 6.2), +-- which is one, two, four or eight octets -- not the single one it is tempting +-- to read. +recvQInt :: (Int -> IO ByteString) -> IO (Maybe Int64) +recvQInt recv = loop QInit + where + loop st = do + bs <- recv 1 + if BS.null bs + then return Nothing + else case parseQInt st bs of + QDone i _ -> return $ Just i + st' -> loop st' + data IFrame = -- | Parsing is about to start IInit @@ -179,28 +201,51 @@ H3FrameType ByteString -- Payload (entire or sentinel) ByteString -- Leftover + | -- | The frame says it is longer than we are willing to hold + ITooLong + H3FrameType + Int -- The length it claimed deriving (Eq, Show) -parseH3Frame :: IFrame -> ByteString -> IFrame -parseH3Frame st "" = st -parseH3Frame IInit bs = case parseQInt QInit bs of +-- | The frame type, once the parse has got far enough to know it. +frameTypeOf :: IFrame -> Maybe H3FrameType +frameTypeOf IInit = Nothing +frameTypeOf (IType _) = Nothing +frameTypeOf (ILen typ _) = Just typ +frameTypeOf (IPay typ _ _ _) = Just typ +frameTypeOf (IDone typ _ _) = Just typ +frameTypeOf (ITooLong typ _) = Just typ + +-- | Feed bytes to a frame parse. +-- +-- The first argument caps the payload of any frame that has to be held whole +-- before it can be used -- everything but DATA, whose payload is handed to the +-- caller as it arrives. A length is a variable-length integer, so without a +-- cap a peer can announce up to 2^62-1 octets and have us buffer whatever it +-- then sends towards that. DATA is exempt because a large body is a perfectly +-- ordinary thing to send; a caller that does /not/ drain DATA must refuse it +-- on sight instead. +parseH3Frame :: Int -> IFrame -> ByteString -> IFrame +parseH3Frame _ st "" = st +parseH3Frame lim IInit bs = case parseQInt QInit bs of QDone i bs' -> let typ = toH3FrameType i - in parseH3Frame (ILen typ QInit) bs' + in parseH3Frame lim (ILen typ QInit) bs' ist -> IType ist -parseH3Frame (IType ist) bs = case parseQInt ist bs of +parseH3Frame lim (IType ist) bs = case parseQInt ist bs of QDone i bs' -> let typ = toH3FrameType i - in parseH3Frame (ILen typ QInit) bs' + in parseH3Frame lim (ILen typ QInit) bs' ist' -> IType ist' -parseH3Frame (ILen typ ist) bs = case parseQInt ist bs of - QDone i bs' -> - let reqLen = fromIntegral i - in if reqLen == 0 - then IDone typ "" bs' - else parseH3Frame (IPay typ reqLen 0 []) bs' +parseH3Frame lim (ILen typ ist) bs = case parseQInt ist bs of + QDone i bs' + | reqLen == 0 -> IDone typ "" bs' + | typ /= H3FrameData && reqLen > lim -> ITooLong typ reqLen + | otherwise -> parseH3Frame lim (IPay typ reqLen 0 []) bs' + where + reqLen = fromIntegral i ist' -> ILen typ ist' -parseH3Frame (IPay typ reqLen len0 bss0) bs0 = case len1 `compare` reqLen of +parseH3Frame _ (IPay typ reqLen len0 bss0) bs0 = case len1 `compare` reqLen of LT -> IPay typ reqLen len1 (bs0 : bss0) EQ -> IDone typ (compose bs0 bss0) "" GT -> @@ -208,7 +253,7 @@ in IDone typ (compose bs2 bss0) leftover where len1 = len0 + BS.length bs0 -parseH3Frame st _ = st +parseH3Frame _ st _ = st compose :: ByteString -> [ByteString] -> ByteString compose bs bss = BS.concat $ reverse (bs : bss) diff --git a/Network/HTTP3/Recv.hs b/Network/HTTP3/Recv.hs --- a/Network/HTTP3/Recv.hs +++ b/Network/HTTP3/Recv.hs @@ -7,10 +7,12 @@ readSource, readSource', recvHeader, - recvBody, + newBodyReader, ) where +import qualified Control.Exception as E import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 import Data.IORef import Network.QUIC @@ -48,18 +50,27 @@ recvHeader :: Context -> StreamId -> Source -> IO (Maybe TokenHeaderTable) recvHeader ctx sid src = loop IInit where + lim = getMaxFieldSectionSize ctx loop st = do bs <- readSource src if bs == "" then return Nothing - else case parseH3Frame st bs of + else case parseH3Frame lim st bs of + ITooLong _ _ -> do + abort ctx H3ExcessiveLoad + loop IInit -- dummy + st0 + -- Nothing here drains DATA, so it is not covered by the + -- length cap; and it is not allowed before HEADERS + -- anyway. Refuse it as soon as the type is known, rather + -- than after buffering whatever length it claimed. + | Just H3FrameData <- frameTypeOf st0 -> do + abort ctx H3FrameUnexpected + loop IInit -- dummy IDone typ payload leftover | typ == H3FrameHeaders -> do pushbackSource src leftover Just <$> qpackDecode ctx sid payload - | typ == H3FrameData -> do - abort ctx H3FrameUnexpected - loop IInit -- dummy | permittedInRequestStream typ -> do pushbackSource src leftover loop IInit @@ -68,41 +79,76 @@ loop IInit -- dummy st' -> loop st' +-- | A body reader for one message, and the place its trailers will appear. +-- +-- The reader counts what it hands out and checks the total against +-- content-length when the body ends, since a message whose content does not +-- match what it declared is malformed (RFC 9114, section 4.1.2). +-- +-- Only what is actually read is counted, so a body the application never asks +-- for is never checked. Answering that would mean draining it on the +-- application's behalf, which is a different design from the one here. +newBodyReader + :: Context + -> StreamId + -> Source + -> ValueTable + -> IO (IO (ByteString, Bool), IORef (Maybe TokenHeaderTable)) +newBodyReader ctx sid src vt = do + refI <- newIORef IInit + refH <- newIORef Nothing + refL <- newIORef 0 + let mcl = fst <$> (getFieldValue tokenContentLength vt >>= C8.readInt) + return (recvBody ctx sid src refI refH mcl refL, refH) + recvBody :: Context -> StreamId -> Source -> IORef IFrame -> IORef (Maybe TokenHeaderTable) + -> Maybe Int + -> IORef Int -> IO (ByteString, Bool) -recvBody ctx sid src refI refH = do +recvBody ctx sid src refI refH mcl refL = do st <- readIORef refI loop st where + lim = getMaxFieldSectionSize ctx + endOfBody = do + forM_ mcl $ \cl -> do + len <- readIORef refL + when (cl /= len) $ E.throwIO $ ContentLengthMismatch cl len + return ("", True) + chunk bs = do + modifyIORef' refL (+ BS.length bs) + return (bs, False) loop st = do bs <- readSource src if bs == "" - then return ("", True) - else case parseH3Frame st bs of + then endOfBody + else case parseH3Frame lim st bs of + ITooLong _ _ -> do + abort ctx H3ExcessiveLoad + return ("", True) -- dummy IPay H3FrameData siz received bss -> do let st' = IPay H3FrameData siz received [] if null bss then loop st' else do writeIORef refI st' - let ret = BS.concat $ reverse bss - return (ret, False) + chunk $ BS.concat $ reverse bss IDone typ payload leftover | typ == H3FrameHeaders -> do writeIORef refI IInit -- pushbackSource src leftover -- fixme hdr <- qpackDecode ctx sid payload writeIORef refH $ Just hdr - return ("", True) + endOfBody | typ == H3FrameData -> do writeIORef refI IInit pushbackSource src leftover - return (payload, False) + chunk payload | permittedInRequestStream typ -> do pushbackSource src leftover loop IInit diff --git a/Network/HTTP3/Server.hs b/Network/HTTP3/Server.hs --- a/Network/HTTP3/Server.hs +++ b/Network/HTTP3/Server.hs @@ -109,14 +109,18 @@ case mvt of Nothing -> QUIC.resetStream strm H3MessageError Just ht -> do - req <- mkRequest ctx strm src ht - let aux = - defaultAux - { auxTimeHandle = th - , auxMySockAddr = getMySockAddr ctx - , auxPeerSockAddr = getPeerSockAddr ctx - } - server req aux $ sendResponse ctx strm th + mreq <- mkRequest ctx strm src ht + case mreq of + -- Malformed; 'mkRequest' has reset the stream. + Nothing -> return () + Just req -> do + let aux = + defaultAux + { auxTimeHandle = th + , auxMySockAddr = getMySockAddr ctx + , auxPeerSockAddr = getPeerSockAddr ctx + } + server req aux $ sendResponse ctx strm th where sid = QUIC.streamId strm reset se @@ -132,8 +136,10 @@ case mvt of Nothing -> QUIC.resetStream strm H3MessageError Just ht -> do - req <- mkRequest ctx strm src ht - put (strm, req) + mreq <- mkRequest ctx strm src ht + case mreq of + Nothing -> return () + Just req -> put (strm, req) where sid = QUIC.streamId strm reset se @@ -142,28 +148,37 @@ abort ctx QpackDecompressionFailed | otherwise = QUIC.resetStream strm H3MessageError +-- | Build the 'Request', or reset the stream and answer 'Nothing' when the +-- message is malformed. +-- +-- RFC 9114 section 4.1.2 makes a malformed request one the server "MUST treat +-- \[...\] as malformed", responding or resetting -- either way it is not a +-- request to serve. The stream was being reset and then the request handed to +-- the application regardless, so a message the server had already rejected +-- still reached whatever was running behind it, on a stream it could no +-- longer answer on. mkRequest :: Context -> Stream -> Source -> (TokenHeaderList, ValueTable) - -> IO Request + -> IO (Maybe Request) mkRequest ctx strm src ht@(_, vt) = do let mMethod = getFieldValue tokenMethod vt mScheme = getFieldValue tokenScheme vt mAuthority = getFieldValue tokenAuthority vt mPath = getFieldValue tokenPath vt case (mMethod, mScheme, mAuthority, mPath) of - (Just "CONNECT", _, Just _, _) -> return () - (Just _, Just _, Just _, Just _) -> return () - _ -> QUIC.resetStream strm H3MessageError - -- fixme: Content-Length - refI <- newIORef IInit - refH <- newIORef Nothing - let sid = QUIC.streamId strm - let readB = recvBody ctx sid src refI refH - req = Request $ InpObj ht Nothing readB refH - return req + (Just "CONNECT", _, Just _, _) -> Just <$> build + (Just _, Just _, Just _, Just _) -> Just <$> build + _ -> do + QUIC.resetStream strm H3MessageError + return Nothing + where + build = do + let sid = QUIC.streamId strm + (readB, refH) <- newBodyReader ctx sid src vt + return $ Request $ InpObj ht Nothing readB refH sendResponse :: Context -> Stream -> T.Handle -> Response -> [PushPromise] -> IO () diff --git a/Network/HTTP3/Settings.hs b/Network/HTTP3/Settings.hs --- a/Network/HTTP3/Settings.hs +++ b/Network/HTTP3/Settings.hs @@ -2,6 +2,7 @@ module Network.HTTP3.Settings where +import qualified Control.Exception as E import Network.ByteOrder import Network.QUIC.Internal @@ -36,8 +37,18 @@ encodeInt' wbuf $ fromIntegral k encodeInt' wbuf $ fromIntegral v -decodeH3Settings :: ByteString -> IO H3Settings -decodeH3Settings bs = withReadBuffer bs $ \rbuf -> loop rbuf id +-- | Decode a SETTINGS payload, or 'Nothing' if it stops in the middle of a +-- parameter. +-- +-- Each parameter is two variable-length integers, and the loop can only tell +-- there is /something/ left, not whether there is a whole pair. Reading off +-- the end raises 'BufferOverrun', which no HTTP\/3 handler knows what to do +-- with; caught here it becomes an answer the caller can turn into the +-- H3_FRAME_ERROR that RFC 9114 section 7.1 asks for. +decodeH3Settings :: ByteString -> IO (Maybe H3Settings) +decodeH3Settings bs = + (withReadBuffer bs $ \rbuf -> Just <$> loop rbuf id) + `E.catch` \BufferOverrun -> return Nothing where dec rbuf = do k <- H3SettingsKey . fromIntegral <$> decodeInt' rbuf diff --git a/Network/QPACK.hs b/Network/QPACK.hs --- a/Network/QPACK.hs +++ b/Network/QPACK.hs @@ -120,7 +120,7 @@ -- | Default configuration for QPACK encoder. -- -- >>> defaultQEncoderConfig --- QEncoderConfig {ecMaxTableCapacity = 4096, ecHeaderBlockBufferSize = 4096, ecInstructionBufferSize = 4096} +-- QEncoderConfig {ecMaxTableCapacity = 4096, ecHeaderBlockBufferSize = 4096, ecInstructionBufferSize = 4096, ecUseHuffman = True} defaultQEncoderConfig :: QEncoderConfig defaultQEncoderConfig = QEncoderConfig diff --git a/Network/QPACK/Error.hs b/Network/QPACK/Error.hs --- a/Network/QPACK/Error.hs +++ b/Network/QPACK/Error.hs @@ -29,6 +29,8 @@ data DecodeError = IllegalStaticIndex Int + | -- | An absolute index outside the dynamic table's live window + IllegalDynamicIndex Int | IllegalInsertCount | BlockedStreamsOverflow deriving (Eq, Show) diff --git a/Network/QPACK/HeaderBlock/Decode.hs b/Network/QPACK/HeaderBlock/Decode.hs --- a/Network/QPACK/HeaderBlock/Decode.hs +++ b/Network/QPACK/HeaderBlock/Decode.hs @@ -38,9 +38,7 @@ checkRequiredInsertCount dyntbl reqInsertCount decreaseStreams dyntbl checkRequiredInsertCount dyntbl reqInsertCount - let bufsiz = 2048 - gcbuf <- mallocPlainForeignPtrBytes 2048 - let hufdec = decodeH gcbuf bufsiz + hufdec <- newHuffmanDecoder rbuf tbl <- decodeSophisticated (toTokenHeader dyntbl bp hufdec) rbuf return (tbl, needAck) @@ -53,13 +51,32 @@ ok <- checkRequiredInsertCountNB dyntbl reqInsertCount if ok then do - let bufsiz = 2048 - gcbuf <- mallocPlainForeignPtrBytes 2048 - let hufdec = decodeH gcbuf bufsiz + hufdec <- newHuffmanDecoder rbuf hs <- decodeSimple (toTokenHeader dyntbl bp hufdec) rbuf return $ Just (hs, needAck) else return Nothing +-- | A Huffman decoder with room for anything the rest of this field section +-- can decode to. +-- +-- The scratch buffer has to hold one decoded string, and the shortest Huffman +-- code is five bits, so an encoded string of n octets cannot come to more than +-- 8n\/5 symbols -- and the section that contains it is itself at most what is +-- left in the buffer. Sizing from that means a header field is refused only +-- when the section it is in is, rather than at a fixed 2048 that nothing +-- announced: a 2100-octet value used to fail to decode while the section +-- carrying it was under 1.4K, well inside the SETTINGS_MAX_FIELD_SECTION_SIZE +-- we advertise. +-- +-- Allocated per section rather than held on the table, because sections from +-- different streams decode concurrently and this buffer is not shared. +newHuffmanDecoder :: ReadBuffer -> IO HuffmanDecoder +newHuffmanDecoder rbuf = do + siz <- remainingSize rbuf + let bufsiz = max 1 ((siz * 8) `div` 5) + gcbuf <- mallocPlainForeignPtrBytes bufsiz + return $ decodeH gcbuf bufsiz + {- FOURMOLU_DISABLE -} toTokenHeader :: DynamicTable @@ -91,8 +108,7 @@ | static = SIndex $ AbsoluteIndex i | otherwise = DIndex $ fromPreBaseIndex (PreBaseIndex i) bp ret <- atomically (entryTokenHeader <$> toIndexedEntry dyntbl hidx) - qpackDebug dyntbl $ do - checkHIndex dyntbl hidx + qpackDebug dyntbl $ putStrLn $ "IndexedFieldLine (" ++ show hidx ++ ") " ++ showTokenHeader ret return ret @@ -104,8 +120,7 @@ i <- decodeI 4 (w8 .&. 0b00001111) rbuf let hidx = DIndex $ fromPostBaseIndex (PostBaseIndex i) bp ret <- atomically (entryTokenHeader <$> toIndexedEntry dyntbl hidx) - qpackDebug dyntbl $ do - checkHIndex dyntbl hidx + qpackDebug dyntbl $ putStrLn $ "IndexedFieldLineWithPostBaseIndex (" ++ show hidx @@ -134,8 +149,7 @@ key <- atomically (entryToken <$> toIndexedEntry dyntbl hidx) val <- decodeS (`clearBit` 7) (`testBit` 7) 7 hufdec rbuf let ret = (key, val) - qpackDebug dyntbl $ do - checkHIndex dyntbl hidx + qpackDebug dyntbl $ putStrLn $ "LiteralFieldLineWithNameReference (" ++ show hidx @@ -157,8 +171,7 @@ key <- atomically (entryToken <$> toIndexedEntry dyntbl hidx) val <- decodeS (`clearBit` 7) (`testBit` 7) 7 hufdec rbuf let ret = (key, val) - qpackDebug dyntbl $ do - checkHIndex dyntbl hidx + qpackDebug dyntbl $ putStrLn $ "LiteralFieldLineWithPostBaseNameReference (" ++ show hidx diff --git a/Network/QPACK/Table/Dynamic.hs b/Network/QPACK/Table/Dynamic.hs --- a/Network/QPACK/Table/Dynamic.hs +++ b/Network/QPACK/Table/Dynamic.hs @@ -115,6 +115,7 @@ ) import System.IO.Unsafe (unsafePerformIO) +import Network.QPACK.Error import Network.QPACK.Table.RevIndex import Network.QPACK.Types import Network.QUIC (StreamId) @@ -278,12 +279,32 @@ modifyTVar' tableSize (+ entrySize ent) return $ AbsoluteIndex insp +-- | Look up an entry of the dynamic table by absolute index. +-- +-- The live window is the most recent 'maxNumOfEntries' insertions. An index +-- outside it names nothing, and the @mod@ below would fold it back into the +-- table and hand over whichever slot it landed on -- a header nobody sent. +-- RFC 9204 section 2.1.2 asks for an error instead, and this one reaches the +-- peer as QPACK_DECOMPRESSION_FAILED from a field section, or as +-- QPACK_ENCODER_STREAM_ERROR from an encoder instruction. +-- +-- The window is empty until a capacity has been set, which is also what keeps +-- the @mod@ from dividing by zero: 'maxNumOfEntries' starts at 0 and a field +-- section can reach here before the peer has sent us a capacity at all. toDynamicEntry :: DynamicTable -> AbsoluteIndex -> STM Entry toDynamicEntry DynamicTable{..} (AbsoluteIndex idx) = do maxN <- readTVar maxNumOfEntries - let i = idx `mod` maxN + InsertionPoint ip <- readTVar insertionPoint + -- @max 0@ because early on the table holds fewer than maxN entries and + -- @ip - maxN@ is negative, which would let a negative index through; the + -- index conversions produce those readily, since a pre-base index larger + -- than the base gives one. + let lo = max 0 (ip - maxN) + when (maxN == 0 || idx < lo || idx >= ip) $ + throwSTM $ + IllegalDynamicIndex idx table <- readTVar circularTable - unsafeRead table i + unsafeRead table (idx `mod` maxN) ---------------------------------------------------------------- diff --git a/Network/QPACK/Table/Static.hs b/Network/QPACK/Table/Static.hs --- a/Network/QPACK/Table/Static.hs +++ b/Network/QPACK/Table/Static.hs @@ -33,7 +33,11 @@ -- Entry 53 (Token {tokenIx = 21, shouldBeIndexed = True, isPseudo = False, tokenKey = "Content-Type"}) "image/png" toStaticEntry :: AbsoluteIndex -> Entry toStaticEntry (AbsoluteIndex sidx) - | sidx < staticTableSize = staticTable `unsafeAt` sidx + -- Both ends, since the read below is unchecked. Nothing reaches here with + -- a negative index today -- http2's decodeI has been bounded since 5.4.5 -- + -- but that is a guarantee from another package standing in front of an + -- unsafeAt, which is not where such a guarantee belongs. + | 0 <= sidx && sidx < staticTableSize = staticTable `unsafeAt` sidx | otherwise = E.throw $ IllegalStaticIndex sidx -- | Pre-defined static table. diff --git a/http3.cabal b/http3.cabal --- a/http3.cabal +++ b/http3.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: http3 -version: 0.1.4 +version: 0.1.5 license: BSD-3-Clause license-file: LICENSE maintainer: Kazu Yamamoto @@ -83,7 +83,7 @@ containers, http-semantics >= 0.4 && <0.5, http-types, - http2 >=5.4 && <5.5, + http2 >=5.4.5 && <5.5, iproute >= 1.7 && < 1.8, network, network-byte-order, @@ -207,8 +207,10 @@ HTTP3.Config HTTP3.Error HTTP3.ErrorSpec + HTTP3.FrameSpec HTTP3.Server HTTP3.ServerSpec + QPACK.HeaderBlockSpec QPACK.InstructionSpec QPACK.QIFSpec QPACK.QIF2Spec diff --git a/test/HTTP3/Error.hs b/test/HTTP3/Error.hs --- a/test/HTTP3/Error.hs +++ b/test/HTTP3/Error.hs @@ -10,6 +10,7 @@ import Data.ByteString () import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 +import Data.IORef import Network.HTTP.Types import qualified Network.HTTP3.Client as H3 import Network.HTTP3.Internal @@ -46,7 +47,33 @@ threadDelay 100000 return ret -h3ErrorSpec :: ClientConfig -> H3.ClientConfig -> Millisecond -> SpecWith a +-- | Like 'runC', but sending a request of our own choosing. +runCReq + :: H3.Request + -> ClientConfig + -> H3.ClientConfig + -> H3.Config + -> Millisecond + -> IO (Maybe ()) +runCReq req qcc cconf conf ms = timeout us $ run qcc $ \conn -> do + info <- getConnectionInfo conn + case alpn info of + Just proto | "hq" `BS.isPrefixOf` proto -> do + waitEstablished conn + E.throwIO $ ApplicationProtocolErrorIsReceived H3InternalError "" + _ -> H3.run conn cconf conf client + where + us = ms * 1000 + client sendRequest _aux = do + ret <- sendRequest req $ \_rsp -> return () + threadDelay 100000 + return ret + +h3ErrorSpec + :: ClientConfig + -> H3.ClientConfig + -> Millisecond + -> SpecWith (ThreadId, IORef Int) h3ErrorSpec qcc cconf ms = do conf0 <- runIO H3.allocSimpleConfig describe "HTTP/3 servers" $ do @@ -63,11 +90,16 @@ `shouldThrow` applicationProtocolErrorsIn [H3MessageError] it "MUST send H3_MESSAGE_ERROR if mandatory pseudo-header fields are absent [HTTP/3 4.1.3]" - $ \_ -> do + $ \(_, served) -> do let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader0 qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "") + before' <- readIORef served runC qcc' cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3MessageError] + -- And it must not have reached the application: the stream was + -- reset and then the request handed over anyway. + threadDelay 200000 + readIORef served `shouldReturn` before' it "MUST send H3_MESSAGE_ERROR if prohibited pseudo-header fields are present[HTTP/3 4.1.3]" $ \_ -> do @@ -83,6 +115,16 @@ runC qcc' cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3MessageError] it + "MUST treat content that does not match content-length as malformed [HTTP/3 4.1.2]" + $ \_ -> do + -- content-length says five octets and the request carries + -- none. /drain reads the body, which is where the count is + -- checked; a body nobody reads is never counted. + let req = H3.requestNoBody methodPost "/drain" [("content-length", "5")] + qcc' = addQUICHook qcc $ setOnResetStreamReceived $ \_strm aerr -> E.throwIO (ApplicationProtocolErrorIsReceived aerr "") + runCReq req qcc' cconf conf0 ms + `shouldThrow` applicationProtocolErrorsIn [H3MessageError] + it "MUST send H3_MISSING_SETTINGS if the first control frame is not SETTINGS [HTTP/3 6.2.1]" $ \_ -> do let conf = addHook conf0 $ setOnControlFrameCreated startWithNonSettings @@ -118,6 +160,24 @@ runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [H3SettingsError] it + "MUST send H3_FRAME_ERROR if a SETTINGS frame stops mid-parameter [HTTP/3 7.1]" + $ \_ -> do + let conf = addHook conf0 $ setOnControlFrameCreated truncatedSettings + runC qcc cconf conf ms + `shouldThrow` applicationProtocolErrorsIn [H3FrameError] + it + "MUST NOT stop reading settings at a reserved identifier [HTTP/3 7.2.4.1]" + $ \_ -> do + let conf = addHook conf0 $ setOnControlFrameCreated greaseThenHttp2Setting + runC qcc cconf conf ms + `shouldThrow` applicationProtocolErrorsIn [H3SettingsError] + it + "treats a repeated setting identifier as an error whatever its value [HTTP/3 7.2.4.1]" + $ \_ -> do + let conf = addHook conf0 $ setOnControlFrameCreated duplicateLargeSetting + runC qcc cconf conf ms + `shouldThrow` applicationProtocolErrorsIn [H3SettingsError] + it "MUST send H3_FRAME_UNEXPECTED if CANCEL_PUSH is received in a request stream [HTTP/3 7.2.5]" $ \_ -> do let conf = addHook conf0 $ setOnHeadersFrameCreated requestCancelPush @@ -130,6 +190,18 @@ runC qcc cconf conf ms `shouldThrow` applicationProtocolErrorsIn [QpackDecompressionFailed] it + "MUST send QPACK_DECOMPRESSION_FAILED if a field line references a dynamic table entry that is not there [QPACK 2.1.2]" + $ \_ -> do + let conf = addHook conf0 $ setOnHeadersFrameCreated illegalHeader5 + runC qcc cconf conf ms + `shouldThrow` applicationProtocolErrorsIn [QpackDecompressionFailed] + it + "MUST NOT buffer a frame longer than SETTINGS_MAX_FIELD_SECTION_SIZE [HTTP/3 7.1]" + $ \_ -> do + let conf = addHook conf0 $ setOnControlStreamCreated overLongFrame + runC qcc cconf conf ms + `shouldThrow` applicationProtocolErrorsIn [H3ExcessiveLoad] + it "MUST send QPACK_ENCODER_STREAM_ERROR if a new dynamic table capacity value exceeds the limit [QPACK 4.1.3]" $ \_ -> do let conf = addHook conf0 $ setOnEncoderStreamCreated largeTableCapacity @@ -248,6 +320,21 @@ "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\xff\x24" ] +-- [(":method","GET") +-- ,(":scheme","https") +-- ,(":authority","127.0.0.1") +-- ,(":path","/")] ++ dynamic index 0 +-- +-- The Required Insert Count in the prefix is 0 and nothing has been inserted, +-- so there is no entry 0 to name. The decoder used to fold the index back +-- into the table and hand over whatever slot it landed on. +illegalHeader5 :: [H3Frame] -> [H3Frame] +illegalHeader5 _ = + [ H3Frame + H3FrameHeaders + "\x00\x00\xd1\xd7\x50\x09\x31\x32\x37\x2e\x30\x2e\x30\x2e\x31\xc1\x80" + ] + {- -- [(SettingsQpackBlockedStreams,100) -- ,(SettingsQpackMaxTableCapacity,4096) @@ -261,6 +348,32 @@ -- ,(H3SettingsKey 0x2,200) -- HTTP/2 Settings -- ,(SettingsQpackMaxTableCapacity,4096) -- ,(SettingsMaxFieldSectionSize,32768)] +-- An identifier with no value behind it. +-- +-- Each parameter is a pair of variable-length integers; this frame stops +-- between them, which section 7.1 makes H3_FRAME_ERROR. Reading off the end +-- used to raise BufferOverrun, which nothing here catches, so the peer was +-- told nothing at all. +truncatedSettings :: [H3Frame] -> [H3Frame] +truncatedSettings _ = [H3Frame H3FrameSettings "\x01"] + +-- [(H3SettingsKey 0x21,0) -- reserved, to be ignored +-- ,(H3SettingsKey 0x2,0)] -- HTTP/2 Settings, which must be refused +-- +-- 0x21 is the first of the identifiers section 7.2.4.1 reserves and tells +-- endpoints they SHOULD send. Reading used to stop at it, so the HTTP/2 +-- setting behind it went unseen -- along with anything else a peer put there. +greaseThenHttp2Setting :: [H3Frame] -> [H3Frame] +greaseThenHttp2Setting _ = [H3Frame H3FrameSettings "\x21\x00\x02\x00"] + +-- [(H3SettingsKey 0x40,0) +-- ,(H3SettingsKey 0x40,0)] -- the same identifier twice +-- +-- 64 in the two-octet form. The duplicate check was bits in an Int, so +-- identifiers this large repeated unnoticed. +duplicateLargeSetting :: [H3Frame] -> [H3Frame] +duplicateLargeSetting _ = [H3Frame H3FrameSettings "\x40\x40\x00\x40\x40\x00"] + illegalSettings1 :: [H3Frame] -> [H3Frame] illegalSettings1 _ = [ H3Frame @@ -269,6 +382,14 @@ ] ---------------------------------------------------------------- + +-- A GOAWAY frame announcing 2^30 octets and then sending none of them. +-- +-- A frame length is a variable-length integer, so a peer can claim up to +-- 2^62-1 and have the other end hold whatever it sends towards that. Nothing +-- has to arrive for the claim to be refused. +overLongFrame :: Stream -> IO () +overLongFrame strm = sendStream strm "\x07\xc0\x00\x00\x00\x40\x00\x00\x00" -- SetDynamicTableCapacity 10000000000 largeTableCapacity :: Stream -> IO () diff --git a/test/HTTP3/ErrorSpec.hs b/test/HTTP3/ErrorSpec.hs --- a/test/HTTP3/ErrorSpec.hs +++ b/test/HTTP3/ErrorSpec.hs @@ -1,14 +1,22 @@ module HTTP3.ErrorSpec where import Data.ByteString () +import Data.IORef import Test.Hspec import HTTP3.Config import HTTP3.Error import HTTP3.Server +-- | The server counts the requests it is handed, so that a test can check a +-- rejected one never got that far. spec :: Spec spec = - beforeAll (setup server 4096) $ - afterAll teardown $ + beforeAll start $ + afterAll (teardown . fst) $ h3ErrorSpec testClientConfig testH3ClientConfig 2000 -- 2 seconds + where + start = do + ref <- newIORef 0 + tid <- setup (countingServer ref) 4096 + return (tid, ref) diff --git a/test/HTTP3/FrameSpec.hs b/test/HTTP3/FrameSpec.hs new file mode 100644 --- /dev/null +++ b/test/HTTP3/FrameSpec.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HTTP3.FrameSpec where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.IORef +import Network.HTTP3.Internal +import Test.Hspec + +-- | A byte source in the shape 'recvStream' has: hands out at most the +-- requested number of octets, then empty strings for ever after. +sourceOf :: ByteString -> IO (Int -> IO ByteString) +sourceOf bs0 = do + ref <- newIORef bs0 + return $ \n -> atomicModifyIORef' ref $ \bs -> + let (taken, rest) = BS.splitAt n bs in (rest, taken) + +spec :: Spec +spec = do + describe "recvQInt" $ do + it "reads a variable-length integer of each width" $ do + -- RFC 9000 section 16: one, two, four and eight octet forms. + -- The stream type of a unidirectional stream is one of these, and + -- reading only the first octet cut everything from 0x40 up in half. + recvOn "\x03" `shouldReturn` Just 3 + recvOn "\x40\x03" `shouldReturn` Just 3 + recvOn "\x80\x00\x00\x03" `shouldReturn` Just 3 + recvOn "\x25" `shouldReturn` Just 0x25 + recvOn "\x40\x25" `shouldReturn` Just 0x25 + recvOn "\x7b\xbd" `shouldReturn` Just 15293 + + it "leaves the rest of the stream alone" $ do + src <- sourceOf "\x40\x03rest" + recvQInt src `shouldReturn` Just 3 + src 4 `shouldReturn` "rest" + + it "gives up when the stream ends first" $ do + -- A peer may open a unidirectional stream and close it without + -- ever saying what it was for. + recvOn "" `shouldReturn` Nothing + recvOn "\x40" `shouldReturn` Nothing + recvOn "\x80\x00" `shouldReturn` Nothing + where + recvOn bs = sourceOf bs >>= recvQInt diff --git a/test/HTTP3/Server.hs b/test/HTTP3/Server.hs --- a/test/HTTP3/Server.hs +++ b/test/HTTP3/Server.hs @@ -4,6 +4,7 @@ module HTTP3.Server ( setup, server, + countingServer, teardown, trailersMaker, firstTrailerValue, @@ -22,6 +23,7 @@ import qualified Data.ByteString as B import Data.ByteString.Builder (byteString) import qualified Data.ByteString.Char8 as C8 +import Data.IORef import Data.IP () import Network.HPACK import Network.HTTP.Types @@ -51,13 +53,31 @@ teardown :: ThreadId -> IO () teardown tid = killThread tid +-- | 'server', but counting how many times it is handed a request. +-- +-- A request the server has already rejected must not reach the application at +-- all, and the only place that shows is here. +countingServer :: IORef Int -> Server +countingServer ref req aux sendResponse = do + atomicModifyIORef' ref $ \n -> (n + 1, ()) + server req aux sendResponse + server :: Server -server req _aux sendResponse = case requestMethod req of +server req aux sendResponse = case requestMethod req of Just "GET" -> case requestPath req of Just "/" -> sendResponse responseHello [] + Just "/sockaddr" -> sendResponse (responseSockAddr aux) [] _ -> sendResponse response404 [] Just "POST" -> case requestPath req of Just "/echo" -> sendResponse (responseEcho req) [] + -- Reads the body and says nothing about it, so that a test can be + -- about what reading the body does rather than about trailers. + Just "/drain" -> do + let loop = do + bs <- getRequestBodyChunk req + unless (B.null bs) loop + loop + sendResponse responseHello [] _ -> sendResponse responseHello [] _ -> sendResponse response405 [] @@ -66,6 +86,17 @@ where header = [("Content-Type", "text/plain")] body = byteString "Hello, world!\n" + +-- | Hands back the two addresses the server was given, so that a test can +-- check they are not the same one twice over. +responseSockAddr :: Aux -> Response +responseSockAddr aux = responseBuilder ok200 header body + where + header = [("Content-Type", "text/plain")] + body = + byteString $ + C8.pack $ + show (auxMySockAddr aux) ++ " " ++ show (auxPeerSockAddr aux) response404 :: Response response404 = responseNoBody notFound404 [] diff --git a/test/HTTP3/ServerSpec.hs b/test/HTTP3/ServerSpec.hs --- a/test/HTTP3/ServerSpec.hs +++ b/test/HTTP3/ServerSpec.hs @@ -23,6 +23,8 @@ h3spec = do describe "H3 server" $ do it "handles normal cases" $ \_ -> runClient + it "tells the application the peer's address, not its own" $ \_ -> + runSockAddrClient runClient :: IO () runClient = QUIC.run testClientConfig $ \conn -> @@ -38,6 +40,31 @@ , client2 sendRequest _aux , client3 sendRequest _aux ] + +-- | The server reports both addresses it was handed; they must differ. +-- +-- Over loopback the host part is 127.0.0.1 either way, so it is the port that +-- tells them apart: the server's is fixed, the client's is ephemeral. +-- 'getPeerSockAddr' used to return the server's own address, which made these +-- two identical and left every application logging or filtering on the client +-- address looking at itself. +runSockAddrClient :: IO () +runSockAddrClient = QUIC.run testClientConfig $ \conn -> + E.bracket allocSimpleConfig freeSimpleConfig $ \conf -> + C.run conn testH3ClientConfig conf $ \sendRequest _aux -> do + let req = C.requestNoBody methodGet "/sockaddr" [] + sendRequest req $ \rsp -> do + C.responseStatus rsp `shouldBe` Just ok200 + body <- consume rsp + case B.split 0x20 body of + [mine, peer] -> peer `shouldNotBe` mine + _ -> expectationFailure $ "unexpected body: " ++ show body + where + consume rsp = go id + where + go build = do + bs <- C.getResponseBodyChunk rsp + if B.null bs then return (B.concat (build [])) else go (build . (bs :)) client0 :: C.Client () client0 sendRequest _aux = do diff --git a/test/QPACK/HeaderBlockSpec.hs b/test/QPACK/HeaderBlockSpec.hs new file mode 100644 --- /dev/null +++ b/test/QPACK/HeaderBlockSpec.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} + +module QPACK.HeaderBlockSpec where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 +import Network.HPACK.Token (toToken) +import Network.QPACK +import Test.Hspec + +spec :: Spec +spec = do + describe "field section round trip" $ do + it "decodes a header value larger than the decoder's scratch buffer" $ do + -- The scratch buffer for Huffman decoding used to be a fixed 2048 + -- octets, so a value above that failed to decode however small the + -- section carrying it was: 2100 octets here comes to well under + -- 1.4K encoded, far inside the SETTINGS_MAX_FIELD_SECTION_SIZE we + -- advertise. + mapM_ roundTrip [1000, 2100, 8000, 20000] + +roundTrip :: Int -> IO () +roundTrip n = do + (enc, _, _) <- + newQEncoder + defaultQEncoderConfig{ecHeaderBlockBufferSize = 262144} + (\_ -> return ()) + (dec, _) <- newQDecoder defaultQDecoderConfig (\_ -> return ()) + let val = C8.replicate n 'a' + blk <- enc 0 [(toToken ":status", "200"), (toToken "x-big", val)] + (ths, _) <- dec 0 blk + -- The encoded section stays well under the announced limit; it is only + -- the decoded value that is large. + BS.length blk `shouldSatisfy` (< dcMaxFieldSectionSize defaultQDecoderConfig) + lookup (toToken "x-big") ths `shouldBe` Just val diff --git a/test/QPACK/TableSpec.hs b/test/QPACK/TableSpec.hs --- a/test/QPACK/TableSpec.hs +++ b/test/QPACK/TableSpec.hs @@ -1,5 +1,7 @@ module QPACK.TableSpec where +import Control.Concurrent.STM +import qualified Control.Exception as E import Network.QPACK.Internal import Test.Hspec import Test.Hspec.QuickCheck @@ -7,6 +9,21 @@ spec :: Spec spec = do + describe "toIndexedEntry" $ do + it "refuses a static index outside the table" $ do + dyntbl <- newDynamicTableForDecoding 2048 (\_ -> return ()) + -- Entry has no Eq, so keep only whether it came back at all. + let look i = do + r <- + E.try $ + atomically (toIndexedEntry dyntbl (SIndex (AbsoluteIndex i))) + >>= E.evaluate + return $ either Left (const (Right ())) r + -- Past the end was already refused; below the start was not, and + -- the read behind it is unchecked. + look 1000 `shouldReturn` Left (IllegalStaticIndex 1000) + look (-1) `shouldReturn` Left (IllegalStaticIndex (-1)) + describe "encodeRequiredInsertCount and decodeRequiredInsertCount" $ do prop "duality" $ \(Triple m ei di) -> do let ereq = encodeRequiredInsertCount m (RequiredInsertCount ei)