[Tkabber-dev] r2020 - in trunk/tkabber: . ifacetk

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Tue Dec 3 22:49:49 MSK 2013


Author: sergei
Date: 2013-12-03 22:49:49 +0400 (Tue, 03 Dec 2013)
New Revision: 2020

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/ifacetk/login.tcl
   trunk/tkabber/login.tcl
   trunk/tkabber/proxy.tcl
Log:
	* proxy.tcl: Enabled TLS1 for secure HTTP connections because there
	  are servers which have disabled SSLv3.

	* ifacetk/login.tcl, login.tcl: Added BOSH XMPP transport support.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2013-12-03 13:51:26 UTC (rev 2019)
+++ trunk/tkabber/ChangeLog	2013-12-03 18:49:49 UTC (rev 2020)
@@ -1,3 +1,10 @@
+2013-12-03  Sergei Golovan  <sgolovan at nes.ru>
+
+	* proxy.tcl: Enabled TLS1 for secure HTTP connections because there
+	  are servers which have disabled SSLv3.
+
+	* ifacetk/login.tcl, login.tcl: Added BOSH XMPP transport support.
+
 2013-09-15  Sergei Golovan  <sgolovan at nes.ru>
 
 	* default.tcl: Replace backslash by %5c in URLs which are passed to

Modified: trunk/tkabber/ifacetk/login.tcl
===================================================================
--- trunk/tkabber/ifacetk/login.tcl	2013-12-03 13:51:26 UTC (rev 2019)
+++ trunk/tkabber/ifacetk/login.tcl	2013-12-03 18:49:49 UTC (rev 2020)
@@ -1,7 +1,16 @@
 # $Id$
 
