C:\Users\kgreen\Documents\_Ixia\NTAF_prod\Q3-2010 demo\tclxmpp_ntaf\xmpp\xmpp.tcl C:\Users\kgreen\Documents\_Ixia\NTAF_prod\Q3-2010 demo\tclxmpp-read-only\xmpp\xmpp.tcl
# xmpp.tcl -- # xmpp.tcl --
# #
#       This file is part of the XMPP library. It implements the main library #       This file is part of the XMPP library. It implements the main library
#       routines. #       routines.
# #
# Copyright (c) 2008-2010 Sergei Golovan <sgolovan@nes.ru> # Copyright (c) 2008-2010 Sergei Golovan <sgolovan@nes.ru>
# #
# See the file "license.terms" for information on usage and redistribution # See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAMER OF ALL WARRANTIES. # of this file, and for a DISCLAMER OF ALL WARRANTIES.
# #
# $Id: xmpp.tcl 142 2010-01-29 15:14:25Z sgolovan $ # $Id: xmpp.tcl 142 2010-01-29 15:14:25Z sgolovan $
   
#    
# KG 13-Aug-2010: Added hooks for XML stanza trace callback -xmltracecommand    
# KG 20-Sep-2010: Added missing proc ::xmpp::status    
#    
package require msgcat package require msgcat
package require xmpp::jid package require xmpp::jid
package require xmpp::xml package require xmpp::xml
package require xmpp::transport::tcp package require xmpp::transport::tcp
package require xmpp::streamerror package require xmpp::streamerror
package require xmpp::stanzaerror package require xmpp::stanzaerror
package require xmpp::iq package require xmpp::iq
package require xmpp::presence package require xmpp::presence
   
package provide xmpp 0.1 package provide xmpp 0.1
   
namespace eval ::xmpp { namespace eval ::xmpp {
   
   # Default debug level (0: no debug, 1: light debug, 2: heavy debug).    # Default debug level (0: no debug, 1: light debug, 2: heavy debug).
   
   variable debug           0    variable debug 0
} }
   
# ::xmpp::new -- # ::xmpp::new --
# #
#       Create a new XMPP token and assigns client callbacks for XMPP events. #       Create a new XMPP token and assigns client callbacks for XMPP events.
# #
# Arguments: # Arguments:
#       token                   (optional, if missing then token is created #       token                   (optional, if missing then token is created
#                               automatically, if present then it must be a #                               automatically, if present then it must be a
#                               fully namespaced nonexistent variable) XMPP #                               fully namespaced nonexistent variable) XMPP
#                               token to create. #                               token to create.
#       -packetcommand     cmd  (optional) Command to call on every incoming #       -packetcommand     cmd  (optional) Command to call on every incoming
#                               XMPP packet except stream errors. #                               XMPP packet except stream errors.
#       -messagecommand    cmd  (optional) Command to call on every XMPP #       -messagecommand    cmd  (optional) Command to call on every XMPP
#                               message packet (overrides -packetCommand). #                               message packet (overrides -packetCommand).
#       -presencecommand   cmd  (optional) Command to call on every XMPP #       -presencecommand   cmd  (optional) Command to call on every XMPP
#                               presence packet (overrides -packetCommand). #                               presence packet (overrides -packetCommand).
#       -disconnectcommand cmd  (optional) Command to call on forced disconnect #       -disconnectcommand cmd  (optional) Command to call on forced disconnect
#                               from XMPP server. #                               from XMPP server.
#       -statuscommand     cmd  (optional) Command to call when XMPP connection #       -statuscommand     cmd  (optional) Command to call when XMPP connection
#                               status is changed (e.g. after successful #                               status is changed (e.g. after successful
#                               authentication). #                               authentication).
#       -errorcommand      cmd  (optional) Command to call on XMPP stream error #       -errorcommand      cmd  (optional) Command to call on XMPP stream error
#                               packet. #                               packet.
#       -xmltracecommand   cmd  (optional) Command to call for each Tx or Rx XML stanza    
# #
# Result: # Result:
#       XMPP token name or error if the supplied variable exists or illegal #       XMPP token name or error if the supplied variable exists or illegal
#       option is listed. #       option is listed.
# #
# Side effects: # Side effects:
#       A new variable is created. #       A new variable is created.
   
proc ::xmpp::new {args} { proc ::xmpp::new {args} {
   variable id    variable id
   
   if {![info exists id]} {    if {![info exists id]} {
       set id 0        set id 0
   }    }
   
   if {[llength $args] > 0 && ![string match -* [lindex $args 0]]} {    if {[llength $args] > 0 && ![string match -* [lindex $args 0]]} {
       set xlib [lindex $args 0]        set xlib [lindex $args 0]
       set args [lrange $args 1 end]        set args [lrange $args 1 end]
   
       if {[info exists $xlib]} {        if {[info exists $xlib]} {
           return -code error \            return -code error \
                  [::msgcat::mc "An existing variable \"%s\" cannot be used\                   [::msgcat::mc "An existing variable \"%s\" cannot be used\
                                 as an XMPP token" $xlib]                                  as an XMPP token" $xlib]
       }        }
   } else {    } else {
       set xlib [namespace current]::[incr id]        set xlib [namespace current]::[incr id]
   
       # Variable id always grows but user may occupy some values        # Variable id always grows but user may occupy some values
   
       while {[info exists $xlib]} {        while {[info exists $xlib]} {
           set xlib [namespace current]::[incr id]            set xlib [namespace current]::[incr id]
       }        }
   }    }
   
   foreach {key val} $args {    foreach {key val} $args {
       switch -- $key {        switch -- $key {
           -packetcommand -            -packetcommand -
           -messagecommand -            -messagecommand -
           -presencecommand -            -presencecommand -
           -iqcommand -            -iqcommand -
           -disconnectcommand -            -disconnectcommand -
           -statuscommand -            -statuscommand -
           -errorcommand -            -errorcommand -
           -logcommand -             -logcommand { 
           -xmltracecommand {    
               set attrs($key) $val                set attrs($key) $val
           }            }
           default {            default {
               return -code error [::msgcat::mc "Illegal option \"%s\"" $key]                return -code error [::msgcat::mc "Illegal option \"%s\"" $key]
           }            }
       }        }
   }    }
   
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   array unset state    array unset state
   set state(status) disconnected    set state(status) disconnected
   
   # A sequence of IQ ids    # A sequence of IQ ids
   set state(id) 0    set state(id) 0
   
   array set state [array get attrs]    array set state [array get attrs]
   
   if {[info exists state(-messagecommand)]} {    if {[info exists state(-messagecommand)]} {
       RegisterElement $xlib message * \        RegisterElement $xlib message * \
                       [namespace code [list ParseMessage $xlib]]                        [namespace code [list ParseMessage $xlib]]
   }    }
   if {[info exists state(-presencecommand)]} {    if {[info exists state(-presencecommand)]} {
       RegisterElement $xlib presence * \        RegisterElement $xlib presence * \
                       [namespace code [list ParsePresence $xlib]]                        [namespace code [list ParsePresence $xlib]]
   }    }
   if {![info exists state(-packetcommand)] || \    if {![info exists state(-packetcommand)] || \
                                   [info exists state(-iqcommand)]} {                                    [info exists state(-iqcommand)]} {
       RegisterElement $xlib iq * \        RegisterElement $xlib iq * \
                       [namespace code [list ParseIQ $xlib]]                        [namespace code [list ParseIQ $xlib]]
   }    }
   
   RegisterElement $xlib error http://etherx.jabber.org/streams \    RegisterElement $xlib error http://etherx.jabber.org/streams \
                   [namespace code [list ParseStreamError $xlib]]                    [namespace code [list ParseStreamError $xlib]]
   RegisterElement $xlib features http://etherx.jabber.org/streams \    RegisterElement $xlib features http://etherx.jabber.org/streams \
                   [namespace code [list ParseStreamFeatures $xlib]]                    [namespace code [list ParseStreamFeatures $xlib]]
   
   Debug $xlib 2 ""     Debug $xlib 2 "" 
   
   return $xlib    return $xlib
} }
   
# ::xmpp::free -- # ::xmpp::free --
# #
#       Destroy an existing XMPP token. #       Destroy an existing XMPP token.
# #
# Arguments: # Arguments:
#       xlib            XMPP token to destroy. #       xlib            XMPP token to destroy.
# #
# Result: # Result:
#       Empty string or error if the token is still connected. #       Empty string or error if the token is still connected.
# #
# Side effects: # Side effects:
#       The variable which contains token state is destroyed. #       The variable which contains token state is destroyed.
   
