peerInformSubscription

1 files changed, 25 insertions, 9 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 94a20c8a..7b220c95 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -680,6 +680,14 @@ resolvedFromRoster doit u = do
             addr <- liftMT $ resolvePeer h
             return (mu,PeerKey addr)
 
+clientCons state ktc u = do
+    mlp <- atomically $ do
+            cmap <- readTVar $ clientsByUser state
+            return $ Map.lookup u cmap
+    let ks = do lp <- maybeToList mlp
+                Map.keys (networkClients lp)
+    return $ mapMaybe (flip Map.lookup ktc) ks
+
 peerSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO ()
 peerSubscriptionRequest state fail k stanza chan = do
     putStrLn $ "Handling pending subscription from remote"
@@ -722,12 +730,8 @@ peerSubscriptionRequest state fail k stanza chan = do
     -- contact ∉ subscribers & contact ∈ pending --> SHOULD NOT
     when (not already_pending) $ do
     -- contact ∉ subscribers & contact ∉ pending --> MUST
-    mlp <- atomically $ do
-            cmap <- readTVar $ clientsByUser state
-            return $ Map.lookup u cmap
-    let ks = do lp <- maybeToList mlp
-                Map.keys (networkClients lp)
-        chans = mapMaybe (flip Map.lookup ktc) ks
+
+    chans <- clientCons state ktc u
     forM_ chans $ \Conn { connChan=chan } -> do
     -- send to clients
     -- TODO: interested/available clients only?
@@ -820,9 +824,21 @@ peerInformSubscription state fail k stanza = do
                 , ConfigFiles.modifyBuddies )
     addToRosterFile      addf user from'' addrs
     removeFromRosterFile remf user from'' addrs
-    -- TODO
-    --   send update to clients
-    return ()
+
+    ktc <- atomically $ readTVar (keyToChan state)
+    flip (maybe fail) (Map.lookup k ktc)
+         $ \Conn { auxAddr=laddr } -> do
+    hostname <- textHostName
+    let to' = unsplitJID (Just user, hostname, Nothing)
+    (_,fromtup) <- rewriteJIDForClient laddr from
+    chans <- clientCons state ktc user
+    forM_ chans $ \Conn { connChan=chan } -> do
+    update <- makeRosterUpdate to' from relationship
+    sendModifiedStanzaToClient update chan
+    dup <- cloneStanza stanza
+    sendModifiedStanzaToClient dup { stanzaFrom = Just $ unsplitJID fromtup
+                                   , stanzaTo = Just to' }
+                               chan
 
 main = runResourceT $ do
     state <- liftIO . atomically $ do