* Set "interested" flag when roster requested.

 * Avoid sending presence status unless "available" flag set.

1 files changed, 13 insertions, 6 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 30ce774d..35d18e92 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -458,6 +458,16 @@ deliverMessage state fail msg =
         sendModifiedStanzaToClient dup
                                   chan
 
+
+setClientFlag state k flag = 
+        atomically $ modifyTVar' (clients state)
+            $ Map.adjust  
+                (\c -> c { clientFlags = clientFlags c .|. flag })
+                k
+
+informSentRoster state k = setClientFlag state k cf_interested
+
+
 -- | Send presence notification to subscribed peers.
 -- Note that a full JID from address will be added to the
 -- stanza if it is not present.
@@ -469,10 +479,7 @@ informClientPresence state k stanza = do
         writeTVar (clientStatus cstate) $ Just dup
     forClient state k (return ()) $ \client -> do
     when (not $ clientIsAvailable client) $ do
-        atomically $ modifyTVar' (clients state)
-            $ Map.adjust  
-                (\c -> c { clientFlags = clientFlags c .|. cf_available })
-                k
+        setClientFlag state k cf_available
         sendCachedPresence state k
     jids <- configText ConfigFiles.getSubscribers (clientUser client)
     let hosts = map ((\(_,h,_)->h) . splitJID) jids
@@ -526,6 +533,7 @@ informPeerPresence state k stanza = do
         return (ck,con,client)
     putStrLn $ "xmppInformPeerPresence (length clients="++show (length clients)++")"
     forM_ clients $ \(ck,con,client) -> do
+        when (clientIsAvailable client) $ do
         froms <- do
             let ClientKey laddr = ck
             (_,trip) <- multiplyJIDForClient laddr from
@@ -628,12 +636,11 @@ main = runResourceT $ do
         , xmppRosterSubscribers = rosterGetSubscribers state
         , xmppRosterSolicited = rosterGetSolicited state
         , xmppRosterOthers = rosterGetOthers state
-        , xmppSubscribeToRoster = \k -> return ()
+        , xmppSubscribeToRoster = informSentRoster state
         , xmppDeliverMessage = deliverMessage state
         , xmppInformClientPresence = informClientPresence state
         , xmppInformPeerPresence = informPeerPresence state
         , xmppAnswerProbe = answerProbe state
-        -- , xmppSendCachedPresenceToClient = sendCachedPresence state
         }
     liftIO $ do
     atomically $ putTMVar (server state) sv