proc ::xmpp::free {xlib} { proc ::xmpp::free {xlib} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 ""     Debug $xlib 2 "" 
   
   if {![status $xlib disconnected]} {    if {![status $xlib disconnected]} {
       return -code error [::msgcat::mc "Free without disconnect"]        return -code error [::msgcat::mc "Free without disconnect"]
   }    }
   
   if {[info exists state(-messagecommand)]} {    if {[info exists state(-messagecommand)]} {
       UnregisterElement $xlib message *        UnregisterElement $xlib message *
   }    }
   if {[info exists state(-presencecommand)]} {    if {[info exists state(-presencecommand)]} {
       UnregisterElement $xlib presence *        UnregisterElement $xlib presence *
   }    }
   if {![info exists state(-packetcommand)]} {    if {![info exists state(-packetcommand)]} {
       UnregisterElement $xlib iq *        UnregisterElement $xlib iq *
   }    }
   
   UnregisterElement $xlib error    http://etherx.jabber.org/streams    UnregisterElement $xlib error    http://etherx.jabber.org/streams
   UnregisterElement $xlib features http://etherx.jabber.org/streams    UnregisterElement $xlib features http://etherx.jabber.org/streams
   
   unset state    unset state
   return    return
} }
   
# ::xmpp::connect -- # ::xmpp::connect --
# #
#       Connect to XMPP server. #       Connect to XMPP server.
# #
# Arguments: # Arguments:
#       xlib                    XMPP token. #       xlib                    XMPP token.
#       host                    (optional, defaults to "localhost") Server name #       host                    (optional, defaults to "localhost") Server name
#                               to connect. It isn't used when transport is #                               to connect. It isn't used when transport is
#                               "poll". #                               "poll".
#       port                    (optional, defaults to 5222) Port to connect. #       port                    (optional, defaults to 5222) Port to connect.
#                               It isn't used for "poll" transport. #                               It isn't used for "poll" transport.
#       -transport transport    (optional, defaults to "tcp") Transport to use #       -transport transport    (optional, defaults to "tcp") Transport to use
#                               when connecting to an XMPP server. May be one #                               when connecting to an XMPP server. May be one
#                               of "tcp", "tls", "poll", "zlib" (though none of #                               of "tcp", "tls", "poll", "zlib" (though none of
#                               the servers support zlib compressed sockets #                               the servers support zlib compressed sockets
#                               without prior negotiating). #                               without prior negotiating).
#       -command cmd            (optional) If present then the connection #       -command cmd            (optional) If present then the connection
#                               becomes asynchronous and the command is called #                               becomes asynchronous and the command is called
#                               upon connection success or failure. Otherwise #                               upon connection success or failure. Otherwise
#                               the connection is in synchronous mode. #                               the connection is in synchronous mode.
#       Other arguments are passed unchanged to corresponding transport open #       Other arguments are passed unchanged to corresponding transport open
#       routine. #       routine.
# #
# Result: # Result:
#       Empty string on success or error on failure in synchronous mode. #       Empty string on success or error on failure in synchronous mode.
#       Connection token to make it possible to abort connection in #       Connection token to make it possible to abort connection in
#       asynchronous mode. #       asynchronous mode.
# #
# Side effects: # Side effects:
#       A new connection to an XMPP server is started (or is opened). In #       A new connection to an XMPP server is started (or is opened). In
#       synchronous mode connection status is set to "connected". In #       synchronous mode connection status is set to "connected". In
#       asynchronous mode an abort command is stored to be called if a user #       asynchronous mode an abort command is stored to be called if a user
#       will decide to abort connection procedure. #       will decide to abort connection procedure.
   
proc ::xmpp::connect {xlib args} { proc ::xmpp::connect {xlib args} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   if {![string equal $state(status) disconnected]} {    if {![string equal $state(status) disconnected]} {
       # TODO: Should we use ForcedDisconnect or call back?        # TODO: Should we use ForcedDisconnect or call back?
       disconnect $xlib        disconnect $xlib
   }    }
   
   set transport tcp    set transport tcp
   set host      localhost    set host      localhost
   set port      5222    set port      5222
   set argList   {}    set argList   {}
   
   if {![string match -* [lindex $args 0]]} {    if {![string match -* [lindex $args 0]]} {
       set host [lindex $args 0]        set host [lindex $args 0]
       set args [lrange $args 1 end]        set args [lrange $args 1 end]
   }    }
   
   if {![string match -* [lindex $args 0]]} {    if {![string match -* [lindex $args 0]]} {
       set port [lindex $args 0]        set port [lindex $args 0]
       set args [lrange $args 1 end]        set args [lrange $args 1 end]
   }    }
   
   foreach {key val} $args {    foreach {key val} $args {
       switch -- $key {        switch -- $key {
           -transport {set transport $val}            -transport {set transport $val}
           -command   {set cmd       $val}            -command   {set cmd       $val}
           default    {lappend argList $key $val}            default    {lappend argList $key $val}
       }        }
   }    }
   
   Debug $xlib 2 "$host $port $transport"     Debug $xlib 2 "$host $port $transport" 
   
   if {![info exists cmd]} {    if {![info exists cmd]} {
       # TODO: Allow abortions in synchronous mode too.        # TODO: Allow abortions in synchronous mode too.
   
       # Propagate error (if any) up.        # Propagate error (if any) up.
       set state(transport) \        set state(transport) \
           [eval [list transport::open $transport $host $port \            [eval [list transport::open $transport $host $port \
                       -streamheadercommand \                        -streamheadercommand \
                               [namespace code [list GotStream $xlib ok]] \                                [namespace code [list GotStream $xlib ok]] \
                       -streamtrailercommand \                        -streamtrailercommand \
                               [namespace code [list EndOfParse $xlib]] \                                [namespace code [list EndOfParse $xlib]] \
                       -stanzacommand \                        -stanzacommand \
                               [namespace code [list Parse $xlib]] \                                [namespace code [list Parse $xlib]] \
                       -eofcommand \                        -eofcommand \
                               [namespace code [list EndOfFile $xlib]]] \                                [namespace code [list EndOfFile $xlib]]] \
                       $argList]                        $argList]
   
       set state(status) connected        set state(status) connected
       return        return
   } else {    } else {
       set token \        set token \
           [eval [list transport::open $transport $host $port \            [eval [list transport::open $transport $host $port \
                       -streamheadercommand \                        -streamheadercommand \
                               [namespace code [list GotStream $xlib ok]] \                                [namespace code [list GotStream $xlib ok]] \
                       -streamtrailercommand \                        -streamtrailercommand \
                               [namespace code [list EndOfParse $xlib]] \                                [namespace code [list EndOfParse $xlib]] \
                       -stanzacommand \                        -stanzacommand \
                               [namespace code [list Parse $xlib]] \                                [namespace code [list Parse $xlib]] \
                       -eofcommand \                        -eofcommand \
                               [namespace code [list EndOfFile $xlib]] \                                [namespace code [list EndOfFile $xlib]] \
                       -command \                        -command \
                               [namespace code [list ConnectAux $xlib $cmd]]] \                                [namespace code [list ConnectAux $xlib $cmd]]] \
                       $argList]                        $argList]
   
       set state(abortCommand) \        set state(abortCommand) \
           [namespace code [list transport::use $token abort]]            [namespace code [list transport::use $token abort]]
       return $token        return $token
   }    }
} }
   
# ::xmpp::ConnectAux -- # ::xmpp::ConnectAux --
# #
#       A helper procedure which calls back with connection to XMPP server #       A helper procedure which calls back with connection to XMPP server
#       result. #       result.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       cmd             Callback to call. #       cmd             Callback to call.
#       status          "ok", "error", "abort", or "timeout". #       status          "ok", "error", "abort", or "timeout".
#       msg             Transport token in case of success or error message in #       msg             Transport token in case of success or error message in
#                       case of failure. #                       case of failure.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       A callback is called and a stored abort command is emptied (it is no #       A callback is called and a stored abort command is emptied (it is no
#       longer needed as the connect procedure is finished). #       longer needed as the connect procedure is finished).
   
proc ::xmpp::ConnectAux {xlib cmd status msg} { proc ::xmpp::ConnectAux {xlib cmd status msg} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   catch {unset state(abortCommand)}    catch {unset state(abortCommand)}
   
   if {[string equal $status ok]} {    if {[string equal $status ok]} {
       set state(transport) $msg        set state(transport) $msg
       set state(status) connected        set state(status) connected
       uplevel #0 $cmd [list ok ""]        uplevel #0 $cmd [list ok ""]
   } else {    } else {
       uplevel #0 $cmd [list $status $msg]        uplevel #0 $cmd [list $status $msg]
   }    }
   return    return
} }
   
# ::xmpp::openStream -- # ::xmpp::openStream --
# #
#       Open XMPP stream over the already opened connection. #       Open XMPP stream over the already opened connection.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       server          XMPP server to which the stream is opened. #       server          XMPP server to which the stream is opened.
#       -xmlns:stream ns (optional, defaults to #       -xmlns:stream ns (optional, defaults to
#                       http://etherx.jabber.org/streams, if present must be #                       http://etherx.jabber.org/streams, if present must be
#                       http://etherx.jabber.org/streams). XMLNS for stream #                       http://etherx.jabber.org/streams). XMLNS for stream
#                       prefix. #                       prefix.
#       -xmlns xmlns    (optional, defaults to jabber:client) Stream default #       -xmlns xmlns    (optional, defaults to jabber:client) Stream default
#                       XMLNS. #                       XMLNS.
#       -xml:lang lang  (optional, defaults to language from msgcat #       -xml:lang lang  (optional, defaults to language from msgcat
#                       preferences) Stream default xml:lang attribute. #                       preferences) Stream default xml:lang attribute.
#       -version ver    (optional) Stream XMPP version. Must be "1.0" if any #       -version ver    (optional) Stream XMPP version. Must be "1.0" if any
#                       XMPP feature is used (SASL, STARTTLS, stream #                       XMPP feature is used (SASL, STARTTLS, stream
#                       compression). #                       compression).
#       -timeout num    (optional, defaults to 0 which means infinity) Timeout #       -timeout num    (optional, defaults to 0 which means infinity) Timeout
#                       after which the operation is finished with failure. #                       after which the operation is finished with failure.
#       -command cmd    (optional) If present then the stream opens in #       -command cmd    (optional) If present then the stream opens in
#                       asynchronous mode and the command "cmd" is called upon #                       asynchronous mode and the command "cmd" is called upon
#                       success or failure. Otherwise the mode is synchronous. #                       success or failure. Otherwise the mode is synchronous.
# #
# Result: # Result:
#       The same as in [OpenStreamAux]. #       The same as in [OpenStreamAux].
# #
# Side effects: # Side effects:
#       The same as in [OpenStreamAux]. Also, server state variable is set. #       The same as in [OpenStreamAux]. Also, server state variable is set.
   
proc ::xmpp::openStream {xlib server args} { proc ::xmpp::openStream {xlib server args} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$server $args"     Debug $xlib 2 "$server $args" 
   
   set state(server) $server    set state(server) $server
   
   eval [list OpenStreamAux $xlib] $args    eval [list OpenStreamAux $xlib] $args
} }
   
# ::xmpp::ReopenStream -- # ::xmpp::ReopenStream --
# #
#       Reset underlying XML parser and reopen XMPP stream. This procedure #       Reset underlying XML parser and reopen XMPP stream. This procedure
#       is useful when changing transport (from tcp to tls or zlib) and #       is useful when changing transport (from tcp to tls or zlib) and
#       when resetting stream after SASL authentication. It's never called #       when resetting stream after SASL authentication. It's never called
#       by user directly. #       by user directly.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       args            Additional arguments to pass to OpenStreamAux. They are #       args            Additional arguments to pass to OpenStreamAux. They are
#                       the same as for [openStream]. But usually the only #                       the same as for [openStream]. But usually the only
#                       useful options are -command and -timeout. #                       useful options are -command and -timeout.
# #
# Result: # Result:
#       The same as in [OpenStreamAux]. #       The same as in [OpenStreamAux].
# #
# Side effects: # Side effects:
#       In addition to [OpenStreamAux] side effects, an XML parser in transport #       In addition to [OpenStreamAux] side effects, an XML parser in transport
#       is reset. #       is reset.
   
proc ::xmpp::ReopenStream {xlib args} { proc ::xmpp::ReopenStream {xlib args} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$args"     Debug $xlib 2 "$args" 
   
   transport::use $state(transport) reset    transport::use $state(transport) reset
   
   # Unset features variable to remove possible trace.    # Unset features variable to remove possible trace.
   array unset state features    array unset state features
   
   if {[info exists state(-version)]} {    if {[info exists state(-version)]} {
       set vargs [list -version $state(-version)]        set vargs [list -version $state(-version)]
   } else {    } else {
       set vargs {}        set vargs {}
   }    }
   
   eval [list OpenStreamAux $xlib \    eval [list OpenStreamAux $xlib \
                            -xmlns:stream $state(-xmlns:stream) \                             -xmlns:stream $state(-xmlns:stream) \
                            -xmlns $state(-xmlns) \                             -xmlns $state(-xmlns) \
                            -xml:lang $state(-xml:lang)] $vargs $args                             -xml:lang $state(-xml:lang)] $vargs $args
} }
   
# ::xmpp::OpenStreamAux -- # ::xmpp::OpenStreamAux --
# #
#       A helper procedure which contains common code for opening and #       A helper procedure which contains common code for opening and
#       reopening XMPP streams. #       reopening XMPP streams.
# #
# Arguments: # Arguments:
#       The same as for openStream (except server which is taken from state #       The same as for openStream (except server which is taken from state
#       variable). #       variable).
# #
# Result: # Result:
#       Empty string in asynchronous mode, session id or error in synchronous #       Empty string in asynchronous mode, session id or error in synchronous
#       mode. #       mode.
# #
# Side effects: # Side effects:
#       Stream header is sent to an open channel. An abort command is stored #       Stream header is sent to an open channel. An abort command is stored
#       to be called if a user will decide to abort stream opening procedure. #       to be called if a user will decide to abort stream opening procedure.
# #
# Bugs: # Bugs:
#       Only stream XMLNS http://etherx.jabber.org/streams is supported. #       Only stream XMLNS http://etherx.jabber.org/streams is supported.
#       On the other hand there's no other defined stream XMLNS currently. #       On the other hand there's no other defined stream XMLNS currently.
   
proc ::xmpp::OpenStreamAux {xlib args} { proc ::xmpp::OpenStreamAux {xlib args} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   array set params [list -xmlns:stream http://etherx.jabber.org/streams \    array set params [list -xmlns:stream http://etherx.jabber.org/streams \
                          -xmlns jabber:client \                           -xmlns jabber:client \
                          -xml:lang [xml::lang]]                           -xml:lang [xml::lang]]
   
   array set state [array get params]    array set state [array get params]
   
   set timeout 0    set timeout 0
   foreach {key val} $args {    foreach {key val} $args {
       switch -- $key {        switch -- $key {
           -xmlns:stream {            -xmlns:stream {
               if {![string equal $val http://etherx.jabber.org/streams]} {                if {![string equal $val http://etherx.jabber.org/streams]} {
                   return -code error \                    return -code error \
                          [::msgcat::mc "Unsupported stream XMLNS \"%s\"" \                           [::msgcat::mc "Unsupported stream XMLNS \"%s\"" \
                                        $val]                                         $val]
               }                }
           }            }
           -xmlns -            -xmlns -
           -xml:lang -            -xml:lang -
           -version {            -version {
               set state($key) $val                set state($key) $val
               set params($key) $val                set params($key) $val
           }            }
           -timeout {            -timeout {
               set timeout $val                set timeout $val
           }            }
           -command {            -command {
               set state(openStreamCommand) $val                set state(openStreamCommand) $val
           }            }
           default  {            default  {
               return -code error [::msgcat::mc "Illegal option \"%s\"" $key]                return -code error [::msgcat::mc "Illegal option \"%s\"" $key]
           }            }
       }        }
   }    }
   
   if {$timeout > 0} {    if {$timeout > 0} {
       set state(streamAfterId) \        set state(streamAfterId) \
           [after $timeout [namespace code [list GotStream $xlib timeout {}]]]            [after $timeout [namespace code [list GotStream $xlib timeout {}]]]
   }    }
   
   # Stream may be reopened inside STARTTLS, or compression, or SASL    # Stream may be reopened inside STARTTLS, or compression, or SASL
   # procedure, so set abort command only if it isn't defined already.    # procedure, so set abort command only if it isn't defined already.
   
   if {![info exists state(abortCommand)]} {    if {![info exists state(abortCommand)]} {
       set state(abortCommand) \        set state(abortCommand) \
           [namespace code [list GotStream $xlib abort {}]]            [namespace code [list GotStream $xlib abort {}]]
   }    }
   
   eval [list transport::use $state(transport) openStream $state(server)] \    eval [list transport::use $state(transport) openStream $state(server)] \
        [array get params]         [array get params]
   
   if {[info exists state(openStreamCommand)]} {    if {[info exists state(openStreamCommand)]} {
       # Asynchronous mode        # Asynchronous mode
       return ""         return "" 
   } else {    } else {
       # Synchronous mode        # Synchronous mode
       vwait $xlib\(openStatus)        vwait $xlib\(openStatus)
   
       if {![string equal $state(openStatus) timeout]} {        if {![string equal $state(openStatus) timeout]} {
           return $state(sessionID)            return $state(sessionID)
       } else {        } else {
           return -code error $state(sessionID)            return -code error $state(sessionID)
       }        }
   }    }
} }
   
