@@ -166,33 +166,41 @@ acceptConnection :: Settings
166166-- First mask all exceptions in the main loop. This is necessary to ensure
167167-- that no async exception is throw between the call to getConnLoop and the
168168-- registering of connClose.
169−acceptConnection set getConnMaker app dc fc tm = mask $ \restore -> do
169+acceptConnection set getConnMaker app dc fc tm = do
170170 -- Allow async exceptions before receiving the next connection maker.
171− allowInterrupt
172−
173− -- getConnLoop will try to receive the next incoming request. It
174− -- returns a /connection maker/, not a connection, since in some
175− -- circumstances creating a working connection from a raw socket may be
176− -- an expensive operation, and this expensive work should not be
177− -- performed in the main event loop. An example of something expensive
178− -- would be TLS negotiation.
179− em <- try getConnLoop
180− case em of
181− Left (_ :: IOException) -> restore gracefulShutdown
182− Right (mkConn, addr) -> do
183− fork set mkConn addr app dc fc tm
184− restore $ acceptConnection set getConnMaker app dc fc tm
171+ shutdown <- mask_ $ do
172+ -- getConnLoop will try to receive the next incoming
173+ -- request. It returns a /connection maker/, not a connection,
174+ -- since in some circumstances creating a working connection
175+ -- from a raw socket may be an expensive operation, and this
176+ -- expensive work should not be performed in the main event
177+ -- loop. An example of something expensive would be TLS
178+ -- negotiation.
179+ mx <- getConnLoop
180+ case mx of
181+ Nothing -> return True
182+ Just (mkConn, addr) -> do
183+ 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
185189 where
186− getConnLoop = getConnMaker `E.catch` \(e :: IOException) -> do
187− onE set Nothing (toException e)
188− if isFullErrorType (ioeGetErrorType e) then do
189− -- "resource exhausted (Too many open files)" may happen
190− -- by accept().
191− -- Wait a second hoping that resource will be available.
192− threadDelay 1000000
193− getConnLoop
194− else
195− throwIO e
190+ getConnLoop = do
191+ ex <- try getConnMaker
192+ case ex of
193+ Right x -> return $ Just x
194+ Left e -> do
195+ onE set Nothing $ toException e
196+ if isFullErrorType (ioeGetErrorType e) then do
197+ -- "resource exhausted (Too many open files)" may
198+ -- happen by accept(). Wait a second hoping that
199+ -- resource will be available.
200+ threadDelay 1000000
201+ getConnLoop
202+ else
203+ return Nothing
196204
197205-- Fork a new worker thread for this connection maker, and ask for a
198206-- function to unmask (i.e., allow async exceptions to be thrown).