[Tkabber-dev] [tclxmpp commit] r101 - * xmpp/sasl.tcl: Also, split

codesite-noreply at google.com codesite-noreply at google.com
Wed Apr 1 00:05:04 MSD 2009


Author: sgolovan
Date: Tue Mar 31 09:52:06 2009
New Revision: 101

Modified:
    trunk/ChangeLog
    trunk/xmpp/sasl.tcl

Log:
	* xmpp/sasl.tcl: Also, split
	  SASL callbacks into two separate parts (one for users, another for
	  components).


Modified: trunk/ChangeLog
==============================================================================
--- trunk/ChangeLog	(original)
+++ trunk/ChangeLog	Tue Mar 31 09:52:06 2009
@@ -1,7 +1,9 @@
  2009-03-31  Sergei Golovan  <sgolovan at nes.ru>

  	* xmpp/sasl.tcl: Took into account that MD5-DIGEST SASL mechanism in
-	  Tcllib converts username and password to UTF-8 itself.
+	  Tcllib converts username and password to UTF-8 itself. Also, split
+	  SASL callbacks into two separate parts (one for users, another for
+	  components).

  2009-03-30  Sergei Golovan  <sgolovan at nes.ru>


Modified: trunk/xmpp/sasl.tcl
==============================================================================
--- trunk/xmpp/sasl.tcl	(original)
+++ trunk/xmpp/sasl.tcl	Tue Mar 31 09:52:06 2009
@@ -164,9 +164,14 @@

      switch -- $saslpack {
          tclsasl {
+            if {[info exists state(-username)]} {
+                set callback TclsaslCallbackUser
+            } else {
+                set callback TclsaslCallbackComponent
+            }
              foreach key {authname pass getrealm cnonce} {
                  lappend callbacks \
-                    [list $key [namespace code [list TclsaslCallback  
$token]]]
+                    [list $key [namespace code [list $callback $token]]]
              }

              set state(token) \
@@ -193,12 +198,16 @@
                                         flags $flags]
          }
          tcllib {
+            if {[info exists state(-username)]} {
+                set callback TcllibCallbackUser
+            } else {
+                set callback TcllibCallbackComponent
+            }
              set state(token) \
                  [SASL::new -service xmpp \
                             -type client \
                             -server $state(-server) \
-                           -callback [namespace code [list TcllibCallback \
-                                                           $token]]]
+                           -callback [namespace code [list $callback  
$token]]]
              # Workaround a bug 1545306 in Tcllib SASL module
              set ::SASL::digest_md5_noncecount 0
          }
@@ -514,7 +523,7 @@

  ##########################################################################

