[Tkabber-dev] [tclxmpp] r112 committed - * xmpp/xml.tcl: Add unique XMLNS prefixes when serializing XML elemen...

codesite-noreply at google.com codesite-noreply at google.com
Fri Jul 31 23:26:35 MSD 2009


Revision: 112
Author: sgolovan
Date: Fri Jul 31 12:26:02 2009
Log: 	* xmpp/xml.tcl: Add unique XMLNS prefixes when serializing XML element
	  if it contains complex attributes with XMLNS prefix prepended to
	  attribute names. Otherwise serializing of parsed XML could end by
	  not-well-formed stanza.

	* examples/chessbot.tcl, examples/echo.tcl, examples/xsend.tcl: Fixed
	  processing secrets in config files, and enclosed all arithmetic
	  expressions into curly brackets.

http://code.google.com/p/tclxmpp/source/detail?r=112

Modified:
  /trunk/ChangeLog
  /trunk/examples/chessbot.tcl
  /trunk/examples/echo.tcl
  /trunk/examples/xsend.tcl
  /trunk/xmpp/xml.tcl

=======================================
--- /trunk/ChangeLog	Wed May 20 23:03:03 2009
+++ /trunk/ChangeLog	Fri Jul 31 12:26:02 2009
@@ -1,3 +1,14 @@
+2009-07-31  Sergei Golovan  <sgolovan at nes.ru>
+
+	* xmpp/xml.tcl: Add unique XMLNS prefixes when serializing XML element
+	  if it contains complex attributes with XMLNS prefix prepended to
+	  attribute names. Otherwise serializing of parsed XML could end by
+	  not-well-formed stanza.
+
+	* examples/chessbot.tcl, examples/echo.tcl, examples/xsend.tcl: Fixed
+	  processing secrets in config files, and enclosed all arithmetic
+	  expressions into curly brackets.
+
  2009-05-21  Sergei Golovan  <sgolovan at nes.ru>

  	* xmpp/search.tcl: Fixed typo in procedure name.
=======================================
--- /trunk/examples/chessbot.tcl	Mon Feb 23 06:48:06 2009
+++ /trunk/examples/chessbot.tcl	Fri Jul 31 12:26:02 2009
@@ -437,9 +437,9 @@
          array set at [list -permissions 600]
          array set at [file attributes $file]

-        if {([set x [lsearch -exact $args "-password"]] > 0) \
-                    && (![expr $x%2]) \
-                    && (![string match *00 $at(-permissions)])} {
+        if {([set x [lsearch -exact $args "-password"]] >= 0) \
+                    && ![expr {$x % 2}] \
+                    && ![string match *00 $at(-permissions)]} {
              error "file should be mode 0600"
          }

=======================================
--- /trunk/examples/echo.tcl	Mon Feb 23 06:48:06 2009
+++ /trunk/examples/echo.tcl	Fri Jul 31 12:26:02 2009
@@ -72,9 +72,9 @@
          array set at [list -permissions 600]
          array set at [file attributes $file]

-        if {([set x [lsearch -exact $args "-secret"]] > 0) \
-                    && (![expr $x%2]) \
-                    && (![string match *00 $at(-permissions)])} {
+        if {([set x [lsearch -exact $args "-secret"]] >= 0) \
+                    && ![expr {$x % 2}] \
+                    && ![string match *00 $at(-permissions)]} {
              error "file should be mode 0600"
          }

=======================================
--- /trunk/examples/xsend.tcl	Mon Feb 23 06:48:06 2009
+++ /trunk/examples/xsend.tcl	Fri Jul 31 12:26:02 2009
@@ -97,8 +97,8 @@

      array set aprops [lindex [mime::parseaddress $options(-from)] 0]
      if {[set x [string first / $aprops(domain)]] >= 0} {
-        set aprops(resource) [string range $aprops(domain) [expr $x+1] end]
-        set aprops(domain) [string range $aprops(domain) 0 [expr $x-1]]
+        set aprops(resource) [string range $aprops(domain) [expr {$x + 1}]  
end]
+        set aprops(domain) [string range $aprops(domain) 0 [expr {$x - 1}]]
      } else {
          set aprops(resource) "xsend"
      }
@@ -299,7 +299,7 @@
      set xmldata \
          [::xmpp::xml::create query -xmlns jabber:iq:last \
                                     -attrs [list seconds \
-                                                [expr  
{$now-$lib(lastwhen)}]] \
+                                                [expr {$now -  
$lib(lastwhen)}]] \
                                     -cdata $lib(lastwhat)]
      return [list result $xmldata]
  }
