# $Id$

package require xmpp::dns
package require xmpp::auth
package require xmpp::register

if {[catch {package require xmpp::starttls}]} {
    set use_tls 0
} else {
    set use_tls 1
}

if {[catch {package require xmpp::compress}]} {
    set have_compress 0
} else {
    set have_compress 1
}

if {[catch {package require xmpp::sasl}]} {
    set have_sasl 0
} else {
    set have_sasl 1
}

if {[catch {package require xmpp::transport::poll}]} {
    set have_http_poll 0
} else {
    set have_http_poll 1
}

custom::defgroup Warnings [::msgcat::mc "Warning display options."] \
    -group Tkabber

if {$use_tls} {
    custom::defvar tls_warnings 1 [::msgcat::mc "Display SSL warnings."] \
	-group Warnings -type boolean
}

custom::defgroup Login \
    [::msgcat::mc "Login options."] \
    -group Tkabber

custom::defvar loginconf(user) "" \
    [::msgcat::mc "User name."] \
    -group Login -type string
custom::defvar loginconf(server) "localhost" \
    [::msgcat::mc "Server name."] \
    -group Login -type string
custom::defvar loginconf(password) "" \
    [::msgcat::mc "Password."] \
    -group Login -type password
custom::defvar loginconf(resource) "tkabber" \
    [::msgcat::mc "Resource."] \
    -group Login -type string
custom::defvar loginconf(priority) "8" \
    [::msgcat::mc "Priority."] \
    -group Login -type integer

custom::defvar loginconf(connect_forever) 0 \
    [::msgcat::mc "Retry to connect forever."] \
    -group Login -type boolean

custom::defvar loginconf(allowauthplain) 0 \
    [::msgcat::mc "Allow plaintext authentication mechanisms (when password\
		   is transmitted unencrypted)."] \
	-group Login -type boolean

custom::defvar loginconf(allowgoogletoken) 1 \
    [::msgcat::mc "Allow X-GOOGLE-TOKEN authentication mechanisms. It requires\
		   connection to Google via HTTPS."] \
	-group Login -type boolean

if {$have_sasl} {
    custom::defvar loginconf(usesasl) 1 \
	[::msgcat::mc "Use SASL authentication."] \
	-group Login -type boolean
}

set values [list plaintext [::msgcat::mc "Plaintext"]]
if {$have_compress} {
    lappend values compressed [::msgcat::mc "Compression"]
}
if {$use_tls} {
    lappend values encrypted [::msgcat::mc "Encryption (STARTTLS)"] \
		   ssl       [::msgcat::mc "Encryption (legacy SSL)"]
}

if {$use_tls || $have_compress} {
    custom::defvar loginconf(stream_options) plaintext \
	[::msgcat::mc "XMPP stream options when connecting to server."] \
	-group Login -type options \
	-values $values
}

if {$use_tls} {
    custom::defvar loginconf(sslcertfile) "" \
	[::msgcat::mc "SSL certificate file (optional)."] \
	-group Login -type file
    custom::defvar loginconf(sslcacertstore) "" \
	[::msgcat::mc "SSL certification authority file or directory (optional)."] \
	-group Login -type file
    custom::defvar loginconf(sslkeyfile) "" \
	[::msgcat::mc "SSL private key file (optional)."] \
	-group Login -type file
}

custom::defvar loginconf(usealtserver) 0 \
    [::msgcat::mc "Use explicitly-specified server address and port."] \
    -group Login -type boolean
custom::defvar loginconf(altserver) "" \
    [::msgcat::mc "Server name or IP-address."] \
    -group Login -type string
custom::defvar loginconf(altport) "5222" \
    [::msgcat::mc "Server port."] \
    -group Login -type integer

custom::defvar loginconf(replace_opened) 1 \
    [::msgcat::mc "Replace opened connections."] \
    -group Login -type boolean

if {$have_http_poll} {
    custom::defvar loginconf(usehttppoll) 0 \
	[::msgcat::mc "Use HTTP poll connection method."] \
	-group Login -type boolean
    custom::defvar loginconf(pollurl) "" \
	[::msgcat::mc "URL to connect to."] \
	-group Login -type string
    custom::defvar loginconf(usepollkeys) 1 \
	[::msgcat::mc "Use HTTP poll client security keys (recommended)."] \
	-group Login -type boolean
    custom::defvar loginconf(numberofpollkeys) 100 \
	[::msgcat::mc "Number of HTTP poll client security keys to send\
		       before creating new key sequence."] \
	-group Login -type integer
    custom::defvar loginconf(polltimeout) 0 \
	[::msgcat::mc "Timeout for waiting for HTTP poll responses (if set\
		       to zero, Tkabber will wait forever)."] \
	-group Login -type integer
    custom::defvar loginconf(pollmin) 6000 \
	[::msgcat::mc "Minimum poll interval."] \
	-group Login -type integer
    custom::defvar loginconf(pollmax) 60000 \
	[::msgcat::mc "Maximum poll interval."] \
	-group Login -type integer
}

