@@ -263,44 +263,24 @@ fork :: Settings
263263 -> Counter
264264 -> InternalInfo0
265265 -> IO ()
266−fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
266+fork set mkConn addr app counter ii0 = settingsFork set $ \unmask ->
267+ -- Call the user-supplied on exception code if any
268+ -- exceptions are thrown.
269+ handle (settingsOnException set Nothing) .
267270 -- Allocate a new IORef indicating whether the connection has been
268271 -- closed, to avoid double-freeing a connection
269272 withClosedRef $ \ref ->
270− let cleanUp (conn, _) = closeConn ref conn `finally` connFree conn
271− serve (conn, transport) =
272− -- We need to register a timeout handler for this thread, and
273− -- cancel that handler as soon as we exit. We additionally close
274− -- the connection immediately in case the child thread catches the
275− -- async exception or performs some long-running cleanup action.
276− bracket (T.registerKillThread (timeoutManager0 ii0) (closeConn ref conn))
277− T.cancel $ \th ->
278− let ii1 = toInternalInfo1 ii0 th
279− -- We now have fully registered a connection close handler
280− -- in the case of all exceptions, so it is safe to one
281− -- again allow async exceptions.
282− in unmask .
283− -- Call the user-supplied on exception code if any
284− -- exceptions are thrown.
285− handle (settingsOnException set Nothing) .
286−
287− -- Call the user-supplied code for connection open and close events
288− bracket (onOpen addr) (onClose addr) $ \goingon ->
289−
290− -- Actually serve this connection.
291− -- bracket with closeConn above ensures the connection is closed.
292− when goingon $ serveConnection conn ii1 addr transport set app
293− -- Run the connection maker to get a new connection, and ensure
294− -- that the connection is closed. If the mkConn call throws an
295− -- exception, we will leak the connection. If the mkConn call is
296− -- vulnerable to attacks (e.g., Slowloris), we do nothing to
297− -- protect the server. It is therefore vital that mkConn is well
298− -- vetted.
299− --
300− -- We grab the connection before registering timeouts since the
301− -- timeouts will be useless during connection creation, due to the
302− -- fact that async exceptions are still masked.
303− in bracket mkConn cleanUp serve `catch` settingsOnException set Nothing
273+ -- Run the connection maker to get a new connection, and ensure
274+ -- that the connection is closed. If the mkConn call throws an
275+ -- exception, we will leak the connection. If the mkConn call is
276+ -- vulnerable to attacks (e.g., Slowloris), we do nothing to
277+ -- protect the server. It is therefore vital that mkConn is well
278+ -- vetted.
279+ --
280+ -- We grab the connection before registering timeouts since the
281+ -- timeouts will be useless during connection creation, due to the
282+ -- fact that async exceptions are still masked.
283+ bracket mkConn (cleanUp ref) (serve unmask ref)
304284 where
305285 withClosedRef inner = newIORef False >>= inner
306286
@@ -308,6 +288,29 @@ fork set mkConn addr app counter ii0 = settingsFork set $ \ unmask ->
308288 isClosed <- atomicModifyIORef' ref $ \x -> (True, x)
309289 unless isClosed $ connClose conn
310290
291+ cleanUp ref (conn, _) = closeConn ref conn `finally` connFree conn
292+
293+ -- We need to register a timeout handler for this thread, and
294+ -- cancel that handler as soon as we exit. We additionally close
295+ -- the connection immediately in case the child thread catches the
296+ -- async exception or performs some long-running cleanup action.
297+ serve unmask ref (conn, transport) = bracket register cancel $ \th -> do
298+ let ii1 = toInternalInfo1 ii0 th
299+ -- We now have fully registered a connection close handler in
300+ -- the case of all exceptions, so it is safe to one again
301+ -- allow async exceptions.
302+ unmask .
303+ -- Call the user-supplied code for connection open and
304+ -- close events
305+ bracket (onOpen addr) (onClose addr) $ \goingon ->
306+ -- Actually serve this connection. bracket with closeConn
307+ -- above ensures the connection is closed.
308+ when goingon $ serveConnection conn ii1 addr transport set app
309+ where
310+ register = T.registerKillThread (timeoutManager0 ii0)
311+ (closeConn ref conn)
312+ cancel = T.cancel
313+
311314 onOpen adr = increase counter >> settingsOnOpen set adr
312315 onClose adr _ = decrease counter >> settingsOnClose set adr
313316