From 124c69763fe05110de34990b98f20d320fd23c8a Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Wed, 24 Nov 2004 15:20:11 +0000 Subject: [PATCH] * s2s.tcl: Finally persuaded both sides to validate. Jabberd is now prepared to talk to us (at least when _we_ initiate the connection). --- ChangeLog | 6 ++ s2s.tcl | 169 ++++++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 137 insertions(+), 38 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6799a9a..dfa669a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2004-11-24 Pat Thoyts + + * s2s.tcl: Finally persuaded both sides to validate. Jabberd is + now prepared to talk to us (at least when _we_ initiate the + connection). + 2004-11-24 Pat Thoyts * s2s.tcl: Redesigned to separate channels and sessions living on diff --git a/s2s.tcl b/s2s.tcl index 226bf07..8caf1fd 100644 --- a/s2s.tcl +++ b/s2s.tcl @@ -34,6 +34,7 @@ namespace eval ::xmppd::s2s { address 0.0.0.0 port 5269 loglevel debug + handler {} } #set options(jid) [info hostname] } @@ -113,6 +114,13 @@ proc ::xmppd::s2s::configure {args} { ${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]] ", -"] @@ -177,12 +185,16 @@ proc ::xmppd::s2s::start {} { 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 } @@ -254,11 +266,11 @@ proc ::xmppd::s2s::CreateChannel {} { } # 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 {} @@ -297,6 +309,7 @@ proc ::xmppd::s2s::FindSession {op args} { 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 } } @@ -350,7 +363,7 @@ proc ::xmppd::s2s::Open {from to} { 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 @@ -563,6 +576,7 @@ proc ::xmppd::s2s::OnError {Channel code args} { } proc ::xmppd::s2s::OnInput {Channel xmllist} { + variable options upvar #0 $Channel channel foreach {cmd attr close value children} $xmllist break @@ -622,14 +636,8 @@ proc ::xmppd::s2s::OnInput {Channel xmllist} { 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 { @@ -680,36 +688,97 @@ proc ::xmppd::s2s::OnInput {Channel xmllist} { } 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 "" + + 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 "" + + 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) \ + "" + } + 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} { @@ -717,25 +786,49 @@ if {!$tcl_interactive} { } else { catch {xmppd::s2s::start} - #set presence {} - #set unpresence {} + namespace import -force xmppd::s2s::* - #xmppd::s2s::route -from uknml2375.renishaw.com -to bugzilla.renishaw.com \ - {} + 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 \ - "" } - proc say {msg} { - xmppd::s2s::route -from conference.patthoyts.tk -to tach.tclers.tk \ - "\ + proc say {msg {type groupchat}} { + global client server + xmppd::s2s::route -from $client -to $server \ + "\ + [wrapper::xmlcrypt $msg]" + } + } + + 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 \ + "" + } + proc say {msg {type chat}} { + global client server who + xmppd::s2s::route -from $client -to $server \ + "\ [wrapper::xmlcrypt $msg]" } + xmppd::s2s::configure -jid $client -handler ::Handler set ns [dns::nameservers] if {[llength $ns] > 0} { -- 2.23.0