Posted to tcl by kostix at Sun Nov 18 22:41:26 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. array set opts {
  7. -from kostix@007spb.ru/Autobot
  8. -password жопасручкой
  9. -to {kostix@007spb.ru/Home brennon1303@jabber.ru}
  10. -type chat
  11. -subject Test
  12. -body Yo!
  13. -host jabber.007spb.ru
  14. -tls true
  15. -verbose true
  16. -debug true
  17. }
  18.  
  19. if {![info exists opts(-debug)] || !$opts(-debug)} {
  20. proc ::LOG args {}
  21. }
  22.  
  23. proc client:errmsg err {
  24. return -code error $err
  25. }
  26.  
  27. proc client:status status {
  28. upvar #0 opts(-verbose) vb
  29. if {[info exists vb] && $vb} {
  30. puts $status
  31. }
  32. }
  33.  
  34. proc on_login {result args} { set ::logged_in [list $result $args] }
  35.  
  36. regexp {^(?:([^@]*)@)?([^/]*)(?:/(.*))?$} $opts(-from) -> user server resource
  37.  
  38. set cmd [list jlib::new]
  39. foreach var {user server resource} {
  40. if {[info exists $var]} {
  41. lappend cmd -$var [set $var]
  42. }
  43. }
  44. set connid [eval $cmd]
  45.  
  46. if {[info exists opts(-tls)] && $opts(-tls)} {
  47. package require tls
  48. set transport tls
  49. if {![info exists opts(-port)]} {
  50. set opts(-port) 5223
  51. }
  52. } else {
  53. set transport tcp
  54. if {![info exists opts(-port)]} {
  55. set opts(-port) 5222
  56. }
  57. }
  58.  
  59. jlib::connect $connid \
  60. -transport $transport \
  61. -host [idna::domain_toascii $opts(-host)] \
  62. -port $opts(-port) \
  63. -password $opts(-password)
  64.  
  65. client:status Connected
  66.  
  67. jlib::login $connid ::on_login
  68.  
  69. client:status "Logging in..."
  70.  
  71. vwait ::logged_in
  72.  
  73. client:status "Logged in"
  74.  
  75. if {![string eq [lindex $::logged_in 0] OK]} {
  76. puts stderr [lindex $::logged_in 1]
  77. exit 1
  78. }
  79.  
  80. foreach jid [split [regsub -all {\s+} $opts(-to) " "]] {
  81. if {$jid == ""} {
  82. puts stderr "No jids to send message to"
  83. exit 2
  84. }
  85. client:status "Sending msg to $jid..."
  86. set cmd [list jlib::send_msg $jid -connection $connid]
  87. foreach var {type subject body} {
  88. if {[info exists opts(-$var)]} {
  89. lappend cmd -$var [set opts(-$var)]
  90. }
  91. }
  92. set res [eval $cmd]
  93. if {$res == -1} {
  94. puts stderr "Failed sending message to $jid, bailing out..."
  95. exit 3
  96. }
  97. }
  98.  
  99. jlib::disconnect $connid
  100. client:status Disconnected
  101.