3eb5866 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Better async exception behavior for timeoutes #602

3eb5866Michael Snoyman10 years ago

warp/Network/Wai/Handler/Warp/HTTP2/Worker.hs+2−1

compare with master

unifiedsplit

@@ -236,7 +236,8 @@ worker :: Context -> S.Settings -> Application -> Responder -> T.Manager -> IO (

236worker ctx@Context{inputQ,controlQ} set app responder tm = do

237 sinfo <- newStreamInfo

238 tcont <- newThreadContinue

239+ let timeoutAction = return () -- cannot close the shared connection

239− E.bracket (T.registerKillThread tm) T.cancel $ go sinfo tcont

240+ E.bracket (T.registerKillThread tm timeoutAction) T.cancel $ go sinfo tcont

240 where

241 where

241 go sinfo tcont th = do

242 go sinfo tcont th = do

242 setThreadContinue tcont True

243 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

35import qualified Network.Wai.Handler.Warp.FileInfoCache as I

36import Network.Wai.Handler.Warp.HTTP2 (http2, isHTTP2)

37import Network.Wai.Handler.Warp.Header

38+import Network.Wai.Handler.Warp.IORef

38import Network.Wai.Handler.Warp.ReadInt

39import Network.Wai.Handler.Warp.ReadInt

39import Network.Wai.Handler.Warp.Recv

40import Network.Wai.Handler.Warp.Recv

40import Network.Wai.Handler.Warp.Request

41import Network.Wai.Handler.Warp.Request

@@ -262,6 +263,10 @@ fork :: Settings

262 -> InternalInfo0

263 -> InternalInfo0

263 -> IO ()

264 -> IO ()

264fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->

265fork 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+

265 -- Run the connection maker to get a new connection, and ensure

270 -- Run the connection maker to get a new connection, and ensure

266 -- that the connection is closed. If the mkConn call throws an

271 -- that the connection is closed. If the mkConn call throws an

267 -- exception, we will leak the connection. If the mkConn call is

272 -- 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 ->

272 -- We grab the connection before registering timeouts since the

277 -- We grab the connection before registering timeouts since the

273 -- timeouts will be useless during connection creation, due to the

278 -- timeouts will be useless during connection creation, due to the

274 -- fact that async exceptions are still masked.

279 -- fact that async exceptions are still masked.

275− bracket mkConn closeConn $ \(conn, transport) ->

280+ bracket mkConn (closeConn ref . fst) $ \(conn, transport) ->

276

281

277 -- We need to register a timeout handler for this thread, and

282 -- We need to register a timeout handler for this thread, and

278− -- cancel that handler as soon as we exit.

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.

279− bracket (T.registerKillThread (timeoutManager0 ii0)) T.cancel $ \th ->

286+ bracket (T.registerKillThread (timeoutManager0 ii0) (closeConn ref conn)) T.cancel $ \th ->

280

287

281 let ii1 = toInternalInfo1 ii0 th

288 let ii1 = toInternalInfo1 ii0 th

282 -- We now have fully registered a connection close handler

289 -- We now have fully registered a connection close handler

@@ -294,7 +301,11 @@ fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->

294 -- bracket with closeConn above ensures the connection is closed.

301 -- bracket with closeConn above ensures the connection is closed.

295 when goingon $ serveConnection conn ii1 addr transport set app

302 when goingon $ serveConnection conn ii1 addr transport set app

296 where

303 where

304+ withClosedRef inner = newIORef False >>= inner

305+

306+ closeConn ref conn = do

307+ isClosed <- atomicModifyIORef' ref $ \x -> (True, x)

297− closeConn (conn, _transport) = connClose conn

308+ unless isClosed $ connClose conn

298

309

299 onOpen adr = increase counter >> settingsOnOpen set adr

310 onOpen adr = increase counter >> settingsOnOpen set adr

300 onClose adr _ = decrease counter >> settingsOnClose set adr

311 onClose adr _ = decrease counter >> settingsOnClose set adr

warp/Network/Wai/Handler/Warp/Timeout.hs+10−4

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3module Network.Wai.Handler.Warp.Timeout (

4module Network.Wai.Handler.Warp.Timeout (

@@ -97,19 +98,24 @@ register mgr onTimeout = do

97 return h

98 return h

99-- | Registering a timeout action of killing this thread.

100-- | Registering a timeout action of killing this thread.

100−registerKillThread :: Manager -> IO Handle

101+registerKillThread :: Manager -> TimeoutAction -> IO Handle

101−registerKillThread m = do

102+registerKillThread m onTimeout = do

102 -- If we hold ThreadId, the stack and data of the thread is leaked.

103 -- If we hold ThreadId, the stack and data of the thread is leaked.

103 -- If we hold Weak ThreadId, the stack is released. However, its

104 -- If we hold Weak ThreadId, the stack is released. However, its

104 -- data is still leaked probably because of a bug of GHC.

105 -- data is still leaked probably because of a bug of GHC.

105 -- So, let's just use ThreadId and release ThreadId by

106 -- So, let's just use ThreadId and release ThreadId by

106 -- overriding the timeout action by "cancel".

107 -- overriding the timeout action by "cancel".

107 tid <- myThreadId

108 tid <- myThreadId

109+ -- First run the timeout action in case the child thread is masked.

108− register m $ E.throwTo tid TimeoutThread

110+ register m $ onTimeout `E.finally` E.throwTo tid TimeoutThread

109

111

110data TimeoutThread = TimeoutThread

112data TimeoutThread = TimeoutThread

111 deriving Typeable

113 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

113instance Show TimeoutThread where

119instance Show TimeoutThread where

114 show TimeoutThread = "Thread killed by Warp's timeout reaper"

120 show TimeoutThread = "Thread killed by Warp's timeout reaper"

115

121