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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Jan 16 16:56:48 MSK 2010


Author: sergei
Date: 2010-01-16 16:56:48 +0300 (Sat, 16 Jan 2010)
New Revision: 1873

Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/ifacetk/iface.tcl
   trunk/tkabber/login.tcl
Log:
	* login.tcl, ifacetk/iface.tcl: Added login log window to which
	  important login/logout messages are stored. Also, a bit rearranged
	  status processing and removed one 8.4-izm ("true" as a boolean
	  value).


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2010-01-16 08:32:05 UTC (rev 1872)
+++ trunk/tkabber/ChangeLog	2010-01-16 13:56:48 UTC (rev 1873)
@@ -6,6 +6,11 @@
 
 	* login.tcl: Fixed typo.
 
+	* login.tcl, ifacetk/iface.tcl: Added login log window to which
+	  important login/logout messages are stored. Also, a bit rearranged
+	  status processing and removed one 8.4-izm ("true" as a boolean
+	  value).
+
 2010-01-15  Sergei Golovan  <sgolovan at nes.ru>
 
 	* privacy.tcl: Added IQ to blocked stanzas for JIDs in invisible list

Modified: trunk/tkabber/ifacetk/iface.tcl
===================================================================
--- trunk/tkabber/ifacetk/iface.tcl	2010-01-16 08:32:05 UTC (rev 1872)
+++ trunk/tkabber/ifacetk/iface.tcl	2010-01-16 13:56:48 UTC (rev 1873)
@@ -304,6 +304,8 @@
 		       -command [list [namespace current]::logout_dialog]] \
 		  [list command [::msgcat::mc "Log out with reason..."] {} {} {} \
 		       -command {show_logout_dialog}] \
+		  [list command [::msgcat::mc "Open login log"] {} {} {} \
+		       -command {login_log_window}] \
 		  {separator} \
 		  [list command [::msgcat::mc "Change password..."] {} {} {} \
 		       -command {::register::password [lindex [connections] 0]}] \

Modified: trunk/tkabber/login.tcl
===================================================================
--- trunk/tkabber/login.tcl	2010-01-16 08:32:05 UTC (rev 1872)
+++ trunk/tkabber/login.tcl	2010-01-16 13:56:48 UTC (rev 1873)
@@ -272,11 +272,16 @@
     set jid [::xmpp::jid::normalize [::xmpp::jid::jid $lc(user) \
 						      $lc(server) \
 						      $lc(resource)]]
+    set lc(jid) $jid
+    set logindata [array get lc]
+
     if {[info exists login_after_id($jid)]} {
 	after cancel $login_after_id($jid)
 	unset login_after_id($jid)
     }
 
+    login_log $jid ok [::msgcat::mc "Starting login"]
+
     debugmsg login "Starting login ($jid)"
     set_status [::msgcat::mc "Connecting to %s" $lc(server)]
 
@@ -287,40 +292,46 @@
     global connect_error
     global login_after_time
 
