[Tkabber-dev] r1694 - in trunk/tkabber: . plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Feb 27 16:49:30 MSK 2009


Author: sergei
Date: 2009-02-27 16:49:29 +0300 (Fri, 27 Feb 2009)
New Revision: 1694

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/plugins/general/caps.tcl
Log:
	* plugins/general/caps.tcl: Added procedure which requests entity info
	  if its capabilities hash was received earlier. Also a bit shortened
	  hash calculating code.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2009-02-27 07:40:13 UTC (rev 1693)
+++ trunk/tkabber/ChangeLog	2009-02-27 13:49:29 UTC (rev 1694)
@@ -5,6 +5,10 @@
 
 	* msgs/de.msg: Updated German translation (thanks to Roger Sondermann).
 
+	* plugins/general/caps.tcl: Added procedure which requests entity info
+	  if its capabilities hash was received earlier. Also a bit shortened
+	  hash calculating code.
+
 2009-02-25  Sergei Golovan  <sgolovan at nes.ru>
 
 	* messages.tcl: Added cancelling subscriptions to roster item popup

Modified: trunk/tkabber/plugins/general/caps.tcl
===================================================================
--- trunk/tkabber/plugins/general/caps.tcl	2009-02-27 07:40:13 UTC (rev 1693)
+++ trunk/tkabber/plugins/general/caps.tcl	2009-02-27 13:49:29 UTC (rev 1694)
@@ -29,9 +29,15 @@
 }
 
 proc caps::hash {identities features extras hash} {
+    debugmsg caps "$identities; $features; $extras; $hash"
+
     set binidentities {}
     foreach id $identities {
-	lappend binidentities [encoding convertto utf-8 $id]
+	set category [::xmpp::xml::getAttr $id category]
+	set type [::xmpp::xml::getAttr $id type]
+	set lang [::xmpp::xml::getAttr $id xml:lang]
+	set name [::xmpp::xml::getAttr $id name]
+	lappend binidentities [encoding convertto utf-8 $category/$type/$lang/$name]
     }
 
     set binfeatures {}
@@ -104,22 +110,6 @@
     return [base64::encode $binhash]
 }
 
