From 6a7489e4b1ba863cd1f724f3284cec16019e000c Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Fri, 19 Nov 2004 16:06:14 +0000 Subject: [PATCH] More work -- now have separate sessions for in and out channels. --- s2s.tcl | 254 ++++++++++++++++++++++++++++++++------------------------ 1 file changed, 146 insertions(+), 108 deletions(-) diff --git a/s2s.tcl b/s2s.tcl index fffb7bc..e9c4845 100644 --- a/s2s.tcl +++ b/s2s.tcl @@ -12,7 +12,7 @@ package require wrapper package require uuid package require sha1 package require logger -package require Tclresolver +#package require Tclresolver namespace eval ::xmppd {} namespace eval ::xmppd::s2s { @@ -156,20 +156,22 @@ proc ::xmppd::s2s::start {} { variable options variable listeners if {![info exists listeners]} {set listeners {}} - set srv [socket -server [namespace current]::Accept \ - -myaddr $options(address) $options(port)] - lappend listeners $srv - Log notice "XMPP s2s listening on $options(address):$options(port)" + foreach addr $options(address) port $options(port) { + set srv [socket -server [namespace current]::Accept -myaddr $addr $port] + lappend listeners $srv + Log notice "XMPP s2s listening on $options(address):$options(port)" + } return } proc ::xmppd::s2s::stop {} { variable listeners - set srv [Pop listeners] - if {[llength $srv] > 0} { - set info [fconfigure $srv -sockname] - close $srv - Log notice "XMPP s2s stopped listening on [lindex $info 0]:[lindex $info 2]" + foreach src $listeners { + catch { + set info [fconfigure $srv -sockname] + close $srv + Log notice "XMPP s2s stopped listening on [lindex $info 0]:[lindex $info 2]" + } } return } @@ -181,17 +183,28 @@ proc ::xmppd::s2s::Log {level msg} { ${log}::${level} $msg } +# Find a session for a given route +proc ::xmppd::s2s::FindConnection {from to} { + foreach connid [info vars sock*] { + upvar #0 [namespace current]::$connid conn + if {$conn(from) eq $from && $conn(to) eq $to} { + return $connid + } + } + return {} +} + proc ::xmppd::s2s::Queue {from to data} { Log debug "Queue message -from $from -to $to" - set ip [lindex [resolve $to] 0] - set connid conn:$ip - variable $connid - if {![info exists $connid]} { - Open $connid $from $to + set connid [FindConnection $from $to] + if {$connid eq {}} { + set connid [Open $from $to] } upvar #0 [namespace current]::$connid conn lappend conn(queue) $data - set conn(after) [after 10 [list [namespace current]::Flush $connid]] + if {[llength $conn(queue)] == 1} { + set conn(after) [after 10 [list [namespace current]::Flush $connid]] + } return } @@ -200,44 +213,47 @@ proc ::xmppd::s2s::Queue {from to data} { # # TODO: check for config details per remote site? # use DNS to look for the SRV resources. -proc ::xmppd::s2s::Open {connid from to} { - variable $connid - upvar #0 [namespace current]::$connid conn - set conn(from) $from - set conn(to) $to - set conn(id) 0 +proc ::xmppd::s2s::Open {from to} { + set chan [socket -async localhost 55269] ;# FIX ME + variable $chan + upvar #0 [namespace current]::$chan conn + set conn(from) $from + set conn(to) $to + set conn(id) 0 set conn(state) init + set conn(queue) {} + set conn(after) {} + set conn(key) {} set conn(parser) [wrapper::new \ - [list [namespace current]::OnOpenOutStream $connid] \ - [list [namespace current]::OnCloseStream $connid] \ - [list [namespace current]::OnInput $connid] \ - [list [namespace current]::OnError $connid]] - #set conn(out) [socket -async $to 5269] - set conn(out) [socket -async localhost 55269] ;# FIX ME - fconfigure $conn(out) -buffering none -blocking 0 \ - -encoding utf-8 -translation lf - fileevent $conn(out) writable \ - [list [namespace current]::OutHeader $connid] - fileevent $conn(out) readable \ - [list [namespace current]::Read $conn(out) $connid] - return + [list [namespace current]::OnOpenStream $chan] \ + [list [namespace current]::OnCloseStream $chan] \ + [list [namespace current]::OnInput $chan] \ + [list [namespace current]::OnError $chan]] + fconfigure $chan -buffering none -blocking 0 -encoding utf-8 -translation lf + fileevent $chan writable [list [namespace current]::Write $chan] + fileevent $chan readable [list [namespace current]::Read $chan] + return $chan } -proc ::xmppd::s2s::OutHeader {connid} { - variable $connid - upvar #0 [namespace current]::$connid conn - fileevent $conn(out) writable {} - set xml "" - WriteTo $conn(out) $xml +proc ::xmppd::s2s::Write {chan} { + variable $chan + upvar #0 [namespace current]::$chan conn + fileevent $chan writable {} + set xml "" + WriteTo $chan $xml } -proc ::xmppd::s2s::Read {chan connid} { - variable $connid - upvar #0 [namespace current]::$connid conn +proc ::xmppd::s2s::Read {chan} { + variable $chan + upvar #0 [namespace current]::$chan conn if {[eof $chan]} { fileevent $chan readable {} - OnCloseStream $chanid + # delete parser + # clean up session + # remove route } set xml [read $chan] Log debug "< $chan $xml" @@ -253,7 +269,8 @@ proc ::xmppd::s2s::Flush {connid} { if {![catch {WriteTo $conn(out) $data} err]} { Pop conn(queue) } - } else { + } + if {[llength $conn(queue)] != 0} { set conn(after) [after 1000 [list [namespace current]::Flush $connid]] } return @@ -276,83 +293,89 @@ proc ::xmppd::s2s::Pop {varname {nth 0}} { proc ::xmppd::s2s::Accept {chan clientaddr clientport} { variable options Log notice "XMPP s2s accept connect from $clientaddr:$clientport on $chan" - if {0} { - set parser [wrapper::new \ - [list [namespace current]::OnOpenStream $chan] \ - [list [namespace current]::OnCloseStream $chan] \ - [list [namespace current]::OnInput $chan] \ - [list [namespace current]::OnError $chan]] - } + # create a state array for this (channels are not variables!) + variable $chan + if {[info exists $chan]} {unset $chan} + upvar #0 [namespace current]::$chan conn + set conn(id) [string map {- {}} [uuid::uuid generate]] + set conn(key) {} + set conn(from) {} + set conn(to) $options(jid) + set conn(queue) {} + set conn(after) {} + set conn(state) init + set conn(chan) $chan + set conn(parser) [wrapper::new \ + [list [namespace current]::OnOpenStream $chan] \ + [list [namespace current]::OnCloseStream $chan] \ + [list [namespace current]::OnInput $chan] \ + [list [namespace current]::OnError $chan]] fconfigure $chan -translation binary -encoding utf-8 -buffering none -blocking 0 - fileevent $chan readable [list [namespace current]::Read2 $chan {}] -} - -proc ::xmppd::s2s::Read2 {chan connid} { - if {[eof $chan]} { - fileevent $chan readable {} - #OnCloseStream $chanid - } - set xml [read $chan] - Log debug "< $chan $xml" - #wrapper::parse $conn(parser) $xml + fileevent $chan readable [list [namespace current]::Read $chan] } - # ------------------------------------------------------------------------- -proc ::xmppd::s2s::OnOpenOutStream {connid args} { +proc ::xmppd::s2s::OnOpenStream {chan args} { variable options - variable $connid - upvar #0 [namespace current]::$connid conn + variable $chan + upvar #0 [namespace current]::$chan conn array set attr $args - Log debug "| OpenStream [array get attr]" - - switch -exact -- $conn(state) { - init { - # We have initiated a s2s connection. This is their reply - set conn(rid) $attr(id) - set conn(key) [sha1::sha1 [sha1::sha1 [sha1::sha1 $options(secret)]$conn(from)]$conn(id)] - set xml "$conn(key)" - set conn(state) dialback - WriteTo $conn(out) $xml - } - default { - Log error "- unexpected state" - } + Log debug "O $chan [array get attr]" + if {$conn(state) ne "init"} { + Log error "- unexpected state \"$conn(state)\" in openstream" } -} -proc xmppd::s2s::OnOpenInStream {chan args} { - # Someone is dialling into us - they are the initiator, so we - # send the open response. - Log debug "- state us $conn(state)" - set conn(id) [string map {- {}} [uuid::uuid generate]] - set xml "" - WriteTo $conn(in) $xml + if {$conn(id) eq {}} { + + # Outgoing stream. They provide the session id and we provide the key. + # + set conn(id) $attr(id) + set conn(key) [sha1::sha1 [sha1::sha1 [sha1::sha1 $options(secret)]$conn(from)]$conn(id)] + set xml "$conn(key)" + set conn(state) dialback + WriteTo $conn(out) $xml + + } else { + + # Incoming stream - at this point we don't know who they are. But we manage the + # session id. So send it now. + set xml "" + append xml "" + set conn(state) dialback + WriteTo $conn $xml + + } } -proc ::xmppd::s2s::OnCloseStream {connid} { - variable $connid - upvar #0 [namespace current]::$connid conn - catch {close $conn(in)} - Log notice "- $conn(in) closed" +proc ::xmppd::s2s::OnCloseStream {chan} { + variable $chan + upvar #0 [namespace current]::$chan conn + catch {close $chan} + catch {unset conn} msg + Log notice "- $chan closed: $msg" } -proc ::xmppd::s2s::OnError {connid code args} { - variable $connid - upvar #0 [namespace current]::$connid conn - puts stderr "- error $connid $code" - WriteTo $conn(out) "" - catch {close $conn(out)} - Log notice "- $conn(out) closed" +proc ::xmppd::s2s::OnError {chan code args} { + variable $chan + upvar #0 [namespace current]::$chan conn + puts stderr "- $chan error $code" + WriteTo $chan "" + catch {close $chan} + catch {unset conn} msg + Log notice "- $chan closed: msg" } -proc ::xmppd::s2s::OnInput {connid xmllist} { - variable $connid - upvar #0 [namespace current]::$connid conn +proc ::xmppd::s2s::OnInput {chan xmllist} { + variable $chan + upvar #0 [namespace current]::$chan conn foreach {cmd attr close value children} $xmllist break + array set a {xmlns {}} array set a $attr switch -exact -- $cmd { features { @@ -361,9 +384,22 @@ proc ::xmppd::s2s::OnInput {connid xmllist} { result { Log debug "- result $xmllist" if {$a(xmlns) eq "jabber:server:dialback"} { - #set state(key,$a(from)) $value - #set xml "$state(key,$a(from))" - #writeto $state(sout) $xml + # This should be from an incoming stream + # result has the key and from + if {$conn(key) ne ""} {error "I GOT IT WRONG"} + set conn(key) $value + set conn(id) $a(id) + set conn(from) $a(id) + # Find the corresponding outgoing stream (if it exists) + set outid [FindConnection $conn(to) $conn(from)] + if {$outid ne {}} { + variable $outid + upvar #0 $outid out + set xml "$conn(key)" + WriteTo $outid $xml + } } } verify { @@ -397,6 +433,8 @@ if {!$tcl_interactive} { set unpresence {} namespace import -force xmppd::s2s::* + xmppd::s2s::route -from uknml2375.renishaw.com -to bugzilla.renishaw.com \ + {} } # ------------------------------------------------------------------------- -- 2.23.0