delay new connection in case of exausted files

yesodweb · Sep 15, 2024 · 3576f6f · 3576f6f
1 parent c50cb91
commit 3576f6f
Showing 1 changed file with 13 additions and 8 deletions.
diff --git a/warp/Network/Wai/Handler/Warp/Run.hs b/warp/Network/Wai/Handler/Warp/Run.hs
@@ -13,7 +13,8 @@ import qualified Control.Exception
 import qualified Data.ByteString as S
 import Data.IORef (newIORef, readIORef)
 import Data.Streaming.Network (bindPortTCP)
-import Foreign.C.Error (Errno (..), eCONNABORTED)
+import Foreign.C.Error (Errno (..), eCONNABORTED, eMFILE)
+import GHC.Conc (threadDelay)
 import GHC.IO.Exception (IOErrorType (..), IOException (..))
 import Network.Socket (
     SockAddr,
@@ -305,13 +306,17 @@ acceptConnection set getConnMaker app counter ii = do
         case ex of
             Right x -> return $ Just x
             Left e -> do
-                let eConnAborted = getErrno eCONNABORTED
-                    getErrno (Errno cInt) = cInt
-                if ioe_errno e == Just eConnAborted
-                    then acceptNewConnection
-                    else do
-                        settingsOnException set Nothing $ toException e
-                        return Nothing
+                let getErrno (Errno cInt) = cInt
+                    isErrno err = ioe_errno e == Just (getErrno err)
+                case () of
+                      _ | isErrno eCONNABORTED -> acceptNewConnection
+                        | isErrno eMFILE -> do
+                            settingsOnException set Nothing $ toException e
+                            threadDelay 100000
+                            acceptNewConnection
+                        | otherwise -> do
+                            settingsOnException set Nothing $ toException e
+                            return Nothing
 
 -- Fork a new worker thread for this connection maker, and ask for a
 -- function to unmask (i.e., allow async exceptions to be thrown).