-proc caps::info_to_hash {identities features extras hash} {
-    set identities2 {}
-
-    foreach identity $identities {
-	set category [::xmpp::xml::getAttr $identity category]
-	set type [::xmpp::xml::getAttr $identity type]
-	set lang [::xmpp::xml::getAttr $identity xml:lang]
-	set name [::xmpp::xml::getAttr $identity name]
-	lappend identities2 $category/$type/$lang/$name
-    }
-
-    debugmsg caps "$identities2; $features; $extras; $hash"
-
-    return [hash $identities2 $features $extras $hash]
-}
-
 proc caps::get_presence_x {varname xlib status} {
     variable options
     variable caps_node
@@ -134,7 +124,7 @@
 
     if {![string equal $status result]} return
 
-    set ver [info_to_hash $identities $features $extras $options(hash)]
+    set ver [hash $identities $features $extras $options(hash)]
     if {[string equal $ver ""]} return
 
     lappend var [::xmpp::xml::create c \
@@ -168,28 +158,28 @@
 # TODO match caps hash to a set of features
 proc caps::process_presence {xlib from type x args} {
     variable htype
+    variable hnode
     variable hver
 
     switch -- $type {
 	unavailable {
 	    catch {unset htype($xlib,$from)}
+	    catch {unset hnode($xlib,$from)}
 	    catch {unset hver($xlib,$from)}
 	}
 	available {
 	    foreach xs $x {
 		::xmpp::xml::split $xs tag xmlns attrs cdata subels
 		if {[string equal $xmlns $::NS(caps)]} {
-		    set hash [::xmpp::xml::getAttr $attrs hash]
-		    if {[string equal $hash ""]} {
-			set hash sha-1
-		    }
-		    set htype($xlib,$from) $hash
-		    set hver($xlib,$from) [::xmpp::xml::getAttr $attrs ver]
+		    set htype($xlib,$from) [::xmpp::xml::getAttr $attrs hash]
+		    set hnode($xlib,$from) [::xmpp::xml::getAttr $attrs node]
+		    set hver($xlib,$from)  [::xmpp::xml::getAttr $attrs ver]
 		    return
 		}
 	    }
 	    # Unset caps if they aren't included in <presence/>
 	    catch {unset htype($xlib,$from)}
+	    catch {unset hnode($xlib,$from)}
 	    catch {unset hver($xlib,$from)}
 	}
     }
@@ -199,47 +189,61 @@
 
 proc caps::clean {xlib} {
     variable htype
+    variable hnode
     variable hver
 
     array unset htype $xlib,*
+    array unset hnode $xlib,*
     array unset hver $xlib,*
 }
 
 hook::add disconnected_hook [namespace current]::caps::clean
 
-proc caps::info_receive \
-     {xlib jid node res identities features extras featured_nodes} {
+proc caps::request_info {xlib jid} {
+    variable hnode
+    variable hver
+
+    if {![info exists hver($xlib,$jid)] || ![info exists hnode($xlib,$jid)]} {
+	after idle [namespace code [list info_receive $xlib $jid error {} {} {}]]
+	return
+    }
+
+    ::disco::request_info $xlib $jid \
+	    -node $hnode($xlib,$jid)#$hver($xlib,$jid) \
+	    -cache yes \
+	    -command [namespace code [list info_receive $xlib $jid]]
+}
+
+proc caps::info_receive {xlib jid status identities features extras} {
     variable hidentities
     variable hfeatures
     variable htype
+    variable hnode
     variable hver
 
-    if {![string equal $res ok]} return
-    if {![info exists hver($xlib,$jid)]} return
+    debugmsg caps "$xlib; $jid; $status; $identities; $features; $extras"
 
-    set ids {}
-    foreach id $identities {
-	set category [::xmpp::xml::getAttr $id category]
-	set type [::xmpp::xml::getAttr $id type]
-	if {![string equal $category ""] && ![string equal $type ""]} {
-	    lappend ids $category/$type
+    if {![string equal $status ok]} return
+
+    if {![info exists hver($xlib,$jid)] || ![info exists htype($xlib,$jid)]} return
+
+    if {[string equal $htype($xlib,$jid) ""]} {
+	debugmsg caps "Legacy caps ver $hver($xlib,$jid) for $jid"
+
+	# TODO: legacy caps support
+    } else {
+	set hash [hash $identities $features $extras $htype($xlib,$jid)]
+	if {![string equal $hash $hver($xlib,$jid)]} {
+	    debugmsg caps "Mismatched caps ver for $jid, expected $hver($xlib,$jid), calculated $hash"
+
+	    # TODO: Treat mismatched ver as legacy one
+	    return
 	}
+
+	debugmsg caps "Caps ver $hash for $jid matches its disco#info"
+
+	set hidentities($htype($xlib,$jid),$hver($xlib,$jid)) $identities
+	set hfeatures($htype($xlib,$jid),$hver($xlib,$jid)) $features
     }
-    set fes {}
-    foreach fe $features {
-	set var [::xmpp::xml::getAttr $fe var]
-	if {![string equal $var ""]} {
-	    lappend fes $var
-	}
-    }
-    if {![string equal [hash $ids $fes $extras $htype($xlib,$jid)] \
-		       $hver($xlib,$jid)]} {
-	return
-    }
-
-    set hidentities($htype($xlib,$jid),$hver($xlib,$jid)) $ids
-    set hfeatures($htype($xlib,$jid),$hver($xlib,$jid)) $fes
 }
 
-hook::add disco_info_hook [namespace current]::caps::info_receive
-



More information about the Tkabber-dev mailing list