Permalink
Browse files

Make sure we call TimeoutManager.cancel when threads die. Closes #99.

  • Loading branch information...
1 parent 2fa39ce commit 3d03b32a6f2d6ecdf9698df09f4ef61096ca5054 @gregorycollins gregorycollins committed May 15, 2017
Showing with 12 additions and 7 deletions.
  1. +1 −0 .gitignore
  2. +1 −1 snap-server.cabal
  3. +7 −3 src/Snap/Internal/Http/Server/Session.hs
  4. +3 −3 src/Snap/Internal/Http/Server/TimeoutManager.hs
View
@@ -1,6 +1,7 @@
dist
dist-newstyle
cabal-dev
+cabal.project.local
.hpc
*.o
*.hi
View
@@ -1,5 +1,5 @@
name: snap-server
-version: 1.0.2.1
+version: 1.0.2.2
synopsis: A web server for the Snap Framework
description:
Snap is a simple and fast web development framework and server written in
@@ -192,8 +192,10 @@ httpAcceptLoop serverHandler serverConfig acceptFunc = runLoops
connClose <- newIORef False
newConn <- newIORef True
let twiddleTimeout = unsafePerformIO $ do
- th <- readMVar thMVar
- return $ TM.modify th
+ th <- readMVar thMVar
+ return $! TM.modify th
+ let cleanupTimeout = do th <- readMVar thMVar
+ return $! TM.cancel th
let !psd = PerSessionData connClose
twiddleTimeout
@@ -205,7 +207,9 @@ httpAcceptLoop serverHandler serverConfig acceptFunc = runLoops
remotePort
readEnd
writeEnd
- restore (session psd) `E.finally` cleanup
+ restore (session psd)
+ `E.finally` cleanup
+ `E.finally` cleanupTimeout
--------------------------------------------------------------------------
session psd = do
@@ -19,10 +19,10 @@ module Snap.Internal.Http.Server.TimeoutManager
------------------------------------------------------------------------------
import Control.Exception (evaluate, finally)
import qualified Control.Exception as E
-import Control.Monad (Monad ((>>=), return), mapM_, void, when)
+import Control.Monad (Monad (return, (>>=)), mapM_, void, when)
import qualified Data.ByteString.Char8 as S
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Prelude (Bool, Double, IO, Int, Show (..), const, fromIntegral, max, null, otherwise, round, ($), ($!), (+), (++), (-), (.), (<=), (==))
+import Prelude (Bool, Double, IO, Int, Show (..), const, fromIntegral, max, null, otherwise, round, ($), ($!), (+), (++), (-), (.), (<=), (==))
------------------------------------------------------------------------------
import Control.Concurrent (MVar, newEmptyMVar, putMVar, readMVar, takeMVar, tryPutMVar)
------------------------------------------------------------------------------
@@ -172,8 +172,8 @@ modify th f = do
-- | Cancel a timeout.
cancel :: TimeoutThread -> IO ()
cancel h = E.uninterruptibleMask_ $ do
- T.cancel $ _thread h
writeIORef (_state h) canceled
+ T.cancel $ _thread h
{-# INLINE cancel #-}

0 comments on commit 3d03b32

Please sign in to comment.