diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +## 3.3.5 + +* New APIs: setGracefulCloseTimeout1 and setGracefulCloseTimeout2. + For HTTP/1.x, connections are closed immediately by default. + gracefullClose is used for HTTP/2 by default. + [#782](https://github.com/yesodweb/wai/pull/782) + ## 3.3.4 * Setting isSecure of HTTP/2 correctly. diff --git a/Network/Wai/Handler/Warp.hs b/Network/Wai/Handler/Warp.hs --- a/Network/Wai/Handler/Warp.hs +++ b/Network/Wai/Handler/Warp.hs @@ -72,6 +72,8 @@ , setLogger , setServerPushLogger , setGracefulShutdownTimeout + , setGracefulCloseTimeout1 + , setGracefulCloseTimeout2 -- ** Getters , getPort , getHost @@ -79,6 +81,8 @@ , getOnClose , getOnException , getGracefulShutdownTimeout + , getGracefulCloseTimeout1 + , getGracefulCloseTimeout2 -- ** Exception handler , defaultOnException , defaultShouldDisplayException @@ -378,7 +382,7 @@ -- -- WARNING: This is contrary to the PROXY protocol specification and -- using it can indicate a security problem with your --- architecture if the web server is directly accessable +-- architecture if the web server is directly accessible -- to the public, since it would allow easy IP address -- spoofing. However, it can be useful in some cases, -- such as if a load balancer health check uses regular @@ -457,3 +461,33 @@ -- Since 3.1.10 getFileInfo :: Request -> FilePath -> IO FileInfo getFileInfo = fromMaybe (\_ -> throwIO (userError "getFileInfo")) . Vault.lookup getFileInfoKey . vault + +-- | A timeout to limit the time (in milliseconds) waiting for +-- FIN for HTTP/1.x. 0 means uses immediate close. +-- Default: 0. +-- +-- Since 3.3.5 +setGracefulCloseTimeout1 :: Int -> Settings -> Settings +setGracefulCloseTimeout1 x y = y { settingsGracefulCloseTimeout1 = x } + +-- | A timeout to limit the time (in milliseconds) waiting for +-- FIN for HTTP/1.x. 0 means uses immediate close. +-- +-- Since 3.3.5 +getGracefulCloseTimeout1 :: Settings -> Int +getGracefulCloseTimeout1 = settingsGracefulCloseTimeout1 + +-- | A timeout to limit the time (in milliseconds) waiting for +-- FIN for HTTP/2. 0 means uses immediate close. +-- Default: 2000. +-- +-- Since 3.3.5 +setGracefulCloseTimeout2 :: Int -> Settings -> Settings +setGracefulCloseTimeout2 x y = y { settingsGracefulCloseTimeout2 = x } + +-- | A timeout to limit the time (in milliseconds) waiting for +-- FIN for HTTP/2. 0 means uses immediate close. +-- +-- Since 3.3.5 +getGracefulCloseTimeout2 :: Settings -> Int +getGracefulCloseTimeout2 = settingsGracefulCloseTimeout2 diff --git a/Network/Wai/Handler/Warp/HTTP2.hs b/Network/Wai/Handler/Warp/HTTP2.hs --- a/Network/Wai/Handler/Warp/HTTP2.hs +++ b/Network/Wai/Handler/Warp/HTTP2.hs @@ -63,13 +63,12 @@ logResponse h2rsp' req return () - toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th secure + toWAIRequest h2req aux = toRequest ii settings addr hdr bdylen bdy th transport where !hdr = H2.requestHeaders h2req !bdy = H2.getRequestBodyChunk h2req !bdylen = H2.requestBodySize h2req !th = H2.auxTimeHandle aux - !secure = isTransportSecure transport logResponse h2rsp req = logger req st msiz where diff --git a/Network/Wai/Handler/Warp/HTTP2/Request.hs b/Network/Wai/Handler/Warp/HTTP2/Request.hs --- a/Network/Wai/Handler/Warp/HTTP2/Request.hs +++ b/Network/Wai/Handler/Warp/HTTP2/Request.hs @@ -26,19 +26,19 @@ import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath) import Network.Wai.Handler.Warp.Types -type ToReq = (TokenHeaderList,ValueTable) -> Maybe Int -> IO ByteString -> T.Handle -> Bool -> IO Request +type ToReq = (TokenHeaderList,ValueTable) -> Maybe Int -> IO ByteString -> T.Handle -> Transport -> IO Request ---------------------------------------------------------------- toRequest :: InternalInfo -> S.Settings -> SockAddr -> ToReq -toRequest ii settings addr ht bodylen body th secure = do +toRequest ii settings addr ht bodylen body th transport = do ref <- newIORef Nothing - toRequest' ii settings addr ref ht bodylen body th secure + toRequest' ii settings addr ref ht bodylen body th transport toRequest' :: InternalInfo -> S.Settings -> SockAddr -> IORef (Maybe HTTP2Data) -> ToReq -toRequest' ii settings addr ref (reqths,reqvt) bodylen body th secure = return req +toRequest' ii settings addr ref (reqths,reqvt) bodylen body th transport = return req where !req = Request { requestMethod = colonMethod @@ -48,7 +48,7 @@ , rawQueryString = query , queryString = H.parseQuery query , requestHeaders = headers - , isSecure = secure + , isSecure = isTransportSecure transport , remoteHost = addr , requestBody = body , vault = vaultValue diff --git a/Network/Wai/Handler/Warp/Request.hs b/Network/Wai/Handler/Warp/Request.hs --- a/Network/Wai/Handler/Warp/Request.hs +++ b/Network/Wai/Handler/Warp/Request.hs @@ -55,6 +55,7 @@ -> Timeout.Handle -> SockAddr -- ^ Peer's address. -> Source -- ^ Where HTTP request comes from. + -> Transport -> IO (Request ,Maybe (I.IORef Int) ,IndexedHeader @@ -64,7 +65,7 @@ -- 'IndexedHeader' of HTTP request for internal use, -- Body producing action used for flushing the request body -recvRequest firstRequest settings conn ii th addr src = do +recvRequest firstRequest settings conn ii th addr src transport = do hdrlines <- headerLines firstRequest src (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines let idxhdr = indexRequestHeader hdr @@ -89,7 +90,7 @@ , rawQueryString = query , queryString = H.parseQuery query , requestHeaders = hdr - , isSecure = False + , isSecure = isTransportSecure transport , remoteHost = addr , requestBody = rbody' , vault = vaultValue 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 @@ -58,17 +58,25 @@ #endif -- | Creating 'Connection' for plain HTTP based on a given socket. -socketConnection :: Socket -> IO Connection -socketConnection s = do +socketConnection :: Settings -> Socket -> IO Connection +socketConnection set s = do bufferPool <- newBufferPool writeBuf <- allocateBuffer bufferSize let sendall = Sock.sendAll s + isH2 <- newIORef False -- HTTP/1.x return Connection { connSendMany = Sock.sendMany s , connSendAll = sendall , connSendFile = sendFile s writeBuf bufferSize sendall #if MIN_VERSION_network(3,1,1) - , connClose = gracefulClose s 5000 + , connClose = do + h2 <- readIORef isH2 + let tm = if h2 then settingsGracefulCloseTimeout2 set + else settingsGracefulCloseTimeout1 set + if tm == 0 then + close s + else + gracefulClose s tm #else , connClose = close s #endif @@ -77,6 +85,7 @@ , connRecvBuf = receiveBuf s , connWriteBuffer = writeBuf , connBufferSize = bufferSize + , connHTTP2 = isH2 } -- | Run an 'Application' on the given port. @@ -138,7 +147,7 @@ setSocketCloseOnExec s -- NoDelay causes an error for AF_UNIX. setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return () - conn <- socketConnection s + conn <- socketConnection set s return (conn, sa) closeListenSocket = close socket @@ -344,6 +353,7 @@ let recvN = wrappedRecvN th istatus (settingsSlowlorisSize settings) rawRecvN -- fixme: origAddr checkTLS + setConnHTTP2 conn True http2 conn transport ii origAddr settings recvN app else do src <- mkSource (wrappedRecv conn th istatus (settingsSlowlorisSize settings)) @@ -419,8 +429,7 @@ errorResponse e = settingsOnExceptionResponse settings e http1 firstRequest addr istatus src = do - (req', mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src - let req = req' { isSecure = isTransportSecure transport } + (req, mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src transport keepAlive <- processRequest istatus src req mremainingRef idxhdr nextBodyFlush `E.catch` \e -> do settingsOnException settings (Just req) e diff --git a/Network/Wai/Handler/Warp/Settings.hs b/Network/Wai/Handler/Warp/Settings.hs --- a/Network/Wai/Handler/Warp/Settings.hs +++ b/Network/Wai/Handler/Warp/Settings.hs @@ -76,6 +76,13 @@ -- -- Since 2.0.3 , settingsInstallShutdownHandler :: IO () -> IO () + -- ^ An action to install a handler (e.g. Unix signal handler) + -- to close a listen socket. + -- The first argument is an action to close the listen socket. + -- + -- Default: no action + -- + -- Since 3.0.1 , settingsServerName :: ByteString -- ^ Default server name if application does not set one. -- @@ -87,28 +94,40 @@ , settingsProxyProtocol :: ProxyProtocol -- ^ Specify usage of the PROXY protocol. -- - -- Since 3.0.5. + -- Since 3.0.5 , settingsSlowlorisSize :: Int -- ^ Size of bytes read to prevent Slowloris protection. Default value: 2048 -- - -- Since 3.1.2. + -- Since 3.1.2 , settingsHTTP2Enabled :: Bool -- ^ Whether to enable HTTP2 ALPN/upgrades. Default: True -- - -- Since 3.1.7. + -- Since 3.1.7 , settingsLogger :: Request -> H.Status -> Maybe Integer -> IO () -- ^ A log function. Default: no action. -- - -- Since 3.X.X. + -- Since 3.1.10 , settingsServerPushLogger :: Request -> ByteString -> Integer -> IO () -- ^ A HTTP/2 server push log function. Default: no action. -- - -- Since 3.X.X. + -- Since 3.2.7 , settingsGracefulShutdownTimeout :: Maybe Int -- ^ An optional timeout to limit the time (in seconds) waiting for -- a graceful shutdown of the web server. -- -- Since 3.2.8 + , settingsGracefulCloseTimeout1 :: Int + -- ^ A timeout to limit the time (in milliseconds) waiting for + -- FIN for HTTP/1.x. 0 means uses immediate close. + -- Default: 0. + -- + -- Since 3.3.5 + , settingsGracefulCloseTimeout2 :: Int + -- ^ A timeout to limit the time (in milliseconds) waiting for + -- FIN for HTTP/2. 0 means uses immediate close. + -- Default: 2000. + -- + -- Since 3.3.5 } -- | Specify usage of the PROXY protocol. @@ -145,6 +164,8 @@ , settingsLogger = \_ _ _ -> return () , settingsServerPushLogger = \_ _ _ -> return () , settingsGracefulShutdownTimeout = Nothing + , settingsGracefulCloseTimeout1 = 0 + , settingsGracefulCloseTimeout2 = 2000 } -- | Apply the logic provided by 'defaultOnException' to determine if an diff --git a/Network/Wai/Handler/Warp/Types.hs b/Network/Wai/Handler/Warp/Types.hs --- a/Network/Wai/Handler/Warp/Types.hs +++ b/Network/Wai/Handler/Warp/Types.hs @@ -122,7 +122,15 @@ , connWriteBuffer :: Buffer -- | The size of the write buffer. , connBufferSize :: BufSize + -- | Is this connection HTTP/2? + , connHTTP2 :: IORef Bool } + +getConnHTTP2 :: Connection -> IO Bool +getConnHTTP2 conn = readIORef (connHTTP2 conn) + +setConnHTTP2 :: Connection -> Bool -> IO () +setConnHTTP2 conn b = writeIORef (connHTTP2 conn) b ---------------------------------------------------------------- diff --git a/test/ResponseSpec.hs b/test/ResponseSpec.hs --- a/test/ResponseSpec.hs +++ b/test/ResponseSpec.hs @@ -83,7 +83,7 @@ it "discards empty lines" $ do sanitizeHeaderValue "foo\r\n\r\nbar" `shouldBe` "foo\r\n bar" - context "when sanitizing single occurences of \n" $ do + context "when sanitizing single occurrences of \n" $ do it "replaces \n with \r\n" $ do sanitizeHeaderValue "foo\n bar" `shouldBe` "foo\r\n bar" diff --git a/warp.cabal b/warp.cabal --- a/warp.cabal +++ b/warp.cabal @@ -1,5 +1,5 @@ Name: warp -Version: 3.3.4 +Version: 3.3.5 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE