ask=suscribe roster update on buddy request

2 files changed, 31 insertions, 15 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index d9cacb4c..a181b3e5 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -795,8 +795,8 @@ makePresenceStanza namespace mjid pstat = do
       , EventContent (ContentText stat)
       , EventEndElement "{jabber:client}show" ]
     
-makeRosterUpdate tojid contact relationship = do
-    let attrs = [attr "subscription" relationship]
+makeRosterUpdate tojid contact (suborask,relationship) = do
+    let attrs = [attr suborask relationship]
     stanzaFromList Unrecognized
       [ EventBeginElement "{jabber:client}iq" 
             [ attr "to"   tojid
diff --git a/xmppServer.hs b/xmppServer.hs
index 7b220c95..d38c78cf 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -652,14 +652,25 @@ clientSubscriptionRequest state fail k stanza chan = do
     if null addrs then fail else do
     -- add to-address to from's solicited
     addToRosterFile ConfigFiles.modifySolicited (clientUser client) to addrs
+
     (ktc,ap) <- atomically $ 
         liftM2 (,) (readTVar $ keyToChan state)
                    (readTVar $ associatedPeers state)
+    
+    hostname <- textHostName
+    let cjid = unsplitJID (Just $ clientUser client, hostname,Nothing)
+    chans <- clientCons state ktc (clientUser client)
+    forM_ chans $ \( Conn { connChan=chan }, client ) -> do
+        -- roster update ask="subscribe"
+        update <- makeRosterUpdate cjid to ("ask","subscribe")
+        sendModifiedStanzaToClient update chan
+
     let dsts = Map.fromList $ map ((,()) . PeerKey) addrs
         cdsts = ktc Map.\\ dsts
     forM_ (Map.toList cdsts) $ \(pk,con) -> do
         -- if already connected, send solicitation ...
         let from = clientJID con client
+        
         sendModifiedStanzaToPeer (stanza { stanzaTo = Just to
                                          , stanzaFrom = Just from })
                                  (connChan con)
@@ -685,8 +696,11 @@ clientCons state ktc u = 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
+                Map.toList (networkClients lp)
+        doit (k,client) = do
+            con <- Map.lookup k ktc
+            return (con,client)
+    return $ mapMaybe doit ks
 
 peerSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO ()
 peerSubscriptionRequest state fail k stanza chan = do
@@ -732,7 +746,7 @@ peerSubscriptionRequest state fail k stanza chan = do
     -- contact ∉ subscribers & contact ∉ pending --> MUST
 
     chans <- clientCons state ktc u
-    forM_ chans $ \Conn { connChan=chan } -> do
+    forM_ chans $ \( Conn { connChan=chan }, client ) -> do
     -- send to clients
     -- TODO: interested/available clients only?
     dup <- cloneStanza stanza
@@ -754,12 +768,12 @@ clientInformSubscription state fail k stanza = do
     let (relationship,addf,remf) =
          case stanzaType stanza of
            PresenceInformSubscription True ->
-                ( if is_buddy then "both"
-                              else "from"
+                ( ("subscription", if is_buddy then "both"
+                                               else "from" )
                 , ConfigFiles.modifySubscribers
                 , ConfigFiles.modifyOthers )
-           _ -> ( if is_buddy then "to"
-                              else "none"
+           _ -> ( ("subscription", if is_buddy then "to"
+                                               else "none" )
                 , ConfigFiles.modifyOthers
                 , ConfigFiles.modifySubscribers )
     addToRosterFile      addf (clientUser client) to addrs
@@ -814,12 +828,12 @@ peerInformSubscription state fail k stanza = do
     let (relationship,addf,remf) =
          case stanzaType stanza of
            PresenceInformSubscription True ->
-                ( if is_sub then "both"
-                            else "to"
+                ( ("subscription", if is_sub then "both"
+                                             else "to" )
                 , ConfigFiles.modifyBuddies
                 , ConfigFiles.modifyOthers )
-           _ -> ( if is_sub then "from"
-                            else "none"
+           _ -> ( ("subscription", if is_sub then "from"
+                                             else "none")
                 , ConfigFiles.modifyOthers
                 , ConfigFiles.modifyBuddies )
     addToRosterFile      addf user from'' addrs
@@ -832,9 +846,11 @@ peerInformSubscription state fail k stanza = do
     let to' = unsplitJID (Just user, hostname, Nothing)
     (_,fromtup) <- rewriteJIDForClient laddr from
     chans <- clientCons state ktc user
-    forM_ chans $ \Conn { connChan=chan } -> do
+    forM_ chans $ \(Conn { connChan=chan }, client) -> do
     update <- makeRosterUpdate to' from relationship
-    sendModifiedStanzaToClient update chan
+    when (clientIsInterested client) $ do
+        sendModifiedStanzaToClient update chan
+    -- TODO: interested/availabe clients only?
     dup <- cloneStanza stanza
     sendModifiedStanzaToClient dup { stanzaFrom = Just $ unsplitJID fromtup
                                    , stanzaTo = Just to' }