# $Id$
set loginconf(use_tls) 1
if {[catch {package require tls 1.4}]} {
puts "
################################### WARNING ###################################
Sorry, can't load tls package. SSL support is disabled.
If you need SSL, install tls (http://tls.sf.net).
###############################################################################
"
set loginconf(use_tls) 0
set loginconf(usessl) 0
}
proc login {} {
global loginconf
global gr_nick gr_server gra_server
global auth_result
set gr_nick $loginconf(user)
set gr_server conference.$loginconf(server)
set gra_server conference.$loginconf(server)
if {!$loginconf(useproxy)} {
if {$loginconf(usessl)} {
set sock [tls::socket $loginconf(server) $loginconf(sslport)]
} else {
set sock [socket $loginconf(server) $loginconf(port)]
}
} else {
set sock [connect_httpproxy]
}
jlib::connect $sock $loginconf(server)
#puts [jlib::wrapper:createtag query -empty 0 \
# -vars {xmlns jabber:iq:auth} \
# -subtags {{username {} 0 {alexey}}} \
# ]
jlib::send_auth $loginconf(user) $loginconf(password) $loginconf(resource) \
recv_auth_result
vwait auth_result
if {$auth_result == "OK"} {
jlib::send_presence -stat Online -pri 8
jlib::roster_get -command client:roster_cmd
}
}
proc logout {} {
jlib::disconnect
roster::clear .roster
}
proc client:disconnect {} {
roster::clear .roster
set_status "Disconnected"
}
proc show_login_dialog {} {
global loginconf
global ltmp
#global tmpusername tmppassword tmpresource tmpserver tmpport tmppriority
#global tmpusessl tmpsslport tmpuseproxy tmphttpproxy tmphttpproxyport
if {[winfo exists .login]} {
focus -force .login
return
}
array set ltmp [array get loginconf]
Dialog .login -title Login -separator 1 -anchor e
set l [.login getframe]
label $l.lusername -text Username:
entry $l.username -textvariable ltmp(user)
label $l.lserver -text Server:
entry $l.server -textvariable ltmp(server)
label $l.lpassword -text Password:
entry $l.password -show * -textvariable ltmp(password)
label $l.lresource -text Resource:
entry $l.resource -textvariable ltmp(resource)
label $l.lport -text Port:
entry $l.port -textvariable ltmp(port)
label $l.lpriority -text Priority:
entry $l.priority -textvariable ltmp(priority)
grid $l.lusername -row 0 -column 0 -sticky e
grid $l.username -row 0 -column 1 -sticky ew
grid $l.lserver -row 1 -column 0 -sticky e
grid $l.server -row 1 -column 1 -sticky ew
grid $l.lpassword -row 2 -column 0 -sticky e
grid $l.password -row 2 -column 1 -sticky ew
grid $l.lresource -row 3 -column 0 -sticky e
grid $l.resource -row 3 -column 1 -sticky ew
grid $l.lport -row 1 -column 2 -sticky e
grid $l.port -row 1 -column 3 -sticky ew
grid $l.lpriority -row 3 -column 2 -sticky e
grid $l.priority -row 3 -column 3 -sticky ew
if {$loginconf(use_tls)} {
checkbutton $l.usessl -text "Use SSL" -variable ltmp(usessl)
label $l.lsslport -text "SSL Port:"
entry $l.sslport -textvariable ltmp(sslport)
grid $l.usessl -row 4 -column 1 -sticky w
grid $l.lsslport -row 4 -column 2 -sticky e
grid $l.sslport -row 4 -column 3 -sticky ew
}
checkbutton $l.useproxy -text "Use Proxy" -variable ltmp(useproxy)
grid $l.useproxy -row 5 -column 1 -sticky w
label $l.lhttpproxy -text "Proxy Server:"
entry $l.httpproxy -textvariable ltmp(httpproxy)
label $l.lhttpproxyport -text "Proxy Port:"
entry $l.httpproxyport -textvariable ltmp(httpproxyport)
grid $l.lhttpproxy -row 6 -column 0 -sticky e
grid $l.httpproxy -row 6 -column 1 -sticky ew
grid $l.lhttpproxyport -row 6 -column 2 -sticky e
grid $l.httpproxyport -row 6 -column 3 -sticky ew
grid columnconfigure $l 1 -weight 1
grid columnconfigure $l 3 -weight 1
set n 1
while {[info exists ::loginconf$n]} {incr n}
incr n -1
if {$n} {
menubutton $l.profiles -text Profiles -relief raised \
-menu $l.profiles.menu
set m [menu $l.profiles.menu -tearoff 0]
for {set i 1} {$i <= $n} {incr i} {
if {[info exists ::loginconf${i}(profile)]} {
set lab [set ::loginconf${i}(profile)]
} else {
set lab "Profile $i"
}
if {$i < 10} {
$m add command -label $lab -accelerator "C-$i" \
-command [list eval array set ltmp \
\[array get loginconf$i\]]
bind .login <Control-Key-$i> [list eval array set ltmp \
\[array get loginconf$i\]]
} else {
$m add command -label $lab \
-command [list eval array set ltmp \
\[array get loginconf$i\]]
}
}
grid $l.profiles -row 0 -column 3 -sticky e
}
.login add -text "Log in" -command {
array set loginconf [array get ltmp]
destroy .login
logout
update
login
}
.login add -text Close -command {destroy .login}
.login setfocus 0
#focus -force .login
.login draw
}
proc connect_httpproxy {} {
global loginconf
set sock [socket $loginconf(httpproxy) $loginconf(httpproxyport)]
fconfigure $sock -buffering line
if {$loginconf(usessl)} {
puts $sock \
"CONNECT ${loginconf(server)}:${loginconf(sslport)} HTTP/1.0\n"
} else {
puts $sock "CONNECT ${loginconf(server)}:${loginconf(port)} HTTP/1.0\n"
}
fileevent $sock readable {set proxy_readable ""}
global proxy_readable
vwait proxy_readable
fileevent $sock readable {}
set result [gets $sock]
set code [lindex [split $result { }] 1]
#puts $code
if {$code >= 200 && $code < 300} {
gets $sock
if {$loginconf(usessl)} {
tls::import $sock
}
return $sock
} else {
error "proxy return: $result"
}
}
proc recv_auth_result {res args} {
global auth_result
global loginconf
if {$res == "OK"} {
set auth_result OK
} else {
set auth_result ERR
set res [MessageDlg .auth_err -icon error \
-message "Authentification failed: $args
Create new account?" -type yesno]
if {!$res} {
jlib::send_iq set \
[jlib::wrapper:createtag query \
-vars {xmlns jabber:iq:register} \
-subtags [list [jlib::wrapper:createtag username \
-chdata $loginconf(user)] \
[jlib::wrapper:createtag password \
-chdata $loginconf(password)]]] \
-command recv_register_result
}
}
}
proc recv_register_result {res args} {
if {$res == "OK"} {
login
} else {
MessageDlg .auth_err -icon error \
-message "Registration failed: $args" -type ok
}
}