@@ -3,7 +3,7 @@
33
44module Network.Wai.Handler.Warp.Run where
55
6−import Control.Concurrent (forkIO, threadDelay)
6+import Control.Concurrent (threadDelay, forkIOWithUnmask)
77import Control.Exception
88import Control.Monad (forever, when, unless, void)
99import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -33,6 +33,7 @@ import Prelude hiding (catch)
3333#if WINDOWS
3434import qualified Control.Concurrent.MVar as MV
3535import Network.Socket (withSocketsDo)
36+import Control.Concurrent (forkIO)
3637#else
3738import System.Posix.IO (FdOption(CloseOnExec), setFdOption)
3839import Network.Socket (fdSocket)
@@ -141,23 +142,71 @@ runSettingsConnectionMaker set getConn app = do
141142 _ -> Just <$> F.initialize (duration * 1000000)
142143#endif
143144 settingsBeforeMainLoop set
144− mask $ \restore -> forever $ do
145+
146+ -- Note that there is a thorough discussion of the exception safety of the
147+ -- following code at: https://github.com/yesodweb/wai/issues/146
148+ --
149+ -- We need to make sure of two things:
150+ --
151+ -- 1. Asynchronous exceptions are not blocked entirely in the main loop.
152+ -- Doing so would make it impossible to kill the Warp thread.
153+ --
154+ -- 2. Once a connection maker is received via getConnLoop, the connection
155+ -- is guaranteed to be closed, even in the presence of async exceptions.
156+ --
157+ -- Our approach is explained in the comments below.
158+
159+ -- First mask all exceptions in the main loop. This is necessary to ensure
160+ -- that no async exception is throw between the call to getConnLoop and the
161+ -- registering of connClose.
162+ mask_ . forever $ do
163+ -- Allow async exceptions before receiving the next connection maker.
145164 allowInterrupt
165+
166+ -- getConnLoop will try to receive the next incoming request. It
167+ -- returns a /connection maker/, not a connection, since in some
168+ -- circumstances creating a working connection from a raw socket may be
169+ -- an expensive operation, and this expensive work should not be
170+ -- performed in the main event loop. An example of something expensive
171+ -- would be TLS negotiation.
146172 (mkConn, addr) <- getConnLoop
147− void . forkIO $ do
148− th <- T.registerKillThread tm
149− bracket mkConn connClose $ \conn -> do
173+
174+ -- Fork a new worker thread for this connection maker, and ask for a
175+ -- function to unmask (i.e., allow async exceptions to be thrown).
176+ void . forkIOWithUnmask $ \unmask ->
177+ -- Run the connection maker to get a new connection, and ensure
178+ -- that the connection is closed. If the mkConn call throws an
179+ -- exception, we will leak the connection. If the mkConn call is
180+ -- vulnerable to attacks (e.g., Slowloris), we do nothing to
181+ -- protect the server. It is therefore vital that mkConn is well
182+ -- vetted.
183+ --
184+ -- We grab the connection before registering timeouts since the
185+ -- timeouts will be useless during connection creation, due to the
186+ -- fact that async exceptions are still masked.
187+ bracket mkConn connClose $ \conn ->
188+
189+ -- We need to register a timeout handler for this thread, and
190+ -- cancel that handler as soon as we exit.
191+ bracket (T.registerKillThread tm) T.cancel $ \th ->
150192#if SENDFILEFD
151193 let cleaner = Cleaner th fc
152194#else
153195 let cleaner = Cleaner th
154196#endif
155− let serve = do
156− onOpen
157− restore $ serveConnection set cleaner port app conn addr
158− cleanup
159− cleanup = T.cancel th >> onClose
160− handle onE (serve `onException` cleanup)
197+ -- We now have fully registered a connection close handler
198+ -- in the case of all exceptions, so it is safe to one
199+ -- again allow async exceptions.
200+ in unmask .
201+ -- Call the user-supplied on exception code if any
202+ -- exceptions are thrown.
203+ handle onE .
204+
205+ -- Call the user-supplied code for connection open and close events
206+ bracket_ onOpen onClose $
207+
208+ -- Actually serve this connection.
209+ serveConnection set cleaner port app conn addr
161210 where
162211 -- FIXME: only IOEception is caught. What about other exceptions?
163212 getConnLoop = getConn `catch` \(e :: IOException) -> do