git.iko.soy/typeable/wai
on master help sign in
Better async exception behavior for timeoutes #602
commit3eb586636b7f0a9a8e4b4ad456c16efe23847c9e authorMichael Snoyman <michael@snoyman.com> dateSun 22 Jan 2017, 11:48 (10 years ago) parent82c8c61
3 files changed+27−9
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+2−1 warp/Network/Wai/Handler/Warp/Run.hs+15−4 warp/Network/Wai/Handler/Warp/Timeout.hs+10−4
warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+2−1
@@ -236,7 +236,8 @@ worker :: Context -> S.Settings -> Application -> Responder -> T.Manager -> IO (
236236worker ctx@Context{inputQ,controlQ} set app responder tm = do
237237 sinfo <- newStreamInfo
238238 tcont <- newThreadContinue
239− E.bracket (T.registerKillThread tm) T.cancel $ go sinfo tcont
239+ let timeoutAction = return () -- cannot close the shared connection
240+ E.bracket (T.registerKillThread tm timeoutAction) T.cancel $ go sinfo tcont
240241 where
241242 go sinfo tcont th = do
242243 setThreadContinue tcont True
warp/Network/Wai/Handler/Warp/Run.hs+15−4
@@ -35,6 +35,7 @@ import qualified Network.Wai.Handler.Warp.FdCache as F
3535import qualified Network.Wai.Handler.Warp.FileInfoCache as I
3636import Network.Wai.Handler.Warp.HTTP2 (http2, isHTTP2)
3737import Network.Wai.Handler.Warp.Header
38+import Network.Wai.Handler.Warp.IORef
3839import Network.Wai.Handler.Warp.ReadInt
3940import Network.Wai.Handler.Warp.Recv
4041import Network.Wai.Handler.Warp.Request
@@ -262,6 +263,10 @@ fork :: Settings
262263 -> InternalInfo0
263264 -> IO ()
264265fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
266+ -- Allocate a new IORef indicating whether the connection has been
267+ -- closed, to avoid double-freeing a connection
268+ withClosedRef $ \ref ->
269+
265270 -- Run the connection maker to get a new connection, and ensure
266271 -- that the connection is closed. If the mkConn call throws an
267272 -- 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 ->
272277 -- We grab the connection before registering timeouts since the
273278 -- timeouts will be useless during connection creation, due to the
274279 -- fact that async exceptions are still masked.
275− bracket mkConn closeConn $ \(conn, transport) ->
280+ bracket mkConn (closeConn ref . fst) $ \(conn, transport) ->
276281
277282 -- We need to register a timeout handler for this thread, and
278− -- cancel that handler as soon as we exit.
279− bracket (T.registerKillThread (timeoutManager0 ii0)) T.cancel $ \th ->
283+ -- cancel that handler as soon as we exit. We additionally close
284+ -- the connection immediately in case the child thread catches the
285+ -- async exception or performs some long-running cleanup action.
286+ bracket (T.registerKillThread (timeoutManager0 ii0) (closeConn ref conn)) T.cancel $ \th ->
280287
281288 let ii1 = toInternalInfo1 ii0 th
282289 -- We now have fully registered a connection close handler
@@ -294,7 +301,11 @@ fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
294301 -- bracket with closeConn above ensures the connection is closed.
295302 when goingon $ serveConnection conn ii1 addr transport set app
296303 where
297− closeConn (conn, _transport) = connClose conn
304+ withClosedRef inner = newIORef False >>= inner
305+
306+ closeConn ref conn = do
307+ isClosed <- atomicModifyIORef' ref $ \x -> (True, x)
308+ unless isClosed $ connClose conn
298309
299310 onOpen adr = increase counter >> settingsOnOpen set adr
300311 onClose adr _ = decrease counter >> settingsOnClose set adr
warp/Network/Wai/Handler/Warp/Timeout.hs+10−4
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DeriveDataTypeable #-}
23
34module Network.Wai.Handler.Warp.Timeout (
@@ -97,19 +98,24 @@ register mgr onTimeout = do
9798 return h
9899
99100-- | Registering a timeout action of killing this thread.
100−registerKillThread :: Manager -> IO Handle
101−registerKillThread m = do
101+registerKillThread :: Manager -> TimeoutAction -> IO Handle
102+registerKillThread m onTimeout = do
102103 -- If we hold ThreadId, the stack and data of the thread is leaked.
103104 -- If we hold Weak ThreadId, the stack is released. However, its
104105 -- data is still leaked probably because of a bug of GHC.
105106 -- So, let's just use ThreadId and release ThreadId by
106107 -- overriding the timeout action by "cancel".
107108 tid <- myThreadId
108− register m $ E.throwTo tid TimeoutThread
109+ -- First run the timeout action in case the child thread is masked.
110+ register m $ onTimeout `E.finally` E.throwTo tid TimeoutThread
109111
110112data TimeoutThread = TimeoutThread
111113 deriving Typeable
112−instance E.Exception TimeoutThread
114+instance E.Exception TimeoutThread where
115+#if MIN_VERSION_base(4,7,0)
116+ toException = E.asyncExceptionToException
117+ fromException = E.asyncExceptionFromException
118+#endif
113119instance Show TimeoutThread where
114120 show TimeoutThread = "Thread killed by Warp's timeout reaper"
115121