-proc ::xmpp::sasl::TclsaslCallback {token data} {
+proc ::xmpp::sasl::TclsaslCallbackUser {token data} {
      variable $token
      upvar 0 $token state
      set xlib $state(xlib)
@@ -526,28 +535,48 @@
      switch -- $params(id) {
          user {
              # authzid
-            if {[info exists state(-username)]} {
-                return [encoding convertto utf-8 \
-                                 [::xmpp::jid::jid $state(-username) \
-                                                   $state(-server)]]
-            } else {
-                return [encoding convertto utf-8 $state(-domain)]
-            }
+            return [encoding convertto utf-8 \
+                             [::xmpp::jid::jid $state(-username) \
+                                               $state(-server)]]
          }
          authname {
              #username
-            if {[info exists state(-username)]} {
-                return [encoding convertto utf-8 $state(-username)]
-            } else {
-                return [encoding convertto utf-8 $state(-domain)]
-            }
+            return [encoding convertto utf-8 $state(-username)]
          }
          pass {
-            if {[info exists state(-username)]} {
-                return [encoding convertto utf-8 $state(-password)]
-            } else {
-                return [encoding convertto utf-8 $state(-secret)]
-            }
+            return [encoding convertto utf-8 $state(-password)]
+        }
+        getrealm {
+            return [encoding convertto utf-8 $state(-server)]
+        }
+        default {
+            return -code error \
+                [::msgcat::mc "SASL callback error: client needs to\
+                               write \"%s\"" $params(id)]
+        }
+    }
+}
+
+proc ::xmpp::sasl::TclsaslCallbackComponent {token data} {
+    variable $token
+    upvar 0 $token state
+    set xlib $state(xlib)
+
+    ::xmpp::Debug $xlib 2 "$token $data"
+
+    array set params $data
+
+    switch -- $params(id) {
+        user {
+            # authzid
+            return [encoding convertto utf-8 $state(-domain)]
+        }
+        authname {
+            #username
+            return [encoding convertto utf-8 $state(-domain)]
+        }
+        pass {
+            return [encoding convertto utf-8 $state(-secret)]
          }
          getrealm {
              return [encoding convertto utf-8 $state(-server)]
@@ -562,7 +591,7 @@

  ##########################################################################

-proc ::xmpp::sasl::TcllibCallback {token stoken command args} {
+proc ::xmpp::sasl::TcllibCallbackUser {token stoken command args} {
      variable $token
      upvar 0 $token state
      set xlib $state(xlib)
@@ -572,47 +601,73 @@
      switch -- $command {
          login {
              # authzid
-            if {[info exists state(-username)]} {
-                return [encoding convertto utf-8 \
-                                 [::xmpp::jid::jid $state(-username) \
-                                                   $state(-server)]]
-            } else {
-                return [encoding convertto utf-8 $state(-domain)]
+            return [encoding convertto utf-8 \
+                             [::xmpp::jid::jid $state(-username) \
+                                               $state(-server)]]
+        }
+        username {
+            switch -- $state(mech) {
+                DIGEST-MD5 {
+                    return $state(-username)
+                }
+                default {
+                    return [encoding convertto utf-8 $state(-username)]
+                }
              }
          }
+        password {
+            switch -- $state(mech) {
+                DIGEST-MD5 {
+                    return $state(-password)
+                }
+                default {
+                    return [encoding convertto utf-8 $state(-password)]
+                }
+            }
+        }
+        realm {
+            return [encoding convertto utf-8 $state(-server)]
+        }
+        hostname {
+            return [info host]
+        }
+        default {
+            return -code error \
+                [::msgcat::mc "SASL callback error: client needs to\
+                               write \"%s\"" $command]
+        }
+    }
+}
+
+proc ::xmpp::sasl::TcllibCallbackComponent {token stoken command args} {
+    variable $token
+    upvar 0 $token state
+    set xlib $state(xlib)
+
+    ::xmpp::Debug $xlib 2 "$token $stoken $command"
+
+    switch -- $command {
+        login {
+            # authzid
+            return [encoding convertto utf-8 $state(-domain)]
+        }
          username {
              switch -- $state(mech) {
                  DIGEST-MD5 {
-                    if {[info exists state(-username)]} {
-                        return $state(-username)
-                    } else {
-                        return $state(-domain)
-                    }
+                    return $state(-domain)
                  }
                  default {
-                    if {[info exists state(-username)]} {
-                        return [encoding convertto utf-8 $state(-username)]
-                    } else {
-                        return [encoding convertto utf-8 $state(-domain)]
-                    }
+                    return [encoding convertto utf-8 $state(-domain)]
                  }
              }
          }
          password {
              switch -- $state(mech) {
                  DIGEST-MD5 {
-                    if {[info exists state(-username)]} {
-                        return $state(-password)
-                    } else {
-                        return $state(-secret)
-                    }
+                    return $state(-secret)
                  }
                  default {
-                    if {[info exists state(-username)]} {
-                        return [encoding convertto utf-8 $state(-password)]
-                    } else {
-                        return [encoding convertto utf-8 $state(-secret)]
-                    }
+                    return [encoding convertto utf-8 $state(-secret)]
                  }
              }
          }


More information about the Tkabber-dev mailing list