@@ -369,7 +369,7 @@
      array set st [list dev 0 ino 0 size 0]

      for {set i 0} {1} {incr i} {
-        if {[expr $i%5] == 0} {
+        if {[expr {$i % 5}] == 0} {
              if {[catch { file stat $file st2 } result]} {
                  ::LOG $result
                  break
@@ -422,7 +422,7 @@
                  ::LOG $result
              }
              if {$result} {
-                set buffer [string range $buffer [expr $x+1] end]
+                set buffer [string range $buffer [expr {$x + 1}] end]
              }
          }

@@ -452,7 +452,7 @@
      variable stayP

      while {$stayP} {
-        after [expr 60*1000]
+        after [expr {60*1000}]
          if {![catch { eval [list xsend::sendit 2] $argv } result]} {
              break
          }
@@ -491,7 +491,7 @@

  if {(([set x [lsearch -exact $argv -help]] >= 0) \
              || ([set x [lsearch -exact $argv --help]] >= 0)) \
-        && (($x == 0) || ([expr $x%2]))} {
+        && (($x == 0) || ([expr {$x % 2}]))} {
      puts stdout \
  "usage: xsend.tcl recipient ?options...?
              -follow      file
@@ -522,7 +522,7 @@
  for default values."

      set status 0
-} elseif {($argc < 1) || (![expr $argc%2])} {
+} elseif {($argc < 1) || (![expr {$argc % 2}])} {
      puts stderr "usage: xsend.tcl recipent ?-key value?..."
  } elseif {[catch {
      if {([file exists [set file .xsendrc.tcl]]) \
@@ -534,9 +534,9 @@
          array set at [list -permissions 600]
          array set at [file attributes $file]

-        if {([set x [lsearch -exact $args "-password"]] > 0) \
-                    && (![expr $x%2]) \
-                    && (![string match *00 $at(-permissions)])} {
+        if {[set x [lsearch -exact $args "-password"]] >= 0 \
+                    && ![expr {$x % 2}] \
+                    && ![string match *00 $at(-permissions)]} {
              error "file should be mode 0600"
          }

@@ -546,18 +546,18 @@
      }
  } result]} {
      puts stderr "error in $file: $result"
-} elseif {([set x [lsearch -exact $argv "-follow"]] > 0) && ([expr $x%2])}  
{
+} elseif {[set x [lsearch -exact $argv "-follow"]] > 0 && [expr {$x % 2}]}  
{
      set keep_alive 1
      set keep_alive_interval 3

-    if {([set y [lsearch -exact $argv "-pidfile"]] > 0) && ([expr $y%2])} {
-        set fd [open [set pf [lindex $argv [expr $y+1]]] \
-                     { WRONLY CREAT TRUNC }]
+    if {[set y [lsearch -exact $argv "-pidfile"]] > 0 && [expr {$y % 2}]} {
+        set fd [open [set pf [lindex $argv [expr {$y + 1}]]] \
+                     {WRONLY CREAT TRUNC}]
          puts $fd [pid]
          close $fd
      }

-    xsend::follow  [lindex $argv [expr $x+1]] $argv
+    xsend::follow [lindex $argv [expr {$x + 1}]] $argv

      catch { file delete -- $pf }
  } elseif {[catch { eval [list xsend::sendit 0] $argv } result]} {
=======================================
--- /trunk/xmpp/xml.tcl	Mon Feb 23 06:48:06 2009
+++ /trunk/xmpp/xml.tcl	Fri Jul 31 12:26:02 2009
@@ -173,6 +173,8 @@
  # Arguments:
  #       xmldata         A parsed (or created by create) XML element.
  #       pxmlns          Optional. XMLNS of a parent XML element.
+#       prefixes        Optional. List of defined XMLNS prefixes.
+#                       Pairs (XMLNS, prefix)
  #
  # Results:
  #       A converted raw XML data.
@@ -180,7 +182,7 @@
  # Side effects:
  #       None.

-proc ::xmpp::xml::toText {xmldata {pxmlns ""}} {
+proc ::xmpp::xml::toText {xmldata {pxmlns ""} {prefixes {xml xml}}} {
      set retext ""

      set tag    [lindex $xmldata 0]
@@ -189,12 +191,42 @@
      set subels [lindex $xmldata 3]
      set cdata  [lindex $xmldata 4]

-    append retext "<$tag"
+    array set p $prefixes
+
+    # Parsimoniously adding new prefixes (only when XMLNS is prepended
+    # to an attribute).
+
+    set newattrs {}
+    foreach {attr value} $attrs {
+        set l [::split $attr :]
+        if {[llength $l] > 1} {
+            set axmlns [join [lrange $l 0 end-1] :]
+            set aattr [lindex $l end]
+
+            if {[string equal $axmlns $xmlns]} {
+                lappend newattrs $aattr $value
+            } elseif {[info exists p($axmlns)]} {
+                lappend newattrs $p($axmlns):$aattr $value
+            } else {
+                set p($axmlns) [FindNewPrefix [array names p]]
+                lappend newattrs xmlns:$p($axmlns) $axmlns  
$p($axmlns):$aattr $value
+            }
+        } else {
+            lappend newattrs $attr $value
+        }
+    }
+
      if {![string equal $xmlns ""] && ![string equal $xmlns $pxmlns]} {
-        append retext " xmlns='[Escape $xmlns]'"
-        set pxmlns $xmlns
-    }
-    foreach {attr value} $attrs {
+        if {![info exists p($xmlns)]} {
+            append retext "<$tag xmlns='[Escape $xmlns]'"
+            set pxmlns $xmlns
+        } else {
+            append retext "<$p($xmlns):$tag"
+        }
+    } else {
+        append retext "<$tag"
+    }
+    foreach {attr value} $newattrs {
          append retext " $attr='[Escape $value]'"
      }
      if {[string equal $cdata ""] && [llength $subels] == 0} {
@@ -207,7 +239,7 @@
      append retext [Escape $cdata]

      foreach subdata $subels {
-        append retext [toText $subdata $pxmlns]
+        append retext [toText $subdata $pxmlns [array get p]]
          append retext [Escape [lindex $subdata 5]]
      }

@@ -699,6 +731,60 @@
          return $lang
      }
  }
+
+
+# ::xmpp::xml::FindNewPrefix --
+#
+#       Find new XMLNS prefix.
+#
+# Arguments:
+#       prefixes            A list of defined prefixes.
+#
+# Results:
+#       A string which isn't contained in the prefixes list.
+#
+# Side effects:
+#       None.
+
+proc ::xmpp::xml::FindNewPrefix {prefixes} {
+    set l0 {a b c d e f g h i j k l m n o p q r s t u v w x y z}
+    set l1 $l0
+
+    while {1} {
+        foreach p $l1 {
+            if {[lsearch -exact $prefixes $p] < 0} {
+                return $p
+            }
+        }
+
+        set l1 [DescartesProduct $l1 $l0]
+    }
+}
+
+# ::xmpp::xml::DescartesProduct --
+#
+#       Returns a sort of Descartes product of two lists of strings - the  
list
+#       of appended strings from the first and the second list.
+#
+# Arguments:
+#       prefixes            The list of prefixes.
+#       suffixes            The lsit of suffixes.
+#
+# Results:
+#       The list of strings, where prefixes from the first list are joined  
with
+#       suffixes from the second one.
+#
+# Side effects:
+#       None.
+
+proc ::xmpp::xml::DescartesProduct {prefixes suffixes} {
+    set res {}
+    foreach p $prefixes {
+        foreach s $suffixes {
+            lappend res $p$s
+        }
+    }
+}

  # ::xmpp::xml::Escape --
  #


More information about the Tkabber-dev mailing list