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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Thu Mar 6 14:04:00 MSK 2008


Author: sergei
Date: 2008-03-06 14:03:59 +0300 (Thu, 06 Mar 2008)
New Revision: 1384

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/disco.tcl
   trunk/tkabber/plugins/general/caps.tcl
Log:
	* disco.tcl: Added new hook disco_node_reply_hook to allow answering
	  service discovery queries to unregistered temporary nodes (as in
	  entity capabilities plugin).

	* plugins/general/caps.tcl: Implemented version 1.5 of XEP-0115 (only
	  sending capabilities and replying to disco#info queries).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-03-04 08:08:47 UTC (rev 1383)
+++ trunk/tkabber/ChangeLog	2008-03-06 11:03:59 UTC (rev 1384)
@@ -1,3 +1,12 @@
+2008-03-06  Sergei Golovan  <sgolovan at nes.ru>
+
+	* disco.tcl: Added new hook disco_node_reply_hook to allow answering
+	  service discovery queries to unregistered temporary nodes (as in
+	  entity capabilities plugin).
+
+	* plugins/general/caps.tcl: Implemented version 1.5 of XEP-0115 (only
+	  sending capabilities and replying to disco#info queries).
+
 2008-03-04  Sergei Golovan  <sgolovan at nes.ru>
 
 	* msgs/ru.msg: Updated Russian translation.

Modified: trunk/tkabber/disco.tcl
===================================================================
--- trunk/tkabber/disco.tcl	2008-03-04 08:08:47 UTC (rev 1383)
+++ trunk/tkabber/disco.tcl	2008-03-06 11:03:59 UTC (rev 1384)
@@ -71,7 +71,7 @@
 proc disco::parse_items {connid jid node handler res child} {
     variable disco
 
-    if {![cequal $res OK]} {
+    if {![string equal $res OK]} {
 	if {$handler != ""} {
 	    eval $handler [list ERR $child]
 	}
@@ -169,7 +169,7 @@
     variable disco
     variable additional_nodes
 
-    if {![cequal $res OK]} {
+    if {![string equal $res OK]} {
 	if {$handler != ""} {
 	    eval $handler [list ERR $child {} {}]
 	}
@@ -283,12 +283,17 @@
     jlib::wrapper:splitxml $child tag vars isempty chdata children
     set node [jlib::wrapper:getattr $vars node]
 
-    if {![cequal $node ""]} {
+    if {![string equal $node ""]} {
 	if {![info exists supported_nodes($node)]} {
-	    return {error cancel not-allowed}
+	    # Probably temporary node
+	    set res {error cancel not-allowed}
+	    hook::run disco_node_reply_hook \
+		      res info $node $connid $from $lang $child
+	    return $res
 	} else {
+	    # Permanent node
 	    set restags [$node_handlers($node) info $connid $from $lang $child]
-	    if {[cequal [lindex $restags 0] error]} {
+	    if {[string equal [lindex $restags 0] error]} {
 		return $restags
 	    } else {
 		set res [jlib::wrapper:createtag query \
@@ -329,12 +334,17 @@
     jlib::wrapper:splitxml $child tag vars isempty chdata children
     set node [jlib::wrapper:getattr $vars node]
 
-    if {![cequal $node ""]} {
+    if {![string equal $node ""]} {
 	if {![info exists supported_nodes($node)]} {
-	    return {error cancel not-allowed}
+	    # Probably temporary node
+	    set res {error cancel not-allowed}
+	    hook::run disco_node_reply_hook \
+		      res items $node $connid $from $lang $child
+	    return $res
 	} else {
+	    # Permanent node
 	    set restags [$node_handlers($node) items $connid $from $lang $child]
-	    if {[cequal [lindex $restags 0] error]} {
+	    if {[string equal [lindex $restags 0] error]} {
 		return $restags
 	    } else {
 		set res [jlib::wrapper:createtag query \
@@ -349,10 +359,10 @@
 
 	foreach node $root_nodes {
 	    set vars [list jid $myjid]
-	    if {![cequal $supported_nodes($node) ""]} {
+	    if {![string equal $supported_nodes($node) ""]} {
 		lappend vars name [::trans::trans $lang $supported_nodes($node)]
 	    }
-	    if {![cequal $node ""]} {
+	    if {![string equal $node ""]} {
 		lappend vars node $node
 	    }
 	    lappend restags [jlib::wrapper:createtag item \
@@ -955,7 +965,7 @@
     } else {
 	set sitems ""
     }
-    if {![cequal $name ""]} {
+    if {![string equal $name ""]} {
 	return "$name$snode ($jid)$sitems"
     } else {
 	return "$jid$snode$sitems"

Modified: trunk/tkabber/plugins/general/caps.tcl
===================================================================
--- trunk/tkabber/plugins/general/caps.tcl	2008-03-04 08:08:47 UTC (rev 1383)
+++ trunk/tkabber/plugins/general/caps.tcl	2008-03-06 11:03:59 UTC (rev 1384)
@@ -7,10 +7,28 @@
 
 namespace eval caps {
     set ::NS(caps) http://jabber.org/protocol/caps
-    variable hash md5
+    variable caps_node ""
+
+    custom::defgroup Plugins \
+	[::msgcat::mc "Plugins options."] \
+	-group Tkabber
+
+    custom::defgroup Caps \
+	[::msgcat::mc "Options for entity capabilities plugin."] \
+	-group Plugins
+
+    custom::defvar options(enable) 1 \
+	[::msgcat::mc "Enable announcing entity capabilities in\
+		       every outgoing presence."] \
+	-group Caps -type boolean
+
+    custom::defvar options(hash) sha-1 \
+	[::msgcat::mc "Use the specified function to hash supported\
+		       features list."] \
+	-group Caps -type options -values {md5 MD5 sha-1 SHA-1}
 }
 
-proc caps::hash {identities features {hash sha-1}} {
+proc caps::hash {identities features hash} {
 
     set binidentities {}
     foreach id $identities {
@@ -50,7 +68,7 @@
     return [base64::encode $binhash]
 }
 
-proc caps::info_to_hash {child {hash sha-1}} {
+proc caps::info_to_hash {child hash} {
     set identities {}
     set features {}
 
@@ -78,10 +96,12 @@
 }
 
 proc caps::get_presence_x {varname connid status} {
-    global tkabber_version
-    variable hash
+    variable options
+    variable caps_node
     upvar 2 $varname var
 
+    if {!$options(enable)} return
+
     lassign [disco::info_query_get_handler \
 		    $connid "" \
 		    [jlib::get_lang] \
@@ -91,19 +111,37 @@
 
     if {![string equal $res result]} return
 
-    set ver [info_to_hash $child $hash]
+    set ver [info_to_hash $child $options(hash)]
     if {[string equal $ver ""]} return
 
     lappend var [jlib::wrapper:createtag c \
 		     -vars [list xmlns $::NS(caps) \
-				 hash $hash \
-				 node http://tkabber.jabber.ru/#$tkabber_version \
+				 hash $options(hash) \
+				 node http://tkabber.jabber.ru/ \
 				 ver $ver]]
+    set caps_node http://tkabber.jabber.ru/#$ver
+
     return
 }
 
 hook::add presence_xlist_hook [namespace current]::caps::get_presence_x
 
+proc caps::disco_reply {varname type node connid from lang child} {
+    variable caps_node
+    upvar 2 $varname res
+
+    if {$type != "info" || $node != $caps_node} return
+
+    set res [disco::info_query_get_handler \
+		    $connid "" \
+		    [jlib::get_lang] \
+		    [jlib::wrapper:createtag query \
+			    -vars [list xmlns $::NS(disco_info)]]]
+    return stop
+}
+
+hook::add disco_node_reply_hook [namespace current]::caps::disco_reply
+
 # TODO match caps hash to a set of features
 proc caps::process_presence {connid from type x args} {
     variable htype



More information about the Tkabber-dev mailing list