custom::defvar reasonlist {} [::msgcat::mc "List of logout reasons."] \
	-group Hidden

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

# connect errors mapping

array set connect_error [list \
	err_unknown 			[::msgcat::mc "Unknown error"] \
	timeout				[::msgcat::mc "Timeout"] \
	network-failure			[::msgcat::mc "Network failure"] \
	err_authorization_required	[::msgcat::mc "Proxy authentication required"] \
	err_version			[::msgcat::mc "Incorrect SOCKS version"] \
	err_unsupported_method		[::msgcat::mc "Unsupported SOCKS method"] \
	err_authentication_unsupported	[::msgcat::mc "Unsupported SOCKS authentication method"] \
	err_authorization		[::msgcat::mc "SOCKS authentication failed"] \
	rsp_failure			[::msgcat::mc "SOCKS request failed"] \
	rsp_errconnect			[::msgcat::mc "SOCKS server cannot identify username"] \
	rsp_erruserid			[::msgcat::mc "SOCKS server username identification failed"] \
	rsp_notallowed			[::msgcat::mc "SOCKS connection not allowed by ruleset"] \
	rsp_netunreachable		[::msgcat::mc "Network unreachable"] \
	rsp_hostunreachable		[::msgcat::mc "Host unreachable"] \
	rsp_refused			[::msgcat::mc "Connection refused by destination host"] \
	rsp_expired			[::msgcat::mc "TTL expired"] \
	rsp_cmdunsupported		[::msgcat::mc "SOCKS command not supported"] \
	rsp_addrunsupported		[::msgcat::mc "Address type not supported by SOCKS proxy"] \
	err_unknown_address_type	[::msgcat::mc "Unknown address type"]]

# TLS info
#
# [::msgcat::mc "Certificate has expired"]
# [::msgcat::mc "Self signed certificate"]

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

if {![info exists connections]} {
    set connections {}
}

proc connections {{all 0}} {
    global connections

    set res {}
    foreach c $connections {
	if {$all || [lindex $c 1]} {
	    lappend res [lindex $c 0]
	}
    }
    return $res
}

proc add_to_connection {active xlib} {
    global connections

    set idx [lsearch -exact $connections [list $xlib 0]]
    set connections [lreplace $connections $idx $idx]
    set idx [lsearch -exact $connections [list $xlib 1]]
    set connections [lreplace $connections $idx $idx]
    lappend connections [list $xlib $active]
}

hook::add connected_hook [list add_to_connection 1] 1

proc remove_from_connection {xlib} {
    global connections

    set idx [lsearch -exact $connections [list $xlib 0]]
    set connections [lreplace $connections $idx $idx]
    set idx [lsearch -exact $connections [list $xlib 1]]
    set connections [lreplace $connections $idx $idx]
}

hook::add disconnected_hook remove_from_connection 1

proc connection_jid {xlib} {
    global connjid
    return $connjid($xlib)
}

proc connection_bare_jid {xlib} {
    global connjid
    return [::xmpp::jid::stripResource $connjid($xlib)]
}

proc connection_user {xlib} {
    global connjid
    return [::xmpp::jid::node $connjid($xlib)]
}

proc connection_server {xlib} {
    global connjid
    return [::xmpp::jid::server $connjid($xlib)]
}

proc connection_resource {xlib} {
    global connjid
    return [::xmpp::jid::resource $connjid($xlib)]
}

proc connection_requested_jid {xlib} {
    global connrjid
    return $connrjid($xlib)
}

proc connection_requested_user {xlib} {
    global connrjid
    return [::xmpp::jid::node $connrjid($xlib)]
}

proc connection_requested_server {xlib} {
    global connrjid
    return [::xmpp::jid::server $connrjid($xlib)]
}

proc connection_requested_resource {xlib} {
    global connrjid
    return [::xmpp::jid::resource $connrjid($xlib)]
}

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

proc login {logindata} {
    global login_after_id

    array set lc $logindata

    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)]

    login_connect $logindata
}

