@@ -152,8 +152,9 @@ onE set mreq e = case fromException e of
152152-- 1. Asynchronous exceptions are not blocked entirely in the main loop.
153153-- Doing so would make it impossible to kill the Warp thread.
154154--
155−-- 2. Once a connection maker is received via getConnLoop, the connection
156−-- is guaranteed to be closed, even in the presence of async exceptions.
155+-- 2. Once a connection maker is received via acceptNewConnection, the
156+-- connection is guaranteed to be closed, even in the presence of
157+-- async exceptions.
157158--
158159-- Our approach is explained in the comments below.
159160acceptConnection :: Settings
@@ -163,31 +164,32 @@ acceptConnection :: Settings
163164 -> Maybe F.MutableFdCache
164165 -> T.Manager
165166 -> IO ()
166−-- First mask all exceptions in the main loop. This is necessary to ensure
167−-- that no async exception is throw between the call to getConnLoop and the
168−-- registering of connClose.
169167acceptConnection set getConnMaker app dc fc tm = do
170− -- Allow async exceptions before receiving the next connection maker.
171− shutdown <- mask_ $ do
172− -- getConnLoop will try to receive the next incoming
168+ -- First mask all exceptions in acceptLoop. This is necessary to
169+ -- ensure that no async exception is throw between the call to
170+ -- acceptNewConnection and the registering of connClose.
171+ void $ mask_ $ acceptLoop
172+ gracefulShutdown
173+ where
174+ acceptLoop = do
175+ -- Allow async exceptions before receiving the next connection maker.
176+ allowInterrupt
177+
178+ -- acceptNewConnection will try to receive the next incoming
173179 -- request. It returns a /connection maker/, not a connection,
174180 -- since in some circumstances creating a working connection
175181 -- from a raw socket may be an expensive operation, and this
176182 -- expensive work should not be performed in the main event
177183 -- loop. An example of something expensive would be TLS
178184 -- negotiation.
179− mx <- getConnLoop
185+ mx <- acceptNewConnection
180186 case mx of
181− Nothing -> return True
187+ Nothing -> return ()
182188 Just (mkConn, addr) -> do
183189 fork set mkConn addr app dc fc tm
184− return False
185− if shutdown then
186− gracefulShutdown
187− else
188− acceptConnection set getConnMaker app dc fc tm
189− where
190− getConnLoop = do
190+ acceptLoop
191+
192+ acceptNewConnection = do
191193 ex <- try getConnMaker
192194 case ex of
193195 Right x -> return $ Just x
@@ -198,8 +200,9 @@ acceptConnection set getConnMaker app dc fc tm = do
198200 -- happen by accept(). Wait a second hoping that
199201 -- resource will be available.
200202 threadDelay 1000000
201− getConnLoop
203+ acceptNewConnection
202204 else
205+ -- Assuming the listen socket is closed.
203206 return Nothing
204207
205208-- Fork a new worker thread for this connection maker, and ask for a