git.iko.soy/distributed-process
on master help sign in
Re-work linked shutdown between NC and listener threads
c52e8deTim Watson
src/Control/Distributed/Process/Node.hs+12−21
compare with master
unifiedsplit
@@ -56,8 +56,8 @@ import Control.Exception
56 , Exception
56 , Exception
57 , throwTo
57 , throwTo
58 )
58 )
59−import qualified Control.Exception as Exception (catch)
59+import qualified Control.Exception as Exception (catch, finally)
60−import Control.Concurrent (forkIO, mkWeakThreadId, ThreadId)
60+import Control.Concurrent (forkIO)
61import Control.Distributed.Process.Internal.StrictMVar
61import Control.Distributed.Process.Internal.StrictMVar
62 ( newMVar
62 ( newMVar
63 , withMVar
63 , withMVar
@@ -216,19 +216,14 @@ createBareLocalNode endPoint rtable = do
216 }
216 }
217 tracedNode <- startTracing node
217 tracedNode <- startTracing node
218
218
219− ncGo <- newEmptyMVar
219+ -- Once the NC terminates, the endpoint isn't much use,
220− ncTid <- forkIO $ do
221− tid <- takeMVar ncGo
222− (runNodeController tracedNode
220+ void $ forkIO $ Exception.finally (runNodeController tracedNode)
223− `Exception.catch` \(e :: SomeException) -> reThrow tid e)
221+ (NT.closeEndPoint (localEndPoint node))
224
222
225− weakNcTid <- mkWeakThreadId ncTid
223+ -- whilst a closed/failing endpoint will terminate the NC
226− evTid <- forkIO $ do
227− (handleIncomingMessages tracedNode >> (stopNC node))
224+ void $ forkIO $ Exception.finally (handleIncomingMessages tracedNode)
228− `Exception.catch` \(e :: SomeException) -> reThrow weakNcTid e
225+ (stopNC node)
229
226
230− weakEvTid <- mkWeakThreadId evTid
231− putMVar ncGo weakEvTid
232 return tracedNode
227 return tracedNode
233 where
228 where
234 stopNC node =
229 stopNC node =
@@ -237,13 +232,6 @@ createBareLocalNode endPoint rtable = do
237 , ctrlMsgSignal = SigShutdown
232 , ctrlMsgSignal = SigShutdown
238 }
233 }
239
234
240− reThrow :: (Exception e) => Weak ThreadId -> e -> IO ()
241− reThrow wTid ex = do
242− tid <- deRefWeak wTid
243− case tid of
244− Nothing -> return ()
245− Just t -> throwTo t ex
246−
247-- | Start and register the service processes on a node
235-- | Start and register the service processes on a node
248-- (for now, this is only the logger)
236-- (for now, this is only the logger)
249startServiceProcesses :: LocalNode -> IO ()
237startServiceProcesses :: LocalNode -> IO ()
@@ -619,7 +607,10 @@ nodeController = do
619 NCMsg (ProcessIdentifier from) (GetInfo pid) ->
607 NCMsg (ProcessIdentifier from) (GetInfo pid) ->
620 ncEffectGetInfo from pid
608 ncEffectGetInfo from pid
621 NCMsg _ SigShutdown ->
609 NCMsg _ SigShutdown ->
610+ liftIO $ do
611+ NT.closeEndPoint (localEndPoint node)
612+ `Exception.finally` throwIO ThreadKilled
622− liftIO $ throwIO ThreadKilled -- seems to make more sense than fail/error
613+ -- ThreadKilled seems to make more sense than fail/error here
623 unexpected ->
614 unexpected ->
624 error $ "nodeController: unexpected message " ++ show unexpected
615 error $ "nodeController: unexpected message " ++ show unexpected
625
616