[Tkabber-dev] [tclxmpp] r164 committed - * xmpp/sasl.tcl: Added preliminary SCRAM mechanism support (it...

tclxmpp at googlecode.com tclxmpp at googlecode.com
Fri Nov 8 11:41:02 MSK 2013


Revision: 164
Author:   sgolovan
Date:     Fri Nov  8 07:40:42 2013 UTC
Log:      	* xmpp/sasl.tcl: Added preliminary SCRAM mechanism support (it
	  requires not included into Tcllib yet SASL::SCRAM package, see
	  http://core.tcl.tk/tcllib/tktview?name=b8f35b9883). Use empty
	  authzid instead of user's bare JID.

	* examples/jsend.tcl: Use -host option for a server to connect to.
	  Added -digest option to allow jsend to use plaintext-based SASL
	  protocols.

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

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

=======================================
--- /trunk/ChangeLog	Sun Apr 21 09:14:38 2013 UTC
+++ /trunk/ChangeLog	Fri Nov  8 07:40:42 2013 UTC
@@ -1,3 +1,14 @@
+2013-11-08  Sergei Golovan  <sgolovan at nes.ru>
+
+	* xmpp/sasl.tcl: Added preliminary SCRAM mechanism support (it
+	  requires not included into Tcllib yet SASL::SCRAM package, see
+	  http://core.tcl.tk/tcllib/tktview?name=b8f35b9883). Use empty
+	  authzid instead of user's bare JID.
+
+	* examples/jsend.tcl: Use -host option for a server to connect to.
+	  Added -digest option to allow jsend to use plaintext-based SASL
+	  protocols.
+
  2013-04-21  Sergei Golovan  <sgolovan at nes.ru>

  	* xmpp/https.tcl: Removed domain flag from the NTLM greeting message.
=======================================
--- /trunk/examples/jsend.tcl	Mon Jan 25 17:14:37 2010 UTC
+++ /trunk/examples/jsend.tcl	Fri Nov  8 07:40:42 2013 UTC
@@ -56,11 +56,16 @@
                              -url         ""    \
                              -tls         false \
                              -starttls    true  \
-                            -sasl        true]
+                            -sasl        true  \
+                            -digest      true]
      array set options $args

      if {[string equal $options(-host) ""]} {
-        set options(-host) [info hostname]
+        if {[string first @ $options(-from)] < 0} {
+            set options(-host) [info hostname]
+        } else {
+            set options(-host) [::xmpp::jid::server $options(-from)]
+        }
      }

      set params [list from]
@@ -173,7 +178,7 @@
          }

          # Connect to a server
-        ::xmpp::connect $xlib $domain $port -transport $transport
+        ::xmpp::connect $xlib $options(-host) $port -transport $transport

          if {!$options(-tls) && $options(-starttls)} {
              # Open XMPP stream
@@ -184,7 +189,8 @@

              ::xmpp::sasl::auth $xlib -username  $node \
                                       -password  $options(-password) \
-                                     -resource  $resource
+                                     -resource  $resource \
+                                     -digest    $options(-digest)
          } elseif {$options(-sasl)} {
              # Open XMPP stream
              set sessionID [::xmpp::openStream $xlib $domain \
@@ -192,7 +198,8 @@

              ::xmpp::sasl::auth $xlib -username  $node \
                                       -password  $options(-password) \
-                                     -resource  $resource
+                                     -resource  $resource \
+                                     -digest    $options(-digest)
          } else {
              # Open XMPP stream
              set sessionID [::xmpp::openStream $xlib $domain]
=======================================
--- /trunk/xmpp/sasl.tcl	Sun Apr 21 09:14:38 2013 UTC
+++ /trunk/xmpp/sasl.tcl	Fri Nov  8 07:40:42 2013 UTC
@@ -27,6 +27,7 @@
      } elseif {![catch {package require SASL 1.0} v]} {
          catch {package require SASL::NTLM}
          catch {package require SASL::XGoogleToken}
+        catch {package require SASL::SCRAM}
          set saslpack tcllib

          if {[package vcompare $v 1.3.2] >= 0} {
@@ -367,7 +368,8 @@
              if {!$code} {
                  set state(mech) $result
                  SASL::configure $state(token) -mech $state(mech)
-                switch -- $state(mech) {
+                switch -glob -- $state(mech) {
+                    SCRAM-* -
                      PLAIN -
                      X-GOOGLE-TOKEN {
                          # Initial responce
@@ -485,6 +487,8 @@

      set serverin [base64::decode $serverin64]

+    ::xmpp::Debug $xlib 2 "$token SASL challenge: $serverin"
+
      switch -- $saslpack {
          tclsasl {
              set code [catch {
@@ -536,9 +540,7 @@
      switch -- $params(id) {
          user {
              # authzid
-            return [encoding convertto utf-8 \
-                             [::xmpp::jid::jid $state(-username) \
-                                               $state(-server)]]
+            return ""
          }
          authname {
              #username
@@ -570,7 +572,7 @@
      switch -- $params(id) {
          user {
              # authzid
-            return [encoding convertto utf-8 $state(-domain)]
+            return ""
          }
          authname {
              #username
@@ -603,12 +605,11 @@
      switch -- $command {
          login {
              # authzid
-            return [encoding convertto utf-8 \
-                             [::xmpp::jid::jid $state(-username) \
-                                               $state(-server)]]
+            return ""
          }
          username {
-            switch -- $state(mech)/$encodeToUTF8 {
+            switch -glob -- $state(mech)/$encodeToUTF8 {
+                SCRAM-*/* -
                  DIGEST-MD5/0 {
                      return $state(-username)
                  }
@@ -618,7 +619,8 @@
              }
          }
          password {
-            switch -- $state(mech)/$encodeToUTF8 {
+            switch -glob -- $state(mech)/$encodeToUTF8 {
+                SCRAM-*/* -
                  DIGEST-MD5/0 {
                      return $state(-password)
                  }
@@ -652,10 +654,11 @@
      switch -- $command {
          login {
              # authzid
-            return [encoding convertto utf-8 $state(-domain)]
+            return ""
          }
          username {
-            switch -- $state(mech)/$encodeToUTF8 {
+            switch -glob -- $state(mech)/$encodeToUTF8 {
+                SCRAM-*/* -
                  DIGEST-MD5/0 {
                      return $state(-domain)
                  }
@@ -665,7 +668,8 @@
              }
          }
          password {
-            switch -- $state(mech)/$encodeToUTF8 {
+            switch -glob -- $state(mech)/$encodeToUTF8 {
+                SCRAM-*/* -
                  DIGEST-MD5/0 {
                      return $state(-secret)
                  }


More information about the Tkabber-dev mailing list