git.iko.soy/distributed-process
on master help sign in
Monitor remote dead process
34b1d5aEdsko de Vries
distributed-process/src/Control/Distributed/Process.hs+14−9
compare with master
unifiedsplit
@@ -339,10 +339,8 @@ nodeController = forever $ do
339
339
340 -- Forward the message if appropriate
340 -- Forward the message if appropriate
341 case destNid (ctrlMsgSignal msg) of
341 case destNid (ctrlMsgSignal msg) of
342− Just nid' | nid' /= localNodeId node ->
342+ Just nid' | nid' /= localNodeId node -> ncSendCtrlMsg nid' msg
343− ctrlSendTo (Right nid') . BSL.toChunks . encode $ msg
344− _ ->
345− return ()
343+ _ -> return ()
346
344
347 processCtrlMsg msg
345 processCtrlMsg msg
348
346
@@ -365,6 +363,9 @@ ctrlSendTo them payload = do
365 , ctrlMsgSignal = Died them DiedDisconnect
363 , ctrlMsgSignal = Died them DiedDisconnect
366 }
364 }
367
365
366+ncSendCtrlMsg :: NodeId -> NodeCtrlMsg -> NodeCtrl ()
367+ncSendCtrlMsg dest = ctrlSendTo (Right dest) . BSL.toChunks . encode
368+
368ctrlSendLocal :: LocalProcessId -> Message -> NodeCtrl ()
369ctrlSendLocal :: LocalProcessId -> Message -> NodeCtrl ()
369ctrlSendLocal lpid msg = do
370ctrlSendLocal lpid msg = do
370 node <- ask
371 node <- ask
@@ -425,6 +426,11 @@ processCtrlMsg (NodeCtrlMsg (Left from) (Monitor them ref)) = do
425 (False, True) -> -- [Unified: second rule]
426 (False, True) -> -- [Unified: second rule]
426 ctrlSendLocal (processLocalId from) . createMessage $
427 ctrlSendLocal (processLocalId from) . createMessage $
427 ProcessDied ref them DiedNoProc
428 ProcessDied ref them DiedNoProc
429+ (False, False) -> -- [Unified: third rule]
430+ ncSendCtrlMsg (processNodeId from) $ NodeCtrlMsg
431+ { ctrlMsgSender = Right (localNodeId node)
432+ , ctrlMsgSignal = Died (Left them) DiedNoProc
433+ }
428
434
429processCtrlMsg (NodeCtrlMsg (Right _) (Monitor _ _)) =
435processCtrlMsg (NodeCtrlMsg (Right _) (Monitor _ _)) =
430 error "Monitor message from a node?"
436 error "Monitor message from a node?"
@@ -466,11 +472,10 @@ processCtrlMsg (NodeCtrlMsg _from (Died (Left pid) reason)) = do
466 then
472 then
467 ctrlSendLocal (processLocalId us) msg
473 ctrlSendLocal (processLocalId us) msg
468 else
474 else
469− ctrlSendTo (Right . processNodeId $ us) . BSL.toChunks . encode $
470− NodeCtrlMsg
475+ ncSendCtrlMsg (processNodeId us) $ NodeCtrlMsg
471− { ctrlMsgSender = Right (localNodeId node) -- TODO: why the change in sender? How does that affect 'reconnect' semantics?
476+ { ctrlMsgSender = Right (localNodeId node) -- TODO: why the change in sender? How does that affect 'reconnect' semantics?
472− , ctrlMsgSignal = Died (Left pid) reason
477+ , ctrlMsgSignal = Died (Left pid) reason
473− }
478+ }
474
479
475 modify $ (nodeCtrlLinksForProcess pid ^= Set.empty)
480 modify $ (nodeCtrlLinksForProcess pid ^= Set.empty)
476 . (nodeCtrlMonsForProcess pid ^= Map.empty)
481 . (nodeCtrlMonsForProcess pid ^= Map.empty)
distributed-process/tests/TestCH.hs+26
@@ -175,6 +175,31 @@ testMonitorLocalDeadProcess transport = do
175
175
176 takeMVar done
176 takeMVar done
177
177
178+-- | Monitor a remote process that is already dead
179+testMonitorRemoteDeadProcess :: NT.Transport -> IO ()
180+testMonitorRemoteDeadProcess transport = do
181+ processDead <- newEmptyMVar
182+ processAddr <- newEmptyMVar
183+ done <- newEmptyMVar
184+
185+ forkIO $ do
186+ localNode <- newLocalNode transport
187+ addr <- forkProcess localNode . liftIO $ putMVar processDead ()
188+ putMVar processAddr addr
189+
190+ forkIO $ do
191+ localNode <- newLocalNode transport
192+ theirAddr <- readMVar processAddr
193+ readMVar processDead
194+ runProcess localNode $ do
195+ ref <- monitor theirAddr
196+ ProcessDied ref' pid DiedNoProc <- expect
197+ True <- return $ ref' == ref && pid == theirAddr
198+ return ()
199+ putMVar done ()
200+
201+ takeMVar done
202+
178{-
203{-
179-- Like 'testMonitor1', but throw an exception instead
204-- Like 'testMonitor1', but throw an exception instead
180testMonitor2 :: NT.Transport -> IO ()
205testMonitor2 :: NT.Transport -> IO ()
@@ -286,6 +311,7 @@ main = do
286 , ("MonitorNormalTermination", testMonitorNormalTermination transport)
311 , ("MonitorNormalTermination", testMonitorNormalTermination transport)
287 , ("MonitorAbnormalTermination", testMonitorAbnormalTermination transport)
312 , ("MonitorAbnormalTermination", testMonitorAbnormalTermination transport)
288 , ("MonitorLocalDeadProcess", testMonitorLocalDeadProcess transport)
313 , ("MonitorLocalDeadProcess", testMonitorLocalDeadProcess transport)
314+ , ("MonitorRemoteDeadProcess", testMonitorRemoteDeadProcess transport)
289 {-
315 {-
290 , ("Monitor2", testMonitor2 transport)
316 , ("Monitor2", testMonitor2 transport)
291 , ("Monitor3", testMonitor3 transport)
317 , ("Monitor3", testMonitor3 transport)