warp 3.1.1 → 3.1.2

raw patch · 7 files changed

+73/−33 lines, 7 files

Files

• ChangeLog.md +4/−0
• Network/Wai/Handler/Warp.hs +7/−0
• Network/Wai/Handler/Warp/HTTP2/Sender.hs +50/−26
• Network/Wai/Handler/Warp/Internal.hs +2/−2
• Network/Wai/Handler/Warp/Run.hs +4/−4
• Network/Wai/Handler/Warp/Settings.hs +5/−0
• warp.cabal +1/−1

@@ -1,3 +1,7 @@+## 3.1.2++* Configurable Slowloris size [#418](https://github.com/yesodweb/wai/pull/418)+ ## 3.1.0  * Supporting HTTP/2 [#399](https://github.com/yesodweb/wai/pull/399)

@@ -64,6 +64,7 @@   , setProxyProtocolNone   , setProxyProtocolRequired   , setProxyProtocolOptional+  , setSlowlorisSize     -- ** Getters   , getPort   , getHost@@ -337,6 +338,12 @@ -- Since 3.0.5 setProxyProtocolOptional :: Settings -> Settings setProxyProtocolOptional y = y { settingsProxyProtocol = ProxyProtocolOptional }++-- | Size in bytes read to prevent Slowloris protection. Default value: 2048+--+-- Since 3.1.2+setSlowlorisSize :: Int -> Settings -> Settings+setSlowlorisSize x y = y { settingsSlowlorisSize = x }  -- | Explicitly pause the slowloris timeout. --

@@ -10,7 +10,7 @@ import Control.Concurrent (forkIO) import Control.Concurrent.STM import qualified Control.Exception as E-import Control.Monad (void, unless)+import Control.Monad (unless, void, when) import qualified Data.ByteString as BS import qualified Data.ByteString.Builder.Extra as B import Foreign.Ptr@@ -111,27 +111,44 @@             case aux of                 Oneshot True -> do -- hasBody                     -- Data frame payload-                    off <- sendHeadersIfNecessary total-                    Next datPayloadLen mnext <- fillResponseBodyGetNext conn ii off lim rsp-                    fillDataHeaderSend strm total datPayloadLen mnext pri+                    (off, _) <- sendHeadersIfNecessary total+                    let payloadOff = off + frameHeaderLength+                    Next datPayloadLen mnext <-+                        fillResponseBodyGetNext conn ii payloadOff lim rsp+                    fillDataHeaderSend strm total datPayloadLen mnext+                    maybeEnqueueNext strm mnext pri                 Oneshot False -> do                     -- "closed" must be before "connSendAll". If not,                     -- the context would be switched to the receiver,                     -- resulting the inconsistency of concurrency.                     closed ctx strm Finished-                    bufferIO connWriteBuffer total connSendAll+                    flushN total                 Persist sq tvar -> do-                    off <- sendHeadersIfNecessary total-                    Next datPayloadLen mnext <- fillStreamBodyGetNext conn off lim sq tvar-                    fillDataHeaderSend strm total datPayloadLen mnext pri+                    (off, needSend) <- sendHeadersIfNecessary total+                    let payloadOff = off + frameHeaderLength+                    Next datPayloadLen mnext <-+                        fillStreamBodyGetNext conn payloadOff lim sq tvar+                    -- If no data was immediately available, avoid sending an+                    -- empty data frame.+                    if datPayloadLen > 0 then+                        fillDataHeaderSend strm total datPayloadLen mnext+                      else+                        when needSend $ flushN off+                    maybeEnqueueNext strm mnext pri         loop     switch out@(ONext strm curr) pri = unlessClosed ctx conn strm $ do         checkWindowSize connectionWindow (streamWindow strm) outputQ out pri $ \lim -> do             -- Data frame payload             Next datPayloadLen mnext <- curr lim-            fillDataHeaderSend strm 0 datPayloadLen mnext pri+            fillDataHeaderSend strm 0 datPayloadLen mnext+            maybeEnqueueNext strm mnext pri         loop +    -- Flush the connection buffer to the socket, where the first 'n' bytes of+    -- the buffer are filled.+    flushN :: Int -> IO ()+    flushN n = bufferIO connWriteBuffer n connSendAll+     headerContinue sid rsp endOfStream = do         builder <- hpackEncodeHeader ctx ii settings rsp         (len, signal) <- B.runBuilder builder bufHeaderPayload headerPayloadLim@@ -144,8 +161,7 @@      continue _   len B.Done = return len     continue sid len (B.More _ writer) = do-        let total = len + frameHeaderLength-        bufferIO connWriteBuffer total connSendAll+        flushN $ len + frameHeaderLength         (len', signal') <- writer bufHeaderPayload headerPayloadLim         let flag = case signal' of                 B.Done -> setEndHeader defaultFlags@@ -153,8 +169,7 @@         fillFrameHeader FrameContinuation len' sid flag connWriteBuffer         continue sid len' signal'     continue sid len (B.Chunk bs writer) = do-        let total = len + frameHeaderLength-        bufferIO connWriteBuffer total connSendAll+        flushN $ len + frameHeaderLength         let (bs1,bs2) = BS.splitAt headerPayloadLim bs             len' = BS.length bs1         void $ copy bufHeaderPayload bs1@@ -164,15 +179,28 @@           else             continue sid len' (B.Chunk bs2 writer) -    sendHeadersIfNecessary total = do-        let datPayloadOff = total + frameHeaderLength-        if datPayloadOff < connBufferSize then-            return datPayloadOff-          else do-            bufferIO connWriteBuffer total connSendAll-            return frameHeaderLength+    -- True if the connection buffer has room for a 1-byte data frame.+    canFitDataFrame total = total + frameHeaderLength < connBufferSize -    fillDataHeaderSend strm otherLen datPayloadLen mnext pri = do+    -- Re-enqueue the stream in the output queue if more output is immediately+    -- available; do nothing otherwise.  If the stream is not finished, it must+    -- already have been written to the 'TVar' owned by 'waiter', which will+    -- put it back into the queue when more output becomes available.+    maybeEnqueueNext :: Stream -> Control DynaNext -> Priority -> IO ()+    maybeEnqueueNext strm (CNext next) = enqueue outputQ (ONext strm next)+    maybeEnqueueNext _    _            = const $ return ()+++    -- Send headers if there is not room for a 1-byte data frame, and return+    -- the offset of the next frame's first header byte and whether the headers+    -- still need to be sent.+    sendHeadersIfNecessary total+      | canFitDataFrame total = return (total, True)+      | otherwise             = do+          flushN total+          return (0, False)++    fillDataHeaderSend strm otherLen datPayloadLen mnext = do         -- Data frame header         let sid = streamNumber strm             buf = connWriteBuffer `plusPtr` otherLen@@ -187,14 +215,10 @@         case mnext of             CFinish    -> closed ctx strm Finished             _          -> return ()-        bufferIO connWriteBuffer total connSendAll+        flushN total         atomically $ do            modifyTVar' connectionWindow (subtract datPayloadLen)            modifyTVar' (streamWindow strm) (subtract datPayloadLen)-        case mnext of-            CFinish    -> return ()-            CNext next -> enqueue outputQ (ONext strm next) pri-            CNone      -> return ()      fillFrameHeader ftyp len sid flag buf = encodeFrameHeaderBuf ftyp hinfo buf       where

