warp 3.2.9 → 3.2.10

raw patch · 7 files changed

+56/−17 lines, 7 files

Files

• ChangeLog.md +5/−1
• Network/Wai/Handler/Warp.hs +10/−0
• Network/Wai/Handler/Warp/HTTP2/Worker.hs +2/−1
• Network/Wai/Handler/Warp/Run.hs +22/−9
• Network/Wai/Handler/Warp/Timeout.hs +10/−4
• Network/Wai/Handler/Warp/Types.hs +6/−1
• warp.cabal +1/−1

@@ -1,6 +1,10 @@+## 3.2.10++* Add `connFree` to `Connection`. Close socket connections on timeout triggered. Timeout exceptions extend from `SomeAsyncException`. [#602](https://github.com/yesodweb/wai/pull/602) [#605](https://github.com/yesodweb/wai/pull/605)+ ## 3.2.9 -* Fixing a space leak. [#586] https://github.com/yesodweb/wai/pull/586+* Fixing a space leak. [#586](https://github.com/yesodweb/wai/pull/586)  ## 3.2.8 

@@ -286,6 +286,16 @@ -- handler. The handler should call the first argument, -- which closes the listen socket, at shutdown. --+-- Example usage:+--+-- @+-- settings :: IO () -> 'Settings'+-- settings shutdownAction = 'setInstallShutdownHandler' shutdownHandler 'defaultSettings'+--   __where__+--     shutdownHandler closeSocket =+--       void $ 'System.Posix.Signals.installHandler' 'System.Posix.Signals.sigTERM' ('System.Posix.Signals.Catch' $ shutdownAction >> closeSocket) 'Nothing'+-- @+-- -- Default: does not install any code. -- -- Since 3.0.1

@@ -236,7 +236,8 @@ worker ctx@Context{inputQ,controlQ} set app responder tm = do     sinfo <- newStreamInfo     tcont <- newThreadContinue-    E.bracket (T.registerKillThread tm) T.cancel $ go sinfo tcont+    let timeoutAction = return () -- cannot close the shared connection+    E.bracket (T.registerKillThread tm timeoutAction) T.cancel $ go sinfo tcont   where     go sinfo tcont th = do         setThreadContinue tcont True

