address 0.0.0.0
port 5269
loglevel debug
+ handler {}
}
#set options(jid) [info hostname]
}
${log}::setlevel $options(loglevel)
}
}
+ -handler {
+ if {$cget} {
+ return $options(handler)
+ } else {
+ set options(handler) [Pop args 1]
+ }
+ }
-- { Pop args ; break }
default {
set opts [join [lsort [array names options]] ", -"]
proc ::xmppd::s2s::stop {} {
variable listeners
- foreach src $listeners {
+ foreach Channel [info vars [namespace current]::channel*] {
+ Close $Channel
+ }
+ foreach srv $listeners {
catch {
set info [fconfigure $srv -sockname]
close $srv
Log notice "XMPP s2s stopped listening on [lindex $info 0]:[lindex $info 2]"
- }
+ } msg
+ puts stderr $msg
}
return
}
}
# Find a session for a given route
-proc ::xmppd::s2s::FindChannel {addr} {
- foreach channel [info vars [namespace current]::channel*] {
- upvar #0 $channel chan
- if {$chan(address) eq $addr} {
- return $channel
+proc ::xmppd::s2s::FindChannel {dir addr} {
+ foreach Channel [info vars [namespace current]::channel*] {
+ upvar #0 $Channel channel
+ if {$channel(dir) eq $dir && $channel(address) eq $addr} {
+ return $Channel
}
}
return {}
if {[info exists session(from)] && $session(from) eq $from
&& [info exists session(to)] && $session(to) eq $to} {
lappend r $Session
+ Log debug " Found session $r: $from -> $to"
break
}
}
return -code error "hostname invalid: \"$to\" failed to resolve ip address"
}
- set Channel [FindChannel [lindex $addr 0]]
+ set Channel [FindChannel out [lindex $addr 0]]
if {[llength $Channel] < 1} {
set Channel [CreateChannel]
upvar #0 $Channel channel
}
proc ::xmppd::s2s::OnInput {Channel xmllist} {
+ variable options
upvar #0 $Channel channel
foreach {cmd attr close value children} $xmllist break
upvar #0 $out(channel) ochannel
WriteTo $ochannel(sock) $xml
} else {
- # We need to create a new out-bound session attached
- # to this channel
- #set Out [CreateSession]
- #upvar #0 $Out out
- #set out(id)
- #set out(state) dialback
- #set out(channel) $Channel
- Log error "FIXME need to open a outbound session"
+ Log debug "- Creating new out channel to $a(from)"
+ Open $a(to) $a(from)
}
} else {
} else {
- # RFC3920 8.3(10): The Receiving Server (us) informs the
- # Originating Server (them) of the result
+ # RFC3920 8.3(9): The Authoritative Server (them) verifies the
+ # valididy of the key and posts a message to
+ # the Recieving Server (us).
set session(state) $a(type)
if {$session(state) eq "valid"} {
- set Out [FindSession name $a(to) $a(from)]
- if {$Out ne {}} {
- Log debug "- $channel(sock) Found session $Out"
- upvar #0 $Out out
- upvar #0 $out(channel) ochannel
- set xml "<db:verify xmlns:db='jabber:server:dialback'\
- from='$session(to)' to='$session(from)'\
- type='$session(state)'/>"
+
+ set Peer [FindSession name $a(to) $a(from)]
+ if {$Peer ne {}} {
+ upvar #0 $Peer peer
+
+ Log debug "* sess: [array get session]"
+ Log debug "* peer: [array get peer]"
+
+ set xml "<db:result xmlns:db='jabber:server:dialback'\
+ from='$peer(from)' to='$peer(to)'\
+ type='$a(type)'/>"
+
+ upvar #0 $session(channel) ochannel
WriteTo $ochannel(sock) $xml
} else {
# We need to create an outbound connection to go with
# this.
#Open $a(to) $a(from)
- Log error "FIXME need to open session (2)"
+ # IMPOSSIBLE??
+ Log error "ARGH: 8.3(10) this isnt supposed to happen"
}
+
} else {
Close $Channel
}
}
}
+
+ iq -
+ message -
+ presence {
+ if {$options(handler) ne {}} {
+ eval $options(handler) $xmllist
+ } else {
+ Log error "No handler defined for \"$cmd\" stanzas"
+ }
+ }
+
default {
Log debug "- event $xmllist"
}
}
}
+# -------------------------------------------------------------------------
+# Application level:
+# The s2s server routes incoming messages to the -handler configuration proc.
+# This is a demo.
+#
+proc Handler {type attributes close value children} {
+
+ switch -exact -- $type {
+ message {
+ array set attr $attributes
+ set msg [lindex [wrapper::gettag $children] 3]
+ puts "$attr(from) -> $attr(to) \[$attr(type)\]\n $msg"
+ }
+ presence {
+ array set attr {type {}}
+ array set attr $attributes
+ switch -exact -- $type {
+ subscribe {
+ # NB: servers should not do this.
+ xmppd::s2s::route \
+ -from $attr(to) -to $attr(from) \
+ "<presence xmlns='jabber:client'\
+ from='$attr(to)' to='attr(from)'\
+ type='subscribed' />"
+ }
+ default {
+ puts "$attr(from) -> $attr(to) \[$attr(type)\]"
+ }
+ }
+ }
+ default {
+ xmppd::s2s::Log debug "$type $attributes $close $value $children"
+ }
+ }
+}
+
+#{from patthoyts@bugzilla.renishaw.com/tkabber xml:lang en-GB type chat to patthoyts@uknml2375.renishaw.com/test xmlns jabber:client} 0 {} {{body {} 0 hehe {}} {x {xmlns jabber:x:event} 0 {} {{offline {} 1 {} {}} {delivered {} 1 {} {}} {displayed {} 1 {} {}} {composing {} 1 {} {}}}}}
+
+
+#{from patthoyts@bugzilla.renishaw.com/tkabber id 37 xml:lang en-GB type get to patthoyts@uknml2375.renishaw.com/test xmlns jabber:client} 0 {} {{query {xmlns jabber:iq:version} 1 {} {}}}
+
+
# -------------------------------------------------------------------------
if {!$tcl_interactive} {
} else {
catch {xmppd::s2s::start}
- #set presence {<presence from='patthoyts@conference.patthoyts.tk/test' to='test@tach.tclers.tk/testing' type='available'><x xmlns='http://jabber.org/protocol/muc'/></presence>}
- #set unpresence {<presence from='patthoyts@conference.patthoyts.tk/test' to='test@tach.tclers.tk' type='unavailable'><x xmlns='http://jabber.org/protocol/muc'/></presence>}
+
namespace import -force xmppd::s2s::*
- #xmppd::s2s::route -from uknml2375.renishaw.com -to bugzilla.renishaw.com \
- {<presence from='patthoyts@uknml2375.renishaw.com' type='available'/>}
+ if {0} {
+ #set client conference.patthoyts.tk
+ #set server tach.tclers.tk
+ #set who test
+
proc presence {type} {
- xmppd::s2s::route -from conference.patthoyts.tk -to tach.tclers.tk \
- "<presence from='patthoyts@conference.patthoyts.tk/test'\
- to='test@tach.tclers.tk/s2s_test' type='$type'><x\
+ global client server
+ xmppd::s2s::route -from $client -to $server \
+ "<presence from='patthoyts@${client}/test'\
+ to='${who}@${server}/s2s_test' type='$type'><x\
xmlns='http://jabber.org/protocols/muc'/></presence>"
}
- proc say {msg} {
- xmppd::s2s::route -from conference.patthoyts.tk -to tach.tclers.tk \
- "<message from='patthoyts@conference.patthoyts.tk/test'\
- to='test@tach.tclers.tk' type='groupchat'>\
+ proc say {msg {type groupchat}} {
+ global client server
+ xmppd::s2s::route -from $client -to $server \
+ "<message from='patthoyts@${client}/test'\
+ to='${who}@${server}' type='$type'>\
+ <body>[wrapper::xmlcrypt $msg]</body></message>"
+ }
+ }
+
+ set client uknml2375.renishaw.com
+ set server bugzilla.renishaw.com
+ set who patthoyts
+
+ proc presence {type} {
+ global client server who
+ xmppd::s2s::route -from $client -to $server \
+ "<presence from='patthoyts@${client}/test'\
+ to='${who}@${server}' type='$type'/>"
+ }
+ proc say {msg {type chat}} {
+ global client server who
+ xmppd::s2s::route -from $client -to $server \
+ "<message from='patthoyts@${client}/test'\
+ to='${who}@${server}' type='$type'>\
<body>[wrapper::xmlcrypt $msg]</body></message>"
}
+ xmppd::s2s::configure -jid $client -handler ::Handler
set ns [dns::nameservers]
if {[llength $ns] > 0} {
projects / tclxmppd.git / commitdiff