-    if {$status == "ok"} {
-	# OK, connected.
-	add_to_connection 0 $xlib
-	debugmsg login "Connect successful $xlib"
+    array set lc $logindata
 
-	set login_after_time 7500
-	login_login $xlib $logindata
-    } elseif {$status == "abort"} {
-	# TODO
-	debugmsg login "Connect aborted: $xlib $msg"
-    } else {
-	# Nasty thing has happened.
-	# $msg contains error message here.
-	debugmsg login "Failed to connect: $xlib $status $msg"
+    switch -- $status {
+	ok {
+	    # OK, connected.
+	    add_to_connection 0 $xlib
+	    debugmsg login "Connect successful $xlib"
 
-	array set lc $logindata
+	    set login_after_time 7500
+	    login_login $xlib $logindata
+	}
+	abort {
+	    # TODO
+	    debugmsg login "Connect aborted: $xlib $msg"
+	    login_log $lc(jid) abort $msg
+	}
+	default {
+	    # Nasty thing has happened.
+	    # $msg contains error message here.
+	    debugmsg login "Failed to connect: $xlib $status $msg"
+	    login_log $lc(jid) $status $msg
 
-	if {$lc(connect_forever)} {
-	    login_retry $logindata
-	} else {
-	    if {[winfo exists .connect_err]} {
-		destroy .connect_err
-	    }
-	    if {[info exists connect_error($msg)]} {
-		set msg $connect_error($msg)
-	    }
-	    set res [MessageDlg .connect_err -width 600 -icon error \
-		-message [::msgcat::mc "Failed to connect: %s" $msg] \
-		-type user -buttons [list abort [::msgcat::mc "Keep trying"]] \
-		-default 0 -cancel 0]
-	    if {$res} {
-		set lc(connect_forever) 1
-		set logindata [array get lc]
+	    if {$lc(connect_forever)} {
 		login_retry $logindata
+	    } else {
+		if {[winfo exists .connect_err]} {
+		    destroy .connect_err
+		}
+		if {[info exists connect_error($msg)]} {
+		    set msg $connect_error($msg)
+		}
+		set res [MessageDlg .connect_err -width 600 -icon error \
+		    -message [::msgcat::mc "Failed to connect: %s" $msg] \
+		    -type user -buttons [list abort [::msgcat::mc "Keep trying"]] \
+		    -default 0 -cancel 0]
+		if {$res} {
+		    set lc(connect_forever) 1
+		    set logindata [array get lc]
+		    login_retry $logindata
+		}
 	    }
 	}
     }
@@ -339,10 +350,8 @@
 	set login_after_time [expr {$login_after_time * 2}]
     }
     array set lc $logindata
+    set jid $lc(jid)
 
-    set jid [::xmpp::jid::normalize [::xmpp::jid::jid $lc(user) \
-						      $lc(server) \
-						      $lc(resource)]]
     debugmsg login "Scheduling connect retry for $jid in ${login_after_time}ms"
     if {[info exists login_after_id($jid)]} {
 	after cancel $login_after_id($jid)
@@ -474,7 +483,7 @@
     set xlib [create_xlib $jid]
 
     set tls_warning_info($xlib) ""
-    set reconnect($xlib) true
+    set reconnect($xlib) 1
 
     set ascii_server [idna::domain_toascii $lc(server)]
 
@@ -677,9 +686,11 @@
 	}
 
 	foreach xlib [connections 1] {
+	    login_log [connection_jid $xlib] ok "Logout"
 	    disconnected $xlib
 	}
     } else {
+	login_log [connection_jid $xlib] ok [::msgcat::mc "Logout"]
 	disconnected $xlib
     }
 }
@@ -688,6 +699,7 @@
     global reconnect
     global loginconf_hist
 
+    login_log [connection_jid $xlib] error [::msgcat::mc "Forced logout"]
 
     if {$reconnect($xlib)} {
 	debugmsg login "RECONNECT $xlib"
@@ -734,61 +746,78 @@
     }
 }
 
-proc recv_auth_result {xlib logindata res xml} {
+proc recv_auth_result {xlib logindata status xml} {
     global connjid
 
     array set lc $logindata
 
-    if {$res == "ok"} {
-	set connjid($xlib) $xml
-	connected $xlib $logindata
-    } else {
-	lassign [error_type_condition $xml] type cond
-	if {($type == "sasl") || ($type == "auth" && $cond == "not-authorized")} {
-	    set res [MessageDlg [epath] -aspect 50000 -icon error \
-			 -message [::msgcat::mc "Authentication failed:\
-						 %s\nCreate new account?" \
-						[error_to_string $xml]] \
-			 -type user -buttons {yes no} -default 0 -cancel 1]
-	    if {!$res} {
-		::xmpp::sendIQ $xlib set \
-		    -query [::xmpp::xml::create query \
-				-xmlns jabber:iq:register \
-				-subelement [::xmpp::xml::create username \
-						    -cdata $lc(user)] \
-				-subelement [::xmpp::xml::create password \
-						    -cdata $lc(password)]] \
-		    -to $lc(server) \
-		    -command [list recv_register_result $xlib $logindata]
-		return
+    switch -- $status {
+	ok {
+	    set connjid($xlib) $xml
+	    login_log $xml ok [::msgcat::mc "Login is successful"]
+	    connected $xlib $logindata
+	}
+	abort {
+	    # TODO
+	    debugmsg login "Authentication aborted: $xlib [error_to_string $xml]"
+	    login_log $lc(jid) abort [error_to_string $xml]
+	    logout $xlib
+	}
+	default {
+	    login_log $lc(jid) $status [error_to_string $xml]
+
+	    lassign [error_type_condition $xml] type cond
+	    if {($type == "sasl") || ($type == "auth" && $cond == "not-authorized")} {
+		set res [MessageDlg [epath] -aspect 50000 -icon error \
+			     -message [::msgcat::mc "Authentication failed:\
+						     %s\nCreate new account?" \
+						    [error_to_string $xml]] \
+			     -type user -buttons {yes no} -default 0 -cancel 1]
+		if {!$res} {
+		    ::xmpp::sendIQ $xlib set \
+			-query [::xmpp::xml::create query \
+				    -xmlns jabber:iq:register \
+				    -subelement [::xmpp::xml::create username \
+							-cdata $lc(user)] \
+				    -subelement [::xmpp::xml::create password \
+							-cdata $lc(password)]] \
+			-to $lc(server) \
+			-command [list recv_register_result $xlib $logindata]
+		    return
+		}
+	    } else {
+		MessageDlg [epath] -aspect 50000 -icon error \
+		    -message [::msgcat::mc "Authentication failed: %s" \
+					   [error_to_string $xml]] \
+		    -type user -buttons {ok} -default 0 -cancel 0
 	    }
-	} else {
-	    MessageDlg [epath] -aspect 50000 -icon error \
-		-message [::msgcat::mc "Authentication failed: %s" \
-				       [error_to_string $xml]] \
-		-type user -buttons {ok} -default 0 -cancel 0
+
+	    logout $xlib
 	}
-
-	logout $xlib
     }
 }
 
-proc recv_register_result {xlib logindata res xml} {
+proc recv_register_result {xlib logindata status xml} {
     logout $xlib
 
-    if {$res == "ok"} {
-	login $logindata
-    } else {
-	MessageDlg [epath] -aspect 50000 -icon error \
-	    -message [::msgcat::mc "Registration failed: %s" \
-				   [error_to_string $xml]] \
-	    -type user -buttons ok -default 0 -cancel 0
+    switch -- $status {
+	ok {
+	    login $logindata
+	}
+	default {
+	    MessageDlg [epath] -aspect 50000 -icon error \
+		-message [::msgcat::mc "Registration failed: %s" \
+				       [error_to_string $xml]] \
+		-type user -buttons ok -default 0 -cancel 0
+	}
     }
 }
 
 proc client:error {xlib condition message} {
     global reconnect
 
+    login_log [connection_jid $xlib] error $message
+
     if {[winfo exists .client_error]} {
 	destroy .client_error
     }
@@ -806,10 +835,10 @@
 	unsupported-encoding -
 	unsupported-stanza-type -
 	xml-not-well-formed {
-	    set reconnect($xlib) true
+	    set reconnect($xlib) 1
 	}
 	default {
-	    set reconnect($xlib) false
+	    set reconnect($xlib) 0
 	}
     }
 
@@ -870,4 +899,88 @@
     logout
 }
 
+proc login_log_window {} {
+    global login_log
+
+    if {![info exists login_log]} {
+	set login_log {}
+    }
+
+    set w .login_log
+
+    if {[winfo exists $w]} {
+	raise_win $w
+	return
+    }
+
+    add_win $w -title [::msgcat::mc "Login log"] \
+	       -tabtitle [::msgcat::mc "Login log"] \
+	       -class Chat \
+	       -raisecmd [list focus $w.body]
+
+    [ScrolledWindow $w.sw] setwidget \
+			   [text $w.body -state disabled -takefocus 1]
+    bind $w.body <1> [list focus $w.body]
+
+    pack $w.sw -side bottom -fill both -expand yes
+
+    $w.body tag configure jid   \
+            -foreground [option get $w meforeground Chat]
+    $w.body tag configure ok \
+            -foreground [option get $w theyforeground Chat]
+    $w.body tag configure error  \
+            -foreground [option get $w errforeground Chat]
+
+    # TODO
+    #search::setup_panel $w
+
+    foreach {timestamp jid status message} $login_log {
+	log_window_append $timestamp $jid $status $message
+    }
+
+    $w.body see end
+    raise_win $w
+}
+
+proc log_window_append {timestamp jid status message} {
+    set w .login_log
+
+    if {![winfo exists $w.body]} return
+
+    $w.body configure -state normal
+
+    set scroll [expr {[lindex [$w.body yview] 1] == 1}]
+
+    $w.body insert end [clock format $timestamp -format "\[%m/%d %T\] "] "" \
+		       $jid jid " "
+
+    switch -- $status {
+	ok {set tag ok}
+	default {set tag error}
+    }
+
+    $w.body insert end $status $tag " "
+
+    $w.body insert end [string trim $message]
+    $w.body insert end "\n"
+
+    if {$scroll} {
+        $w.body see end
+    }
+
+    $w.body configure -state disabled
+}
+
+proc login_log {jid status message} {
+    global login_log
+
+    if {![info exists login_log]} {
+	set login_log {}
+    }
+
+    set timestamp [clock seconds]
+    lappend login_log $timestamp $jid $status $message
+    log_window_append $timestamp $jid $status $message
+}
+
 # vim:ts=8:sw=4:sts=4:noet



More information about the Tkabber-dev mailing list