# ::xmpp::GotStream -- # ::xmpp::GotStream --
# #
#       A helper procedure which is invoked when an incoming XMPP stream #       A helper procedure which is invoked when an incoming XMPP stream
#       header is parsed by a transport. It finishes headers exchange. #       header is parsed by a transport. It finishes headers exchange.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       status          "ok", "abort", or "timeout". #       status          "ok", "abort", or "timeout".
#       attrs           List of XMPP stream attributes. #       attrs           List of XMPP stream attributes.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       A callback is called in asynchronous mode or [vwait] is triggered #       A callback is called in asynchronous mode or [vwait] is triggered
#       in synchronous mode. Also, a stored abort command is emptied (it is no #       in synchronous mode. Also, a stored abort command is emptied (it is no
#       longer needed as the connect procedure is finished). #       longer needed as the connect procedure is finished).
   
proc ::xmpp::GotStream {xlib status attrs} { proc ::xmpp::GotStream {xlib status attrs} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   if {![info exists state(abortCommand)]} {    if {![info exists state(abortCommand)]} {
       # state(abortCommand) must exist, otherwise it's a stale stream        # state(abortCommand) must exist, otherwise it's a stale stream
       Debug $xlib 2 "Stale stream: $status $attrs"         Debug $xlib 2 "Stale stream: $status $attrs" 
       return        return
   }    }
   
   Debug $xlib 2 "$status $attrs"     Debug $xlib 2 "$status $attrs" 
   if {[string equal $status ok]} {    if {[string equal $status ok]} {
       set msg "<stream:stream "         set msg "<stream:stream " 
       foreach {attr val} $attrs {        foreach {attr val} $attrs {
           append msg " $attr='[xml::Escape $val]'"             append msg " $attr='[xml::Escape $val]'" 
       }        }
       append msg ">"         append msg ">" 
       CallBack $xlib log input text $msg        CallBack $xlib log input text $msg
   }    }
   
   if {[info exists state(openStreamCommand)]} {    if {[info exists state(openStreamCommand)]} {
       set cmd $state(openStreamCommand)        set cmd $state(openStreamCommand)
       unset state(openStreamCommand)        unset state(openStreamCommand)
   }    }
   
   if {[info exists state(streamAfterId)]} {    if {[info exists state(streamAfterId)]} {
       after cancel $state(streamAfterId)        after cancel $state(streamAfterId)
       unset state(streamAfterId)        unset state(streamAfterId)
   }    }
   
   # Stream may be reopened inside STARTTLS, or compression, or SASL    # Stream may be reopened inside STARTTLS, or compression, or SASL
   # procedure, so unset abort command only if it was set in [openStream]    # procedure, so unset abort command only if it was set in [openStream]
   
   if {[string equal $state(abortCommand) \    if {[string equal $state(abortCommand) \
                     [namespace code [list GotStream $xlib abort {}]]]} {                      [namespace code [list GotStream $xlib abort {}]]]} {
       catch {unset state(abortCommand)}        catch {unset state(abortCommand)}
   }    }
   
   switch -- $status {    switch -- $status {
       timeout {        timeout {
           set state(sessionID) [::msgcat::mc "Opening stream timed out"]            set state(sessionID) [::msgcat::mc "Opening stream timed out"]
   
           # Trigger vwait in [openStream] in synchronous mode            # Trigger vwait in [openStream] in synchronous mode
           set state(openStatus) $status            set state(openStatus) $status
   
           if {[info exists cmd]} {            if {[info exists cmd]} {
               # Invoke callback in asynchronous mode                # Invoke callback in asynchronous mode
               uplevel #0 $cmd [list $status $state(sessionID)]                uplevel #0 $cmd [list $status $state(sessionID)]
           }            }
           return            return
       }        }
       abort {        abort {
           set state(sessionID) [::msgcat::mc "Opening stream aborted"]            set state(sessionID) [::msgcat::mc "Opening stream aborted"]
   
           # Trigger vwait in [openStream] in synchronous mode            # Trigger vwait in [openStream] in synchronous mode
           set state(openStatus) $status            set state(openStatus) $status
   
           if {[info exists cmd]} {            if {[info exists cmd]} {
               # Invoke callback in asynchronous mode                # Invoke callback in asynchronous mode
               uplevel #0 $cmd [list $status $state(sessionID)]                uplevel #0 $cmd [list $status $state(sessionID)]
           }            }
           return            return
       }        }
   }    }
   
   if {[xml::isAttr $attrs from]} {    if {[xml::isAttr $attrs from]} {
       # Sometimes server (ejabberd is known to) returns 'from'        # Sometimes server (ejabberd is known to) returns 'from'
       # attribute which differs from 'to' attribute sent to the server.        # attribute which differs from 'to' attribute sent to the server.
       # If XMLNS is 'jabber:component:accept' then the address in 'from'        # If XMLNS is 'jabber:component:accept' then the address in 'from'
       # attribute is ignored.        # attribute is ignored.
   
       if {![string equal $state(-xmlns) jabber:component:accept]} {        if {![string equal $state(-xmlns) jabber:component:accept]} {
           set state(server) [xml::getAttr $attrs from]            set state(server) [xml::getAttr $attrs from]
       }        }
   }    }
   
   set version [xml::getAttr $attrs version]    set version [xml::getAttr $attrs version]
   if {![string is double -strict $version]} {    if {![string is double -strict $version]} {
       set version 0.0        set version 0.0
   }    }
   
   set sessionID [xml::getAttr $attrs id]    set sessionID [xml::getAttr $attrs id]
   
   Debug $xlib 2 "server = $state(server), sessionID = $sessionID,\    Debug $xlib 2 "server = $state(server), sessionID = $sessionID,\
                  version = $version"                    version = $version" 
   
   if {$version < 1.0} {    if {$version < 1.0} {
       # Register iq-auth and iq-register namespaces to allow        # Register iq-auth and iq-register namespaces to allow
       # authenticate and register in-band on pre-XMPP server        # authenticate and register in-band on pre-XMPP server
       ParseStreamFeatures $xlib \        ParseStreamFeatures $xlib \
           [xml::create features \            [xml::create features \
                 -xmlns http://etherx.jabber.org/streams \                  -xmlns http://etherx.jabber.org/streams \
                 -subelement \                  -subelement \
                     [xml::create auth \                      [xml::create auth \
                           -xmlns http://jabber.org/features/iq-auth] \                            -xmlns http://jabber.org/features/iq-auth] \
                 -subelement \                  -subelement \
                     [xml::create register \                      [xml::create register \
                           -xmlns http://jabber.org/features/iq-register]]                            -xmlns http://jabber.org/features/iq-register]]
   }    }
   
   set state(status) streamOpened    set state(status) streamOpened
   
   set state(sessionID) $sessionID    set state(sessionID) $sessionID
   # Trigger vwait in [openStream] in synchronous mode    # Trigger vwait in [openStream] in synchronous mode
   set state(openStatus) $status    set state(openStatus) $status
   
   if {[info exists cmd]} {    if {[info exists cmd]} {
       # Invoke callback in asynchronous mode        # Invoke callback in asynchronous mode
       uplevel #0 $cmd [list $status $sessionID]        uplevel #0 $cmd [list $status $sessionID]
   }    }
   return    return
} }
   
# ::xmpp::ParseStreamFeatures -- # ::xmpp::ParseStreamFeatures --
# #
#       A helper procedure which is called when stream features are received. #       A helper procedure which is called when stream features are received.
#       It stores features list (as a list of XML elements, because it may be #       It stores features list (as a list of XML elements, because it may be
#       a deep list) in a variable. This procedure is registered as a handler #       a deep list) in a variable. This procedure is registered as a handler
#       for features element in http://etherx.jabber.org/streams XMLNS in #       for features element in http://etherx.jabber.org/streams XMLNS in
#       [new]. #       [new].
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       xmlElement      Features XML element to store. #       xmlElement      Features XML element to store.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       Features list is stored in a state variable. #       Features list is stored in a state variable.
   
proc ::xmpp::ParseStreamFeatures {xlib xmlElement} { proc ::xmpp::ParseStreamFeatures {xlib xmlElement} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$xmlElement"     Debug $xlib 2 "$xmlElement" 
   
   xml::split $xmlElement tag xmlns attrs cdata subels    xml::split $xmlElement tag xmlns attrs cdata subels
   
   set state(features) $subels    set state(features) $subels
   return    return
} }
   
# ::xmpp::TraceStreamFeatures -- # ::xmpp::TraceStreamFeatures --
# #
#       Call the specified command back if stream features are already #       Call the specified command back if stream features are already
#       received, or set a trace to call the command upon receiving them. #       received, or set a trace to call the command upon receiving them.
#       Trace syntax is old-style to make it work in Tcl 8.3. #       Trace syntax is old-style to make it work in Tcl 8.3.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       cmd             Command to call. #       cmd             Command to call.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       If stream features aren't received yet then a trace is added for #       If stream features aren't received yet then a trace is added for
#       variable state(features). #       variable state(features).
   
proc ::xmpp::TraceStreamFeatures {xlib cmd} { proc ::xmpp::TraceStreamFeatures {xlib cmd} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   if {[info exists state(features)]} {    if {[info exists state(features)]} {
       after idle $cmd [list $state(features)]        after idle $cmd [list $state(features)]
   } else {    } else {
       # Variable state(features) must not be set outside ParseStreamFeatures,        # Variable state(features) must not be set outside ParseStreamFeatures,
       # to prevent spurious trace callback triggering.        # to prevent spurious trace callback triggering.
       trace variable $xlib\(features) w \        trace variable $xlib\(features) w \
             [namespace code [list TraceStreamFeaturesAux $xlib $cmd]]              [namespace code [list TraceStreamFeaturesAux $xlib $cmd]]
   }    }
   return    return
} }
   
# ::xmpp::TraceStreamFeaturesAux -- # ::xmpp::TraceStreamFeaturesAux --
# #
#       A helper procedure which is called by a trace of state(features) #       A helper procedure which is called by a trace of state(features)
#       variable. It in turn removes trace and calls a specified command back. #       variable. It in turn removes trace and calls a specified command back.
#       Trace syntax is old-style to make it work in Tcl 8.3. #       Trace syntax is old-style to make it work in Tcl 8.3.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       cmd             Command to call. #       cmd             Command to call.
#       args            Arguments, added by trace. #       args            Arguments, added by trace.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       Trace of state(features) variable is removed. #       Trace of state(features) variable is removed.
   
proc ::xmpp::TraceStreamFeaturesAux {xlib cmd args} { proc ::xmpp::TraceStreamFeaturesAux {xlib cmd args} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   RemoveTraceStreamFeatures $xlib $cmd    RemoveTraceStreamFeatures $xlib $cmd
   
   uplevel #0 $cmd [list $state(features)]    uplevel #0 $cmd [list $state(features)]
   return    return
} }
   
# ::xmpp::RemoveTraceStreamFeatures -- # ::xmpp::RemoveTraceStreamFeatures --
# #
#       Remove trace of state(features) variable if it's set. This procedure #       Remove trace of state(features) variable if it's set. This procedure
#       may be called in case if it's needed to abort connection process, or #       may be called in case if it's needed to abort connection process, or
#       in case when stream features are received (see #       in case when stream features are received (see
#       [TraceStreamFeaturesAux]). #       [TraceStreamFeaturesAux]).
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       cmd             Command that was to be called. #       cmd             Command that was to be called.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       Trace of state(features) is removed if it was set. #       Trace of state(features) is removed if it was set.
   
proc ::xmpp::RemoveTraceStreamFeatures {xlib cmd} { proc ::xmpp::RemoveTraceStreamFeatures {xlib cmd} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   trace vdelete $xlib\(features) w \    trace vdelete $xlib\(features) w \
         [namespace code [list TraceStreamFeaturesAux $xlib $cmd]]          [namespace code [list TraceStreamFeaturesAux $xlib $cmd]]
   
   return    return
} }
   
# ::xmpp::ParseStreamError -- # ::xmpp::ParseStreamError --
# #
#       A helper procedure which is called when stream error is received. #       A helper procedure which is called when stream error is received.
#       It calls back error command (-errorcommand option in [new]) with #       It calls back error command (-errorcommand option in [new]) with
#       appended error message. This procedure is registered as a handler #       appended error message. This procedure is registered as a handler
#       for error element in http://etherx.jabber.org/streams XMLNS in [new]. #       for error element in http://etherx.jabber.org/streams XMLNS in [new].
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       xmlElement      Stream error XML element. #       xmlElement      Stream error XML element.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       A client error callback is invoked. #       A client error callback is invoked.
   
proc ::xmpp::ParseStreamError {xlib xmlElement} { proc ::xmpp::ParseStreamError {xlib xmlElement} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$xmlElement"     Debug $xlib 2 "$xmlElement" 
   
   CallBack $xlib error [streamerror::condition $xmlElement] \    CallBack $xlib error [streamerror::condition $xmlElement] \
                        [streamerror::message $xmlElement]                         [streamerror::message $xmlElement]
   return    return
} }
   
