git.iko.soy/distributed-process
on master help sign in
Remove monitors from remote nodes. (#295)
0f0a5ecFacundo Domínguez
src/Control/Distributed/Process/Internal/BiMultiMap.hs+8−5
compare with master
unifiedsplit
@@ -5,7 +5,8 @@ module Control.Distributed.Process.Internal.BiMultiMap
5 , singleton
5 , singleton
6 , size
6 , size
7 , insert
7 , insert
8− , lookup
8+ , lookupBy1st
9+ , lookupBy2nd
9 , delete
10 , delete
10 , deleteAllBy1st
11 , deleteAllBy1st
11 , deleteAllBy2nd
12 , deleteAllBy2nd
@@ -62,10 +63,12 @@ insert a b v (BiMultiMap m r) =
62 r)
63 r)
63
64
64-- | Looks up all the triplets whose first component is the given value.
65-- | Looks up all the triplets whose first component is the given value.
65−--
66−-- See 'flip' in order to look up by the second component.
67−lookup :: Ord a => a -> BiMultiMap a b v -> Set (b, v)
66+lookupBy1st :: Ord a => a -> BiMultiMap a b v -> Set (b, v)
68−lookup a (BiMultiMap m _) = maybe Set.empty id $ Map.lookup a m
67+lookupBy1st a (BiMultiMap m _) = maybe Set.empty id $ Map.lookup a m
68+
69+-- | Looks up all the triplets whose second component is the given value.
70+lookupBy2nd :: Ord b => b -> BiMultiMap a b v -> Set (a, v)
71+lookupBy2nd b = lookupBy1st b . flip
69
72
70-- | Deletes a triplet. It yields the original multimap if the triplet is
73-- | Deletes a triplet. It yields the original multimap if the triplet is
71-- not present.
74-- not present.
src/Control/Distributed/Process/Node.hs+17−4
@@ -45,6 +45,7 @@ import qualified Data.Set as Set
45 , map
45 , map
46 , member
46 , member
47 , toList
47 , toList
48+ , union
48 )
49 )
49import Data.Foldable (forM_)
50import Data.Foldable (forM_)
50import Data.List (foldl')
51import Data.List (foldl')
@@ -879,6 +880,18 @@ ncEffectDied ident reason = do
879 when (localOnly <= isLocal node (ProcessIdentifier us)) $
880 when (localOnly <= isLocal node (ProcessIdentifier us)) $
880 notifyDied us them reason (Just ref)
881 notifyDied us them reason (Just ref)
881
882
883+ -- Notify remote nodes that the process died so it can be removed from monitor
884+ -- lists.
885+ mapM_ (forwardDeath node) $
886+ [ nid | ProcessIdentifier pid <- [ident]
887+ , i <- Set.toList $ Set.union
888+ (Set.map fst $ BiMultiMap.lookupBy2nd pid unaffectedLinks)
889+ (Set.map fst $ BiMultiMap.lookupBy2nd pid unaffectedMons)
890+ , let nid = nodeOf i
891+ , nid /= localNodeId node
892+ ]
893+
894+ -- Delete monitors in the local node.
882 let deleteDeads :: (Ord a, Ord v)
895 let deleteDeads :: (Ord a, Ord v)
883 => BiMultiMap a ProcessId v -> BiMultiMap a ProcessId v
896 => BiMultiMap a ProcessId v -> BiMultiMap a ProcessId v
884 deleteDeads = case ident of
897 deleteDeads = case ident of
@@ -899,12 +912,12 @@ ncEffectDied ident reason = do
899 True ->
912 True ->
900 do forM_ nidlist $ \(nid,_) ->
913 do forM_ nidlist $ \(nid,_) ->
901 when (not $ isLocal node (NodeIdentifier nid))
914 when (not $ isLocal node (NodeIdentifier nid))
902− (forwardNameDeath node nid)
915+ (forwardDeath node nid)
903 return Nothing
916 return Nothing
904 False -> return $ Just (pid,nidlist) )
917 False -> return $ Just (pid,nidlist) )
905 modify' $ registeredOnNodes ^= (Map.fromList (catMaybes remaining))
918 modify' $ registeredOnNodes ^= (Map.fromList (catMaybes remaining))
906 where
919 where
907− forwardNameDeath node nid = ncSendToNode nid
920+ forwardDeath node nid = ncSendToNode nid
908 NCMsg { ctrlMsgSender = NodeIdentifier (localNodeId node)
921 NCMsg { ctrlMsgSender = NodeIdentifier (localNodeId node)
909 , ctrlMsgSignal = Died ident reason
922 , ctrlMsgSignal = Died ident reason
910 }
923 }
@@ -1059,9 +1072,9 @@ ncEffectGetInfo from pid =
1059 Nothing -> dispatch (isLocal node (ProcessIdentifier from))
1072 Nothing -> dispatch (isLocal node (ProcessIdentifier from))
1060 from (ProcessInfoNone DiedUnknownId)
1073 from (ProcessInfoNone DiedUnknownId)
1061 Just proc -> do
1074 Just proc -> do
1062− itsLinks <- Set.map fst . BiMultiMap.lookup them <$>
1075+ itsLinks <- Set.map fst . BiMultiMap.lookupBy1st them <$>
1063 gets (^. links)
1076 gets (^. links)
1064− itsMons <- BiMultiMap.lookup them <$> gets (^. monitors)
1077+ itsMons <- BiMultiMap.lookupBy1st them <$> gets (^. monitors)
1065 registered <- gets (^. registeredHere)
1078 registered <- gets (^. registeredHere)
1066 size <- liftIO $ queueSize $ processQueue $ proc
1079 size <- liftIO $ queueSize $ processQueue $ proc
1067
1080