diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,9 @@ +## 3.2.13 + +* Tickling HTTP/2 timer. [624](https://github.com/yesodweb/wai/pull/624) +* Guarantee atomicity of WINDOW_UPDATE increments [622](https://github.com/yesodweb/wai/pull/622) +* Relax HTTP2 headers check [621](https://github.com/yesodweb/wai/pull/621) + ## 3.2.12 * If an empty string is set by setServerName, the Server header is not included in response headers [#619](https://github.com/yesodweb/wai/issues/619) diff --git a/Network/Wai/Handler/Warp/File.hs b/Network/Wai/Handler/Warp/File.hs --- a/Network/Wai/Handler/Warp/File.hs +++ b/Network/Wai/Handler/Warp/File.hs @@ -6,13 +6,12 @@ RspFileInfo(..) , conditionalRequest , addContentHeadersForFilePart - , parseByteRanges + , H.parseByteRanges ) where import Control.Applicative ((<|>)) import Data.Array ((!)) -import qualified Data.ByteString as B hiding (pack) -import qualified Data.ByteString.Char8 as B (pack, readInteger) +import qualified Data.ByteString.Char8 as B (pack) import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) import Network.HTTP.Date @@ -24,10 +23,6 @@ import Network.Wai.Handler.Warp.PackInt import Numeric (showInt) -#ifndef MIN_VERSION_http_types -#define MIN_VERSION_http_types(x,y,z) 1 -#endif - -- $setup -- >>> import Test.QuickCheck @@ -99,7 +94,7 @@ ---------------------------------------------------------------- parseRange :: ByteString -> Integer -> RspFileInfo -parseRange rng size = case parseByteRanges rng of +parseRange rng size = case H.parseByteRanges rng of Nothing -> WithoutBody H.requestedRangeNotSatisfiable416 Just [] -> WithoutBody H.requestedRangeNotSatisfiable416 Just (r:_) -> let (!beg, !end) = checkRange r size @@ -115,46 +110,12 @@ checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size - 1) end) checkRange (H.ByteRangeSuffix count) size = (max 0 (size - count), size - 1) --- | Parse the value of a Range header into a 'H.ByteRanges'. -parseByteRanges :: B.ByteString -> Maybe H.ByteRanges -parseByteRanges bs1 = do - bs2 <- stripPrefix "bytes=" bs1 - (r, bs3) <- range bs2 - ranges (r:) bs3 - where - range bs2 = do - (i, bs3) <- B.readInteger bs2 - if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-") - then Just (H.ByteRangeSuffix (negate i), bs3) - else do - bs4 <- stripPrefix "-" bs3 - case B.readInteger bs4 of - Just (j, bs5) | j >= i -> Just (H.ByteRangeFromTo i j, bs5) - _ -> Just (H.ByteRangeFrom i, bs4) - ranges front bs3 - | B.null bs3 = Just (front []) - | otherwise = do - bs4 <- stripPrefix "," bs3 - (r, bs5) <- range bs4 - ranges (front . (r:)) bs5 - - stripPrefix x y - | x `B.isPrefixOf` y = Just (B.drop (B.length x) y) - | otherwise = Nothing - ---------------------------------------------------------------- -contentRange :: H.HeaderName -#if MIN_VERSION_http_types(0,9,0) -contentRange = H.hContentRange -#else -contentRange = "Content-Range" -#endif - -- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header' -- for the range specified. contentRangeHeader :: Integer -> Integer -> Integer -> H.Header -contentRangeHeader beg end total = (contentRange, range) +contentRangeHeader beg end total = (H.hContentRange, range) where range = B.pack -- building with ShowS @@ -166,13 +127,6 @@ ( '/' : showInt total "") -acceptRange :: H.HeaderName -#if MIN_VERSION_http_types(0,9,0) -acceptRange = H.hAcceptRanges -#else -acceptRange = "Accept-Ranges" -#endif - addContentHeaders :: H.ResponseHeaders -> Integer -> Integer -> Integer -> H.ResponseHeaders addContentHeaders hs off len size | len == size = hs' @@ -180,7 +134,7 @@ in ctrng:hs' where !lengthBS = packIntegral len - !hs' = (H.hContentLength, lengthBS) : (acceptRange,"bytes") : hs + !hs' = (H.hContentLength, lengthBS) : (H.hAcceptRanges,"bytes") : hs -- | -- diff --git a/Network/Wai/Handler/Warp/HTTP2/File.hs b/Network/Wai/Handler/Warp/HTTP2/File.hs --- a/Network/Wai/Handler/Warp/HTTP2/File.hs +++ b/Network/Wai/Handler/Warp/HTTP2/File.hs @@ -6,12 +6,11 @@ RspFileInfo(..) , conditionalRequest , addContentHeadersForFilePart - , parseByteRanges + , H.parseByteRanges ) where import Control.Applicative ((<|>)) -import qualified Data.ByteString as B hiding (pack) -import qualified Data.ByteString.Char8 as B (pack, readInteger) +import qualified Data.ByteString.Char8 as B (pack) import Data.ByteString (ByteString) import Data.Maybe (fromMaybe) import Network.HTTP.Date @@ -23,10 +22,6 @@ import Network.HPACK import Network.HPACK.Token -#ifndef MIN_VERSION_http_types -#define MIN_VERSION_http_types(x,y,z) 1 -#endif - -- $setup -- >>> import Test.QuickCheck @@ -104,7 +99,7 @@ {-# INLINE parseRange #-} parseRange :: ByteString -> Integer -> RspFileInfo -parseRange rng size = case parseByteRanges rng of +parseRange rng size = case H.parseByteRanges rng of Nothing -> WithoutBody H.requestedRangeNotSatisfiable416 Just [] -> WithoutBody H.requestedRangeNotSatisfiable416 Just (r:_) -> let (!beg, !end) = checkRange r size @@ -120,34 +115,6 @@ checkRange (H.ByteRangeFrom beg) size = (beg, size - 1) checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size - 1) end) checkRange (H.ByteRangeSuffix count) size = (max 0 (size - count), size - 1) - -{-# INLINE parseByteRanges #-} --- | Parse the value of a Range header into a 'H.ByteRanges'. -parseByteRanges :: B.ByteString -> Maybe H.ByteRanges -parseByteRanges bs1 = do - bs2 <- stripPrefix "bytes=" bs1 - (r, bs3) <- range bs2 - ranges (r:) bs3 - where - range bs2 = do - (i, bs3) <- B.readInteger bs2 - if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-") - then Just (H.ByteRangeSuffix (negate i), bs3) - else do - bs4 <- stripPrefix "-" bs3 - case B.readInteger bs4 of - Just (j, bs5) | j >= i -> Just (H.ByteRangeFromTo i j, bs5) - _ -> Just (H.ByteRangeFrom i, bs4) - ranges front bs3 - | B.null bs3 = Just (front []) - | otherwise = do - bs4 <- stripPrefix "," bs3 - (r, bs5) <- range bs4 - ranges (front . (r:)) bs5 - - stripPrefix x y - | x `B.isPrefixOf` y = Just (B.drop (B.length x) y) - | otherwise = Nothing ---------------------------------------------------------------- diff --git a/Network/Wai/Handler/Warp/HTTP2/HPACK.hs b/Network/Wai/Handler/Warp/HTTP2/HPACK.hs --- a/Network/Wai/Handler/Warp/HTTP2/HPACK.hs +++ b/Network/Wai/Handler/Warp/HTTP2/HPACK.hs @@ -93,7 +93,6 @@ | mScheme == Nothing = False | mPath == Nothing = False | mPath == Just "" = False - | mAuthority == Nothing = False | mConnection /= Nothing = False | just mTE (/= "trailers") = False | otherwise = True @@ -102,7 +101,6 @@ mScheme = getHeaderValue tokenScheme reqvt mPath = getHeaderValue tokenPath reqvt mMethod = getHeaderValue tokenMethod reqvt - mAuthority = getHeaderValue tokenAuthority reqvt mConnection = getHeaderValue tokenConnection reqvt mTE = getHeaderValue tokenTE reqvt diff --git a/Network/Wai/Handler/Warp/HTTP2/Receiver.hs b/Network/Wai/Handler/Warp/HTTP2/Receiver.hs --- a/Network/Wai/Handler/Warp/HTTP2/Receiver.hs +++ b/Network/Wai/Handler/Warp/HTTP2/Receiver.hs @@ -232,9 +232,12 @@ control FrameWindowUpdate header bs Context{connectionWindow} = do WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs - !w <- (n +) <$> atomically (readTVar connectionWindow) + !w <- atomically $ do + w0 <- readTVar connectionWindow + let !w1 = w0 + n + writeTVar connectionWindow w1 + return w1 when (isWindowOverflow w) $ E.throwIO $ ConnectionError FlowControlError "control window should be less than 2^31" - atomically $ writeTVar connectionWindow w return True control _ _ _ _ = @@ -336,10 +339,13 @@ stream FrameWindowUpdate header@FrameHeader{streamId} bs _ s Stream{streamWindow} = do WindowUpdateFrame n <- guardIt $ decodeWindowUpdateFrame header bs - !w <- (n +) <$> atomically (readTVar streamWindow) + !w <- atomically $ do + w0 <- readTVar streamWindow + let !w1 = w0 + n + writeTVar streamWindow w1 + return w1 when (isWindowOverflow w) $ E.throwIO $ StreamError FlowControlError streamId - atomically $ writeTVar streamWindow w return s stream FrameRSTStream header bs ctx _ strm = do diff --git a/Network/Wai/Handler/Warp/Response.hs b/Network/Wai/Handler/Warp/Response.hs --- a/Network/Wai/Handler/Warp/Response.hs +++ b/Network/Wai/Handler/Warp/Response.hs @@ -18,10 +18,6 @@ #define MIN_VERSION_base(x,y,z) 1 #endif -#ifndef MIN_VERSION_http_types -#define MIN_VERSION_http_types(x,y,z) 1 -#endif - import Blaze.ByteString.Builder.HTTP (chunkedTransferEncoding, chunkedTransferTerminator) #if __GLASGOW_HASKELL__ < 709 import Control.Applicative @@ -50,9 +46,7 @@ import Data.Version (showVersion) import Data.Word8 (_cr, _lf) import qualified Network.HTTP.Types as H -#if MIN_VERSION_http_types(0,9,0) import qualified Network.HTTP.Types.Header as H -#endif import Network.Wai import Network.Wai.Handler.Warp.Buffer (toBuilderBuffer) import qualified Network.Wai.Handler.Warp.Date as D @@ -411,11 +405,7 @@ ---------------------------------------------------------------- addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders -#if MIN_VERSION_http_types(0,9,0) addTransferEncoding hdrs = (H.hTransferEncoding, "chunked") : hdrs -#else -addTransferEncoding hdrs = ("transfer-encoding", "chunked") : hdrs -#endif addDate :: IO D.GMTDate -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders addDate getdate rspidxhdr hdrs = case rspidxhdr ! fromEnum ResDate of diff --git a/Network/Wai/Handler/Warp/Run.hs b/Network/Wai/Handler/Warp/Run.hs --- a/Network/Wai/Handler/Warp/Run.hs +++ b/Network/Wai/Handler/Warp/Run.hs @@ -331,12 +331,13 @@ return (True, bs0) else return (False, bs0) + istatus <- newIORef False if settingsHTTP2Enabled settings && h2 then do - recvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn) + rawRecvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn) + let recvN = wrappedRecvN th istatus (settingsSlowlorisSize settings) rawRecvN -- fixme: origAddr http2 conn ii1 origAddr transport settings recvN app else do - istatus <- newIORef False src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings)) writeIORef istatus True leftoverSource src bs @@ -510,6 +511,19 @@ unless (S.null bs) $ do writeIORef istatus True when (S.length bs >= slowlorisSize) $ T.tickle th + return bs + +wrappedRecvN :: T.Handle -> IORef Bool -> Int -> (BufSize -> IO ByteString) -> (BufSize -> IO ByteString) +wrappedRecvN th istatus slowlorisSize readN bufsize = do + bs <- readN bufsize + unless (S.null bs) $ do + writeIORef istatus True + -- TODO: think about the slowloris protection in HTTP2: current code + -- might open a slow-loris attack vector. Rather than timing we should + -- consider limiting the per-client connections assuming that in HTTP2 + -- we should allow only few connections per host (real-world + -- deployments with large NATs may be trickier). + when (S.length bs >= slowlorisSize || bufsize <= slowlorisSize) $ T.tickle th return bs -- Copied from: https://github.com/mzero/plush/blob/master/src/Plush/Server/Warp.hs diff --git a/test/ExceptionSpec.hs b/test/ExceptionSpec.hs --- a/test/ExceptionSpec.hs +++ b/test/ExceptionSpec.hs @@ -14,7 +14,7 @@ import Control.Exception import qualified Data.Streaming.Network as N import Control.Concurrent.Async (withAsync) -import Network.Socket (sClose) +import Network.Socket (close) import HTTP @@ -24,7 +24,7 @@ withTestServer :: (Int -> IO a) -> IO a withTestServer inner = bracket (N.bindRandomPortTCP "127.0.0.1") - (sClose . snd) + (close . snd) $ \(prt, lsocket) -> do withAsync (runSettingsSocket defaultSettings lsocket testApp) $ \_ -> inner prt diff --git a/test/RunSpec.hs b/test/RunSpec.hs --- a/test/RunSpec.hs +++ b/test/RunSpec.hs @@ -19,7 +19,7 @@ import Data.Streaming.Network (bindPortTCP, getSocketTCP, safeRecv) import Network (connectTo, PortID (PortNumber)) import Network.HTTP.Types -import Network.Socket (sClose) +import Network.Socket (close) import Network.Socket.ByteString (sendAll) import Network.Wai import Network.Wai.Handler.Warp @@ -84,7 +84,7 @@ case esocket of Left (_ :: IOException) -> RunSpec.getPort Right socket -> do - sClose socket + close socket return port withApp :: Settings -> Application -> (Int -> IO a) -> IO a diff --git a/warp.cabal b/warp.cabal --- a/warp.cabal +++ b/warp.cabal @@ -1,5 +1,5 @@ Name: warp -Version: 3.2.12 +Version: 3.2.13 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE @@ -43,7 +43,7 @@ , case-insensitive >= 0.2 , containers , ghc-prim - , http-types >= 0.8.5 + , http-types >= 0.9.1 , iproute >= 1.3.1 , http2 >= 1.6 && < 1.7 , simple-sendfile >= 0.2.7 && < 0.3