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

  1. #!/usr/bin/env tclsh
  2.  
  3. set use_external_tclxml on
  4. package require -exact jabberlib 0.10.1
  5.  
  6. # Possible options:
  7. if 0 {
  8. -from SENDER_JID
  9. -password secret!
  10. -to {JID1 JID2 ...}
  11. -type chat
  12. -subject Test
  13. -body Yo!
  14. -host SENDER_SERVER
  15. -tls true
  16. -verbose true
  17. -debug true
  18. }
  19. array set opts {
  20. -type normal
  21. -tls true
  22. -verbose false
  23. -debug false
  24. }
  25.  
  26. proc usage {{out stdout}} {
  27. puts $out "Usage: [file tail $::argv0] OPTIONS
  28.  
  29. Required OPTIONS are:
  30.  
  31. -from JID -- Message sender.
  32. -password STRING -- Password to authenticate JID given by \"-from\".
  33. -to \"JID \[JID ...\]\" -- List of JIDs to send message to, separated by whitespace.\
  34. Note that this must be a single argument, so quote it if needed.
  35. -body STRING -- Body of the message.
  36.  
  37. Miscellaneous OPTIONS are:
  38.  
  39. -type TYPE -- Message type, one of \"normal\" or \"chat\".
  40. -subject STRING -- Message subject. Usually only relevant for normal messages.
  41. -tls BOOLEAN -- Use TLS for stream protection (default: yes).
  42. -host HOSTNAME -- Hostname of the server listed in the \"-from\" JID.
  43. -port PORT -- Override default post (5222 is selectded if TLS is not used,\
  44. 5333 -- when it's used).
  45. -verbose BOOLEAN -- Explain what's happening (default: off).
  46. -debug BOOLEAN -- Output debug info on the XMPP session (default: off).
  47. "
  48. }
  49.  
  50. if {$argc == 1 && [string eq [lindex $argv 0] -help]} {
  51. usage
  52. exit 0
  53. }
  54.  
  55. if {[file readable .jmsgrc]} {
  56. set fd [open .jmsgrc]
  57. set lineno 1
  58. foreach line [split [read $fd] \n] {
  59. if {$line == "" || [regexp {^\s*#.*$} $line]} continue
  60. if {[catch {llength $line} len] || $len < 2} {
  61. puts stderr "Invalid format at line: $lineno"
  62. exit 1
  63. }
  64. set ::opts(-[lindex $line 0]) [lrange $line 1 end]
  65. incr lineno
  66. }
  67. close $fd
  68. }
  69.  
  70. array set opts $argv
  71.  
  72. foreach opt {from to password body} {
  73. if {![info exists opts(-$opt)]} {
  74. puts stderr "Required option not specified: -$opt"
  75. usage stderr
  76. exit 2
  77. }
  78. }
  79.  
  80. if {![info exists opts(-debug)] || !$opts(-debug)} {
  81. proc ::LOG args {}
  82. }
  83.  
  84. proc client:errmsg err {
  85. return -code error $err
  86. }
  87.  
  88. proc client:status status {
  89. upvar #0 opts(-verbose) vb
  90. if {[info exists vb] && $vb} {
  91. puts $status
  92. }
  93. }
  94.  
  95. proc on_login {result args} { set ::logged_in [list $result $args] }
  96.  
  97. if {![regexp {^(?:([^@]*)@)?([^/]+)(?:/(.*))?$} \
  98. $opts(-from) -> user server resource]} {
  99. puts stderr "Sender's JID appears incorrect: $opts(-from)"
  100. exit 3
  101. }
  102.  
  103. set cmd [list jlib::new]
  104. foreach var {user server resource} {
  105. if {[info exists $var]} {
  106. lappend cmd -$var [set $var]
  107. }
  108. }
  109. set connid [eval $cmd]
  110.  
  111. if {![info exists opts(-host)]} {
  112. set opts(-host) $server
  113. }
  114.  
  115. if {[info exists opts(-tls)] && $opts(-tls)} {
  116. package require tls
  117. set transport tls
  118. if {![info exists opts(-port)]} {
  119. set opts(-port) 5223
  120. }
  121. } else {
  122. set transport tcp
  123. if {![info exists opts(-port)]} {
  124. set opts(-port) 5222
  125. }
  126. }
  127.  
  128. jlib::connect $connid \
  129. -transport $transport \
  130. -host [idna::domain_toascii $opts(-host)] \
  131. -port $opts(-port) \
  132. -password $opts(-password)
  133.  
  134. client:status Connected
  135.  
  136. jlib::login $connid ::on_login
  137.  
  138. client:status "Logging in..."
  139.  
  140. vwait ::logged_in
  141.  
  142. client:status "Logged in"
  143.  
  144. if {![string eq [lindex $::logged_in 0] OK]} {
  145. puts stderr [lindex $::logged_in 1]
  146. exit 4
  147. }
  148.  
  149. foreach jid [split [regsub -all {\s+} $opts(-to) " "]] {
  150. if {$jid == ""} {
  151. puts stderr "No jids to send message to"
  152. exit 5
  153. }
  154. client:status "Sending msg to $jid..."
  155. set cmd [list jlib::send_msg $jid -connection $connid]
  156. foreach var {type subject body} {
  157. if {[info exists opts(-$var)]} {
  158. lappend cmd -$var [set opts(-$var)]
  159. }
  160. }
  161. set res [eval $cmd]
  162. if {$res == -1} {
  163. puts stderr "Failed sending message to $jid, bailing out..."
  164. exit 6
  165. }
  166. }
  167.  
  168. jlib::disconnect $connid
  169. client:status Disconnected