# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
-set auto_path [linsert $auto_path 0 [file dirname [file dirname [info script]]]]
+set auto_path [linsert $auto_path 0 \
+ [file dirname [file dirname [file normalize [info script]]]]]
package require xmppd::jcp; # tclxmppd
package require xmppd::wrapper; # tclxmppd
-namespace eval ::component {
- variable version 1.0.0
+namespace eval ::testbridge {
+ variable version 1.1.0
variable rcsid {$Id$}
+ variable uid; if {![info exists uid]} { set uid 0 }
+ # The options array holds configuration information for this component.
+ # We use the LoadConfig procedure to load the actual configuration from
+ # a file to avoid committing passwords into the code repository.
+ #
variable Options
if {![info exists Options]} {
array set Options {
}
}
- variable Component
+ # The NS array holds some standard XMPP XML namespaces.
variable NS
array set NS {
discoinfo "http://jabber.org/protocol/disco#info"
discoitems "http://jabber.org/protocol/disco#items"
muc "http://jabber.org/protocols/muc"
}
+
+ namespace import ::xmppd::jcp::jid
}
-# component::start --
+# testbridge::start --
#
# Start the component. We create the JCP link. A successful link
# will result in a call to the -handler function from where we
# can perform further setup over the valid link
#
-proc ::component::start {} {
+proc ::testbridge::start {} {
variable Options
variable Component
variable NS
+
+ set Options(JID) [stringprep::stringprep nameprep $Options(JID)]
set Component [xmppd::jcp::create \
-component $Options(JID) \
-secret $Options(Secret) \
-server $Options(JabberServer) \
-port $Options(JabberPort) \
- -loglevel $Options(LogLevel) \
- -connectproc [namespace origin OnConnect] \
- -messageproc [namespace origin OnMessage] \
- -presenceproc [namespace origin OnPresence] \
- -iqproc [namespace origin OnIq]]
- $Component iq_register get jabber:iq:version \
- [namespace code [list OnIqVersion $Component]]
+ -loglevel $Options(LogLevel)]
+
+ $Component configure -connectproc [namespace code [list OnConnect $Component]]
+ $Component configure -disconnectproc [namespace code [list OnDisconnect $Component]]
+ $Component configure -messageproc [namespace code [list OnMessage $Component]]
+ $Component configure -presenceproc [namespace code [list OnPresence $Component]]
+
$Component iq_register get $NS(discoinfo) \
[namespace code [list OnIqDiscoInfo $Component]]
- # presence_register / message_register ?
+ $Component iq_register get jabber:iq:version \
+ [namespace code [list OnIqVersion $Component]]
+ $Component iq_register get urn:xmpp:time \
+ [namespace code [list OnIqTime $Component]]
+
+ # Connect the component.
$Component connect
- component start
+
return $Component
}
-# component::stop --
+# testbridge::stop --
#
# Halt the component. We disconnect from the configured chat
# by sending a presence unavailable and then destroy the component.
#
-proc ::component::stop {} {
+proc ::testbridge::stop {} {
variable Options
variable Component
- component stop
- set jid "$Options(Name)@$Options(JID)/$Options(Resource)"
+
+ set jid [jid normalize "$Options(Name)@$Options(JID)/$Options(Resource)"]
presence $jid {} unavailable
xmppd::jcp::destroy $Component
}
-# component::OnConnect --
+# testbridge::OnConnect --
#
# Jabber message routing. For this component, we don't need to
# do anything as all we do is issue a time message on the hour.
#
-proc ::component::OnConnect {xmllist} {
+proc ::testbridge::OnConnect {xmllist} {
variable Options
# initial presence from the bridge client
presence "$Options(Name)@$Options(JID)/$Options(Resource)"
+ return
}
-proc ::component::OnMessage {xmllist} {
+proc ::testbridge::OnMessage {xmllist} {
array set a [linsert [wrapper::getattrlist $xmllist] 0 type normal]
switch -exact -- $a(type) {
groupchat -
return
}
-proc ::component::OnPresence {xmllist} {
+proc ::testbridge::OnPresence {xmllist} {
array set a [linsert [wrapper::getattrlist $xmllist] 0 type available]
switch -exact -- $a(type) {
available {
subscribe {
# always refuse subsription requests
presence $a(to) $a(from) unsubscribed
+ return -code break
}
subscribed - unsubscribe - unsubscribed - probe - error {
return
}
-# component::OnIq --
-#
-# iq get stanza handling
-#
-proc ::component::OnIq {xmllist} {
- return
-}
-
# iq handler for jabber:iq:version (xep-0092)
-proc ::component::OnIqVersion {Component xmllist} {
+proc ::testbridge::OnIqVersion {Component xmllist} {
variable version
variable Options
array set a [linsert [wrapper::getattrlist $xmllist] 0 id 0]
}
# iq handler for urn:xmpp:time (xep-0202)
-proc ::component::OnIqTime {Component xmllist} {
+proc ::testbridge::OnIqTime {Component xmllist} {
variable version
variable Options
array set a [linsert [wrapper::getattrlist $xmllist] 0 id 0]
}
# iq handler for service discovery
-proc ::component::OnIqDiscoInfo {Component xmllist} {
+proc ::testbridge::OnIqDiscoInfo {Component xmllist} {
variable version
variable Options
variable NS
return -code break
}
-# component::presence --
+# testbridge::presence --
#
# Send a jabber presence message
#
-proc ::component::presence {from {to {}} {type {}} {show {}} {status {}}} {
+proc ::testbridge::presence {from {to {}} {type {}} {show {}} {status {}}} {
variable Component
variable Options
variable NS
return
}
-# component::LoadConfig --
+# testbridge::LoadConfig --
#
# This procedure reads a text file and updates the Options array
# from the contents. Comments and blank lines are ignored. All
# other lines must be a list of two elements, the first element
# must be an item in the Options array.
#
-proc ::component::LoadConfig {{conf {}}} {
+proc ::testbridge::LoadConfig {{conf {}}} {
variable Options
if {$conf eq {}} {
set conf [file normalize [info script]]
return
}
-# component::component --
-#
-# The implementation of this component.
-#
-proc ::component::component {cmd} {
- switch -exact -- $cmd {
- start {
-
- }
- stop {
-
- }
- default {
- return -code error "invalid option \"$cmd\": rtfm"
- }
- }
-}
-
# -------------------------------------------------------------------------
# wubchain is using:
# irc_send msg
# When they leave, send a presence unavailable for this jid.
#
-# component::JoinMUC --
+# testbridge::JoinMUC --
#
# Join a MUC by sending a suitable presence to our desired nick jid.
#
proc JoinMUC {from conference nick} {
- variable ::component::Component
- variable ::component::NS
+ variable ::testbridge::Component
+ variable ::testbridge::NS
lappend hist [wrapper::createtag history -attrlist {maxchars 0 maxstanzas 0}]
lappend kids [wrapper::createtag x -attrlist [list xmlns $NS(muc)] -subtags $hist]
}
proc /join {nick} {
- variable ::component::Component
- variable ::component::Options
+ variable ::testbridge::Component
+ variable ::testbridge::Options
set userjid $nick@$Options(JID)/webchat
set nickjid $Options(Conference)/$nick
- ::component::presence $userjid
- ::component::presence $userjid $nickjid
+ ::testbridge::presence $userjid
+ ::testbridge::presence $userjid $nickjid
}
proc /part {nick} {
- variable ::component::Component
- variable ::component::Options
+ variable ::testbridge::Component
+ variable ::testbridge::Options
set userjid $nick@$Options(JID)/webchat
set nickjid $Options(Conference)/$nick
- ::component::presence $userjid $nickjid unavailable
- ::component::presence $userjid {} unavailable
+ ::testbridge::presence $userjid $nickjid unavailable
+ ::testbridge::presence $userjid {} unavailable
}
+proc /whisper {nick tonick message} {
+ variable ::testbridge::Component
+ variable ::testbridge::Options
+ set userjid $nick@$Options(JID)/webchat
+ set nickjid $Options(Conference)/$nick
+ set tojid $Options(Conference)/$tonick
+
+ lappend body [wrapper::createtag body -chdata $message]
+ set xmllist [wrapper::createtag message \
+ -attrlist [list xmlns jabber:client type chat \
+ to $tojid from $userjid]\
+ -subtags $body]
+ $Component route [wrapper::createxml $xmllist]
+}
proc /post {nick message} {
- variable ::component::Component
- variable ::component::Options
+ variable ::testbridge::Component
+ variable ::testbridge::Options
set userjid $nick@$Options(JID)/webchat
set nickjid $Options(Conference)/$nick
# -------------------------------------------------------------------------
-proc ::component::Main {} {
+proc ::testbridge::Main {} {
global tcl_platform tcl_interactive tcl_service tk_version
variable Options
LoadConfig
}
if {!$tcl_interactive} {
- set r [catch [linsert $argv 0 ::component::Main] err]
+ set r [catch [linsert $argv 0 ::testbridge::Main] err]
if {$r} {puts $errorInfo}
exit $r
}
projects / tclxmppd.git / commitdiff