From 3eb586636b7f0a9a8e4b4ad456c16efe23847c9e Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 22 Jan 2017 11:48:23 +0200 Subject: [PATCH 1/2] Better async exception behavior for timeoutes #602 --- warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs | 3 ++- warp/Network/Wai/Handler/Warp/Run.hs | 19 +++++++++++++++---- warp/Network/Wai/Handler/Warp/Timeout.hs | 14 ++++++++++---- 3 files changed, 27 insertions(+), 9 deletions(-) diff --git a/warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs b/warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs index 3a659bf02..d85b9bb52 100644 --- a/warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs +++ b/warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs @@ -236,7 +236,8 @@ worker :: Context -> S.Settings -> Application -> Responder -> T.Manager -> IO ( 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 diff --git a/warp/Network/Wai/Handler/Warp/Run.hs b/warp/Network/Wai/Handler/Warp/Run.hs index 47370d9cf..3ae3185ef 100644 --- a/warp/Network/Wai/Handler/Warp/Run.hs +++ b/warp/Network/Wai/Handler/Warp/Run.hs @@ -35,6 +35,7 @@ import qualified Network.Wai.Handler.Warp.FdCache as F 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 @@ -262,6 +263,10 @@ fork :: Settings -> 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 +277,13 @@ fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask -> -- 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 (closeConn ref . fst) $ \(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 +301,11 @@ fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask -> -- 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 diff --git a/warp/Network/Wai/Handler/Warp/Timeout.hs b/warp/Network/Wai/Handler/Warp/Timeout.hs index 1b6fbfd4e..6a1a8ed5a 100644 --- a/warp/Network/Wai/Handler/Warp/Timeout.hs +++ b/warp/Network/Wai/Handler/Warp/Timeout.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} module Network.Wai.Handler.Warp.Timeout ( @@ -97,19 +98,24 @@ register mgr onTimeout = do 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" From b63ec0e865cf91af4143416adaf430969ba0ebb5 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Tue, 24 Jan 2017 16:57:04 +0000 Subject: [PATCH 2/2] Separate connClose and connFree Thanks to @lehins for figuring out that this was causing the segfault --- warp-tls/Network/Wai/Handler/WarpTLS.hs | 4 ++-- warp-tls/warp-tls.cabal | 2 +- warp/ChangeLog.md | 6 ++++++ warp/Network/Wai/Handler/Warp/Run.hs | 6 ++++-- warp/Network/Wai/Handler/Warp/Types.hs | 7 ++++++- warp/warp.cabal | 2 +- 6 files changed, 20 insertions(+), 7 deletions(-) diff --git a/warp-tls/Network/Wai/Handler/WarpTLS.hs b/warp-tls/Network/Wai/Handler/WarpTLS.hs index 30128e8e2..732cb5db4 100644 --- a/warp-tls/Network/Wai/Handler/WarpTLS.hs +++ b/warp-tls/Network/Wai/Handler/WarpTLS.hs @@ -345,6 +345,7 @@ httpOverTls TLSSettings{..} s bs0 params = do , connSendAll = sendall , connSendFile = sendfile , connClose = close' + , connFree = freeBuffer writeBuf , connRecv = recv ref , connRecvBuf = recvBuf ref , connWriteBuffer = writeBuf @@ -355,8 +356,7 @@ httpOverTls TLSSettings{..} s bs0 params = do sendfile fid offset len hook headers = readSendFile writeBuf bufferSize sendall fid offset len hook headers - close' = freeBuffer writeBuf `finally` - void (tryIO $ TLS.bye ctx) `finally` + close' = void (tryIO $ TLS.bye ctx) `finally` TLS.contextClose ctx -- TLS version of recv with a cache for leftover input data. diff --git a/warp-tls/warp-tls.cabal b/warp-tls/warp-tls.cabal index a3ae22283..821c45a62 100644 --- a/warp-tls/warp-tls.cabal +++ b/warp-tls/warp-tls.cabal @@ -21,7 +21,7 @@ Library Build-Depends: base >= 4 && < 5 , bytestring >= 0.9 , wai >= 3.2 && < 3.3 - , warp >= 3.2 && < 3.3 + , warp >= 3.2.10 && < 3.3 , data-default-class >= 0.0.1 , tls >= 1.3.5 , cryptonite >= 0.12 diff --git a/warp/ChangeLog.md b/warp/ChangeLog.md index 1a303e3e8..0777d327b 100644 --- a/warp/ChangeLog.md +++ b/warp/ChangeLog.md @@ -1,3 +1,9 @@ +## 3.2.10 + +* Add `connFree` to `Connection` +* Close socket connections on timeout triggered +* Timeout exceptions extend from `SomeAsyncException` + ## 3.2.9 * Fixing a space leak. [#586] https://github.com/yesodweb/wai/pull/586 diff --git a/warp/Network/Wai/Handler/Warp/Run.hs b/warp/Network/Wai/Handler/Warp/Run.hs index 3ae3185ef..c3f3ce63b 100644 --- a/warp/Network/Wai/Handler/Warp/Run.hs +++ b/warp/Network/Wai/Handler/Warp/Run.hs @@ -64,7 +64,8 @@ socketConnection s = do connSendMany = Sock.sendMany s , connSendAll = sendall , connSendFile = sendFile s writeBuf bufferSize sendall - , connClose = close s >> freeBuffer writeBuf + , connClose = close s + , connFree = freeBuffer writeBuf , connRecv = receive s bufferPool , connRecvBuf = receiveBuf s , connWriteBuffer = writeBuf @@ -277,7 +278,8 @@ fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask -> -- 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 ref . fst) $ \(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. We additionally close diff --git a/warp/Network/Wai/Handler/Warp/Types.hs b/warp/Network/Wai/Handler/Warp/Types.hs index ef8c00183..4185ee1d7 100644 --- a/warp/Network/Wai/Handler/Warp/Types.hs +++ b/warp/Network/Wai/Handler/Warp/Types.hs @@ -92,8 +92,13 @@ data Connection = Connection { , 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. diff --git a/warp/warp.cabal b/warp/warp.cabal index c4fd1d479..d32147190 100644 --- a/warp/warp.cabal +++ b/warp/warp.cabal @@ -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