warp 1.3.7.4 → 1.3.7.5

raw patch · 3 files changed

+83/−16 lines, 3 filesdep ~base

Dependency ranges changed: base

Files

• Network/Wai/Handler/Warp/Run.hs +62/−13
• Network/Wai/Handler/Warp/Timeout.hs +20/−2
• warp.cabal +1/−1

@@ -3,7 +3,7 @@  module Network.Wai.Handler.Warp.Run where -import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent (threadDelay, forkIOWithUnmask) import Control.Exception import Control.Monad (forever, when, unless, void) import Control.Monad.IO.Class (MonadIO, liftIO)@@ -33,6 +33,7 @@ #if WINDOWS import qualified Control.Concurrent.MVar as MV import Network.Socket (withSocketsDo)+import Control.Concurrent (forkIO) #else import System.Posix.IO (FdOption(CloseOnExec), setFdOption) import Network.Socket (fdSocket)@@ -141,23 +142,71 @@         _ -> Just <$> F.initialize (duration * 1000000) #endif     settingsBeforeMainLoop set-    mask $ \restore -> forever $ do++    -- Note that there is a thorough discussion of the exception safety of the+    -- following code at: https://github.com/yesodweb/wai/issues/146+    --+    -- We need to make sure of two things:+    --+    -- 1. Asynchronous exceptions are not blocked entirely in the main loop.+    --    Doing so would make it impossible to kill the Warp thread.+    --+    -- 2. Once a connection maker is received via getConnLoop, the connection+    --    is guaranteed to be closed, even in the presence of async exceptions.+    --+    -- Our approach is explained in the comments below.++    -- First mask all exceptions in the main loop. This is necessary to ensure+    -- that no async exception is throw between the call to getConnLoop and the+    -- registering of connClose.+    mask_ . forever $ do+        -- Allow async exceptions before receiving the next connection maker.         allowInterrupt++        -- getConnLoop will try to receive the next incoming request. It+        -- returns a /connection maker/, not a connection, since in some+        -- circumstances creating a working connection from a raw socket may be+        -- an expensive operation, and this expensive work should not be+        -- performed in the main event loop. An example of something expensive+        -- would be TLS negotiation.         (mkConn, addr) <- getConnLoop-        void . forkIO $ do-            th <- T.registerKillThread tm-            conn <- mkConn++        -- Fork a new worker thread for this connection maker, and ask for a+        -- function to unmask (i.e., allow async exceptions to be thrown).+        void . forkIOWithUnmask $ \unmask ->+            -- Run the connection maker to get a new connection, and ensure+            -- that the connection is closed. If the mkConn call throws an+            -- exception, we will leak the connection. If the mkConn call is+            -- vulnerable to attacks (e.g., Slowloris), we do nothing to+            -- protect the server. It is therefore vital that mkConn is well+            -- vetted.+            --+            -- We grab the connection before registering timeouts since the+            -- timeouts will be useless during connection creation, due to the+            -- fact that async exceptions are still masked.+            bracket mkConn connClose $ \conn ->++            -- We need to register a timeout handler for this thread, and+            -- cancel that handler as soon as we exit.+            bracket (T.registerKillThread tm) T.cancel $ \th -> #if SENDFILEFD-            let cleaner = Cleaner th fc+                let cleaner = Cleaner th fc #else-            let cleaner = Cleaner th+                let cleaner = Cleaner th #endif-            let serve = do-                    onOpen-                    restore $ serveConnection set cleaner port app conn addr-                    cleanup-                cleanup = connClose conn >> T.cancel th >> onClose-            handle onE (serve `onException` cleanup)+                    -- We now have fully registered a connection close handler+                    -- in the case of all exceptions, so it is safe to one+                    -- again allow async exceptions.+                 in unmask .+                    -- Call the user-supplied on exception code if any+                    -- exceptions are thrown.+                    handle onE .++                    -- Call the user-supplied code for connection open and close events+                    bracket_ onOpen onClose $++                    -- Actually serve this connection.+                    serveConnection set cleaner port app conn addr   where     -- FIXME: only IOEception is caught. What about other exceptions?     getConnLoop = getConn `catch` \(e :: IOException) -> do

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples, MagicHash #-} module Network.Wai.Handler.Warp.Timeout (     Manager   , Handle@@ -12,6 +14,15 @@   , dummyHandle   ) where +import System.Mem.Weak (deRefWeak)+#if MIN_VERSION_base(4,6,0)+import Control.Concurrent (mkWeakThreadId)+#else+import GHC.Weak (Weak (..))+import GHC.Conc.Sync (ThreadId (..))+import GHC.IO (IO (IO))+import GHC.Exts (mkWeak#)+#endif import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread) import qualified Control.Exception as E import Control.Monad (forever, void)@@ -68,8 +79,15 @@  registerKillThread :: Manager -> IO Handle registerKillThread m = do-    tid <- myThreadId-    register m $ killThread tid+    wtid <- myThreadId >>= mkWeakThreadId+    register m $ deRefWeak wtid >>= maybe (return ()) killThread++#if !MIN_VERSION_base(4,6,0)+mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)+mkWeakThreadId t@(ThreadId t#) = IO $ \s ->+   case mkWeak# t# t Nothing s of+      (# s1, w #) -> (# s1, Weak w #)+#endif  tickle, pause, resume, cancel :: Handle -> IO () tickle (Handle _ iactive) = I.writeIORef iactive Active

@@ -1,5 +1,5 @@ Name:                warp-Version:             1.3.7.4+Version:             1.3.7.5 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE