git.iko.soy/typeable/wai
on master help sign in
Implement stopManager (#148)
commit550c3a3ad19cfd901974d4764bb1a8c21d91a8f2 authorMichael Snoyman <michael@snoyman.com> dateTue 26 Mar 2013, 20:50 (14 years ago) parent9663de0
2 files changed+20−5
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/Run.hs+9−3 warp/Network/Wai/Handler/Warp/Timeout.hs+11−2
warp/Network/Wai/Handler/Warp/Run.hs+9−3
@@ -133,8 +133,6 @@ runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMa
133133-- Since 1.3.5
134134runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()
135135runSettingsConnectionMaker set getConn app = do
136− tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
137− $ settingsManager set
138136#if SENDFILEFD
139137 let duration = settingsFdCacheDuration set
140138 fc <- case duration of
@@ -159,7 +157,7 @@ runSettingsConnectionMaker set getConn app = do
159157 -- First mask all exceptions in the main loop. This is necessary to ensure
160158 -- that no async exception is throw between the call to getConnLoop and the
161159 -- registering of connClose.
162− mask_ . forever $ do
160+ withTimeoutManager $ \tm -> mask_ . forever $ do
163161 -- Allow async exceptions before receiving the next connection maker.
164162 allowInterrupt
165163
@@ -220,6 +218,14 @@ runSettingsConnectionMaker set getConn app = do
220218 onOpen = settingsOnOpen set
221219 onClose = settingsOnClose set
222220
221+ withTimeoutManager f =
222+ case settingsManager set of
223+ Nothing -> bracket
224+ (T.initialize $ settingsTimeout set * 1000000)
225+ T.stopManager
226+ f
227+ Just tm -> f tm
228+
223229serveConnection :: Settings
224230 -> Cleaner
225231 -> Port -> Application -> Connection -> SockAddr-> IO ()
warp/Network/Wai/Handler/Warp/Timeout.hs+11−2
@@ -1,9 +1,11 @@
11{-# LANGUAGE CPP #-}
2+{-# LANGUAGE BangPatterns #-}
23{-# LANGUAGE UnboxedTuples, MagicHash #-}
34module Network.Wai.Handler.Warp.Timeout (
45 Manager
56 , Handle
67 , initialize
8+ , stopManager
79 , register
810 , registerKillThread
911 , tickle
@@ -29,8 +31,6 @@ import Control.Monad (forever, void)
2931import qualified Data.IORef as I
3032import System.IO.Unsafe (unsafePerformIO)
3133
32−-- FIXME implement stopManager
33−
3434-- | A timeout manager
3535newtype Manager = Manager (I.IORef [Handle])
3636
@@ -67,6 +67,15 @@ initialize timeout = do
6767 go' Active = Inactive
6868 go' x = x
6969
70+stopManager :: Manager -> IO ()
71+stopManager (Manager ihandles) = E.mask_ $ do
72+ -- Put an undefined value in the IORef to kill the worker thread (yes, it's
73+ -- a bit of a hack)
74+ !handles <- I.atomicModifyIORef ihandles $ \h -> (error "Timeout manager stopped", h)
75+ mapM_ go handles
76+ where
77+ go (Handle onTimeout _) = onTimeout
78+
7079ignoreAll :: E.SomeException -> IO ()
7180ignoreAll _ = return ()
7281