30123fc · distributed-process

git.iko.soy/distributed-process

Fix exception handling in callLocal.

Interrupting the cleanup could cause the original exception to be ignored (i.e. the exception which caused the clean up to be executed). Ignoring the exception could be problematic. For instance, the exception can be meant to kill the thread. A later exception comming during the clean up could come from a wrapping call of System.Timeout.timeout, which would rather interrupt the computation but certainly not kill the thread.

commit30123fcc7e06d61cb862b5063490ad2b5c4c8fb6 authorFacundo Domínguez <facundo.dominguez@tweag.io> dateWed 9 Sep 2015, 16:54 (11 years ago) parent8d406d1

1 file changed+27−4

compare with master

unifiedsplit

src/Control/Distributed/Process.hs+27−4

src/Control/Distributed/Process.hs+27−4

@@ -162,6 +162,7 @@ module Control.Distributed.Process

162162import Control.Monad.IO.Class (liftIO)

163163import Control.Applicative

164164import Control.Monad.Reader (ask)

165+import Control.Concurrent (killThread)

165166import Control.Concurrent.MVar

166167 ( MVar

167168 , newEmptyMVar

@@ -196,6 +197,7 @@ import Control.Distributed.Process.Internal.Types

196197 , RegisterReply(..)

197198 , LocalProcess(processNode)

198199 , Message

200+ , localProcessWithId

199201 )

200202import Control.Distributed.Process.Serializable (Serializable)

201203import Control.Distributed.Process.Internal.Primitives

@@ -303,6 +305,10 @@ import Control.Distributed.Process.Internal.Primitives

303305 , reconnectPort

304306 )

305307import Control.Distributed.Process.Node (forkProcess)

308+import Control.Distributed.Process.Internal.Types

309+ ( processThread

310+ , withValidLocalState

311+ )

306312import Control.Distributed.Process.Internal.Spawn

307313 ( -- Spawning Processes/Channels

308314 spawn

@@ -319,6 +325,11 @@ import Prelude

319325#else

320326import Prelude hiding (catch)

321327#endif

328+import Control.Distributed.Process.Internal.StrictMVar (readMVar)

329+import qualified Control.Exception as Exception (onException)

330+import Data.Accessor ((^.))

331+import Data.Foldable (forM_)

332+

322333

323334-- INTERNAL NOTES

324335--

@@ -416,8 +427,20 @@ spawnChannelLocal proc = do

416427-- Silently dropping messages may not always be the best approach.

417428callLocal :: Process a -> Process a

418429callLocal proc = Catch.mask $ \release -> do

419− mv <- liftIO newEmptyMVar :: Process (MVar (Either Catch.SomeException a))

430+ mv <- liftIO newEmptyMVar :: Process (MVar (Either Catch.SomeException a))

420431 child <- spawnLocal $ Catch.try (release proc) >>= liftIO . putMVar mv

421− rs <- liftIO (takeMVar mv) `Catch.onException`

422− (kill child "exception in parent process" >> liftIO (takeMVar mv))

423− either Catch.throwM return rs

432+ lproc <- ask

433+ liftIO $ do

434+ rs <- Exception.onException (takeMVar mv) $ Catch.uninterruptibleMask_ $

435+ -- Exceptions need to be prevented from interrupting the clean up or

436+ -- the original exception which caused entering the handler could be

437+ -- forgotten. For instance, this could have a problematic effect

438+ -- when the original exception was meant to kill the thread and the

439+ -- second exception doesn't (like the exception thrown by

440+ -- 'System.Timeout.timeout').

441+ do mchildThreadId <- withValidLocalState (processNode lproc) $

442+ \vst -> return $ fmap processThread $

443+ vst ^. localProcessWithId (processLocalId child)

444+ forM_ mchildThreadId killThread

445+ takeMVar mv

446+ either Catch.throwM return rs