@@ -45,8 +45,8 @@     --     -- * When all request headers are read, the timeout is tickled.     ---    -- * Every time at least 2048 bytes of the request body are read, the timeout-    --   is tickled.+    -- * Every time at least the slowloris size settings number of bytes of the request+    --   body are read, the timeout is tickled.     --     -- * The timeout is paused while executing user code. This will apply to both     --   the application itself, and a ResponseSource response. The timeout is

@@ -314,7 +314,7 @@         http2 conn ii origAddr transport settings recvN app       else do         istatus <- newIORef False-        src <- mkSource (wrappedRecv conn th istatus)+        src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings))         writeIORef istatus True         leftoverSource src bs         addr <- getProxyProtocolAddr src@@ -470,12 +470,12 @@                 | toRead' >= 0 -> loop toRead'                 | otherwise -> return False -wrappedRecv :: Connection -> T.Handle -> IORef Bool -> IO ByteString-wrappedRecv Connection { connRecv = recv } th istatus = do+wrappedRecv :: Connection -> T.Handle -> IORef Bool -> Int -> IO ByteString+wrappedRecv Connection { connRecv = recv } th istatus slowlorisSize = do     bs <- recv     unless (S.null bs) $ do         writeIORef istatus True-        when (S.length bs >= 2048) $ T.tickle th+        when (S.length bs >= slowlorisSize) $ T.tickle th     return bs  -- Copied from: https://github.com/mzero/plush/blob/master/src/Plush/Server/Warp.hs

@@ -89,6 +89,10 @@       -- ^ Specify usage of the PROXY protocol.       --       -- Since 3.0.5.+    , settingsSlowlorisSize :: Int+      -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048+      --+      -- Since 3.1.2.     }  -- | Specify usage of the PROXY protocol.@@ -119,6 +123,7 @@     , settingsServerName = S8.pack $ "Warp/" ++ showVersion Paths_warp.version     , settingsMaximumBodyFlush = Just 8192     , settingsProxyProtocol = ProxyProtocolNone+    , settingsSlowlorisSize = 2048     }  -- | Apply the logic provided by 'defaultOnException' to determine if an

@@ -1,5 +1,5 @@ Name:                warp-Version:             3.1.1+Version:             3.1.2 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE