Posted to tcl by kostix at Sun Nov 18 23:45:32 GMT 2007view pretty

#!/usr/bin/env tclsh

set use_external_tclxml on
package require -exact jabberlib 0.10.1

# Possible options:
if 0 {
	-from     SENDER_JID
	-password secret!
	-to       {JID1 JID2 ...}
	-type     chat
	-subject  Test
	-body     Yo!
	-host     SENDER_SERVER
	-tls      true
	-verbose  true
	-debug    true
}
array set opts {
	-type     normal
	-tls      true
	-verbose  false
	-debug    false
}

proc usage {{out stdout}} {
	puts $out "Usage: [file tail $::argv0] OPTIONS

Required OPTIONS are:

-from JID         -- Message sender.
-password STRING  -- Password to authenticate JID given by \"-from\".
-to \"JID \[JID ...\]\" -- List of JIDs to send message to, separated by whitespace.\
Note that this must be a single argument, so quote it if needed.
-body STRING      -- Body of the message.

Miscellaneous OPTIONS are:

-type TYPE        -- Message type, one of \"normal\" or \"chat\".
-subject STRING   -- Message subject. Usually only relevant for normal messages.
-tls BOOLEAN      -- Use TLS for stream protection (default: yes).
-host HOSTNAME    -- Hostname of the server listed in the \"-from\" JID.
-port PORT        -- Override default post (5222 is selectded if TLS is not used,\
5333 -- when it's used).
-verbose BOOLEAN  -- Explain what's happening (default: off).
-debug BOOLEAN    -- Output debug info on the XMPP session (default: off).
"
}

if {$argc == 1 && [string eq [lindex $argv 0] -help]} {
	usage
	exit 0
}

if {[file readable .jmsgrc]} {
	set fd [open .jmsgrc]
	set lineno 1
	foreach line [split [read $fd] \n] {
		if {$line == "" || [regexp {^\s*#.*$} $line]} continue
		if {[catch {llength $line} len] || $len < 2} {
			puts stderr "Invalid format at line: $lineno"
			exit 1
		}
		set ::opts(-[lindex $line 0]) [lrange $line 1 end]
		incr lineno
	}
	close $fd
}

array set opts $argv

foreach opt {from to password body} {
	if {![info exists opts(-$opt)]} {
		puts stderr "Required option not specified: -$opt"
		usage stderr
		exit 2
	}
}

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

if {![regexp {^(?:([^@]*)@)?([^/]+)(?:/(.*))?$} \
		$opts(-from) -> user server resource]} {
	puts stderr "Sender's JID appears incorrect: $opts(-from)"
	exit 3
}

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(-host)]} {
	set opts(-host) $server
}

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

foreach jid [split [regsub -all {\s+} $opts(-to) " "]] {
	if {$jid == ""} {
		puts stderr "No jids to send message to"
		exit 5
	}
	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 6
	}
}

jlib::disconnect $connid
client:status Disconnected