6f77480 · 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.

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

1 file changed+27−4

compare with master

unifiedsplit

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

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

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

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

164164import Control.Applicative

165165import Control.Monad.Reader (ask)

166+import Control.Concurrent (killThread)

166167import Control.Concurrent.MVar

167168 ( MVar

168169 , newEmptyMVar

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

197198 , RegisterReply(..)

198199 , LocalProcess(processNode)

199200 , Message

201+ , localProcessWithId

200202 )

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

202204import Control.Distributed.Process.Internal.Primitives

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

305307 , reconnectPort

306308 )

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

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

311+ ( processThread

312+ , withValidLocalState

313+ )

308314import Control.Distributed.Process.Internal.Spawn

309315 ( -- Spawning Processes/Channels

310316 spawn

@@ -321,6 +327,11 @@ import Prelude

321327#else

322328import Prelude hiding (catch)

323329#endif

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

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

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

333+import Data.Foldable (forM_)

334+

324335

325336-- INTERNAL NOTES

326337--

@@ -418,8 +429,20 @@ spawnChannelLocal proc = do

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

419430callLocal :: Process a -> Process a

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

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

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

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

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

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

425− either Catch.throwM return rs

434+ lproc <- ask

435+ liftIO $ do

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

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

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

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

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

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

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

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

444+ \vst -> return $ fmap processThread $

445+ vst ^. localProcessWithId (processLocalId child)

446+ forM_ mchildThreadId killThread

447+ takeMVar mv

448+ either Catch.throwM return rs