# ::xmpp::SwitchTransport -- # ::xmpp::SwitchTransport --
# #
#       Switch XMPP transport. This procedure is helpful if STARTTLS or #       Switch XMPP transport. This procedure is helpful if STARTTLS or
#       stream compression over TCP is used. #       stream compression over TCP is used.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       transport       Transport name to switch to. #       transport       Transport name to switch to.
# #
# Result: # Result:
#       Empty string or error. #       Empty string or error.
# #
# Side effects: # Side effects:
#       Transport is changed if it's possible. #       Transport is changed if it's possible.
   
proc ::xmpp::SwitchTransport {xlib transport args} { proc ::xmpp::SwitchTransport {xlib transport args} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$transport"     Debug $xlib 2 "$transport" 
   
   set state(transport) \    set state(transport) \
       [eval [list transport::switch $state(transport) $transport] $args]        [eval [list transport::switch $state(transport) $transport] $args]
   return    return
} }
   
# ::xmpp::outXML -- # ::xmpp::outXML --
# #
#       Output XML element to an XMPP channel. #       Output XML element to an XMPP channel.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       xmlElement      XML element to send. #       xmlElement      XML element to send.
# #
# Result: # Result:
#       Length of the sent textual XML representation. #       Length of the sent textual XML representation.
# #
# Side effects: # Side effects:
#       XML element is sent to the server. #       XML element is sent to the server.
   
proc ::xmpp::outXML {xlib xmlElement} { proc ::xmpp::outXML {xlib xmlElement} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   set xmlString "[xml::toTabbedText $xmlElement]"     Debug $xlib 2 "[xml::toText $xmlElement]" 
   Debug $xlib 2 $xmlString    
   CallBack $xlib xmltrace TX $xmlString    
   CallBack $xlib log output xml $xmlElement    CallBack $xlib log output xml $xmlElement
   
   transport::use $state(transport) outXML $xmlElement    transport::use $state(transport) outXML $xmlElement
} }
   
# ::xmpp::outText -- # ::xmpp::outText --
# #
#       Output text string to an XMPP channel. If the text doesn't represent #       Output text string to an XMPP channel. If the text doesn't represent
#       valid XML then server will likely disconnect the XMPP session. #       valid XML then server will likely disconnect the XMPP session.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       text            Text to send. #       text            Text to send.
# #
# Result: # Result:
#       Length of the sent XML textual representation. #       Length of the sent XML textual representation.
# #
# Side effects: # Side effects:
#       XML element is sent to the server. #       XML element is sent to the server.
   
proc ::xmpp::outText {xlib text} { proc ::xmpp::outText {xlib text} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$text"     Debug $xlib 2 "$text" 
   CallBack $xlib log output text $text    CallBack $xlib log output text $text
   
   transport::use $state(transport) outText $text    transport::use $state(transport) outText $text
} }
   
# ::xmpp::closeStream -- # ::xmpp::closeStream --
# #
#       Close XMPP stream (usually by sending </stream:stream>). #       Close XMPP stream (usually by sending </stream:stream>).
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
# #
# Result: # Result:
#       Length of the sent stream trailer. #       Length of the sent stream trailer.
# #
# Side effects: # Side effects:
#       XMPP stream trailer is sent to the server. #       XMPP stream trailer is sent to the server.
   
proc ::xmpp::closeStream {xlib} { proc ::xmpp::closeStream {xlib} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   set msg [xml::streamTrailer]    set msg [xml::streamTrailer]
   Debug $xlib 2 "$msg"     Debug $xlib 2 "$msg" 
   CallBack $xlib log output text $msg    CallBack $xlib log output text $msg
   
   transport::use $state(transport) closeStream    transport::use $state(transport) closeStream
} }
   
# ::xmpp::EndOfParse -- # ::xmpp::EndOfParse --
# #
#       A callback procedure which is called if end of stream is received from #       A callback procedure which is called if end of stream is received from
#       an XMPP server. If it's intentional (XMPP token is in disconnecting #       an XMPP server. If it's intentional (XMPP token is in disconnecting
#       state) then do nothing, otherwise disconnect. #       state) then do nothing, otherwise disconnect.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       In disconnected or disconnecting state none, otherwise ForcedDisconnect #       In disconnected or disconnecting state none, otherwise ForcedDisconnect
#       procedure is called. #       procedure is called.
   
