tested: informs client of remote presences when peer comes online

1 files changed, 14 insertions, 7 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 8656c91f..30d6b2c4 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -417,9 +417,11 @@ informClientPresence state k stanza = do
         mb <- fmap (Map.lookup k) $ readTVar (clients state)
         flip (maybe $ return ()) mb $ \cstate -> do
         writeTVar (clientStatus cstate) $ Just dup
+    -- TODO: inform subscribers
 
 informPeerPresence state k stanza = do
     -- Presence must indicate full JID with resource...
+    putStrLn $ "xmppInformPeerPresence checking from address..."
     flip (maybe $ return ()) (stanzaFrom stanza) $ \from -> do
     let (muser,h,mresource) = splitJID from
     flip (maybe $ return ()) mresource       $ \resource -> do
@@ -431,15 +433,19 @@ informPeerPresence state k stanza = do
         -- (TODO: interested/authorized clients only.)
         ktc <- readTVar (keyToChan state)
         runTraversableT $ do
-        (k,client) <- liftMT $ fmap Map.toList $ readTVar (clients state)
-        con <- liftMaybe $ Map.lookup k ktc 
-        return (k,con,client)
-    forM_ clients $ \(k,con,client) -> do
+        (ck,client) <- liftMT $ fmap Map.toList $ readTVar (clients state)
+        con <- liftMaybe $ Map.lookup ck ktc 
+        return (ck,con,client)
+    putStrLn $ "xmppInformPeerPresence (length clients="++show (length clients)++")"
+    forM_ clients $ \(ck,con,client) -> do
         from' <- do
-            let ClientKey laddr = k
+            let ClientKey laddr = ck
             (_,trip) <- rewriteJIDForClient laddr from
-            return trip
-        sendModifiedStanzaToClient stanza (connChan con)
+            return (unsplitJID trip)
+        putStrLn $ "sending to client: " ++ show (stanzaType stanza)
+        dup <- cloneStanza stanza
+        sendModifiedStanzaToClient (dup { stanzaFrom=Just from' })
+                                   (connChan con)
 
 answerProbe state k stanza chan = do
     putStrLn $ "answerProbe! " ++ show (stanzaType stanza)
@@ -455,6 +461,7 @@ answerProbe state k stanza chan = do
         lpres <- liftMaybe $ Map.lookup u cbu
         clientState <- liftT $ Map.elems (networkClients lpres)
         stanza <- liftIOMaybe $ atomically (readTVar (clientStatus clientState))
+        stanza <- lift $ cloneStanza stanza
         let jid = unsplitJID (Just $ clientUser clientState
                              , ch
                              ,Just $ clientResource clientState)