@@ -20,6 +20,7 @@ import Network.Socket (accept, withSocketsDo, SockAddr)
2020import qualified Network.Socket.ByteString as Sock
2121import Network.Wai
2222import Network.Wai.Handler.Warp.Buffer
23+import Network.Wai.Handler.Warp.Counter
2324import qualified Network.Wai.Handler.Warp.Date as D
2425import qualified Network.Wai.Handler.Warp.FdCache as F
2526import Network.Wai.Handler.Warp.Header
@@ -125,11 +126,12 @@ runSettingsConnectionMaker x y =
125126runSettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Bool), SockAddr) -> Application -> IO ()
126127runSettingsConnectionMakerSecure set getConnMaker app = do
127128 settingsBeforeMainLoop set
129+ counter <- newCounter
128130
129131 D.withDateCache $ \dc ->
130132 F.withFdCache fdCacheDurationInSeconds $ \fc ->
131133 withTimeoutManager $ \tm ->
132− acceptConnection set getConnMaker app dc fc tm
134+ acceptConnection set getConnMaker app dc fc tm counter
133135 where
134136 fdCacheDurationInSeconds = settingsFdCacheDuration set * 1000000
135137 withTimeoutManager f = case settingsManager set of
@@ -163,13 +165,14 @@ acceptConnection :: Settings
163165 -> D.DateCache
164166 -> Maybe F.MutableFdCache
165167 -> T.Manager
168+ -> Counter
166169 -> IO ()
167−acceptConnection set getConnMaker app dc fc tm = do
170+acceptConnection set getConnMaker app dc fc tm counter = do
168171 -- First mask all exceptions in acceptLoop. This is necessary to
169172 -- ensure that no async exception is throw between the call to
170173 -- acceptNewConnection and the registering of connClose.
171174 void $ mask_ $ acceptLoop
172− gracefulShutdown
175+ gracefulShutdown counter
173176 where
174177 acceptLoop = do
175178 -- Allow async exceptions before receiving the next connection maker.
@@ -186,7 +189,7 @@ acceptConnection set getConnMaker app dc fc tm = do
186189 case mx of
187190 Nothing -> return ()
188191 Just (mkConn, addr) -> do
189− fork set mkConn addr app dc fc tm
192+ fork set mkConn addr app dc fc tm counter
190193 acceptLoop
191194
192195 acceptNewConnection = do
@@ -214,8 +217,9 @@ fork :: Settings
214217 -> D.DateCache
215218 -> Maybe F.MutableFdCache
216219 -> T.Manager
220+ -> Counter
217221 -> IO ()
218−fork set mkConn addr app dc fc tm = void $ forkIOWithUnmask $ \unmask ->
222+fork set mkConn addr app dc fc tm counter = void $ forkIOWithUnmask $ \unmask ->
219223 -- Run the connection maker to get a new connection, and ensure
220224 -- that the connection is closed. If the mkConn call throws an
221225 -- exception, we will leak the connection. If the mkConn call is
@@ -251,8 +255,8 @@ fork set mkConn addr app dc fc tm = void $ forkIOWithUnmask $ \unmask ->
251255 where
252256 closeConn (conn, _isSecure) = connClose conn
253257
254− onOpen = settingsOnOpen set
255− onClose adr _ = settingsOnClose set adr
258+ onOpen adr = increase counter >> settingsOnOpen set adr
259+ onClose adr _ = decrease counter >> settingsOnClose set adr
256260
257261serveConnection :: Connection
258262 -> InternalInfo
@@ -342,5 +346,8 @@ setSocketCloseOnExec socket =
342346 setFdOption (fromIntegral $ fdSocket socket) CloseOnExec True
343347#endif
344348
345−gracefulShutdown :: IO ()
346−gracefulShutdown = return ()
349+gracefulShutdown :: Counter -> IO ()
350+gracefulShutdown counter = do
351+ threadDelay 10000000
352+ noConnections <- isZero counter
353+ unless noConnections $ gracefulShutdown counter