proc ::xmpp::EndOfParse {xlib} { proc ::xmpp::EndOfParse {xlib} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 ""     Debug $xlib 2 "" 
   CallBack $xlib log input text "</stream:stream>"     CallBack $xlib log input text "</stream:stream>" 
   
   switch -- $state(status) {    switch -- $state(status) {
       disconnecting -        disconnecting -
       disconnected {}        disconnected {}
       default {        default {
           ForcedDisconnect $xlib            ForcedDisconnect $xlib
       }        }
   }    }
   
   return    return
} }
   
# ::xmpp::EndOfFile -- # ::xmpp::EndOfFile --
# #
#       A callback procedure which is called if an XMPP server has closed #       A callback procedure which is called if an XMPP server has closed
#       connection. If it's intentional (XMPP token is in disconnecting #       connection. If it's intentional (XMPP token is in disconnecting
#       state) then do nothing, otherwise disconnect. #       state) then do nothing, otherwise disconnect.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       In disconnected or disconnecting state none, otherwise ForcedDisconnect #       In disconnected or disconnecting state none, otherwise ForcedDisconnect
#       procedure is called. #       procedure is called.
   
proc ::xmpp::EndOfFile {xlib} { proc ::xmpp::EndOfFile {xlib} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 ""     Debug $xlib 2 "" 
   
   switch -- $state(status) {    switch -- $state(status) {
       disconnecting -        disconnecting -
       disconnected {}        disconnected {}
       default {        default {
           ForcedDisconnect $xlib            ForcedDisconnect $xlib
       }        }
   }    }
   
   return    return
} }
   
# ::xmpp::ForcedDisconnect -- # ::xmpp::ForcedDisconnect --
# #
#       Disconnect from an XMPP server if this disconnect id forced by the #       Disconnect from an XMPP server if this disconnect id forced by the
#       server itself. #       server itself.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       In disconnected or disconnecting state none, otherwise this procedure #       In disconnected or disconnecting state none, otherwise this procedure
#       aborts any pending operation, closes the XMPP channel, calls back #       aborts any pending operation, closes the XMPP channel, calls back
#       "disconnect" client function and clears the token state. #       "disconnect" client function and clears the token state.
   
proc ::xmpp::ForcedDisconnect {xlib} { proc ::xmpp::ForcedDisconnect {xlib} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 ""     Debug $xlib 2 "" 
   
   switch -- $state(status) {    switch -- $state(status) {
       disconnecting -        disconnecting -
       disconnected {}        disconnected {}
       default {        default {
           set state(status) disconnecting            set state(status) disconnecting
   
           if {[info exists state(abortCommand)]} {            if {[info exists state(abortCommand)]} {
               uplevel #0 $state(abortCommand)                uplevel #0 $state(abortCommand)
               catch {unset state(abortCommand)}                catch {unset state(abortCommand)}
           }            }
   
           if {[catch {transport::use $state(transport) close} msg]} {            if {[catch {transport::use $state(transport) close} msg]} {
               Debug $xlib 1 "Closing connection failed: $msg"                 Debug $xlib 1 "Closing connection failed: $msg" 
           }            }
           catch {unset state(transport)}            catch {unset state(transport)}
   
           CallBack $xlib disconnect            CallBack $xlib disconnect
   
           ClearState $xlib            ClearState $xlib
       }        }
   }    }
   
   return    return
} }
   
# ::xmpp::disconnect -- # ::xmpp::disconnect --
# #
#       Disconnect from an XMPP server. #       Disconnect from an XMPP server.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       In disconnected or disconnecting state none, otherwise this procedure #       In disconnected or disconnecting state none, otherwise this procedure
#       aborts any pending operation, closes the XMPP stream and channel, and #       aborts any pending operation, closes the XMPP stream and channel, and
#       clears the token state. #       clears the token state.
   
proc ::xmpp::disconnect {xlib} { proc ::xmpp::disconnect {xlib} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 ""     Debug $xlib 2 "" 
   
   switch -- $state(status) {    switch -- $state(status) {
       disconnecting -        disconnecting -
       disconnected {}        disconnected {}
       default {        default {
           set state(status) disconnecting            set state(status) disconnecting
   
           if {[info exists state(abortCommand)]} {            if {[info exists state(abortCommand)]} {
               uplevel #0 $state(abortCommand)                uplevel #0 $state(abortCommand)
               catch {unset state(abortCommand)}                catch {unset state(abortCommand)}
           }            }
   
           if {[catch {closeStream $xlib} msg]} {            if {[catch {closeStream $xlib} msg]} {
               Debug $xlib 1 "Closing stream failed: $msg"                 Debug $xlib 1 "Closing stream failed: $msg" 
           }            }
           if {[catch {transport::use $state(transport) close} msg]} {            if {[catch {transport::use $state(transport) close} msg]} {
               Debug $xlib 1 "Closing connection failed: $msg"                 Debug $xlib 1 "Closing connection failed: $msg" 
           }            }
           catch {unset state(transport)}            catch {unset state(transport)}
   
           ClearState $xlib            ClearState $xlib
       }        }
   }    }
} }
   
# ::xmpp::ClearState -- # ::xmpp::ClearState --
# #
#       Clean XMPP token state. #       Clean XMPP token state.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       All pending IQ callbacks are called and state array is cleaned up. #       All pending IQ callbacks are called and state array is cleaned up.
   
proc ::xmpp::ClearState {xlib} { proc ::xmpp::ClearState {xlib} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 ""     Debug $xlib 2 "" 
   
   foreach idx [array names state iq,*] {    foreach idx [array names state iq,*] {
       set cmd $state($idx)        set cmd $state($idx)
       unset state($idx)        unset state($idx)
   
       uplevel #0 $cmd [list abort \        uplevel #0 $cmd [list abort \
                             [xml::create error \                              [xml::create error \
                                  -cdata [::msgcat::mc "Disconnected"]]]                                   -cdata [::msgcat::mc "Disconnected"]]]
   }    }
   
   # Don't reset ID counter because the higher level application may    # Don't reset ID counter because the higher level application may
   # still use the old values.    # still use the old values.
   #set state(id) 0    #set state(id) 0
   set state(status) disconnected    set state(status) disconnected
   
   # connect    # connect
   # This variable is unset in [disconnect] or [ForcedDisconnect]    # This variable is unset in [disconnect] or [ForcedDisconnect]
   #array unset state transport    #array unset state transport
   
   # openStream    # openStream
   array unset state server    array unset state server
   array unset state -xmlns:stream    array unset state -xmlns:stream
   array unset state -xmlns    array unset state -xmlns
   array unset state -xml:lang    array unset state -xml:lang
   array unset state -version    array unset state -version
   array unset state openStreamCommand    array unset state openStreamCommand
   array unset state streamAfterId    array unset state streamAfterId
   array unset state openStatus    array unset state openStatus
   array unset state sessionID    array unset state sessionID
   
   # TraceStreamFeatures    # TraceStreamFeatures
   array unset state features    array unset state features
   
   # various    # various
   array unset state abortCommand    array unset state abortCommand
   
   return    return
} }
   
# ::xmpp::RegisterElement -- # ::xmpp::RegisterElement --
# #
#       Register callback for XMPP top-level stanza in a stream. #       Register callback for XMPP top-level stanza in a stream.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       tag             XML element tag pattern. #       tag             XML element tag pattern.
#       xmlns           XMLNS pattern. #       xmlns           XMLNS pattern.
#       cmd             Command to call when the top-level stanza in XMPP #       cmd             Command to call when the top-level stanza in XMPP
#                       stream matches tag ans XMLNS patterns. #                       stream matches tag ans XMLNS patterns.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       Command is pushed to a stack of registered commands for given tag and #       Command is pushed to a stack of registered commands for given tag and
#       XMLNS patterns. #       XMLNS patterns.
   
proc ::xmpp::RegisterElement {xlib tag xmlns cmd} { proc ::xmpp::RegisterElement {xlib tag xmlns cmd} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$tag $xmlns $cmd"     Debug $xlib 2 "$tag $xmlns $cmd" 
   
   lappend state(registered,$tag,$xmlns) $cmd    lappend state(registered,$tag,$xmlns) $cmd
   return    return
} }
   
# ::xmpp::UnregisterElement -- # ::xmpp::UnregisterElement --
# #
#       Unregister the last callback for XMPP top-level stanza in a stream. #       Unregister the last callback for XMPP top-level stanza in a stream.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       tag             XML element tag pattern. #       tag             XML element tag pattern.
#       xmlns           XMLNS pattern. #       xmlns           XMLNS pattern.
# #
# Result: # Result:
#       Empty string. Error is raised if there wasn't a registered command for #       Empty string. Error is raised if there wasn't a registered command for
#       specified tag ans XMLNS patterns. #       specified tag ans XMLNS patterns.
# #
# Side effects: # Side effects:
#       The last registered command is popped from a stack of registered #       The last registered command is popped from a stack of registered
#       commands for given tag and XMLNS patterns. #       commands for given tag and XMLNS patterns.
   
proc ::xmpp::UnregisterElement {xlib tag xmlns} { proc ::xmpp::UnregisterElement {xlib tag xmlns} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$tag $xmlns"     Debug $xlib 2 "$tag $xmlns" 
   
   set state(registered,$tag,$xmlns) \    set state(registered,$tag,$xmlns) \
       [lreplace $state(registered,$tag,$xmlns) end end]        [lreplace $state(registered,$tag,$xmlns) end end]
   return    return
} }
   
# ::xmpp::ElementCommand -- # ::xmpp::ElementCommand --
# #
#       Return the last registerd command for XMPP top-level stanza. #       Return the last registerd command for XMPP top-level stanza.
# #
# Arguments: # Arguments:
#       xlib            XMPP token. #       xlib            XMPP token.
#       tag             XML element tag. #       tag             XML element tag.
#       xmlns           XMLNS. #       xmlns           XMLNS.
# #
# Result: # Result:
#       Command which was registered for specified tag and XMLNS if any. #       Command which was registered for specified tag and XMLNS if any.
#       Otherwise a command which was registered for patterns which match tag #       Otherwise a command which was registered for patterns which match tag
#       and XMLNS if any. Otherwise an empty string. #       and XMLNS if any. Otherwise an empty string.
# #
# Side effects: # Side effects:
#       None. #       None.
   
proc ::xmpp::ElementCommand {xlib tag xmlns} { proc ::xmpp::ElementCommand {xlib tag xmlns} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   # If there's an exact match, return it    # If there's an exact match, return it
   if {[info exists state(registered,$tag,$xmlns)]} {    if {[info exists state(registered,$tag,$xmlns)]} {
       return [lindex $state(registered,$tag,$xmlns) end]        return [lindex $state(registered,$tag,$xmlns) end]
   }    }
   
   # Otherwise find matching indices    # Otherwise find matching indices
   foreach idx [lsort [array names state registered,*]] {    foreach idx [lsort [array names state registered,*]] {
       set fields [split $idx ,]        set fields [split $idx ,]
       set ptag [lindex $fields 1]        set ptag [lindex $fields 1]
       set pxmlns [join [lrange $fields 2 end] ,]        set pxmlns [join [lrange $fields 2 end] ,]
   
       if {[string match $ptag $tag] && [string match $pxmlns $xmlns]} {        if {[string match $ptag $tag] && [string match $pxmlns $xmlns]} {
           return [lindex $state($idx) end]            return [lindex $state($idx) end]
       }        }
   }    }
   
   # There's no matches    # There's no matches
   return    return
} }
   
# ::xmpp::Parse -- # ::xmpp::Parse --
# #
#       A callback procedure which is called when a top-level XMPP stanza is #       A callback procedure which is called when a top-level XMPP stanza is
#       received. It in turn calls a procedure which parses and processes the #       received. It in turn calls a procedure which parses and processes the
#       stanza. #       stanza.
# #
# Arguments: # Arguments:
#       xlib            XMPP token #       xlib            XMPP token
#       xmlElement      Top-level XML stanza. #       xmlElement      Top-level XML stanza.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       A registered command for the xmlElement tag and XMLNS is called if any, #       A registered command for the xmlElement tag and XMLNS is called if any,
#       or general "packet" callback is invoked. #       or general "packet" callback is invoked.
   
proc ::xmpp::Parse {xlib xmlElement} { proc ::xmpp::Parse {xlib xmlElement} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 "$xmlElement"     Debug $xlib 2 "$xmlElement" 
   CallBack $xlib xmltrace RX "[xml::toTabbedText $xmlElement]"    
   CallBack $xlib log input xml $xmlElement    CallBack $xlib log input xml $xmlElement
   
   if {![info exists state(transport)]} {    if {![info exists state(transport)]} {
       Debug $xlib 1 "Connection doesn't exist"         Debug $xlib 1 "Connection doesn't exist" 
       return -1        return -1
   }    }
   
   xml::split $xmlElement tag xmlns attrs cdata subels    xml::split $xmlElement tag xmlns attrs cdata subels
   
   set cmd [ElementCommand $xlib $tag $xmlns]    set cmd [ElementCommand $xlib $tag $xmlns]
   if {![string equal $cmd ""]} {    if {![string equal $cmd ""]} {
       uplevel #0 $cmd [list $xmlElement]        uplevel #0 $cmd [list $xmlElement]
       return        return
   }    }
   
   CallBack $xlib packet $xmlElement    CallBack $xlib packet $xmlElement
   return    return
} }
   
# ::xmpp::ParseMessage -- # ::xmpp::ParseMessage --
# #
#       Parse XMPP message and invoke "message" client callback. The callback #       Parse XMPP message and invoke "message" client callback. The callback
#       must take the following arguments: #       must take the following arguments:
#       (Mandatory) #       (Mandatory)
#           xlib                XMPP token. #           xlib                XMPP token.
#           from                From JID. #           from                From JID.
#           type                Message type ("", "error", "normal", "chat", #           type                Message type ("", "error", "normal", "chat",
#                               "groupchat", "headline"). #                               "groupchat", "headline").
#           x                   Extra subelements (attachments). #           x                   Extra subelements (attachments).
#       (Optional) #       (Optional)
#           -x keypairs         Key-valus pairs of extra attributes. #           -x keypairs         Key-valus pairs of extra attributes.
#           -lang lang          xml:lang #           -lang lang          xml:lang
#           -to to              To JID (usually own JID). #           -to to              To JID (usually own JID).
#           -id id              Stanza ID (string). #           -id id              Stanza ID (string).
#           -subject subject    Message subject (string). #           -subject subject    Message subject (string).
#           -thread thread      Message thread (string). #           -thread thread      Message thread (string).
#           -body body          Message body (string). #           -body body          Message body (string).
#           -error error        Error stanza (XML element). #           -error error        Error stanza (XML element).
# #
# Arguments: # Arguments:
#       xlib            XMPP token #       xlib            XMPP token
#       xmlElement      XMPP <message/> stanza. #       xmlElement      XMPP <message/> stanza.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       A message callback is called if defined. #       A message callback is called if defined.
   
proc ::xmpp::ParseMessage {xlib xmlElement} { proc ::xmpp::ParseMessage {xlib xmlElement} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   xml::split $xmlElement tag xmlns attrs cdata subels    xml::split $xmlElement tag xmlns attrs cdata subels
   
   set from   ""     set from   "" 
   set type   ""     set type   "" 
   set x      {}    set x      {}
   set params {}    set params {}
   set xparam {}    set xparam {}
   
   foreach {key val} $attrs {    foreach {key val} $attrs {
       switch -- $key {        switch -- $key {
           from     {set from $val}            from     {set from $val}
           type     {            type     {
               switch -- $val {                switch -- $val {
                   chat -                    chat -
                   error -                    error -
                   groupchat -                    groupchat -
                   headline -                    headline -
                   normal {                    normal {
                       set type $val                        set type $val
                   }                    }
                   default {                    default {
                       Debug $xlib 1 \                        Debug $xlib 1 \
                             [::msgcat::mc "Unknown message type %s" $val]                              [::msgcat::mc "Unknown message type %s" $val]
                   }                    }
               }                }
           }            }
           xml:lang {lappend params -lang $val}            xml:lang {lappend params -lang $val}
           to       {lappend params -to   $val}            to       {lappend params -to   $val}
           id       {lappend params -id   $val}            id       {lappend params -id   $val}
           default  {lappend xparam $key  $val}            default  {lappend xparam $key  $val}
       }        }
   }    }
   
   foreach subel $subels {    foreach subel $subels {
       xml::split $subel stag sxmlns sattrs scdata ssubels        xml::split $subel stag sxmlns sattrs scdata ssubels
   
       switch -- $stag {        switch -- $stag {
           subject {lappend params -subject $scdata}            subject {lappend params -subject $scdata}
           thread  {lappend params -thread  $scdata}            thread  {lappend params -thread  $scdata}
           body    {lappend params -body    $scdata}            body    {lappend params -body    $scdata}
           error   {lappend params -error   $subel}            error   {lappend params -error   $subel}
           default {lappend x $subel}            default {lappend x $subel}
       }        }
   }    }
   
   eval [list CallBack $xlib message $from $type $x -x $xparam] $params    eval [list CallBack $xlib message $from $type $x -x $xparam] $params
   return    return
} }
   
