[Tkabber-dev] r1567 - trunk/tkabber

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Mon Oct 20 23:50:06 MSD 2008


Author: sergei
Date: 2008-10-20 23:50:06 +0400 (Mon, 20 Oct 2008)
New Revision: 1567

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/iface.tcl
   trunk/tkabber/login.tcl
Log:
	* iface.tcl, login.tcl: Adapted STARTTLS and old SSL to new
	  -verifycommand option of starttls and tls transport. Restored SSL
	  button in the right lower corner of the Tkabber window.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2008-10-20 18:14:54 UTC (rev 1566)
+++ trunk/tkabber/ChangeLog	2008-10-20 19:50:06 UTC (rev 1567)
@@ -2,6 +2,10 @@
 
 	* messages.tcl: Fixed typo.
 
+	* iface.tcl, login.tcl: Adapted STARTTLS and old SSL to new
+	  -verifycommand option of starttls and tls transport. Restored SSL
+	  button in the right lower corner of the Tkabber window.
+
 2008-10-19  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/roster/annotations.tcl: Fixed widget name with connection

Modified: trunk/tkabber/iface.tcl
===================================================================
--- trunk/tkabber/iface.tcl	2008-10-20 18:14:54 UTC (rev 1566)
+++ trunk/tkabber/iface.tcl	2008-10-20 19:50:06 UTC (rev 1567)
@@ -19,44 +19,50 @@
     sbits     [::msgcat::mc "Session key bits"] \
     sha1_hash [::msgcat::mc "SHA1 hash"]]
 
+proc update_tls_info {xlib args} {
+    global tls_info
+
+    catch {unset tls_info($xlib)}
+    if {[llength $args] > 0} {
+	set tls_info($xlib) $args
+    }
+}
+
+hook::add disconnected_hook update_tls_info
+
 proc ssl_info {} {
     global ssl_certificate_fields
+    global tls_info
 
     set server_list {}
     set msg_list {}
     foreach xlib [connections] {
-
-	# TODO
-	break
-
-	if {[info exists ::jlib::lib($xlib,sck)]} {
-	    if {![catch { tls::status $::jlib::lib($xlib,sck) } status]} {
-		set server [connection_server $xlib]
-		if {[lcontain $server_list $server]} {
-		    continue
-		} else {
-		    lappend server_list $server
-		    lappend msg_list $server
+	if {[info exists tls_info($xlib)]} {
+	    set server [connection_server $xlib]
+	    if {[lsearch -exact $server_list $server] >= 0} {
+		continue
+	    } else {
+		lappend server_list $server
+		lappend msg_list $server
+	    }
+	    set info {}
+	    foreach {k v} $tls_info($xlib) {
+		switch -- $k {
+		    subject -
+		    issuer {
+			set v [regsub -all {\s*[/,]\s*(\w+=)} $v \n\t\\1]
+		    }
 		}
-		set info {}
-		foreach {k v} $status {
-		    switch -- $k {
-			subject - issuer {
-			    set v [regsub -all {\s*[/,]\s*(\w+=)} $v \n\t\\1]
-			}
+		if {![string equal $v ""]} {
+		    if {[info exists ssl_certificate_fields($k)]} {
+			append info [format "%s: %s\n" \
+					    $ssl_certificate_fields($k) $v]
+		    } else {
+			append info [format "%s: %s\n" $k $v]
 		    }
-		    if {![cequal $v ""]} {
-			if {[info exists ssl_certificate_fields($k)]} {
-			    append info \
-				   [format "%s: %s\n" \
-					   $ssl_certificate_fields($k) $v]
-			} else {
-			    append info [format "%s: %s\n" $k $v]
-			}
-		    }
 		}
-		lappend msg_list [string trim $info]
 	    }
+	    lappend msg_list [string trim $info]
 	}
     }
     return $msg_list
@@ -64,6 +70,7 @@
 
 proc update_ssl_info {} {
     global tls_warning_info
+    global tls_info
 
     set state disabled
     set len [llength [connections]]
@@ -71,28 +78,20 @@
     if {$len} {
 	set balloon ""
 	foreach xlib [connections] {
-
-	    # TODO
-	    break
-
 	    if {$len > 1} {
 		append balloon "[connection_jid $xlib]: "
 	    }
-	    if {[info exists ::jlib::lib($xlib,sck)]} {
-		if {![catch { tls::status $::jlib::lib($xlib,sck) } status]} {
-		    if {![info exists tls_warning_info($xlib)] ||
-			    [cequal $tls_warning_info($xlib) ""]} {
-			append balloon [::msgcat::mc "Enabled\n"]
-		    } else {
-			append balloon $tls_warning_info($xlib)
-			set fg warning
-		    }
-		    set state normal
+	    if {[info exists tls_info($xlib)]} {
+		if {![info exists tls_warning_info($xlib)] ||
+			[string equal $tls_warning_info($xlib) ""]} {
+		    append balloon [::msgcat::mc "Enabled\n"]
 		} else {
-		    append balloon [::msgcat::mc "Disabled\n"]
+		    append balloon $tls_warning_info($xlib)
+		    set fg warning
 		}
+		set state normal
 	    } else {
-		append balloon [::msgcat::mc "Disconnected"] "\n"
+		append balloon [::msgcat::mc "Disabled\n"]
 	    }
 	}
     } else {

Modified: trunk/tkabber/login.tcl
===================================================================
--- trunk/tkabber/login.tcl	2008-10-20 18:14:54 UTC (rev 1566)
+++ trunk/tkabber/login.tcl	2008-10-20 19:50:06 UTC (rev 1567)
@@ -561,10 +561,11 @@
 		lappend hosts1 [list $host [incr port]]
 	    }
 	    set hosts $hosts1
-	    lappend args -certfile $lc(sslcertfile) \
-			 -castore  $lc(sslcacertstore) \
-			 -keyfile  $lc(sslkeyfile) \
-			 -callback [list client:tls_callback $xlib]
+	    lappend args -certfile      $lc(sslcertfile) \
+			 -castore       $lc(sslcacertstore) \
+			 -keyfile       $lc(sslkeyfile) \
+			 -verifycommand [list client:tls_callback $xlib] \
+			 -infocommand   [list update_tls_info $xlib]
 	}
 
 	if {$lc(usealtserver)} {
@@ -632,11 +633,12 @@
 
     if {$use_tls && $lc(stream_options) == "encrypted"} {
 	::xmpp::starttls::starttls $xlib \
-			-command  [list login_login2 $xlib $logindata] \
-			-certfile $lc(sslcertfile) \
-			-castore  $lc(sslcacertstore) \
-			-keyfile  $lc(sslkeyfile) \
-			-callback [list client:tls_callback $xlib]
+			-command       [list login_login2 $xlib $logindata] \
+			-certfile      $lc(sslcertfile) \
+			-castore       $lc(sslcacertstore) \
+			-keyfile       $lc(sslkeyfile) \
+			-verifycommand [list client:tls_callback $xlib] \
+			-infocommand   [list update_tls_info $xlib]
     } elseif {$have_compress && $lc(stream_options) == "compressed"} {
 	::xmpp::compress::compress $xlib \
 			-command     [list login_login2 $xlib $logindata]



More information about the Tkabber-dev mailing list