+proc enable_disable_field {field state} {
+    if {[winfo exists $field]} {
+        $field configure -state $state
+        if {[string equal [focus] $field] && [string equal $state "disabled"]} {
+            focus [Widget::focusPrev $field]
+        }
+    }
+}
+
 proc update_login_entries {l {i 0}} {
-    global ltmp
+    global ltmp have_bosh have_http_poll
 
     if {$i} {
         array set ltmp [array get ::loginconf$i]
@@ -9,23 +18,56 @@
     }
     foreach ent {username server port password resource priority \
             altserver proxyhost proxyport proxyusername proxypassword \
-            sslcertfile pollurl} {
+            sslcertfile boshurl pollurl} {
         if {[winfo exists $l.$ent]} {
             catch { $l.$ent icursor end }
         }
     }
-    foreach {check enable disable} { \
-            usehttppoll {lpollurl pollurl usepollkeys} \
-			{dontusessl usecompress legacyssl encrypted \
-			 sslcertfile lsslcertfile bsslcertfile} \
-            usealtserver {altserver laltserver port lport} {} \
-	    usesasl {allowgoogletoken} {} \
-	    } {
+
+    set checks {}
+    if {$have_bosh} {
+	enable_disable_field $l.usebosh normal
+	if {$ltmp(usebosh)} {
+	    enable_disable_field $l.usehttppoll disabled
+	    set checks {usebosh {lboshurl boshurl useboshkeys}
+			    {lpollurl pollurl usepollkeys
+			     dontusessl usecompress legacyssl encrypted
+			     sslcertfile lsslcertfile bsslcertfile}}
+	} else {
+	    if {$have_http_poll} {
+		enable_disable_field $l.usehttppoll normal
+		if {$ltmp(usehttppoll)} {
+		    enable_disable_field $l.usebosh disabled
+		}
+		enable_disable_field $l.lboshurl disabled
+		enable_disable_field $l.boshurl disabled
+		enable_disable_field $l.useboshkeys disabled
+		set checks {usehttppoll {lpollurl pollurl usepollkeys}
+				{usebosh
+				 dontusessl usecompress legacyssl encrypted
+				 sslcertfile lsslcertfile bsslcertfile}}
+	    } else {
+		set checks {usebosh {lboshurl boshurl useboshkeys}
+				    {dontusessl usecompress legacyssl encrypted
+				     sslcertfile lsslcertfile bsslcertfile}}
+	    }
+	}
+    } elseif {$have_http_poll} {
+	enable_disable_field $l.usehttppoll normal
+	set checks {usehttppoll {lpollurl pollurl usepollkeys}
+				{dontusessl usecompress legacyssl encrypted
+				 sslcertfile lsslcertfile bsslcertfile}}
+    }
+
+    foreach {check enable disable} [concat $checks \
+	    {usealtserver {altserver laltserver port lport} {} \
+	    usesasl {allowgoogletoken} {}}] {
+
         if {![info exists ltmp($check)] || ![winfo exists $l.$check]} {
             continue
         }
 
-        if {$ltmp($check) && ![cequal [$l.$check cget -state] disabled]} {
+        if {$ltmp($check) && ![string equal [$l.$check cget -state] disabled]} {
             set state1 normal
             set state2 disabled
         } else {
@@ -33,28 +75,18 @@
             set state2 normal
         }
         foreach ent $enable {
-            if {[winfo exists $l.$ent]} {
-                $l.$ent configure -state $state1
-                if {[cequal [focus] $l.$ent] && [cequal $state1 "disabled"]} {
-                    focus [Widget::focusPrev $l.$ent]
-                }
-            }
+	    enable_disable_field $l.$ent $state1
         }
         foreach ent $disable {
-            if {[winfo exists $l.$ent]} {
-                $l.$ent configure -state $state2
-                if {[cequal [focus] $l.$ent] && [cequal $state2 "disabled"]} {
-                    focus [Widget::focusPrev $l.$ent]
-                }
-	    }
+	    enable_disable_field $l.$ent $state2
 	}
     }
     catch {
-	if {[cequal $ltmp(proxy) none]} {
+	if {[string equal $ltmp(proxy) none]} {
 	    foreach ent {proxyhost proxyport proxyusername proxypassword \
 			 lproxyhost lproxyport lproxyusername lproxypassword} {
 		$l.$ent configure -state disabled
-                if {[cequal [focus] $l.$ent]} {
+                if {[string equal [focus] $l.$ent]} {
                     focus [Widget::focusPrev $l.$ent]
                 }
 	    }
@@ -66,7 +98,7 @@
 	}
     }
     catch {
-	if {![cequal [$l.dontusessl cget -state] disabled] && \
+	if {![string equal [$l.dontusessl cget -state] disabled] && \
 		($ltmp(stream_options) == "ssl" || \
 		 $ltmp(stream_options) == "encrypted")} {
 	    $l.sslcertfile configure -state normal
@@ -76,8 +108,8 @@
 	    $l.sslcertfile configure -state disabled
 	    $l.lsslcertfile configure -state disabled
 	    $l.bsslcertfile configure -state disabled
-	    if {[cequal [focus] $l.sslcertfile] || \
-		    [cequal [focus] $l.bsslcertfile]} {
+	    if {[string equal [focus] $l.sslcertfile] || \
+		    [string equal [focus] $l.bsslcertfile]} {
 		focus [Widget::focusPrev $l.sslcertfile]
 	    }
 	}
@@ -87,7 +119,7 @@
 proc login_dialog {} {
     global loginconf
     global ltmp
-    global use_tls have_compress have_sasl have_http_poll have_proxy
+    global use_tls have_compress have_sasl have_bosh have_http_poll have_proxy
 
     if {[winfo exists .login]} {
 	focus -force .login
@@ -264,6 +296,27 @@
 	grid columnconfigure $ssl_page 2 -weight 1
     }
 
+    if {$have_bosh} {
+	set bosh_page [$nb insert end bosh_page -text [::msgcat::mc "BOSH"]]
+
+	checkbutton $l.usebosh -text [::msgcat::mc "Connect via BOSH"] \
+	    -variable ltmp(usebosh) \
+	    -command [list [namespace current]::update_login_entries $l]
+	label $l.lboshurl -text [::msgcat::mc "URL to use:"]
+	entry $l.boshurl -textvariable ltmp(boshurl)
+	checkbutton $l.useboshkeys -text [::msgcat::mc "Use client security keys"] \
+	    -state disabled \
+	    -variable ltmp(useboshkeys) \
+	    -command [list [namespace current]::update_login_entries $l]
+    
+	grid $l.usebosh -row 0 -column 0 -sticky w -columnspan 3 -in $bosh_page
+	grid $l.lboshurl -row 1 -column 0 -sticky e -in $bosh_page
+	grid $l.boshurl -row 1 -column 1 -sticky ew -in $bosh_page
+	grid $l.useboshkeys -row 2 -column 0 -sticky w -columnspan 3 -in $bosh_page
+
+	grid columnconfigure $bosh_page 1 -weight 1
+    }
+    
     if {$have_http_poll} {
 	set httppoll_page [$nb insert end httpoll_page -text [::msgcat::mc "HTTP Poll"]]
 
@@ -364,9 +417,9 @@
 
     update_login_entries $l
 
-    if {[cequal $ltmp(user) ""]} {
+    if {[string equal $ltmp(user) ""]} {
 	.login draw $l.username
-    } elseif {[cequal $ltmp(password) ""]} {
+    } elseif {[string equal $ltmp(password) ""]} {
 	.login draw $l.password
     } else {
 	.login draw $l.resource

Modified: trunk/tkabber/login.tcl
===================================================================
--- trunk/tkabber/login.tcl	2013-12-03 13:51:26 UTC (rev 2019)
+++ trunk/tkabber/login.tcl	2013-12-03 18:49:49 UTC (rev 2020)
@@ -22,6 +22,12 @@
     set have_sasl 1
 }
 
+if {[catch {package require xmpp::transport::bosh}]} {
+    set have_bosh 0
+} else {
+    set have_bosh 1
+}
+
 if {[catch {package require xmpp::transport::poll}]} {
     set have_http_poll 0
 } else {
@@ -118,6 +124,34 @@
     [::msgcat::mc "Replace opened connections."] \
     -group Login -type boolean
 
+if {$have_bosh} {
+    custom::defvar loginconf(usebosh) 0 \
+	[::msgcat::mc "Use BOSH connection method."] \
+	-group Login -type boolean
+    custom::defvar loginconf(boshurl) "" \
+	[::msgcat::mc "URL to connect to using BOSH."] \
+	-group Login -type string
+    custom::defvar loginconf(usekeys) 1 \
+	[::msgcat::mc "Use BOSH client security keys (recommended)."] \
+	-group Login -type boolean
+    custom::defvar loginconf(numberofboshkeys) 100 \
+	[::msgcat::mc "Number of BOSH client security keys to send\
+		       before creating new key sequence."] \
+	-group Login -type integer
+    custom::defvar loginconf(boshtimeout) 0 \
+	[::msgcat::mc "Timeout for waiting for BOSH responses (if set\
+		       to zero, Tkabber will wait forever)."] \
+	-group Login -type integer
+    custom::defvar loginconf(boshwait) 30000 \
+	[::msgcat::mc "Interval server can wait before responding to BOSH request\
+		       (in milliseconds)."] \
+	-group Login -type integer
+    custom::defvar loginconf(boshhold) 2 \
+	[::msgcat::mc "Maximum number of requests the connection manager is\
+		       allowed to keep waiting at any time."] \
+	-group Login -type integer
+}
+
 if {$have_http_poll} {
     custom::defvar loginconf(usehttppoll) 0 \
 	[::msgcat::mc "Use HTTP poll connection method."] \
@@ -471,7 +505,7 @@
 }
 
 proc login_connect {logindata} {
-    global use_tls have_compress have_sasl have_http_poll
+    global use_tls have_compress have_sasl have_bosh have_http_poll
     global tls_warning_info
     global reconnect
 
@@ -490,7 +524,33 @@
 
     set args {-proxyfilter ::proxy::proxyfilter}
 
-    if {$have_http_poll && $lc(usehttppoll)} {
+    if {$have_bosh && $lc(usebosh)} {
+	if {$lc(boshurl) != ""} {
+	    set url $lc(boshurl)
+	} else {
+	    # TODO: Asynchronous DNS resolution
+	    if {[catch {::xmpp::dns::resolveBOSH $ascii_server} urls]} {
+		set urls {}
+	    }
+	    if {[llength $urls] == 0} {
+		set url ""
+	    } else {
+		set url [lindex $urls 0]
+	    }
+	}
+
+	lappend args -transport bosh \
+		     -timeout   $lc(boshtimeout) \
+		     -wait      $lc(boshwait) \
+		     -hold      $lc(boshhold) \
+		     -url       $url \
+		     -usekeys   $lc(useboshkeys) \
+		     -numkeys   $lc(numberofboshkeys) \
+
+	eval [list ::xmpp::connect $xlib \
+				   -command [list login_connect_result $xlib {} $logindata $args]] \
+				   $args
+    } elseif {$have_http_poll && $lc(usehttppoll)} {
 	if {$lc(pollurl) != ""} {
 	    set url $lc(pollurl)
 	} else {

Modified: trunk/tkabber/proxy.tcl
===================================================================
--- trunk/tkabber/proxy.tcl	2013-12-03 13:51:26 UTC (rev 2019)
+++ trunk/tkabber/proxy.tcl	2013-12-03 18:49:49 UTC (rev 2020)
@@ -89,11 +89,11 @@
 
 	# Find tunnelling proxy
 	if {![catch {proxyfilter $host $port} answer] && $answer != {}} {
-	    return [::tls::import \
+	    return [::tls::import -tls1 1 \
 			[::pconnect::socket $host $port \
 			    -proxyfilter [namespace current]::proxyfilter]]
 	} else {
-	    return [eval [list ::tls::socket] $args]
+	    return [eval [list ::tls::socket -tls1 1] $args]
 	}
     }
 



More information about the Tkabber-dev mailing list