@@ -24,8 +24,8 @@ import Data.Streaming.Network (bindPortTCP) import Foreign.C.Error (Errno(..), eCONNABORTED) import GHC.IO.Exception (IOException(..))-import Network (sClose, Socket)-import Network.Socket (accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6), setSocketOption, SocketOption(..))+import Network (Socket)+import Network.Socket (close, accept, withSocketsDo, SockAddr(SockAddrInet, SockAddrInet6), setSocketOption, SocketOption(..)) import qualified Network.Socket.ByteString as Sock import Network.Wai import Network.Wai.Handler.Warp.Buffer@@ -35,6 +35,7 @@ import qualified Network.Wai.Handler.Warp.FileInfoCache as I import Network.Wai.Handler.Warp.HTTP2 (http2, isHTTP2) import Network.Wai.Handler.Warp.Header+import Network.Wai.Handler.Warp.IORef import Network.Wai.Handler.Warp.ReadInt import Network.Wai.Handler.Warp.Recv import Network.Wai.Handler.Warp.Request@@ -63,7 +64,8 @@         connSendMany = Sock.sendMany s       , connSendAll = sendall       , connSendFile = sendFile s writeBuf bufferSize sendall-      , connClose = sClose s >> freeBuffer writeBuf+      , connClose = close s+      , connFree = freeBuffer writeBuf       , connRecv = receive s bufferPool       , connRecvBuf = receiveBuf s       , connWriteBuffer = writeBuf@@ -104,7 +106,7 @@ runSettings set app = withSocketsDo $     bracket         (bindPortTCP (settingsPort set) (settingsHost set))-        sClose+        close         (\socket -> do             setSocketCloseOnExec socket             runSettingsSocket set socket app)@@ -137,7 +139,7 @@         conn <- socketConnection s         return (conn, sa) -    closeListenSocket = sClose socket+    closeListenSocket = close socket  -- | The connection setup action would be expensive. A good example -- is initialization of TLS.@@ -262,6 +264,10 @@      -> InternalInfo0      -> IO () fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->+    -- Allocate a new IORef indicating whether the connection has been+    -- closed, to avoid double-freeing a connection+    withClosedRef $ \ref ->+     -- Run the connection maker to get a new connection, and ensure     -- that the connection is closed. If the mkConn call throws an     -- exception, we will leak the connection. If the mkConn call is@@ -272,11 +278,14 @@     -- We grab the connection before registering timeouts since the     -- timeouts will be useless during connection creation, due to the     -- fact that async exceptions are still masked.-    bracket mkConn closeConn $ \(conn, transport) ->+    bracket mkConn (\(conn, _) -> closeConn ref conn `finally` connFree conn)+    $ \(conn, transport) ->      -- We need to register a timeout handler for this thread, and-    -- cancel that handler as soon as we exit.-    bracket (T.registerKillThread (timeoutManager0 ii0)) T.cancel $ \th ->+    -- cancel that handler as soon as we exit. We additionally close+    -- the connection immediately in case the child thread catches the+    -- async exception or performs some long-running cleanup action.+    bracket (T.registerKillThread (timeoutManager0 ii0) (closeConn ref conn)) T.cancel $ \th ->      let ii1 = toInternalInfo1 ii0 th         -- We now have fully registered a connection close handler@@ -294,7 +303,11 @@        -- bracket with closeConn above ensures the connection is closed.        when goingon $ serveConnection conn ii1 addr transport set app   where-    closeConn (conn, _transport) = connClose conn+    withClosedRef inner = newIORef False >>= inner++    closeConn ref conn = do+        isClosed <- atomicModifyIORef' ref $ \x -> (True, x)+        unless isClosed $ connClose conn      onOpen adr    = increase counter >> settingsOnOpen  set adr     onClose adr _ = decrease counter >> settingsOnClose set adr

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}  module Network.Wai.Handler.Warp.Timeout (@@ -97,19 +98,24 @@     return h  -- | Registering a timeout action of killing this thread.-registerKillThread :: Manager -> IO Handle-registerKillThread m = do+registerKillThread :: Manager -> TimeoutAction -> IO Handle+registerKillThread m onTimeout = do     -- If we hold ThreadId, the stack and data of the thread is leaked.     -- If we hold Weak ThreadId, the stack is released. However, its     -- data is still leaked probably because of a bug of GHC.     -- So, let's just use ThreadId and release ThreadId by     -- overriding the timeout action by "cancel".     tid <- myThreadId-    register m $ E.throwTo tid TimeoutThread+    -- First run the timeout action in case the child thread is masked.+    register m $ onTimeout `E.finally` E.throwTo tid TimeoutThread  data TimeoutThread = TimeoutThread     deriving Typeable-instance E.Exception TimeoutThread+instance E.Exception TimeoutThread where+#if MIN_VERSION_base(4,7,0)+    toException = E.asyncExceptionToException+    fromException = E.asyncExceptionFromException+#endif instance Show TimeoutThread where     show TimeoutThread = "Thread killed by Warp's timeout reaper" 

@@ -92,8 +92,13 @@     , connSendAll     :: ByteString -> IO ()     -- | The sending function for files in HTTP/1.1.     , connSendFile    :: SendFile-    -- | The connection closing function.+    -- | The connection closing function. Warp guarantees it will only be+    -- called once. Other functions (like 'connRecv') may be called after+    -- 'connClose' is called.     , connClose       :: IO ()+    -- | Free any buffers allocated. Warp guarantees it will only be+    -- called once, and no other functions will be called after it.+    , connFree        :: IO ()     -- | The connection receiving function. This returns "" for EOF.     , connRecv        :: Recv     -- | The connection receiving function. This tries to fill the buffer.

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