# ::xmpp::ParsePresence -- # ::xmpp::ParsePresence --
# #
#       Parse XMPP presence and invoke "presence" client callback. The callback #       Parse XMPP presence and invoke "presence" client callback. The callback
#       must take the following arguments: #       must take the following arguments:
#       (Mandatory) #       (Mandatory)
#           xlib                XMPP token. #           xlib                XMPP token.
#           from                From JID. #           from                From JID.
#           type                Presence type ("", "error", "unavailable", #           type                Presence type ("", "error", "unavailable",
#                               "probe", "subscribe", "subscribed", #                               "probe", "subscribe", "subscribed",
#                               "unsubscribe", "unsubscribed"). #                               "unsubscribe", "unsubscribed").
#           x                   Extra subelements (attachments). #           x                   Extra subelements (attachments).
#       (Optional) #       (Optional)
#           -x keypairs         Key-valus pairs of extra attributes. #           -x keypairs         Key-valus pairs of extra attributes.
#           -lang lang          xml:lang #           -lang lang          xml:lang
#           -to to              To JID (usually own JID). #           -to to              To JID (usually own JID).
#           -id id              Stanza ID (string). #           -id id              Stanza ID (string).
#           -priority priority  Presence priority (number). #           -priority priority  Presence priority (number).
#           -show show          Presence status (missing, "away", "chat", #           -show show          Presence status (missing, "away", "chat",
#                               "dnd", "xa"). #                               "dnd", "xa").
#           -status status      Presence extended status (string). #           -status status      Presence extended status (string).
#           -error error        Error stanza (XML element). #           -error error        Error stanza (XML element).
# #
# Arguments: # Arguments:
#       xlib            XMPP token #       xlib            XMPP token
#       xmlElement      XMPP <presence/> stanza. #       xmlElement      XMPP <presence/> stanza.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       A presence callback is called if defined. #       A presence callback is called if defined.
   
proc ::xmpp::ParsePresence {xlib xmlElement} { proc ::xmpp::ParsePresence {xlib xmlElement} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   xml::split $xmlElement tag xmlns attrs cdata subels    xml::split $xmlElement tag xmlns attrs cdata subels
   
   set from   ""     set from   "" 
   set type   ""     set type   "" 
   set x      {}    set x      {}
   set params {}    set params {}
   set xparam {}    set xparam {}
   
   foreach {key val} $attrs {    foreach {key val} $attrs {
       switch -- $key {        switch -- $key {
           from     {set from $val}            from     {set from $val}
           type     {set type $val}            type     {set type $val}
           xml:lang {lappend params -lang $val}            xml:lang {lappend params -lang $val}
           to       {lappend params -to   $val}            to       {lappend params -to   $val}
           id       {lappend params -id   $val}            id       {lappend params -id   $val}
           default  {lappend xparam $key  $val}            default  {lappend xparam $key  $val}
       }        }
   }    }
   
   foreach subel $subels {    foreach subel $subels {
       xml::split $subel stag sxmlns sattrs scdata ssubels        xml::split $subel stag sxmlns sattrs scdata ssubels
   
       switch $stag {        switch $stag {
           priority {            priority {
               if {[string is integer -strict $scdata]} {                if {[string is integer -strict $scdata]} {
                   lappend params -priority $scdata                    lappend params -priority $scdata
               }                }
           }            }
           show {            show {
               switch -- $scdata {                switch -- $scdata {
                   away -                    away -
                   chat -                    chat -
                   dnd  -                    dnd  -
                   xa   {                    xa   {
                       lappend params -show $scdata                        lappend params -show $scdata
                   }                    }
               }                }
           }            }
           status  {lappend params -status $scdata}            status  {lappend params -status $scdata}
           error   {lappend params -error  $subel}            error   {lappend params -error  $subel}
           default {lappend x $subel}            default {lappend x $subel}
       }        }
   }    }
   
   # Evaluate client callback    # Evaluate client callback
   eval [list CallBack $xlib presence $from $type $x -x $xparam] $params    eval [list CallBack $xlib presence $from $type $x -x $xparam] $params
   
   # Evaluate internal (or otherwise registered) callbacks    # Evaluate internal (or otherwise registered) callbacks
   eval [list presence::process $xlib $from $type $x -x $xparam] $params    eval [list presence::process $xlib $from $type $x -x $xparam] $params
   return    return
} }
   
# ::xmpp::ParseIQ -- # ::xmpp::ParseIQ --
# #
#       Parse XMPP IQ. For get or set IQ type invoke [iq::process] command #       Parse XMPP IQ. For get or set IQ type invoke [iq::process] command
#       which will find and invoke the corresponding handler. For result or #       which will find and invoke the corresponding handler. For result or
#       error IQ type find and call the callback stored in [sendIQ]. #       error IQ type find and call the callback stored in [sendIQ].
# #
# Arguments: # Arguments:
#       xlib            XMPP token #       xlib            XMPP token
#       xmlElement      XMPP <iq/> stanza. #       xmlElement      XMPP <iq/> stanza.
# #
# Result: # Result:
#       Empty string. #       Empty string.
# #
# Side effects: # Side effects:
#       An IQ handler or the callback specified when IQ was sent is called if #       An IQ handler or the callback specified when IQ was sent is called if
#       defined. #       defined.
   
proc ::xmpp::ParseIQ {xlib xmlElement} { proc ::xmpp::ParseIQ {xlib xmlElement} {
   variable $xlib    variable $xlib
   upvar 0 $xlib state    upvar 0 $xlib state
   
   Debug $xlib 2 $xmlElement    Debug $xlib 2 $xmlElement
   
   xml::split $xmlElement tag xmlns attrs cdata subels    xml::split $xmlElement tag xmlns attrs cdata subels
   
   set to     ""     set to     "" 
   set from   ""     set from   "" 
   set type   ""     set type   "" 
   set id     ""     set id     "" 
   set x      {}    set x      {}
   set params {}    set params {}
   set xparam {}    set xparam {}
   
   foreach {key val} $attrs {    foreach {key val} $attrs {
       switch -- $key {        switch -- $key {
           from {set from $val}            from {set from $val}
           type {set type $val}            type {set type $val}
           xml:lang {lappend params -lang $val}            xml:lang {lappend params -lang $val}
           to {            to {
               set to $val                set to $val
               lappend params -to $val                lappend params -to $val
           }            }
           id {            id {
               set id $val                set id $val
               lappend params -id $val                lappend params -id $val
           }            }
           default {lappend xparam $key $val}            default {lappend xparam $key $val}
       }        }
   }    }
   
   # Any IQ.    # Any IQ.
   eval [list CallBack $xlib iq $from $type $subels -x $xparam] $params    eval [list CallBack $xlib iq $from $type $subels -x $xparam] $params
   
   switch -- $type {    switch -- $type {
       get -        get -
       set {        set {
           # Registered IQ.            # Registered IQ.
           eval [list iq::process $xlib $from $type \            eval [list iq::process $xlib $from $type \
                                  [lindex $subels 0]] $params                                   [lindex $subels 0]] $params
           return            return
       }        }
       result {        result {
           if {[info exists state(iq,$id)]} {            if {[info exists state(iq,$id)]} {
               set cmd $state(iq,$id)                set cmd $state(iq,$id)
               unset state(iq,$id)                unset state(iq,$id)
   
               uplevel #0 $cmd [list ok [lindex $subels 0]]                uplevel #0 $cmd [list ok [lindex $subels 0]]
           } else {            } else {
               Debug $xlib 1 \                Debug $xlib 1 \
                     [::msgcat::mc "IQ id %s doesn't exist in memory" $id]                      [::msgcat::mc "IQ id %s doesn't exist in memory" $id]
           }            }
           return            return
       }        }
       error {        error {
           if {[info exists state(iq,$id)]} {            if {[info exists state(iq,$id)]} {
               set cmd $state(iq,$id)                set cmd $state(iq,$id)
               unset state(iq,$id)                unset state(iq,$id)
   
               set error {}                set error {}
               foreach subel $subels {                foreach subel $subels {
                   xml::split $subel stag sxmlns sattrs scdata ssubels                    xml::split $subel stag sxmlns sattrs scdata ssubels
                   if {[string equal $stag error]} {                    if {[string equal $stag error]} {
                       set error $subel                        set error $subel
                       break                        break
                   }                    }
               }                }
   
               uplevel #0 $cmd [list error $error]                uplevel #0 $cmd [list error $error]
           } else {            } else {
               Debug $xlib 1 \                Debug $xlib 1 \
                     [::msgcat::mc "IQ id %s doesn't exist in memory" $id]