proc login_connected {xlib logindata status msg} {
    global connect_error
    global login_after_time

    array set lc $logindata

    switch -- $status {
	ok {
	    # OK, connected.
	    add_to_connection 0 $xlib
	    debugmsg login "Connect successful $xlib"

	    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]
		    login_retry $logindata
		}
	    }
	}
    }
}

proc login_retry {logindata} {
    global login_after_time
    global login_after_id

    if {![info exists login_after_time]} {
	set login_after_time 7500
    }
    if {$login_after_time < 1800000} {
	# 1800000 == 30 * 60 * 1000 == 30min
	# the sequence goes: 15s, 30s, 1min, 2min, 4min, 8min, 16min, 32min, 32min...
	set login_after_time [expr {$login_after_time * 2}]
    }
    array set lc $logindata
    set jid $lc(jid)

    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)
	unset login_after_id($jid)
    }
    login_retry1 $login_after_time $jid $logindata
}

proc login_retry1 {interval jid logindata} {
    global login_after_id

    incr interval -1000

    if {$interval <= 0} {
	login $logindata
    } else {
	set login_after_id($jid) [after 1000 [list login_retry1 $interval $jid $logindata]]
	set_status [::msgcat::mc "Login retry for %s in %s" $jid \
				 [format_time [expr {$interval/1000}]]]
    }
}

proc client:tls_callback {xlib args} {
    global tls_result tls_warnings
    global ssl_certificate_fields
    global tls_warning_info

    switch -- [lindex $args 0] {
	info {
	    set_status [lindex $args 4]
	}

	verify {
	    if {[cequal [set reason [lindex $args 5]] ""]} {
		return 1
	    }
	    set info [::msgcat::mc [string totitle $reason 0 0]]
	    append tls_warning_info($xlib) "$info\n"
	    if {!$tls_warnings} {
		return 1
	    }
	    append info [::msgcat::mc ". Proceed?\n\n"]
	    foreach {k v} [lindex $args 3] {
		switch -- $k {
		    subject - issuer {
			set v [regsub -all {\s*[/,]\s*(\w+=)} $v \n\t\\1]
		    }
		}
		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]
		    }
		}
	    }

	    set blocking [fconfigure [set fd [lindex $args 1]] -blocking]
	    fconfigure $fd -blocking 1
	    set readable [fileevent $fd readable]
	    fileevent $fd readable {}

	    set res [MessageDlg .tls_callback -aspect 50000 -icon warning \
			        -type user -buttons {yes no} -default 1 \
			        -cancel 1 \
			        -message [string trim $info]]

	    fileevent $fd readable $readable
	    fconfigure $fd -blocking $blocking

	    if {$res} {
		set res 0
	    } else {
		set res 1
	    }
	    return $res
	}

	error {
	    set tls_result [join [lrange $args 2 end] " "]
	}

	default {
	}
    }
}

proc create_xlib {jid} {
    global connhist connrjid connjid

    set njid [::xmpp::jid::normalize $jid]
    if {[info exists connhist($njid)] && \
	    [lsearch -exact [connections] $connhist($njid)] < 0} {
	set xlib $connhist($njid)
    } else {
	set xlib [::xmpp::new -messagecommand    client:message    \
			      -presencecommand   client:presence   \
			      -iqcommand         client:iq         \
			      -disconnectcommand client:disconnect \
			      -statuscommand     client:status     \
			      -errorcommand      client:error      \
			      -logcommand        client:log]
    }

    if {![info exists connhist($njid)]} {
	set connhist($njid) $xlib
    }

    set connrjid($xlib) $jid
    set connjid($xlib) $jid

    disco::new $xlib

    return $xlib
}

