@@ -8,10 +8,12 @@ module Network.Wai.Handler.Warp.FdCache (
88
99import Control.Applicative ((<$>), (<*>))
1010import Control.Concurrent
11+import Control.Exception (mask_)
1112import Control.Monad
1213import Data.Hashable
1314import Data.IORef
1415import Network.Wai.Handler.Warp.MultiMap
16+import System.Mem.Weak (addFinalizer)
1517import System.Posix.IO
1618import System.Posix.Types
1719
@@ -79,16 +81,25 @@ look mfc path key = searchWith key check <$> fdCache mfc
7981initialize :: Int -> IO MutableFdCache
8082initialize duration = do
8183 mfc <- newMutableFdCache
82− void . forkIO $ loop mfc
84+ tid <- forkIO $ loop mfc
85+ addFinalizer mfc $ terminate mfc tid
8386 return mfc
8487 where
8588 loop mfc = do
86− old <- swapWithNew mfc
87− new <- pruneWith old prune
88− update mfc (merge new)
89+ mask_ $ do
90+ old <- swapWithNew mfc
91+ new <- pruneWith old prune
92+ update mfc (merge new)
8993 threadDelay duration
9094 loop mfc
9195
96+terminate :: MutableFdCache -> ThreadId -> IO ()
97+terminate (MutableFdCache icache) tid = do
98+ killThread tid
99+ readIORef icache >>= mapM_ go . toList
100+ where
101+ go (_, FdEntry _ fd _) = closeFd fd
102+
92103prune :: t -> Some FdEntry -> IO [(t, Some FdEntry)]
93104prune k v@(One (FdEntry _ fd mst)) = status mst >>= prune'
94105 where