on master help sign in
Merge branch 'fix-h2' (#450, #454)
commit7c7d01d57fff73ba379fc81b659f7d24f4c71a23 authorKazu Yamamoto <kazu@iij.ad.jp> dateTue 20 Oct 2015, 09:36 (11 years ago) parentc4eb3f9a5b3c33
7 files changed+28−25
warp-tls/Network/Wai/Handler/WarpTLS.hs+3−1 warp/Network/Wai/Handler/Warp.hs+7 warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+7−14 warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+5−1 warp/Network/Wai/Handler/Warp/HTTP2/Types.hs−8 warp/Network/Wai/Handler/Warp/Run.hs+1−1 warp/Network/Wai/Handler/Warp/Settings.hs+5
warp-tls/Network/Wai/Handler/WarpTLS.hs+3−1
@@ -44,6 +44,7 @@ module Network.Wai.Handler.WarpTLS (
4444#if __GLASGOW_HASKELL__ < 709
4545import Control.Applicative ((<$>))
4646#endif
47+import Control.Applicative ((<|>))
4748import Control.Exception (Exception, throwIO, bracket, finally, handle, fromException, try, IOException, onException, SomeException(..))
4849import qualified Control.Exception as E
4950import Control.Monad (void)
@@ -279,7 +280,8 @@ runServeTLSSocket' tlsset@TLSSettings{..} set credential sock serve =
279280 }
280281 -- Adding alpn to user's tlsServerHooks.
281282 hooks = tlsServerHooks {
282− TLS.onALPNClientSuggest = Just alpn
283+ TLS.onALPNClientSuggest = TLS.onALPNClientSuggest tlsServerHooks <|>
284+ (if settingsHTTP2Enabled set then Just alpn else Nothing)
283285 }
284286 shared = def {
285287 TLS.sharedCredentials = TLS.Credentials [credential]
warp/Network/Wai/Handler/Warp.hs+7
@@ -76,6 +76,7 @@ module Network.Wai.Handler.Warp (
7676 , setProxyProtocolRequired
7777 , setProxyProtocolOptional
7878 , setSlowlorisSize
79+ , setHTTP2Disabled
7980 -- ** Getters
8081 , getPort
8182 , getHost
@@ -356,6 +357,12 @@ setProxyProtocolOptional y = y { settingsProxyProtocol = ProxyProtocolOptional }
356357setSlowlorisSize :: Int -> Settings -> Settings
357358setSlowlorisSize x y = y { settingsSlowlorisSize = x }
358359
360+-- | Disable HTTP2.
361+--
362+-- Since 3.1.7
363+setHTTP2Disabled :: Settings -> Settings
364+setHTTP2Disabled y = y { settingsHTTP2Enabled = False }
365+
359366-- | Explicitly pause the slowloris timeout.
360367--
361368-- This is useful for cases where you partially consume a request body. For
warp/Network/Wai/Handler/Warp/HTTP2/HPACK.hs+7−14
@@ -10,7 +10,6 @@ import Data.ByteString.Builder (Builder)
1010import qualified Data.ByteString.Char8 as B8
1111import Data.CaseInsensitive (foldedCase)
1212import Data.IORef (readIORef, writeIORef)
13−import qualified Data.List as L
1413import Network.HPACK
1514import qualified Network.HTTP.Types as H
1615import Network.HTTP2
@@ -63,17 +62,11 @@ hpackDecodeHeader hdrblk Context{decodeDynamicTable} = do
6362-- >>> concatCookie [("foo","bar")]
6463-- [("foo","bar")]
6564-- >>> concatCookie [("cookie","a=b"),("foo","bar"),("cookie","c=d"),("cookie","e=f")]
66−-- [("cookie","a=b; c=d; e=f"),("foo","bar")]
67−-- >>> concatCookie [(":pseudo","pseudo"),("cookie","a=b"),("foo","bar"),("cookie","c=d"),("cookie","e=f")]
68−-- [(":pseudo","pseudo"),("cookie","a=b; c=d; e=f"),("foo","bar")]
65+-- [("foo","bar"),("cookie","a=b; c=d; e=f")]
6966concatCookie :: HeaderList -> HeaderList
70−concatCookie hdr = case L.partition (\x -> fst x == "cookie") hdr of
71− ([],_) -> hdr
72− (cookies,others) -> let cookieValue = B.intercalate "; " (map snd cookies)
73− in insertAfterPseudo ("cookie",cookieValue) others
74−
75−insertAfterPseudo :: Header -> HeaderList -> HeaderList
76−insertAfterPseudo x [] = [x]
77−insertAfterPseudo x yys@(y:ys)
78− | isPseudo (fst y) = y : insertAfterPseudo x ys
79− | otherwise = x : yys
67+concatCookie = collect []
68+ where
69+ collect cookies (("cookie",c):rest) = collect (cookies ++ [c]) rest
70+ collect cookies (h:rest) = h : collect cookies rest
71+ collect [] [] = []
72+ collect cookies [] = [("cookie", B.intercalate "; " cookies)]
warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+5−1
@@ -22,7 +22,7 @@ import Data.Maybe (isJust)
2222#if __GLASGOW_HASKELL__ < 709
2323import Data.Monoid (mempty)
2424#endif
25−import Data.Word8 (isUpper)
25+import Data.Word8 (isUpper,_colon)
2626import Network.HPACK
2727import Network.HTTP.Types (RequestHeaders,hRange)
2828import qualified Network.HTTP.Types as H
@@ -119,6 +119,10 @@ validateHeaders hs = case pseudo hs (emptyPseudo,id) of
119119 Nothing -> normal kvs (p, b . ((mk k,v) :))
120120 Just _ -> Nothing
121121
122+ isPseudo "" = False
123+ isPseudo k = BS.head k == _colon
124+
125+
122126----------------------------------------------------------------
123127
124128newReadBody :: TQueue ByteString -> IO (IO ByteString)
warp/Network/Wai/Handler/Warp/HTTP2/Types.hs−8
@@ -17,7 +17,6 @@ import Data.ByteString (ByteString)
1717import qualified Data.ByteString as BS
1818import Data.IntMap.Strict (IntMap, IntMap)
1919import qualified Data.IntMap.Strict as M
20−import Data.Word8 (_colon)
2120import qualified Network.HTTP.Types as H
2221import Network.Wai (Request, FilePart)
2322import Network.Wai.HTTP2 (PushPromise, Trailers)
@@ -309,10 +308,3 @@ enqueueOrSpawnTemporaryWaiter strm outQ out = do
309308 else do
310309 pri <- readIORef $ streamPriority strm
311310 enqueue outQ out pri
312−
313−----------------------------------------------------------------
314−
315−{-# INLINE isPseudo #-}
316−isPseudo :: ByteString -> Bool
317−isPseudo "" = False
318−isPseudo k = BS.head k == _colon
warp/Network/Wai/Handler/Warp/Run.hs+1−1
@@ -387,7 +387,7 @@ serveHTTP2 app2 app conn ii origAddr transport settings = do
387387 return (True, bs0)
388388 else
389389 return (False, bs0)
390− if h2 then do
390+ if settingsHTTP2Enabled settings && h2 then do
391391 recvN <- makeReceiveN bs (connRecv conn) (connRecvBuf conn)
392392 -- fixme: origAddr
393393 http2 conn ii origAddr transport settings recvN app2
warp/Network/Wai/Handler/Warp/Settings.hs+5
@@ -92,6 +92,10 @@ data Settings = Settings
9292 -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048
9393 --
9494 -- Since 3.1.2.
95+ , settingsHTTP2Enabled :: Bool
96+ -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True
97+ --
98+ -- Since 3.1.7.
9599 }
96100
97101-- | Specify usage of the PROXY protocol.
@@ -123,6 +127,7 @@ defaultSettings = Settings
123127 , settingsMaximumBodyFlush = Just 8192
124128 , settingsProxyProtocol = ProxyProtocolNone
125129 , settingsSlowlorisSize = 2048
130+ , settingsHTTP2Enabled = True
126131 }
127132
128133-- | Apply the logic provided by 'defaultOnException' to determine if an