Posted to tcl by kostix at Sun Nov 18 22:41:26 GMT 2007view raw
- #!/usr/bin/env tclsh
- set use_external_tclxml on
- package require -exact jabberlib 0.10.1
- array set opts {
- -from kostix@007spb.ru/Autobot
- -password жопасручкой
- -to {kostix@007spb.ru/Home brennon1303@jabber.ru}
- -type chat
- -subject Test
- -body Yo!
- -host jabber.007spb.ru
- -tls true
- -verbose true
- -debug true
- }
- if {![info exists opts(-debug)] || !$opts(-debug)} {
- proc ::LOG args {}
- }
- proc client:errmsg err {
- return -code error $err
- }
- proc client:status status {
- upvar #0 opts(-verbose) vb
- if {[info exists vb] && $vb} {
- puts $status
- }
- }
- proc on_login {result args} { set ::logged_in [list $result $args] }
- regexp {^(?:([^@]*)@)?([^/]*)(?:/(.*))?$} $opts(-from) -> user server resource
- set cmd [list jlib::new]
- foreach var {user server resource} {
- if {[info exists $var]} {
- lappend cmd -$var [set $var]
- }
- }
- set connid [eval $cmd]
- if {[info exists opts(-tls)] && $opts(-tls)} {
- package require tls
- set transport tls
- if {![info exists opts(-port)]} {
- set opts(-port) 5223
- }
- } else {
- set transport tcp
- if {![info exists opts(-port)]} {
- set opts(-port) 5222
- }
- }
- jlib::connect $connid \
- -transport $transport \
- -host [idna::domain_toascii $opts(-host)] \
- -port $opts(-port) \
- -password $opts(-password)
- client:status Connected
- jlib::login $connid ::on_login
- client:status "Logging in..."
- vwait ::logged_in
- client:status "Logged in"
- if {![string eq [lindex $::logged_in 0] OK]} {
- puts stderr [lindex $::logged_in 1]
- exit 1
- }
- foreach jid [split [regsub -all {\s+} $opts(-to) " "]] {
- if {$jid == ""} {
- puts stderr "No jids to send message to"
- exit 2
- }
- client:status "Sending msg to $jid..."
- set cmd [list jlib::send_msg $jid -connection $connid]
- foreach var {type subject body} {
- if {[info exists opts(-$var)]} {
- lappend cmd -$var [set opts(-$var)]
- }
- }
- set res [eval $cmd]
- if {$res == -1} {
- puts stderr "Failed sending message to $jid, bailing out..."
- exit 3
- }
- }
- jlib::disconnect $connid
- client:status Disconnected