From 24f1e2d226f494444ab8dddd3bd2d81ccd7eecde Mon Sep 17 00:00:00 2001 From: Bas van Dijk Date: Tue, 23 Mar 2010 14:07:59 +0100 Subject: [PATCH 2/2] Block asynchronous exceptions before installing exception handler --- src/Network/Salvia/Impl/Server.hs | 6 +++--- 1 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Network/Salvia/Impl/Server.hs b/src/Network/Salvia/Impl/Server.hs index cabc9fb..22b4995 100644 --- a/src/Network/Salvia/Impl/Server.hs +++ b/src/Network/Salvia/Impl/Server.hs @@ -3,7 +3,7 @@ module Network.Salvia.Impl.Server (start) where import Control.Concurrent (myThreadId) import Control.Concurrent.Thread (ThreadId, forkIO, wait_, threadId) import Control.Concurrent.MVar (newMVar, modifyMVar_, readMVar) -import Control.Exception (finally) +import Control.Exception (finally, block, unblock) import Control.Monad.State import Data.Functor ((<$)) import Network.Protocol.Http hiding (accept, hostname) @@ -48,8 +48,8 @@ start conf handler payload = forM (listenOn conf) (forkIO . listener) >>= waitAl acceptHandle handlersTidsMVar s = do a <- accept s modifyMVar_ handlersTidsMVar $ \handlersTids -> - fmap (:handlersTids) $ forkIO $ - handle a `finally` deleteMyTid handlersTidsMVar + fmap (:handlersTids) $ block $ forkIO $ + unblock (handle a) `finally` deleteMyTid handlersTidsMVar handle (sck, cAddr) = do hndl <- socketToHandle sck ReadWriteMode -- 1.6.4.4