[Tkabber-dev] [tclxmpp] r120 committed - * examples/jsend.tcl: Restored historical name and added -date option...

codesite-noreply at google.com codesite-noreply at google.com
Sun Oct 4 15:32:30 MSD 2009


Revision: 120
Author: sgolovan
Date: Sun Oct  4 04:31:25 2009
Log: 	* examples/jsend.tcl: Restored historical name and added -date option
	  to include delay subelement with a given date.

	* examples/rssbot.tcl: Adapted RSS bot from tkabber examples/tools to
	  TclXMPP. Also, added thorough dates parsers taken from Tclers' wiki
	  (http://wiki.tcl.tk/13094 and http://wiki.tcl.tk/24074).

http://code.google.com/p/tclxmpp/source/detail?r=120

Added:
  /trunk/examples/jsend.tcl
  /trunk/examples/rssbot.tcl
Deleted:
  /trunk/examples/xsend.tcl
Modified:
  /trunk/ChangeLog

=======================================
--- /dev/null
+++ /trunk/examples/jsend.tcl	Sun Oct  4 04:31:25 2009
@@ -0,0 +1,577 @@
+#!/usr/bin/env tclsh
+
+# jsend.tcl --
+#
+#       This file is an example provided with the XMPP library. It allows  
to
+#       send messages via XMPP non-interactively. It was initially  
developed
+#       by Marshall T. Rose and adapted to the XMPP library by Sergei  
Golovan.
+#
+# Copyright (c) 2008-2009 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package require mime
+package require sha1
+package require tls
+
+package require xmpp
+package require xmpp::auth
+package require xmpp::sasl
+package require xmpp::starttls
+package require xmpp::roster
+package require xmpp::delay
+
+# Register IQ XMLNS
+::xmpp::iq::register get * http://jabber.org/protocol/disco#info \
+                           jsend::iqDiscoInfo
+::xmpp::iq::register get * http://jabber.org/protocol/disco#items \
+                           jsend::iqDiscoItems
+::xmpp::iq::register get * jabber:iq:last    jsend::iqLast
+::xmpp::iq::register get * jabber:iq:time    jsend::iqTime
+::xmpp::iq::register get * jabber:iq:version jsend::iqVersion
+
+namespace eval jsend {}
+
+proc jsend::sendit {stayP to args} {
+    global xlib
+    global env
+
+    variable lib
+    variable sendit_result
+
+    array set options [list -to          $to   \
+                            -from        ""    \
+                            -password    ""    \
+                            -host        ""    \
+                            -port        ""    \
+                            -activity    ""    \
+                            -type        chat  \
+                            -subject     ""    \
+                            -body        ""    \
+                            -xhtml       ""    \
+                            -date        ""    \
+                            -description ""    \
+                            -url         ""    \
+                            -tls         false \
+                            -starttls    true  \
+                            -sasl        true]
+    array set options $args
+
+    if {[string equal $options(-host) ""]} {
+        set options(-host) [info hostname]
+    }
+
+    set params [list from]
+    if {![string equal $options(-to) "-"]} {
+        lappend params to
+    }
+    foreach k $params {
+        if {[string first @ $options(-$k)] < 0} {
+            if {[set x [string first / $options(-$k)]] >= 0} {
+                set options(-$k) [string replace $options(-$k) $x $x \
+                                         @$options(-host)/]
+            } else {
+                append options(-$k) @$options(-host)
+            }
+        }
+        if {([string first @ $options(-$k)] == 0) \
+                && ([info exists env(USER)])} {
+            set options(-$k) $env(USER)$options(-$k)
+        }
+    }
+    if {![string equal $options(-to) "-"]} {
+        set options(-to) [list $options(-to)]
+    }
+
+    foreach k [list tls starttls] {
+        switch -- [string tolower $options(-$k)] {
+            1 - 0               {}
+            false - no  - off   { set options(-$k) 0 }
+            true  - yes - on    { set options(-$k) 1 }
+            default {
+                error "invalid value for -$k: $options(-$k)"
+            }
+        }
+    }
+
+    array set aprops [lindex [mime::parseaddress $options(-from)] 0]
+    if {[set x [string first / $aprops(domain)]] >= 0} {
+        set aprops(resource) [string range $aprops(domain) [expr {$x + 1}]  
end]
+        set aprops(domain) [string range $aprops(domain) 0 [expr {$x - 1}]]
+    } else {
+        set aprops(resource) "jsend"
+    }
+
+    if {[string equal $options(-body) ""] && $stayP < 2} {
+        set options(-body) [read -nonewline stdin]
+    }
+
+    set options(-xlist) {}
+    if {![string equal $options(-url)$options(-description) ""]} {
+        lappend options(-xlist) \
+                [::xmpp::xml::create x \
+                       -xmlns jabber:x:oob \
+                       -subelement [::xmpp::xml::create url \
+                                        -cdata $options(-url)] \
+                       -subelement [::xmpp::xml::create desc \
+                                        -cdata $options(-description)]]
+    }
+    if {[string compare $options(-date) ""]} {
+        lappend options(-xlist) \
+                [::xmpp::delay::create $options(-date)]
+    }
+    if {![string equal $options(-xhtml) ""] \
+            && ![string equal $options(-body) ""] \
+            && $stayP < 1} {
+        lappend options(-xlist) \
+                [::xmpp::xml::create html \
+                       -xmlns http://jabber.org/protocol/xhtml-im \
+                       -subelement [::xmpp::xml::create body \
+                                        -xmlns  
http://www.w3.org/1999/xhtml \
+                                        -subelements [jsend::parse_xhtml \
+                                                             
$options(-xhtml)]]]
+    }
+    if {[string equal $options(-type) announce]} {
+        set options(-type) normal
+        set announce [sha1::sha1 \
+                          [clock seconds]$options(-subject)$options(-body)]
+        lappend options(-xlist) \
+                [::xmpp::xml::create x \
+                     -xmlns http://2entwine.com/protocol/gush-announce-1_0  
\
+                     -subelement [::xmpp::xml::create id -cdata $announce]]
+    }
+
+    set lib(lastwhat) $options(-activity)
+    if {[catch { clock scan $options(-time) } lib(lastwhen)]} {
+        set lib(lastwhen) [clock seconds]
+    }
+
+    set params {}
+    foreach k [list body subject type xlist] {
+        if {![string equal $options(-$k) ""]} {
+            lappend params -$k $options(-$k)
+        }
+    }
+
+    if {![info exists xlib]} {
+        # Create an XMPP library instance
+        set xlib [::xmpp::new]
+
+        if {$options(-tls)} {
+            set transport tls
+            if {![string equal $options(-port) ""]} {
+                set port $options(-port)
+            } else {
+                set port 5223
+            }
+        } else {
+            set transport tcp
+            if {![string equal $options(-port) ""]} {
+                set port $options(-port)
+            } else {
+                set port 5222
+            }
+        }
+
+        # Connect to a server
+        ::xmpp::connect $xlib $aprops(domain) $port -transport $transport
+
+        if {!$options(-tls) && $options(-starttls)} {
+            # Open XMPP stream
+            set sessionID [::xmpp::openStream $xlib $aprops(domain) \
+                                                    -version 1.0]
+
+            ::xmpp::starttls::starttls $xlib
+
+            ::xmpp::sasl::auth $xlib -username  $aprops(local) \
+                                     -password  $options(-password) \
+                                     -resource  $aprops(resource)
+        } elseif {$options(-sasl)} {
+            # Open XMPP stream
+            set sessionID [::xmpp::openStream $xlib $aprops(domain) \
+                                                    -version 1.0]
+
+            ::xmpp::sasl::auth $xlib -username  $aprops(local) \
+                                     -password  $options(-password) \
+                                     -resource  $aprops(resource)
+        } else {
+            # Open XMPP stream
+            set sessionID [::xmpp::openStream $xlib $aprops(domain)]
+
+            # Authenticate
+            ::xmpp::auth::auth $xlib -sessionid $sessionID \
+                                     -username  $aprops(local) \
+                                     -password  $options(-password) \
+                                     -resource  $aprops(resource)
+        }
+
+        set roster [::xmpp::roster::new $xlib]
+        ::xmpp::roster::get $roster
+    }
+
+    if {[string equal $options(-to) "-"]} {
+        set options(-to) [::xmpp::roster::items $roster]
+    }
+
+    if {$stayP > 1} {
+        ::xmpp::sendPresence $xlib -status Online
+
+        if {[string equal $options(-type) groupchat]} {
+            set nick $aprops(local)@$aprops(domain)/$aprops(resource)
+            set nick [string range [sha1::sha1 $nick+[clock seconds]] 0 7]
+            foreach to $options(-to) {
+                ::xmpp::sendPresence $xlib -to $to/$nick
+            }
+        }
+        return 1
+    }
+
+    foreach to $options(-to) {
+        switch -- [eval [list ::xmpp::sendMessage $xlib $to] $params] {
+            -1 -
+            -2 {
+                if {$stayP} {
+                    set cmd [list ::LOG]
+                } else {
+                    set cmd [list error]
+                }
+                eval $cmd [list "error writing to socket, continuing..."]
+                return 0
+            }
+
+            default {}
+        }
+    }
+    if {!$stayP} {
+        set jsend::stayP 0
+        ::xmpp::disconnect $xlib
+    }
+
+    return 1
+}
+
+proc jsend::iqDiscoInfo {xlib from xmlElement args} {
+    ::LOG "jsend::iqDiscoInfo $from"
+
+    ::xmpp::xml::split $xmlElement tag xmlns attrs cdata subels
+
+    if {[::xmpp::xml::isAttr $attrs node]} {
+        return [list error cancel service-unavailable]
+    }
+
+    set identity [::xmpp::xml::create identity \
+                                      -attrs [list name     jsend \
+                                                   category client \
+                                                   type     bot]]
+
+    set subelements {}
+    foreach var [list http://jabber.org/protocol/disco#info \
+                      http://jabber.org/protocol/disco#items \
+                      jabber:iq:last \
+                      jabber:iq:time \
+                      jabber:iq:version] {
+        lappend subelements [::xmpp::xml::create feature \
+                                    -attrs [list var $var]]
+    }
+    set xmldata \
+        [::xmpp::xml::create query -xmlns       $xmlns \
+                                   -attrs       [list type client] \
+                                   -subelement  $identity \
+                                   -subelements $subelements]
+    return [list result $xmldata]
+}
+
+proc jsend::iqDiscoItems {xlib from xmlElement args} {
+    ::LOG "jsend::iqDiscoItems $from"
+
+    ::xmpp::xml::split $xmlElement tag xmlns attrs cdata subels
+
+    if {[::xmpp::xml::isAttr $attrs node]} {
+        return [list error cancel service-unavailable]
+    }
+
+    return [list result [::xmpp::xml::create query -xmlns $xmlns]]
+}
+
+proc jsend::iqLast {xlib from xmlElement args} {
+    variable lib
+
+    ::LOG "jsend::iqLast $from"
+
+    set now [clock seconds]
+    set xmldata \
+        [::xmpp::xml::create query -xmlns jabber:iq:last \
+                                   -attrs [list seconds \
+                                                [expr {$now -  
$lib(lastwhen)}]] \
+                                   -cdata $lib(lastwhat)]
+    return [list result $xmldata]
+}
+
+proc jsend::iqTime {xlib from xmlElement args} {
+    ::LOG "jsend::iqTime $from"
+
+    set now [clock seconds]
+    set gmtP true
+    foreach {k f} [list utc     "%Y%m%dT%T" \
+                        tz      "%Z"        \
+                        display "%a %b %d %H:%M:%S %Z %Y"] {
+        lappend tags [::xmpp::xml::create $k -cdata [clock format $now \
+                                                           -format $f  \
+                                                           -gmt    $gmtP]]
+        set gmtP false
+    }
+    set xmldata [::xmpp::xml::create query -xmlns jabber:iq:time \
+                                           -subelements $tags]
+    return [list result $xmldata]
+}
+
+proc jsend::iqVersion {xlib from xmlElement args} {
+    global argv0 tcl_platform
+
+    ::LOG "jsend::iqVersion $from"
+
+    foreach {k v} [list name    [file tail [file rootname $argv0]] \
+                        version "1.0 (Tcl [info patchlevel])"      \
+                        os      "$tcl_platform(os)  
$tcl_platform(osVersion)"] {
+        lappend tags [::xmpp::xml::create $k -cdata $v]
+    }
+    set xmldata [::xmpp::xml::create query -xmlns jabber:iq:version \
+                                           -subelements $tags]
+    return [list result $xmldata]
+}
+
+proc client:reconnect {xlib} {
+    jsend::reconnect
+}
+
+proc client:disconnect {xlib} {
+    jsend::reconnect
+}
+
+proc client:status {args} {
+    ::LOG "client:status $args"
+}
+
+
+namespace eval jsend {
+    variable stayP 1
+}
+
+proc jsend::follow {file argv} {
+    proc [namespace current]::reconnect {} \
+         [list [namespace current]::reconnect_aux $argv]
+
+    if {[catch { eval [list jsend::sendit 2] $argv } result]} {
+        ::bgerror $result
+        return
+    }
+
+    set buffer ""
+    set fd ""
+    set newP 1
+    array set st [list dev 0 ino 0 size 0]
+
+    for {set i 0} {1} {incr i} {
+        if {[expr {$i % 5}] == 0} {
+            if {[catch { file stat $file st2 } result]} {
+                ::LOG $result
+                break
+            }
+
+            if {($st(dev) != $st2(dev)) \
+                    || ($st(ino) != $st2(ino)) \
+                    || ($st(size) > $st2(size))} {
+                if {$newP} {
+                    catch { close $fd }
+                }
+
+                fconfigure [set fd [open $file { RDONLY }]] -blocking off
+                unset st
+                array set st [array get st2]
+
+                if {!$newP && [string equal $st(type) file]} {
+                    seek $fd 0 end
+                }
+
+                if {!$newP} {
+                    set newP 0
+                }
+
+                if {[string length $buffer] > 0} {
+                    if {[catch { eval [list jsend::sendit 1] $argv \
+                                      [parse $buffer] \
+                                      [list -body $buffer] } result]} {
+                        ::LOG $result
+                        break
+                    } elseif {$result} {
+                        set buffer ""
+                    }
+                }
+            }
+        }
+
+        if {[fblocked $fd]} {
+        } elseif {[catch {
+            set len [string length [set line [read $fd]]]
+            append buffer $line
+        } result]} {
+            ::LOG $result
+            break
+        } elseif {[set x [string first "\n" $buffer]] < 0} {
+        } else {
+            set body [string range $buffer 0 [expr {$x-1}]]
+            while {[catch { eval [list jsend::sendit 1] $argv [parse  
$body] \
+                                 [list -body $body] } result]} {
+                ::LOG $result
+            }
+            if {$result} {
+                set buffer [string range $buffer [expr {$x + 1}] end]
+            }
+        }
+
+        after 1000 "set alarmP 1"
+        vwait alarmP
+    }
+}
+
+proc jsend::parse {line} {
+    set args {}
+
+    if {![string equal [string index $line 15] " "]} {
+        return $args
+    }
+    catch { lappend args -time [clock scan [string range $line 0 14]] }
+
+    set line [string range $line 16 end]
+    if {([set d [string first " " $line]] > 0) \
+            && ([string first ": " $line] > $d)} {
+        lappend args -activity [string trim [string range $line $d end]]
+    }
+
+    return $args
+}
+
+proc jsend::reconnect_aux {argv} {
+    variable stayP
+
+    while {$stayP} {
+        after [expr {60*1000}]
+        if {![catch { eval [list jsend::sendit 2] $argv } result]} {
+            break
+        }
+
+        ::LOG $result
+    }
+}
+
+proc jsend::parse_xhtml {text} {
+    return [::xmpp::xml::parseData "<body>$text</body>"]
+}
+
+proc ::LOG {text} {
+#    puts stderr $text
+}
+
+proc ::debugmsg {args} {
+#    ::LOG "debugmsg: $args"
+}
+
+proc ::bgerror {err} {
+    global errorInfo
+
+    ::LOG "$err\n$errorInfo"
+}
+
+
+set status 1
+
+array set jsend::lib [list lastwhen [clock seconds] lastwhat ""]
+
+if {[string equal [file tail [lindex $argv 0]] "jsend.tcl"]} {
+    incr argc -1
+    set argv [lrange $argv 1 end]
+}
+
+if {(([set x [lsearch -exact $argv -help]] >= 0) \
+            || ([set x [lsearch -exact $argv --help]] >= 0)) \
+        && (($x == 0) || ([expr {$x % 2}]))} {
+    puts stdout \
+"usage: jsend.tcl recipient ?options...?
+            -follow      file
+            -pidfile     file
+            -from        jid
+            -host        hostname
+            -port        number
+            -password    string
+            -type        string (e.g., 'chat')
+            -subject     string
+            -body        string
+            -xhtml       string
+            -description string
+            -url         string
+            -tls         boolean (e.g., 'false')
+            -starttls    boolean (e.g., 'true')
+            -sasl        boolean (e.g., 'true')
+
+If recipient is '-', roster is used.
+
+If both '-body' and '-follow' are absent, the standard input is used.
+
+The file .jsendrc.tcl in the current or in home directory is consulted,
+e.g.,
+
+    set args {-from fred at example.com/bedrock -password wilma}
+
+for default values."
+
+    set status 0
+} elseif {($argc < 1) || (![expr {$argc % 2}])} {
+    puts stderr "usage: jsend.tcl recipent ?-key value?..."
+} elseif {[catch {
+    if {([file exists [set file .jsendrc.tcl]]) \
+            || ([file exists [set file ~/.jsendrc.tcl]])} {
+        set args {}
+
+        source $file
+
+        array set at [list -permissions 600]
+        array set at [file attributes $file]
+
+        if {[set x [lsearch -exact $args "-password"]] >= 0 \
+                    && ![expr {$x % 2}] \
+                    && ![string match *00 $at(-permissions)]} {
+            error "file should be mode 0600"
+        }
+
+        if {[llength $args] > 0} {
+            set argv [eval [list linsert $argv 1] $args]
+        }
+    }
+} result]} {
+    puts stderr "error in $file: $result"
+} elseif {[set x [lsearch -exact $argv "-follow"]] > 0 && [expr {$x % 2}]}  
{
+    set keep_alive 1
+    set keep_alive_interval 3
+
+    if {[set y [lsearch -exact $argv "-pidfile"]] > 0 && [expr {$y % 2}]} {
+        set fd [open [set pf [lindex $argv [expr {$y + 1}]]] \
+                     {WRONLY CREAT TRUNC}]
+        puts $fd [pid]
+        close $fd
+    }
+
+    jsend::follow [lindex $argv [expr {$x + 1}]] $argv
+
+    catch { file delete -- $pf }
+} elseif {[catch { eval [list jsend::sendit 0] $argv } result]} {
+    puts stderr $result
+} else {
+    set status 0
+}
+
+exit $status
+
+# vim:ft=tcl:ts=8:sw=4:sts=4:et
=======================================
--- /dev/null
+++ /trunk/examples/rssbot.tcl	Sun Oct  4 04:31:25 2009
@@ -0,0 +1,1499 @@
+#!/usr/bin/env tclsh
+
+# rssbot.tcl --
+#
+#       This file is an example provided with the XMPP library. It  
implements
+#       RSS/XMPP gateway. It was initially developed by Marshall T. Rose  
and
+#       adapted to the XMPP library by Sergei Golovan.
+#
+# Copyright (c) 2009 Sergei Golovan <sgolovan at nes.ru>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAMER OF ALL WARRANTIES.
+#
+# $Id$
+
+package require Tcl 8.5
+package require http 2
+package require mime
+package require tls
+package require uri
+
+package require xmpp
+package require xmpp::auth
+package require xmpp::sasl
+package require xmpp::starttls
+package require xmpp::roster
+package require xmpp::private
+package require xmpp::delay
+
+# Register IQ XMLNS
+::xmpp::iq::register get * http://jabber.org/protocol/disco#info \
+                           xsend::iqDiscoInfo
+::xmpp::iq::register get * http://jabber.org/protocol/disco#items \
+                           xsend::iqDiscoItems
+::xmpp::iq::register get * jabber:iq:last    xsend::iqLast
+::xmpp::iq::register get * jabber:iq:time    xsend::iqTime
+::xmpp::iq::register get * jabber:iq:version xsend::iqVersion
+
+namespace eval rssbot {}
+
+proc rssbot::sendit {stayP to args} {
+    global env
+    global xlib
+
+    variable lib
+    variable roster
+
+    array set options [list -to          $to      \
+                            -from        ""       \
+                            -password    ""       \
+                            -host        ""       \
+                            -port        ""       \
+                            -activity    ""       \
+                            -type        headline \
+                            -subject     ""       \
+                            -date        ""       \
+                            -body        ""       \
+                            -description ""       \
+                            -url         ""       \
+                            -tls         false    \
+                            -starttls    true     \
+                            -sasl        true]
+    array set options $args
+
+    if {![string compare $options(-host) ""]} {
+        set options(-host) [info hostname]
+    }
+
+    set params [list from]
+    foreach k $params {
+        if {[string first @ $options(-$k)] < 0} {
+            if {[set x [string first / $options(-$k)]] >= 0} {
+                set options(-$k) [string replace $options(-$k) $x $x \
+                                         @$options(-host)/]
+            } else {
+                append options(-$k) @$options(-host)
+            }
+        }
+        if {([string first @ $options(-$k)] == 0) \
+                && ([info exists env(USER)])} {
+            set options(-$k) $env(USER)$options(-$k)
+        }
+    }
+
+    foreach k [list tls starttls] {
+        switch -- [string tolower $options(-$k)] {
+            1 - 0               {}
+            false - no  - off   { set options(-$k) 0 }
+            true  - yes - on    { set options(-$k) 1 }
+            default {
+                error "invalid value for -$k: $options(-$k)"
+            }
+        }
+    }
+
+    array set aprops [lindex [mime::parseaddress $options(-from)] 0]
+    if {[set x [string first / $aprops(domain)]] >= 0} {
+        set aprops(resource) [string range $aprops(domain) [expr {$x + 1}]  
end]
+        set aprops(domain) [string range $aprops(domain) 0 [expr {$x - 1}]]
+    } else {
+        set aprops(resource) "rssbot"
+    }
+
+    set options(-xlist) {}
+    if {[string compare $options(-url)$options(-description) ""]} {
+        lappend options(-xlist) \
+                [::xmpp::xml::create x \
+                        -xmlns jabber:x:oob \
+                        -subelement [::xmpp::xml::create url \
+                                        -cdata $options(-url)] \
+                        -subelement [::xmpp::xml::create desc \
+                                        -cdata $options(-description)]]
+    }
+    if {[string compare $options(-date) ""]} {
+        lappend options(-xlist) \
+                [::xmpp::delay::create $options(-date)]
+    }
+
+    set lib(lastwhat) $options(-activity)
+    if {[catch { clock scan $options(-time) } lib(lastwhen)]} {
+        set lib(lastwhen) [clock seconds]
+    }
+
+    set params {}
+    foreach k [list body subject type xlist] {
+        if {[string compare $options(-$k) ""]} {
+            lappend params -$k $options(-$k)
+        }
+    }
+
+    if {![info exists xlib]} {
+        # Create an XMPP library instance
+        set xlib [::xmpp::new -messagecommand [namespace current]::message  
\
+                              -presencecommand [namespace  
current]::presence]
+
+        if {$options(-tls)} {
+            set transport tls
+            if {![string equal $options(-port) ""]} {
+                set port $options(-port)
+            } else {
+                set port 5223
+            }
+        } else {
+            set transport tcp
+            if {![string equal $options(-port) ""]} {
+                set port $options(-port)
+            } else {
+                set port 5222
+            }
+        }
+
+        # Connect to a server
+        ::xmpp::connect $xlib $aprops(domain) $port -transport $transport
+
+        if {!$options(-tls) && $options(-starttls)} {
+            # Open XMPP stream
+            set sessionID [::xmpp::openStream $xlib $aprops(domain) \
+                                                    -version 1.0]
+
+            ::xmpp::starttls::starttls $xlib
+
+            ::xmpp::sasl::auth $xlib -username  $aprops(local) \
+                                     -password  $options(-password) \
+                                     -resource  $aprops(resource)
+        } elseif {$options(-sasl)} {
+            # Open XMPP stream
+            set sessionID [::xmpp::openStream $xlib $aprops(domain) \
+                                                    -version 1.0]
+
+            ::xmpp::sasl::auth $xlib -username  $aprops(local) \
+                                     -password  $options(-password) \
+                                     -resource  $aprops(resource)
+        } else {
+            # Open XMPP stream
+            set sessionID [::xmpp::openStream $xlib $aprops(domain)]
+
+            # Authenticate
+            ::xmpp::auth::auth $xlib -sessionid $sessionID \
+                                     -username  $aprops(local) \
+                                     -password  $options(-password) \
+                                     -resource  $aprops(resource)
+        }
+
+        set roster [::xmpp::roster::new $xlib]
+        ::xmpp::roster::get $roster
+    }
+
+    if {$stayP > 1} {
+        ::xmpp::sendPresence $xlib -status Online
+
+        return 1
+    }
+
+    foreach to $options(-to) {
+        switch -- [eval [list ::xmpp::sendMessage $xlib $to] $params] {
+            -1 -
+            -2 {
+                if {$stayP} {
+                    set cmd [list ::LOG]
+                } else {
+                    set cmd [list error]
+                }
+                eval $cmd [list "error writing to socket, continuing..."]
+                return 0
+            }
+            default {}
+        }
+    }
+    if {!$stayP} {
+        ::xmpp::disconnect $xlib
+    }
+
+    return 1
+}
+
+proc rssbot::message {xlib from type x args} {
+    ::LOG "rssbot::message $from $type $x $args"
+
+    set jid [::xmpp::jid::stripResource $from]
+
+    switch -- $type {
+        normal -
+        chat { }
+        "" { set type normal }
+        default {
+            ::LOG "$from ignoring $type"
+            return
+        }
+    }
+
+    set body ""
+    set subject ""
+    foreach {key val} $args {
+        switch -- $key {
+            -body { set body $val }
+            -subject { set subject $val }
+        }
+    }
+
+    if {[catch { rssbot::message_aux $jid $body } answer]} {
+        ::LOG "$jid/$body: $answer"
+        set answer "internal error, sorry! ($answer)"
+    }
+    if {[catch { rssbot::sendit 1 "" \
+                     -to       $from         \
+                     -activity "$jid: $body" \
+                     -type     $type         \
+                     -subject  $subject      \
+                     -body     $answer } result]} {
+        ::LOG "$from: $result"
+    }
+}
+
+proc rssbot::presence {xlib from type x args} {
+    variable articles
+    variable sources
+    variable subscribers
+
+    ::LOG "rssbot:presence $from $type $x $args"
+
+    set jid [::xmpp::jid::stripResource $from]
+
+    switch -- $type {
+        available -
+        unavailable { }
+        "" { set type available }
+        default {
+            ::LOG "$from ignoring $type"
+            return
+        }
+    }
+
+    rssbot::presence_aux $jid $type
+}
+
+proc rssbot::iqDiscoInfo {xlib from xmlElement args} {
+    ::LOG "rssbot::iqDiscoInfo $from"
+
+    ::xmpp::xml::split $xmlElement tag xmlns attrs cdata subels
+
+    if {[::xmpp::xml::isAttr $attrs node]} {
+        return [list error cancel service-unavailable]
+    }
+
+    set identity [::xmpp::xml::create identity \
+                                      -attrs [list name     rssbot \
+                                                   category client \
+                                                   type     bot]]
+
+    set subelements {}
+    foreach var [list http://jabber.org/protocol/disco#info \
+                      http://jabber.org/protocol/disco#items \
+                      jabber:iq:last \
+                      jabber:iq:time \
+                      jabber:iq:version] {
+        lappend subelements [::xmpp::xml::create feature \
+                                    -attrs [list var $var]]
+    }
+    set xmldata \
+        [::xmpp::xml::create query -xmlns       $xmlns \
+                                   -attrs       [list type client] \
+                                   -subelement  $identity \
+                                   -subelements $subelements]
+    return [list result $xmldata]
+}
+
+proc rssbot::iqDiscoItems {xlib from xmlElement args} {
+    ::LOG "rssbot::iqDiscoItems $from"
+
+    ::xmpp::xml::split $xmlElement tag xmlns attrs cdata subels
+
+    if {[::xmpp::xml::isAttr $attrs node]} {
+        return [list error cancel service-unavailable]
+    }
+
+    return [list result [::xmpp::xml::create query -xmlns $xmlns]]
+}
+
+proc rssbot::iqLast {xlib from xmlElement args} {
+    variable lib
+
+    ::LOG "rssbot::iqLast $from"
+
+    set now [clock seconds]
+    set xmldata \
+        [::xmpp::xml::create query -xmlns jabber:iq:last \
+                                   -attrs [list seconds \
+                                                [expr {$now -  
$lib(lastwhen)}]] \
+                                   -cdata $lib(lastwhat)]
+    return [list result $xmldata]
+}
+
+proc rssbot::iqTime {xlib from xmlElement args} {
+    ::LOG "rssbot::iqTime $from"
+
+    set now [clock seconds]
+    set gmtP true
+    foreach {k f} [list utc     "%Y%m%dT%T" \
+                        tz      "%Z"        \
+                        display "%a %b %d %H:%M:%S %Z %Y"] {
+        lappend tags [::xmpp::xml::create $k -cdata [clock format $now \
+                                                           -format $f  \
+                                                           -gmt    $gmtP]]
+        set gmtP false
+    }
+    set xmldata [::xmpp::xml::create query -xmlns jabber:iq:time \
+                                           -subelements $tags]
+    return [list result $xmldata]
+}
+
+proc rssbot::iqVersion {xlib from xmlElement args} {
+    global argv0 tcl_platform
+
+    ::LOG "rssbot::iqVersion $from"
+
+    foreach {k v} [list name    [file tail [file rootname $argv0]] \
+                        version "1.0 (Tcl [info patchlevel])"      \
+                        os      "$tcl_platform(os)  
$tcl_platform(osVersion)"] {
+        lappend tags [::xmpp::xml::create $k -cdata $v]
+    }
+    set xmldata [::xmpp::xml::create query -xmlns jabber:iq:version \
+                                           -subelements $tags]
+    return [list result $xmldata]
+}
+
+proc client:reconnect {xlib} {
+    rssbot::reconnect
+}
+
+proc client:disconnect {xlib} {
+    rssbot::reconnect
+}
+
+proc client:status {args} {
+    ::LOG "client:status $args"
+}
+
+# state variables
+#     mtime - modified time
+#     ntime - expiration time
+#
+#
+# articles(source,url)    [list mtime ... ntime ... args { ... }   
source "..."]
+# sources(site)           [list mtime ... ntime ...]
+# subscribers(jid)        [list mtime ...           sites { ... }  
status "..."]
+#
+
+proc rssbot::begin {argv} {
+    global xlib
+    global doneP
+
+    variable iqP
+    variable loopID
+    variable parser
+
+    variable articles
+    variable sources
+    variable subscribers
+
+    proc [namespace current]::reconnect {} \
+         [list [namespace current]::reconnect_aux $argv]
+
+    if {[catch {
+        set loopID ""
+        [set parser [xml::parser]] configure \
+                -elementstartcommand  [namespace code [list element  
begin]] \
+                -elementendcommand    [namespace code [list element  
end]]   \
+                -characterdatacommand [namespace code pcdata]
+
+        array set articles {}
+        array set sources {}
+        array set subscribers {}
+
+        eval [list rssbot::sendit 2 ""] $argv
+
+        set iqP 0
+        foreach array [list articles sources subscribers] {
+            incr iqP
+            ::xmpp::private::retrieve $xlib \
+                    [list [::xmpp::xml::create $array \
+                                    -xmlns rssbot.$array]] \
+                -command [namespace code [list iq_private 0]]
+        }
+        while {$iqP > 0} {
+            vwait [namespace current]::iqP
+        }
+
+        loop $argv
+    } result]} {
+        set doneP 1
+        bgerror $result
+    }
+}
+
+proc rssbot::loop {argv} {
+    variable loopID
+
+    set loopID ""
+
+    if {[catch { loop_aux $argv } result]} {
+        bgerror $result
+    }
+
+    set loopID [after [expr {30*60*1000}] [list [namespace current]::loop  
$argv]]
+}
+
+proc rssbot::loop_aux {argv} {
+    global xlib
+    variable articles
+    variable sources
+    variable subscribers
+    variable lib
+
+    array set updateP [list articles 0 sources 0 subscribers 0]
+
+    set sites {}
+    foreach jid [array names subscribers] {
+        array set props $subscribers($jid)
+
+        if {![string compare $props(status) available]} {
+            foreach site $props(sites) {
+                if {[lsearch -exact $sites $site] < 0} {
+                    lappend sites $site
+                }
+            }
+        }
+    }
+
+    set now [clock seconds]
+    foreach site $sites {
+        catch { array unset sprops }
+        array set sprops [list ntime 0]
+        catch { array set sprops $sources($site) }
+
+        if {$sprops(ntime) > $now} {
+            continue
+        }
+
+        if {[catch { ::http::geturl $site } httpT]} {
+            ::LOG "$site: $httpT"
+            continue
+        }
+
+        switch -exact -- [set status [::http::status $httpT]] {
+            ok {
+                if {![string match 2* [set ncode [::http::ncode $httpT]]]}  
{
+                    ::LOG "$site: returns code $ncode"
+                } else {
+                    catch { unset state }
+                    upvar #0 $httpT state
+
+                    catch { unset array meta }
+                    array set meta $state(meta)
+                    if {![info exists meta(Last-Modified)]} {
+                        set mtime $now
+                    } elseif {[catch { rfc2822::parseDate  
$meta(Last-Modified) } t]} {
+                        ::LOG "$site: invalid Last-Modified meta-data  
$meta(Last-Modified)"
+                        set mtime $now
+                    } else {
+                        set mtime $t
+                    }
+                    foreach {k v} [process $site $mtime [expr {$now +  
(30*60)}] \
+                                           $now [::http::data $httpT]] {
+                        if {$v} {
+                            set updateP($k) 1
+                        }
+                    }
+                }
+            }
+            timeout -
+            default {
+                ::LOG "$site: $status"
+            }
+        }
+
+        ::http::cleanup $httpT
+    }
+
+    foreach jid [array names subscribers] {
+        catch { array unset props }
+        array set props $subscribers($jid)
+
+        if {[catch { set props(mtime) } mtime]} {
+            set mtime 0
+        }
+
+        set xtime 0
+        foreach site $props(sites) {
+            foreach article [array names articles] {
+                catch { array unset aprops }
+                array set aprops $articles($article)
+
+                if {$aprops(ntime) <= $now} {
+                    unset articles($article)
+
+                    set updateP(articles) 1
+                    continue
+                }
+
+                if {[string first "$site," $article]} {
+                    continue
+                }
+
+                if {$aprops(mtime) <= $mtime} {
+                    continue
+                }
+
+                if {[catch { eval [list rssbot::sendit 1 $jid] $argv \
+                                  $aprops(args) } result]} {
+                    ::LOG "$jid: $result"
+                } else {
+                    if {$xtime < $aprops(mtime)} {
+                        set xtime $aprops(mtime)
+                    }
+
+                    set lib(lastwhat) $aprops(source)
+                    set lib(lastwhen) $aprops(mtime)
+                }
+            }
+        }
+
+        if {$xtime > $mtime} {
+            set updateP(subscribers) 1
+
+            set props(mtime) $xtime
+            set subscribers($jid) [array get props]
+        }
+    }
+
+    foreach array [list articles sources subscribers] {
+        if {$updateP($array)} {
+            ::xmpp::private::store $xlib \
+                    [list [::xmpp::xml::create $array \
+                                    -xmlns rssbot.$array \
+                                    -cdata [array get $array]]] \
+                -command [namespace code [list iq_private 1]]
+        }
+    }
+}
+
+proc rssbot::process {site mtime ntime now data} {
+    variable info
+    variable parser
+    variable stack
+
+    variable sources
+
+    array set info [list site $site ctime $mtime now $now articleP 0]
+
+    set stack {}
+    if {[catch { $parser parse $data } result]} {
+        ::LOG "$site: $result"
+    } else {
+        set sources($site) [list mtime $mtime ntime $ntime]
+    }
+
+    return [list articles $info(articleP) sources $info(articleP)]
+}
+
+proc rssbot::element {tag name {av {}} args} {
+    variable info
+    variable stack
+
+    variable articles
+
+    switch -- $tag {
+        begin {
+            set parent [lindex [lindex $stack end] 0]
+            lappend stack [list $name $av]
+            switch -- $parent/$name {
+                channel/title {
+                    array set info [list subject ""]
+                }
+                channel/item -
+                rdf:RDF/item -
+                RDF/item {
+                    array set info [list description "" \
+                                         body        "" \
+                                         url         "" \
+                                         date        ""]
+                }
+            }
+        }
+        end {
+            set stack [lreplace $stack end end]
+            set parent [lindex [lindex $stack end] 0]
+
+            switch -- $parent/$name {
+                channel/item -
+                rdf:RDF/item -
+                RDF/item {}
+                default {
+                    return
+                }
+            }
+
+            if {[string compare $info(date) ""]} {
+                if {[catch { iso8601::parse_date $info(date) }  
info(mtime)] && \
+                        [catch { iso8601::parse_time $info(date) }  
info(mtime)] && \
+                        [catch { rfc2822::parseDate $info(date) }  
info(mtime)]} {
+                    ::LOG "$info(site): invalid date $info(date)"
+                    set info(mtime) $info(ctime)
+                }
+            } else {
+                set info(mtime) $info(ctime)
+            }
+
+            if {![string compare [set url $info(url)] ""]} {
+                ::LOG "$info(site): missing URL in item"
+                return
+            }
+
+            set ntime [expr {$info(mtime) + (7*24*60*60)}]
+            if {$ntime <= $info(now)} {
+                ::LOG "DEBUG $info(site): article for $url at $info(date)  
is expired"
+                return
+            }
+
+            set site $info(site)
+            if {[info exists articles($site,$url)]} {
+                ::LOG "DEBUG $info(site): article for $url already exists"
+                return
+            }
+
+            if {![string compare $info(body) ""]} {
+                set info(body) [string  
trim "$info(description)\n$info(url)"]
+            }
+
+            set args {}
+            foreach k [list subject body description url] {
+                lappend args -$k [string trim $info($k)]
+            }
+            lappend args -date $info(mtime)
+
+            set articles($site,$url) \
+                [list mtime  $info(mtime)                 \
+                      ntime  $ntime                       \
+                      source [string trim $info(subject)] \
+                      args   $args]
+
+            set info(articleP) 1
+        }
+    }
+}
+
+proc rssbot::pcdata {text} {
+    variable info
+    variable stack
+
+    if {![string compare [string trim $text] ""]} {
+        return
+    }
+
+    set name [lindex [lindex $stack end] 0]
+    set parent [lindex [lindex $stack end-1] 0]
+    switch -- $parent/$name {
+        channel/title {
+            append info(subject) $text
+        }
+        item/title {
+            append info(description) $text
+        }
+        item/link {
+            append info(url) $text
+        }
+        item/description {
+            append info(body) $text
+        }
+        item/dc:date -
+        item/date -
+        item/pubDate {
+            append info(date) $text
+        }
+    }
+}
+
+proc rssbot::message_aux {jid request} {
+    global xlib
+    variable loopID
+
+    variable articles
+    variable sources
+    variable subscribers
+    variable roster
+
+    if {[catch { split [string trim $request] } args]} {
+        return $args
+    }
+
+    set answer ""
+    set updateP 0
+    set arrayL [list subscribers]
+
+    set fmt "%a %b %d %H:%M:%S %Z %Y"
+    switch -glob -- [set arg0 [string tolower [lindex $args 0]]] {
+        h* {
+            set answer {commands are:
+    subscribe URL
+    unsubscribe [URL ...]
+    reset [DATE-TIME]
+    list
+    dump [URL ...]
+    flush
+    help}
+        }
+        sub* {
+            if {[llength $args] <= 1} {
+                return "usage: subscribe URL ..."
+            }
+
+            array set props [list mtime 0 sites {} status available]
+            if {([catch { array set props $subscribers($jid) }]) \
+                    && ([lsearch -exact [::xmpp::roster::items $roster]  
$jid] < 0)} {
+                return "not authorized"
+            }
+
+            set s ""
+            foreach arg [lrange $args 1 end] {
+                if {![string compare $arg ""]} {
+                    append answer $s "invalid source: empty URL"
+                } elseif {[lsearch -exact $props(sites) $arg] >= 0} {
+                    append answer $s "already subscribed to $arg"
+                } elseif {[catch { uri::split $arg } result]} {
+                    append answer $s "invalid source: $arg ($result)"
+                } else {
+                    lappend props(sites) $arg
+                    set updateP 1
+
+                    append answer $s "added subscription to $arg"
+                }
+                set s "\n"
+            }
+        }
+        unsub* {
+            if {![info exists subscribers($jid)]} {
+                return "no subscriptions"
+            }
+
+            array set props $subscribers($jid)
+            if {[llength $args] <= 1} {
+                set s {}
+                foreach site $props(sites) {
+                    lappend s "cancelled subscription to $site"
+                }
+                append answer [join $s \n]
+
+                set props(sites) {}
+                set updateP 1
+            } else {
+                set s {}
+                foreach arg [lrange $args 1 end] {
+                    if {[set x [lsearch -exact $props(sites) $arg]] < 0} {
+                        lappend s "not subscribed to $arg"
+                    } else {
+                        set props(sites) [lreplace $props(sites) $x $x]
+                        set updateP 1
+
+                        lappend s "cancelled subscription to $arg"
+                    }
+                }
+                append answer [join $s \n]
+            }
+        }
+        reset {
+            if {![info exists subscribers($jid)]} {
+                return "no subscriptions"
+            }
+
+            array set props $subscribers($jid)
+
+            append answer "subscription history reset"
+            if {[llength $args] <= 1} {
+                set props(mtime) 0
+            } elseif {[catch { clock scan [concat [lrange $args 1 end]] \
+                                     -base [clock seconds] } m]} {
+                return "invalid date-time: [concat [lrange $args 1 end]]  
($m)"
+            } else {
+                set props(mtime) $m
+                append answer " to [clock format $m -format $fmt]"
+            }
+            set updateP 1
+        }
+        list {
+            if {![info exists subscribers($jid)]} {
+                return "no subscriptions"
+            }
+
+            array set props $subscribers($jid)
+
+            if {[llength $props(sites)] == 0} {
+                append answer "no sites"
+            } else {
+                append answer [join $props(sites) \n]
+            }
+        }
+        dump {
+            if {![info exists subscribers($jid)]} {
+                return [::xmpp::xml::toTabbedText \
+                            [::xmpp::xml::create subscriber \
+                                    -attrs [list jid $jid]]]
+            }
+
+            array set props $subscribers($jid)
+
+            set tags {}
+
+            if {[info exists props(mtime)]} {
+                set cdata [clock format $props(mtime) -format $fmt]
+            } else {
+                set cdata never
+            }
+            lappend tags [::xmpp::xml::create updated -cdata $cdata]
+
+            foreach site $props(sites) {
+                if {([llength $args] > 1) && \
+                        ([lsearch -exact [lrange $args 1 end] $site] < 0)}  
{
+                    continue
+                }
+
+                catch { unset array sprops }
+                array set sprops $sources($site)
+
+                set stags {}
+                lappend stags [::xmpp::xml::create url -cdata $site]
+                lappend stags [::xmpp::xml::create modified \
+                                   -cdata [clock format $sprops(mtime) \
+                                                 -format $fmt]]
+                lappend stags [::xmpp::xml::create expires \
+                                   -cdata [clock format $sprops(ntime) \
+                                                 -format $fmt]]
+                set atags {}
+                foreach article [array names articles] {
+                    if {[string first "$site," $article]} {
+                        continue
+                    }
+                    set url [string range $article [string  
length "$site,"] end]
+
+                    catch { array unset aprops }
+                    array set aprops $articles($article)
+
+                    set atag {}
+                    lappend atag [::xmpp::xml::create url -cdata $url]
+                    lappend atag [::xmpp::xml::create modified \
+                                      -cdata [clock format $aprops(mtime) \
+                                                    -format $fmt]]
+                    lappend atag [::xmpp::xml::create expires \
+                                      -cdata [clock format $aprops(ntime) \
+                                                    -format $fmt]]
+                    lappend atag [::xmpp::xml::create args \
+                                      -cdata $aprops(args)]
+
+                    lappend atags [::xmpp::xml::create article \
+                                       -subelements $atag]
+                }
+
+                lappend stags [::xmpp::xml::create articles \
+                                   -subelements $atags]
+
+                lappend tags [::xmpp::xml::create site \
+                                  -subelements $stags]
+            }
+
+            set answer [::xmpp::xml::toTabbedText \
+                            [::xmpp::xml::create subscriber \
+                                    -attrs [list jid $jid] \
+                                    -subelement [::xmpp::xml::create sites  
\
+                                                        -subelements  
$tags]]]
+        }
+        flush {
+            if {![info exists subscribers($jid)]} {
+                return "no subscriptions"
+            }
+
+            array set props $subscribers($jid)
+
+            foreach array [set arrayL [list articles sources]] {
+                lappend arrayL $array
+                array unset $array
+                array set $array {}
+            }
+            set updateP 1
+
+            append answer "cache flushed"
+        }
+        default {
+            append answer "unknown request: $arg0\n"
+            append answer "try \"help\" instead"
+        }
+    }
+
+    if {$updateP} {
+        set subscribers($jid) [array get props]
+
+        foreach array $arrayL {
+            ::xmpp::private::store $xlib \
+                    [list [::xmpp::xml::create $array \
+                                    -xmlns rssbot.$array \
+                                    -cdata [array get $array]]] \
+                    -command [namespace code [list iq_private 1]]
+        }
+
+        if {[string compare $loopID ""]} {
+            set script [lindex [after info $loopID] 0]
+            after cancel $loopID
+            set loopID [after idle $script]
+        }
+    }
+
+    return $answer
+}
+
+
+proc rssbot::presence_aux {jid status} {
+    global xlib
+    variable loopID
+
+    variable articles
+    variable sources
+    variable subscribers
+
+    if {![info exists subscribers($jid)]} {
+        ::LOG "$jid not subscribed?!?"
+        return
+    }
+
+    array set props $subscribers($jid)
+
+    if {[string compare $props(status) $status]} {
+        set props(status) $status
+        set subscribers($jid) [array get props]
+
+        ::xmpp::private::store $xlib \
+                [list [::xmpp::xml::create subscribers \
+                                -xmlns rssbot.subscribers \
+                                -cdata [array get subscribers]]] \
+                -command [namespace code [list iq_private 1]]
+
+        if {(![string compare $status available]) \
+                && ([string compare $loopID ""])} {
+            set script [lindex [after info $loopID] 0]
+            after cancel $loopID
+            set loopID [after idle $script]
+        }
+    }
+}
+
+
+proc rssbot::reconnect_aux {argv} {
+    while {1} {
+        after [expr {60*1000}]
+        if {![catch { eval [list rssbot::sendit 2 ""] $argv } result]} {
+            break
+        }
+
+        ::LOG $result
+    }
+}
+
***The diff for this file has been truncated for email.***
=======================================
--- /trunk/examples/xsend.tcl	Fri Jul 31 12:26:02 2009
+++ /dev/null
@@ -1,571 +0,0 @@
-#!/usr/bin/env tclsh
-
-# xsend.tcl --
-#
-#       This file is an example provided with the XMPP library. It allows  
to
-#       send messages via XMPP non-interactively. It was initially  
developed
-#       by Marshall T. Rose and adapted to the XMPP library by Sergei  
Golovan.
-#
-# Copyright (c) 2008-2009 Sergei Golovan <sgolovan at nes.ru>
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAMER OF ALL WARRANTIES.
-#
-# $Id$
-
-package require mime
-package require sha1
-package require tls
-
-package require xmpp
-package require xmpp::auth
-package require xmpp::sasl
-package require xmpp::starttls
-package require xmpp::roster
-
-# Register IQ XMLNS
-::xmpp::iq::register get * http://jabber.org/protocol/disco#info \
-                           xsend::iqDiscoInfo
-::xmpp::iq::register get * http://jabber.org/protocol/disco#items \
-                           xsend::iqDiscoItems
-::xmpp::iq::register get * jabber:iq:last    xsend::iqLast
-::xmpp::iq::register get * jabber:iq:time    xsend::iqTime
-::xmpp::iq::register get * jabber:iq:version xsend::iqVersion
-
-namespace eval xsend {}
-
-proc xsend::sendit {stayP to args} {
-    global xlib
-    global env
-
-    variable lib
-    variable sendit_result
-
-    array set options [list -to          $to   \
-                            -from        ""    \
-                            -password    ""    \
-                            -host        ""    \
-                            -port        ""    \
-                            -activity    ""    \
-                            -type        chat  \
-                            -subject     ""    \
-                            -body        ""    \
-                            -xhtml       ""    \
-                            -description ""    \
-                            -url         ""    \
-                            -tls         false \
-                            -starttls    true  \
-                            -sasl        true]
-    array set options $args
-
-    if {[string equal $options(-host) ""]} {
-        set options(-host) [info hostname]
-    }
-
-    set params [list from]
-    if {![string equal $options(-to) "-"]} {
-        lappend params to
-    }
-    foreach k $params {
-        if {[string first @ $options(-$k)] < 0} {
-            if {[set x [string first / $options(-$k)]] >= 0} {
-                set options(-$k) [string replace $options(-$k) $x $x \
-                                         @$options(-host)/]
-            } else {
-                append options(-$k) @$options(-host)
-            }
-        }
-        if {([string first @ $options(-$k)] == 0) \
-                && ([info exists env(USER)])} {
-            set options(-$k) $env(USER)$options(-$k)
-        }
-    }
-    if {![string equal $options(-to) "-"]} {
-        set options(-to) [list $options(-to)]
-    }
-
-    foreach k [list tls starttls] {
-        switch -- [string tolower $options(-$k)] {
-            1 - 0               {}
-            false - no  - off   { set options(-$k) 0 }
-            true  - yes - on    { set options(-$k) 1 }
-            default {
-                error "invalid value for -$k: $options(-$k)"
-            }
-        }
-    }
-
-    array set aprops [lindex [mime::parseaddress $options(-from)] 0]
-    if {[set x [string first / $aprops(domain)]] >= 0} {
-        set aprops(resource) [string range $aprops(domain) [expr {$x + 1}]  
end]
-        set aprops(domain) [string range $aprops(domain) 0 [expr {$x - 1}]]
-    } else {
-        set aprops(resource) "xsend"
-    }
-
-    if {[string equal $options(-body) ""] && $stayP < 2} {
-        set options(-body) [read -nonewline stdin]
-    }
-
-    set options(-xlist) {}
-    if {![string equal $options(-url)$options(-description) ""]} {
-        lappend options(-xlist) \
-                [::xmpp::xml::create x \
-                       -xmlns jabber:x:oob \
-                       -subelement [::xmpp::xml::create url \
-                                        -cdata $options(-url)] \
-                       -subelement [::xmpp::xml::create desc \
-                                        -cdata $options(-description)]]]
-    }
-    if {![string equal $options(-xhtml) ""] \
-            && ![string equal $options(-body) ""] \
-            && $stayP < 1} {
-        lappend options(-xlist) \
-                [::xmpp::xml::create html \
-                       -xmlns http://jabber.org/protocol/xhtml-im \
-                       -subelement [::xmpp::xml::create body \
-                                        -xmlns  
http://www.w3.org/1999/xhtml \
-                                        -subelements [xsend::parse_xhtml \
-                                                             
$options(-xhtml)]]]
-    }
-    if {[string equal $options(-type) announce]} {
-        set options(-type) normal
-        set announce [sha1::sha1 \
-                          [clock seconds]$options(-subject)$options(-body)]
-        lappend options(-xlist) \
-                [::xmpp::xml::create x \
-                     -xmlns http://2entwine.com/protocol/gush-announce-1_0  
\
-                     -subelement [::xmpp::xml::create id -cdata $announce]]
-    }
-
-    set lib(lastwhat) $options(-activity)
-    if {[catch { clock scan $options(-time) } lib(lastwhen)]} {
-        set lib(lastwhen) [clock seconds]
-    }
-
-    set params {}
-    foreach k [list body subject type xlist] {
-        if {![string equal $options(-$k) ""]} {
-            lappend params -$k $options(-$k)
-        }
-    }
-
-    if {![info exists xlib]} {
-        # Create an XMPP library instance
-        set xlib [::xmpp::new]
-
-        if {$options(-tls)} {
-            set transport tls
-            if {![string equal $options(-port) ""]} {
-                set port $options(-port)
-            } else {
-                set port 5223
-            }
-        } else {
-            set transport tcp
-            if {![string equal $options(-port) ""]} {
-                set port $options(-port)
-            } else {
-                set port 5222
-            }
-        }
-
-        # Connect to a server
-        ::xmpp::connect $xlib $aprops(domain) $port -transport $transport
-
-        if {!$options(-tls) && $options(-starttls)} {
-            # Open XMPP stream
-            set sessionID [::xmpp::openStream $xlib $aprops(domain) \
-                                                    -version 1.0]
-
-            ::xmpp::starttls::starttls $xlib
-
-            ::xmpp::sasl::auth $xlib -username  $aprops(local) \
-                                     -password  $options(-password) \
-                                     -resource  $aprops(resource)
-        } elseif {$options(-sasl)} {
-            # Open XMPP stream
-            set sessionID [::xmpp::openStream $xlib $aprops(domain) \
-                                                    -version 1.0]
-
-            ::xmpp::sasl::auth $xlib -username  $aprops(local) \
-                                     -password  $options(-password) \
-                                     -resource  $aprops(resource)
-        } else {
-            # Open XMPP stream
-            set sessionID [::xmpp::openStream $xlib $aprops(domain)]
-
-            # Authenticate
-            ::xmpp::auth::auth $xlib -sessionid $sessionID \
-                                     -username  $aprops(local) \
-                                     -password  $options(-password) \
-                                     -resource  $aprops(resource)
-        }
-
-        set roster [::xmpp::roster::new $xlib]
-        ::xmpp::roster::get $roster
-    }
-
-    if {[string equal $options(-to) "-"]} {
-        set options(-to) [::xmpp::roster::items $roster]
-    }
-
-    if {$stayP > 1} {
-        ::xmpp::sendPresence $xlib -status Online
-
-        if {[string equal $options(-type) groupchat]} {
-            set nick $aprops(local)@$aprops(domain)/$aprops(resource)
-            set nick [string range [sha1::sha1 $nick+[clock seconds]] 0 7]
-            foreach to $options(-to) {
-                ::xmpp::sendPresence $xlib -to $to/$nick
-            }
-        }
-        return 1
-    }
-
-    foreach to $options(-to) {
-        switch -- [eval [list ::xmpp::sendMessage $xlib $to] $params] {
-            -1 -
-            -2 {
-                if {$stayP} {
-                    set cmd [list ::LOG]
-                } else {
-                    set cmd [list error]
-                }
-                eval $cmd [list "error writing to socket, continuing..."]
-                return 0
-            }
-
-            default {}
-        }
-    }
-    if {!$stayP} {
-        set xsend::stayP 0
-        ::xmpp::disconnect $xlib
-    }
-
-    return 1
-}
-
-proc xsend::iqDiscoInfo {xlib from xmlElement args} {
-    ::LOG "xsend::iqDiscoInfo $from"
-
-    ::xmpp::xml::split $xmlElement tag xmlns attrs cdata subels
-
-    if {[::xmpp::xml::isAttr $attrs node]} {
-        return [list error cancel service-unavailable]
-    }
-
-    set identity [::xmpp::xml::create identity \
-                                      -attrs [list name     xsend \
-                                                   category client \
-                                                   type     bot]]
-
-    set subelements {}
-    foreach var [list http://jabber.org/protocol/disco#info \
-                      http://jabber.org/protocol/disco#items \
-                      jabber:iq:last \
-                      jabber:iq:time \
-                      jabber:iq:version] {
-        lappend subelements [::xmpp::xml::create feature \
-                                    -attrs [list var $var]]
-    }
-    set xmldata \
-        [::xmpp::xml::create query -xmlns       $xmlns \
-                                   -attrs       [list type client] \
-                                   -subelement  $identity \
-                                   -subelements $subelements]
-    return [list result $xmldata]
-}
-
-proc xsend::iqDiscoItems {xlib from xmlElement args} {
-    ::LOG "xsend::iqDiscoItems $from"
-
-    ::xmpp::xml::split $xmlElement tag xmlns attrs cdata subels
-
-    if {[::xmpp::xml::isAttr $attrs node]} {
-        return [list error cancel service-unavailable]
-    }
-
-    return [list result [::xmpp::xml::create query -xmlns $xmlns]]
-}
-
-proc xsend::iqLast {xlib from xmlElement args} {
-    variable lib
-
-    ::LOG "xsend::iqLast $from"
-
-    set now [clock seconds]
-    set xmldata \
-        [::xmpp::xml::create query -xmlns jabber:iq:last \
-                                   -attrs [list seconds \
-                                                [expr {$now -  
$lib(lastwhen)}]] \
-                                   -cdata $lib(lastwhat)]
-    return [list result $xmldata]
-}
-
-proc xsend::iqTime {xlib from xmlElement args} {
-    ::LOG "xsend::iqTime $from"
-
-    set now [clock seconds]
-    set gmtP true
-    foreach {k f} [list utc     "%Y%m%dT%T" \
-                        tz      "%Z"        \
-                        display "%a %b %d %H:%M:%S %Z %Y"] {
-        lappend tags [::xmpp::xml::create $k -cdata [clock format $now \
-                                                           -format $f  \
-                                                           -gmt    $gmtP]]
-        set gmtP false
-    }
-    set xmldata [::xmpp::xml::create query -xmlns jabber:iq:time \
-                                           -subelements $tags]
-    return [list result $xmldata]
-}
-
-proc xsend::iqVersion {xlib from xmlElement args} {
-    global argv0 tcl_platform
-
-    ::LOG "xsend::iqVersion $from"
-
-    foreach {k v} [list name    [file tail [file rootname $argv0]] \
-                        version "1.0 (Tcl [info patchlevel])"      \
-                        os      "$tcl_platform(os)  
$tcl_platform(osVersion)"] {
-        lappend tags [::xmpp::xml::create $k -cdata $v]
-    }
-    set xmldata [::xmpp::xml::create query -xmlns jabber:iq:version \
-                                           -subelements $tags]
-    return [list result $xmldata]
-}
-
-proc client:reconnect {xlib} {
-    xsend::reconnect
-}
-
-proc client:disconnect {xlib} {
-    xsend::reconnect
-}
-
-proc client:status {args} {
-    ::LOG "client:status $args"
-}
-
-
-namespace eval xsend {
-    variable stayP 1
-}
-
-proc xsend::follow {file argv} {
-    proc [namespace current]::reconnect {} \
-         [list [namespace current]::reconnect_aux $argv]
-
-    if {[catch { eval [list xsend::sendit 2] $argv } result]} {
-        ::bgerror $result
-        return
-    }
-
-    set buffer ""
-    set fd ""
-    set newP 1
-    array set st [list dev 0 ino 0 size 0]
-
-    for {set i 0} {1} {incr i} {
-        if {[expr {$i % 5}] == 0} {
-            if {[catch { file stat $file st2 } result]} {
-                ::LOG $result
-                break
-            }
-
-            if {($st(dev) != $st2(dev)) \
-                    || ($st(ino) != $st2(ino)) \
-                    || ($st(size) > $st2(size))} {
-                if {$newP} {
-                    catch { close $fd }
-                }
-
-                fconfigure [set fd [open $file { RDONLY }]] -blocking off
-                unset st
-                array set st [array get st2]
-
-                if {!$newP && [string equal $st(type) file]} {
-                    seek $fd 0 end
-                }
-
-                if {!$newP} {
-                    set newP 0
-                }
-
-                if {[string length $buffer] > 0} {
-                    if {[catch { eval [list xsend::sendit 1] $argv \
-                                      [parse $buffer] \
-                                      [list -body $buffer] } result]} {
-                        ::LOG $result
-                        break
-                    } elseif {$result} {
-                        set buffer ""
-                    }
-                }
-            }
-        }
-
-        if {[fblocked $fd]} {
-        } elseif {[catch {
-            set len [string length [set line [read $fd]]]
-            append buffer $line
-        } result]} {
-            ::LOG $result
-            break
-        } elseif {[set x [string first "\n" $buffer]] < 0} {
-        } else {
-            set body [string range $buffer 0 [expr {$x-1}]]
-            while {[catch { eval [list xsend::sendit 1] $argv [parse  
$body] \
-                                 [list -body $body] } result]} {
-                ::LOG $result
-            }
-            if {$result} {
-                set buffer [string range $buffer [expr {$x + 1}] end]
-            }
-        }
-
-        after 1000 "set alarmP 1"
-        vwait alarmP
-    }
-}
-
-proc xsend::parse {line} {
-    set args {}
-
-    if {![string equal [string index $line 15] " "]} {
-        return $args
-    }
-    catch { lappend args -time [clock scan [string range $line 0 14]] }
-
-    set line [string range $line 16 end]
-    if {([set d [string first " " $line]] > 0) \
-            && ([string first ": " $line] > $d)} {
-        lappend args -activity [string trim [string range $line $d end]]
-    }
-
-    return $args
-}
-
-proc xsend::reconnect_aux {argv} {
-    variable stayP
-
-    while {$stayP} {
-        after [expr {60*1000}]
-        if {![catch { eval [list xsend::sendit 2] $argv } result]} {
-            break
-        }
-
-        ::LOG $result
-    }
-}
-
-proc xsend::parse_xhtml {text} {
-    return [::xmpp::xml::parseData "<body>$text</body>"]
-}
-
-proc ::LOG {text} {
-#    puts stderr $text
-}
-
-proc ::debugmsg {args} {
-#    ::LOG "debugmsg: $args"
-}
-
-proc ::bgerror {err} {
-    global errorInfo
-
-    ::LOG "$err\n$errorInfo"
-}
-
-
-set status 1
-
-array set xsend::lib [list lastwhen [clock seconds] lastwhat ""]
-
-if {[string equal [file tail [lindex $argv 0]] "xsend.tcl"]} {
-    incr argc -1
-    set argv [lrange $argv 1 end]
-}
-
-if {(([set x [lsearch -exact $argv -help]] >= 0) \
-            || ([set x [lsearch -exact $argv --help]] >= 0)) \
-        && (($x == 0) || ([expr {$x % 2}]))} {
-    puts stdout \
-"usage: xsend.tcl recipient ?options...?
-            -follow      file
-            -pidfile     file
-            -from        jid
-            -host        hostname
-            -port        number
-            -password    string
-            -type        string (e.g., 'chat')
-            -subject     string
-            -body        string
-            -xhtml       string
-            -description string
-            -url         string
-            -tls         boolean (e.g., 'false')
-            -starttls    boolean (e.g., 'true')
-            -sasl        boolean (e.g., 'true')
-
-If recipient is '-', roster is used.
-
-If both '-body' and '-follow' are absent, the standard input is used.
-
-The file .xsendrc.tcl in the current or in home directory is consulted,
-e.g.,
-
-    set args {-from fred at example.com/bedrock -password wilma}
-
-for default values."
-
-    set status 0
-} elseif {($argc < 1) || (![expr {$argc % 2}])} {
-    puts stderr "usage: xsend.tcl recipent ?-key value?..."
-} elseif {[catch {
-    if {([file exists [set file .xsendrc.tcl]]) \
-            || ([file exists [set file ~/.xsendrc.tcl]])} {
-        set args {}
-
-        source $file
-
-        array set at [list -permissions 600]
-        array set at [file attributes $file]
-
-        if {[set x [lsearch -exact $args "-password"]] >= 0 \
-                    && ![expr {$x % 2}] \
-                    && ![string match *00 $at(-permissions)]} {
-            error "file should be mode 0600"
-        }
-
-        if {[llength $args] > 0} {
-            set argv [eval [list linsert $argv 1] $args]
-        }
-    }
-} result]} {
-    puts stderr "error in $file: $result"
-} elseif {[set x [lsearch -exact $argv "-follow"]] > 0 && [expr {$x % 2}]}  
{
-    set keep_alive 1
-    set keep_alive_interval 3
-
-    if {[set y [lsearch -exact $argv "-pidfile"]] > 0 && [expr {$y % 2}]} {
-        set fd [open [set pf [lindex $argv [expr {$y + 1}]]] \
-                     {WRONLY CREAT TRUNC}]
-        puts $fd [pid]
-        close $fd
-    }
-
-    xsend::follow [lindex $argv [expr {$x + 1}]] $argv
-
-    catch { file delete -- $pf }
-} elseif {[catch { eval [list xsend::sendit 0] $argv } result]} {
-    puts stderr $result
-} else {
-    set status 0
-}
-
-exit $status
-
-# vim:ft=tcl:ts=8:sw=4:sts=4:et
=======================================
--- /trunk/ChangeLog	Mon Aug 17 06:10:10 2009
+++ /trunk/ChangeLog	Sun Oct  4 04:31:25 2009
@@ -1,3 +1,12 @@
+2009-10-04  Sergei Golovan  <sgolovan at nes.ru>
+
+	* examples/jsend.tcl: Restored historical name and added -date option
+	  to include delay subelement with a given date.
+
+	* examples/rssbot.tcl: Adapted RSS bot from tkabber examples/tools to
+	  TclXMPP. Also, added thorough dates parsers taken from Tclers' wiki
+	  (http://wiki.tcl.tk/13094 and http://wiki.tcl.tk/24074).
+
  2009-08-17  Sergei Golovan  <sgolovan at nes.ru>

  	* auth.tcl, component.tcl, compress.tcl, sasl.tcl, starttls.tcl: Added


More information about the Tkabber-dev mailing list