proc login_connect {logindata} {
    global use_tls have_compress have_sasl have_http_poll
    global tls_warning_info
    global reconnect

    array set lc $logindata

    set jid [::xmpp::jid::jid $lc(user) \
			      $lc(server) \
			      $lc(resource)]

    set xlib [create_xlib $jid]

    set tls_warning_info($xlib) ""
    set reconnect($xlib) 1

    set ascii_server [idna::domain_toascii $lc(server)]

    set args {-proxyfilter ::proxy::proxyfilter}

    if {$have_http_poll && $lc(usehttppoll)} {
	if {$lc(pollurl) != ""} {
	    set url $lc(pollurl)
	} else {
	    # TODO: Asynchronous DNS resolution
	    if {[catch {::xmpp::dns::resolveHTTPPoll $ascii_server} urls]} {
		set urls {}
	    }
	    if {[llength $urls] == 0} {
		set url ""
	    } else {
		set url [lindex $urls 0]
	    }
	}

	lappend args -transport poll \
		     -timeout   $lc(polltimeout) \
		     -int       $lc(pollmin) \
		     -min       $lc(pollmin) \
		     -max       $lc(pollmax) \
		     -url       $url \
		     -usekeys   $lc(usepollkeys) \
		     -numkeys   $lc(numberofpollkeys) \

	eval [list ::xmpp::connect $xlib \
				   -command [list login_connect_result $xlib {} $logindata $args]] \
				   $args
    } else {
	if {$lc(usealtserver)} {
	    set hosts {}
	} else {
	    # TODO: Asynchronous DNS resolution
	    if {[catch {::xmpp::dns::resolveXMPPClient $ascii_server} hosts]} {
		set hosts {}
	    }
	    if {[llength $hosts] == 0} {
		set hosts [list [list $ascii_server 5222]]
	    }
	}
	set transport tcp
	if {$use_tls && $lc(stream_options) == "ssl"} {
	    set transport tls
	    # Do some heuristic.
	    # Traditionally legacy SSL port is 5223,
	    # so let's add 1 to all ports from SRV reply
	    set hosts1 {}
	    foreach hp $hosts {
		lassign $hp host port
		lappend hosts1 [list $host [incr port]]
	    }
	    set hosts $hosts1
	    lappend args -certfile      $lc(sslcertfile) \
			 -castore       $lc(sslcacertstore) \
			 -keyfile       $lc(sslkeyfile) \
			 -verifycommand [list client:tls_callback $xlib] \
			 -infocommand   [list update_tls_info $xlib]
	}

	lappend args -transport $transport

	if {$lc(usealtserver)} {
	    set hosts [list [list [idna::domain_toascii $lc(altserver)] \
			    $lc(altport)]]
	}

	set hosts [lassign $hosts hp]
	lassign $hp host port

	eval [list ::xmpp::connect $xlib $host $port \
				   -command [list login_connect_result $xlib $hosts $logindata $args]] \
				   $args
    }
}

proc login_connect_result {xlib hosts logindata args status msg} {
    if {$status == "ok" || $status == "abort" || [llength $hosts] == 0} {
	login_connected $xlib $logindata $status $msg
    } else {
	set hosts [lassign $hosts hp]
	lassign $hp host port

	eval [list ::xmpp::connect $xlib $host $port \
				   -command [list login_connect_result $xlib $hosts $logindata $args]] \
				   $args
    }
}

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

proc login_login {xlib logindata} {
    global use_tls have_compress have_sasl
    global loginconf_hist

    set loginconf_hist($xlib) $logindata

    array set lc $logindata

    if {($use_tls && $lc(stream_options) == "encrypted") || \
	    ($have_compress && $lc(stream_options) == "compressed") || \
	    ($have_sasl && $lc(usesasl))} {
	::xmpp::openStream $xlib $lc(server) \
			   -version 1.0 \
			   -command [list login_login1 $xlib $logindata]
    } else {
	::xmpp::openStream $xlib $lc(server) \
			   -command [list login_login1 $xlib $logindata]
    }
}

proc login_login1 {xlib logindata status sessionid} {
    global use_tls have_compress

    if {$status != "ok"} {
	recv_auth_result $xlib $logindata $status $sessionid
	return
    }

    array set lc $logindata

    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) \
			-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]
    } else {
	login_login2 $xlib $logindata $status $sessionid
    }
}

proc login_login2 {xlib logindata status sessionid} {
    global have_sasl

    if {$status != "ok"} {
	recv_auth_result $xlib $logindata $status $sessionid
	return
    }

    array set lc $logindata

    if {$lc(allowauthplain)} {
	set digest auto
    } else {
	set digest true
    }

    if {$lc(allowgoogletoken)} {
	set disable {}
    } else {
	set disable {X-GOOGLE-TOKEN}
    }

    if {$have_sasl && $lc(usesasl)} {
	# SASL authentication
        ::xmpp::sasl::auth $xlib -username $lc(user) \
                                 -password $lc(password) \
                                 -resource $lc(resource) \
				 -digest   $digest \
				 -disable  $disable \
				 -command  [list recv_auth_result $xlib \
								 $logindata]
    } else {
	# Non-SASL authentication
        ::xmpp::auth::auth $xlib -sessionid $sessionid \
                                 -username  $lc(user) \
                                 -password  $lc(password) \
                                 -resource  $lc(resource) \
				 -digest    $digest \
				 -command [list recv_auth_result $xlib \
								 $logindata]
    }
}

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

