@@ -1,7 +1,4 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE MagicHash #-}
4−{-# LANGUAGE UnboxedTuples #-} -- for GHC 7.4 or earlier
52
63module Network.Wai.Handler.Warp.Timeout (
74 -- ** Types
@@ -24,25 +21,12 @@ module Network.Wai.Handler.Warp.Timeout (
2421 , TimeoutThread (..)
2522 ) where
2623
27−#ifndef MIN_VERSION_base
28−#define MIN_VERSION_base(x,y,z) 1
29−#endif
30−
31−#if MIN_VERSION_base(4,6,0)
32−import Control.Concurrent (mkWeakThreadId, ThreadId)
33−#else
34−import GHC.Conc (ThreadId(..))
35−import GHC.Exts (mkWeak#)
36−import GHC.IO (IO (IO))
37−#endif
3824import Control.Concurrent (myThreadId)
3925import qualified Control.Exception as E
40−import GHC.Weak (Weak (..))
26+import Control.Reaper
27+import Data.Typeable (Typeable)
4128import Network.Wai.Handler.Warp.IORef (IORef)
4229import qualified Network.Wai.Handler.Warp.IORef as I
43−import System.Mem.Weak (deRefWeak)
44−import Data.Typeable (Typeable)
45−import Control.Reaper
4630
4731----------------------------------------------------------------
4832
@@ -53,7 +37,7 @@ type Manager = Reaper [Handle] Handle
5337type TimeoutAction = IO ()
5438
5539-- | A handle used by 'Manager'
56−data Handle = Handle TimeoutAction (IORef State)
40+data Handle = Handle !(IORef TimeoutAction) !(IORef State)
5741
5842data State = Active -- Manager turns it to Inactive.
5943 | Inactive -- Manager removes it with timeout action.
@@ -70,10 +54,11 @@ initialize timeout = mkReaper defaultReaperSettings
7054 , reaperDelay = timeout
7155 }
7256 where
73− prune m@(Handle onTimeout iactive) = do
74− state <- I.atomicModifyIORef' iactive (\x -> (inactivate x, x))
57+ prune m@(Handle actionRef stateRef) = do
58+ state <- I.atomicModifyIORef' stateRef (\x -> (inactivate x, x))
7559 case state of
7660 Inactive -> do
61+ onTimeout <- I.readIORef actionRef
7762 onTimeout `E.catch` ignoreAll
7863 return Nothing
7964 Canceled -> return Nothing
@@ -88,7 +73,9 @@ initialize timeout = mkReaper defaultReaperSettings
8873stopManager :: Manager -> IO ()
8974stopManager mgr = E.mask_ (reaperStop mgr >>= mapM_ fire)
9075 where
91− fire (Handle onTimeout _) = onTimeout `E.catch` ignoreAll
76+ fire (Handle actionRef _) = do
77+ onTimeout <- I.readIORef actionRef
78+ onTimeout `E.catch` ignoreAll
9279
9380ignoreAll :: E.SomeException -> IO ()
9481ignoreAll _ = return ()
@@ -98,24 +85,22 @@ ignoreAll _ = return ()
9885-- | Registering a timeout action.
9986register :: Manager -> TimeoutAction -> IO Handle
10087register mgr onTimeout = do
101− iactive <- I.newIORef Active
102− let h = Handle onTimeout iactive
88+ actionRef <- I.newIORef onTimeout
89+ stateRef <- I.newIORef Active
90+ let h = Handle actionRef stateRef
10391 reaperAdd mgr h
10492 return h
10593
10694-- | Registering a timeout action of killing this thread.
10795registerKillThread :: Manager -> IO Handle
10896registerKillThread m = do
109− wtid <- myThreadId >>= mkWeakThreadId
110− register m $ killIfExist wtid
111−
112−-- If ThreadId is hold referred by a strong reference,
113−-- it leaks even after the thread is killed.
114−-- So, let's use a weak reference so that CG can throw ThreadId away.
115−-- deRefWeak checks if ThreadId referenced by the weak reference
116−-- exists. If exists, it means that the thread is alive.
117−killIfExist :: Weak ThreadId -> TimeoutAction
118−killIfExist wtid = deRefWeak wtid >>= maybe (return ()) (`E.throwTo` TimeoutThread)
97+ -- If we hold ThreadId, the stack and data of the thread is leaked.
98+ -- If we hold Weak ThreadId, the stack is released. However, its
99+ -- data is still leaked probably because of a bug of GHC.
100+ -- So, let's just use ThreadId and release ThreadId by
101+ -- overriding the timeout action by "cancel".
102+ tid <- myThreadId
103+ register m $ E.throwTo tid TimeoutThread
119104
120105data TimeoutThread = TimeoutThread
121106 deriving Typeable
@@ -123,29 +108,24 @@ instance E.Exception TimeoutThread
123108instance Show TimeoutThread where
124109 show TimeoutThread = "Thread killed by Warp's timeout reaper"
125110
126−#if !MIN_VERSION_base(4,6,0)
127−mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)
128−mkWeakThreadId t@(ThreadId t#) = IO $ \s ->
129− case mkWeak# t# t Nothing s of
130− (# s1, w #) -> (# s1, Weak w #)
131−#endif
132−
133111----------------------------------------------------------------
134112
135113-- | Setting the state to active.
136114-- 'Manager' turns active to inactive repeatedly.
137115tickle :: Handle -> IO ()
138−tickle (Handle _ iactive) = I.writeIORef iactive Active
116+tickle (Handle _ stateRef) = I.writeIORef stateRef Active
139117
140118-- | Setting the state to canceled.
141119-- 'Manager' eventually removes this without timeout action.
142120cancel :: Handle -> IO ()
143−cancel (Handle _ iactive) = I.writeIORef iactive Canceled
121+cancel (Handle actionRef stateRef) = do
122+ I.writeIORef actionRef (return ()) -- ensuring to release ThreadId
123+ I.writeIORef stateRef Canceled
144124
145125-- | Setting the state to paused.
146126-- 'Manager' does not change the value.
147127pause :: Handle -> IO ()
148−pause (Handle _ iactive) = I.writeIORef iactive Paused
128+pause (Handle _ stateRef) = I.writeIORef stateRef Paused
149129
150130-- | Setting the paused state to active.
151131-- This is an alias to 'tickle'.