proc logout {{xlib {}}} {
    global login_after_id

    debugmsg login "LOGOUT $xlib"

    if {$xlib == {}} {
	foreach jid [array names login_after_id] {
	    after cancel $login_after_id($jid)
	    unset login_after_id($jid)
	}

	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
    }
}

proc client:disconnect {xlib} {
    global reconnect
    global loginconf_hist

    login_log [connection_jid $xlib] error [::msgcat::mc "Forced logout"]

    if {$reconnect($xlib)} {
	debugmsg login "RECONNECT $xlib"
    } else {
	debugmsg login "DISCONNECT $xlib"
    }

    disconnected $xlib

    if {$reconnect($xlib)} {
	after 1000 [list login $loginconf_hist($xlib)]
    }
}

proc connected {xlib logindata} {
    hook::run connected_hook $xlib
}

# TODO
proc disconnected {xlib} {
    remove_from_login_after_id $xlib

    if {[lsearch -exact [connections] $xlib] < 0} {
	::xmpp::disconnect $xlib
	return
    }

    hook::run disconnected_hook $xlib
}

hook::add disconnected_hook ::xmpp::disconnect 10

proc client:log {xlib dir type msg} {
    hook::run log_hook $xlib $dir $type $msg
}

proc remove_from_login_after_id {xlib} {
    global login_after_id

    set jid [::xmpp::jid::normalize [connection_requested_jid $xlib]]
    if {[info exists login_after_id($jid)]} {
	after cancel $login_after_id($jid)
	unset login_after_id($jid)
    }
}

proc recv_auth_result {xlib logindata status xml} {
    global connjid

    array set lc $logindata

    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} {
		    ::register::open $xlib $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
	    }

	    logout $xlib
	}
    }
}

proc recv_register_result {xlib logindata status xml} {
    logout $xlib

    switch -- $status {
	ok {
	    login $logindata
	}
    }
}

proc client:error {xlib condition message} {
    global reconnect

    login_log [connection_jid $xlib] error $message

    if {[winfo exists .client_error]} {
	destroy .client_error
    }

    switch -- $condition {
	bad-format -
	connection-timeout -
	invalid-from -
	invalid-id -
	invalid-namespace -
	invalid-xml -
	remote-connection-failed -
	restricted-xml -
	unsupported-encoding -
	unsupported-stanza-type -
	xml-not-well-formed {
	    set reconnect($xlib) 1
	}
	default {
	    set reconnect($xlib) 0
	}
    }

    NonmodalMessageDlg .client_error -aspect 50000 -icon error \
				     -message $message
}

# TODO
proc show_logout_dialog {} {
    global reason reasonlist

    set lw .logout

    if {[winfo exists $lw]} {
	destroy $lw
    }

    Dialog $lw -title [::msgcat::mc "Logout with reason"] \
	    -separator 1 -anchor e -default 0 -cancel 1

    set lf [$lw getframe]
    grid columnconfigure $lf 1 -weight 1

    if {[llength $reasonlist]} {set reason [lindex $reasonlist 0]}

    label $lf.lreason   -text    [::msgcat::mc "Reason:"]
    ecursor_entry [ComboBox $lf.reason -textvariable reason \
	    -values $reasonlist -width 35].e
    label $lf.lpriority -text    [::msgcat::mc "Priority:"]
    ecursor_entry [entry $lf.priority -textvariable loginconf(priority)]

    grid $lf.lreason   -row 0 -column 0 -sticky e
    grid $lf.reason    -row 0 -column 1 -sticky ew
    grid $lf.lpriority -row 1 -column 0 -sticky e
    grid $lf.priority  -row 1 -column 1 -sticky ew

    $lw add -text [::msgcat::mc "Log out"] -command logout_reason
    $lw add -text [::msgcat::mc "Cancel"] -command "$lw withdraw"

    $lw draw $lf.reason
}

proc logout_reason {} {
    global logoutuserstatus logouttextstatus logoutpriority reason reasonlist

    set reasonlist [update_combo_list $reasonlist $reason 10]

    set lw .logout
    if {[winfo exists $lw]} {
	destroy $lw
    }

    # TODO
    set logoutpriority $::loginconf(priority)
    set logouttextstatus $reason
    set logoutuserstatus unavailable

    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