From 51872ae6ac0a6ae763504bd72e41a10ac61d9ad7 Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Wed, 24 Nov 2004 03:54:40 +0000 Subject: [PATCH] * s2s.tcl: Redesigned to separate channels and sessions living on top of channels. This permits multiple routes over a single socket (which jabberd2 is doing). Close. --- ChangeLog | 6 + s2s.tcl | 570 ++++++++++++++++++++++++++++++++++++------------------ 2 files changed, 392 insertions(+), 184 deletions(-) diff --git a/ChangeLog b/ChangeLog index 59ce529..6799a9a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2004-11-24 Pat Thoyts + + * s2s.tcl: Redesigned to separate channels and sessions living on + top of channels. This permits multiple routes over a single socket + (which jabberd2 is doing). Close. + 2004-11-20 Pat Thoyts * s2s.tcl: Still in progress. This version nicely keeps each diff --git a/s2s.tcl b/s2s.tcl index 01aee5f..226bf07 100644 --- a/s2s.tcl +++ b/s2s.tcl @@ -15,8 +15,8 @@ package require wrapper; # jabberlib package require uuid; # tcllib package require sha1; # tcllib package require logger; # tcllib +package require dns 1.2.1; # tcllib 1.8 #package require tls -#package require Tclresolver namespace eval ::xmppd {} namespace eval ::xmppd::s2s { @@ -187,6 +187,53 @@ proc ::xmppd::s2s::stop {} { return } +# look up the IP address for the server of a given JID. +# This uses the DNS SRV records as described in RFC3920 and +# falls back to DNS A record resolution if no SRV records. +proc ::xmppd::s2s::resolve {jid} { + set front [string first @ $jid] + set back [string last / $jid] + if {$back == -1} {set back end} else {incr back -1} + set hostname [string range $jid [incr front] $back] + + set result {} + set port 5269 + foreach srvd {"_xmpp-server._tcp" "_jabber._tcp"} { + set tok [dns::resolve "${srvd}.${hostname}" -type SRV] + if {[dns::status $tok] eq "ok"} { + set answers {} + foreach rr [dns::result $tok] { + array set res $rr + if {[info exists res(type)] \ + && $res(type) eq "SRV" \ + && [llength $res(rdata)] > 0} { + lappend answers $res(rdata) + } + } + lsort -index 1 $answers + array set rrr [lindex $answers 0] + set port $rrr(port) + if {[ip::version $rrr(target)] == -1} { + set hostname $rrr(target) + } else { + set result [list $rrr(target) $port] + } + } + dns::cleanup $tok + if {[llength $result] > 0} {break} + } + + if {[llength $result] == 0} { + set tok [dns::resolve $hostname -type A] + if {[dns::status $tok] eq "ok"} { + set result [list [dns::address $tok] $port] + } + dns::cleanup $tok + } + + return $result +} + # ------------------------------------------------------------------------- proc ::xmppd::s2s::Log {level msg} { @@ -194,27 +241,97 @@ proc ::xmppd::s2s::Log {level msg} { ${log}::${level} $msg } +# Holds info about a socket stream. +# The from and to items are temporary as routes are held on session objects. +# Once the session is created, we erase the from and to items. +proc ::xmppd::s2s::CreateChannel {} { + variable uid + set Channel [namespace current]::channel[incr uid] + variable $Channel + upvar #0 $Channel channel + array set channel {sock {} address {} port {} from {} to {} parser {}} + return $Channel +} + # Find a session for a given route -proc ::xmppd::s2s::FindConnection {from to} { - foreach connid [info vars [namespace current]::sock*] { - upvar #0 $connid conn - if {$conn(from) eq $from && $conn(to) eq $to} { - return [namespace tail $connid] +proc ::xmppd::s2s::FindChannel {addr} { + foreach channel [info vars [namespace current]::channel*] { + upvar #0 $channel chan + if {$chan(address) eq $addr} { + return $channel } } return {} } +proc ::xmppd::s2s::CreateSession {} { + variable uid + set Session [namespace current]::session[incr uid] + variable $Session + upvar #0 $Session session + array set session { + chan {} from {} to {} id {} state new + queue {} after {} key {} parser {} + } + return $Session +} + +# Find a session for a given route +proc ::xmppd::s2s::FindSession {op args} { + set r {} + switch -exact -- $op { + id { + set id [lindex $args 0] + foreach Session [info vars [namespace current]::session*] { + upvar #0 $Session session + if {[info exists session(id)] && $session(id) eq $id} { + lappend r $Session + break + } + } + } + name { + foreach {from to} $args break + foreach Session [info vars [namespace current]::session*] { + upvar #0 $Session session + if {[info exists session(from)] && $session(from) eq $from + && [info exists session(to)] && $session(to) eq $to} { + lappend r $Session + break + } + } + } + channel { + set Channel [lindex $args 0] + foreach Session [info vars [namespace current]::session*] { + upvar #0 $Session session + if {[info exists session(channel)] + && $session(channel) eq $Channel} { + lappend r $Session + } + } + } + default { + return -code error "invalid operation \"$op\":\ + must be one of \"id\", \"name\" or \"channel\"" + } + } + return $r +} + proc ::xmppd::s2s::Queue {from to data} { Log debug "Queue message -from $from -to $to" - set connid [FindConnection $from $to] - if {$connid eq {}} { - set connid [Open $from $to] + # Either find an open session or open a new one. + set Session [FindSession name $from $to] + if {[llength $Session] < 1} { + set Session [Open $from $to] } - upvar #0 [namespace current]::$connid conn - lappend conn(queue) $data - if {[llength $conn(queue)] == 1} { - set conn(after) [after 10 [list [namespace current]::Flush $connid]] + # Queue our message for transmission by this session. + upvar #0 $Session session + lappend session(queue) $data + if {[llength $session(queue)] == 1} { + set session(after) \ + [after 10 [list [namespace current]::Flush $Session]] } return } @@ -225,66 +342,104 @@ 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 {from to} { - set chan [socket -async $to 5269] - variable $chan - upvar #0 [namespace current]::$chan conn - set conn(chan) $chan - set conn(from) $from - set conn(to) $to - set conn(id) {} - set conn(state) init - set conn(queue) {} - set conn(after) {} - set conn(key) {} - 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 -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 + + # First, resolve the hostname. If possible we can re-use a connection that + # already exists. + + if {[llength [set addr [resolve $to]]] < 1} { + return -code error "hostname invalid: \"$to\" failed to resolve ip address" + } + + set Channel [FindChannel [lindex $addr 0]] + if {[llength $Channel] < 1} { + set Channel [CreateChannel] + upvar #0 $Channel channel + set channel(dir) out + set channel(address) [lindex $addr 0] + set channel(port) [lindex $addr 1] + set channel(from) $from + set channel(to) $to + set channel(parser) \ + [wrapper::new \ + [list [namespace current]::OnOpenStream $Channel] \ + [list [namespace current]::OnCloseStream $Channel] \ + [list [namespace current]::OnInput $Channel] \ + [list [namespace current]::OnError $Channel]] + + set sock [socket -async $channel(address) $channel(port)] + set channel(sock) $sock + fconfigure $sock -buffering none -blocking 0 \ + -encoding utf-8 -translation lf + fileevent $sock writable [list [namespace current]::Write $Channel] + fileevent $sock readable [list [namespace current]::Read $Channel] + } + + return $Channel +} + +proc ::xmppd::s2s::Accept {chan clientaddr clientport} { + variable options + Log notice "XMPP s2s accept connect from $clientaddr:$clientport on $chan" + # RFC3920 8.3(5): The remote server opens a stream back here based upon + # the domain name we provided. + set Channel [CreateChannel] + upvar #0 $Channel channel + set channel(dir) in + set channel(address) $clientaddr + set channel(port) $clientport + set channel(sock) $chan + set channel(parser) \ + [wrapper::new \ + [list [namespace current]::OnOpenStream $Channel] \ + [list [namespace current]::OnCloseStream $Channel] \ + [list [namespace current]::OnInput $Channel] \ + [list [namespace current]::OnError $Channel]] + + fconfigure $chan -translation binary -encoding utf-8 \ + -buffering none -blocking 0 + fileevent $chan readable [list [namespace current]::Read $Channel] } -proc ::xmppd::s2s::Write {chan} { - variable $chan - upvar #0 [namespace current]::$chan conn - fileevent $chan writable {} +proc ::xmppd::s2s::Write {Channel} { + upvar #0 $Channel channel + fileevent $channel(sock) writable {} set xml "" append xml "" - WriteTo $chan $xml + append xml " version='1.0'>" + WriteTo $channel(sock) $xml } -proc ::xmppd::s2s::Read {chan} { - variable $chan - upvar #0 [namespace current]::$chan conn - if {[eof $conn(chan)]} { - fileevent $chan readable {} - Log warn "- EOF on $chan" +proc ::xmppd::s2s::Read {Channel} { + upvar #0 $Channel channel + if {[eof $channel(sock)]} { + fileevent $channel(sock) readable {} + Log warn "- EOF on $Channel ($channel(sock))" # delete parser # clean up session # remove route } - set xml [read $conn(chan)] - Log debug "< $chan $xml" - wrapper::parse $conn(parser) $xml + set xml [read $channel(sock)] + Log debug "< $channel(sock) $xml" + wrapper::parse $channel(parser) $xml } -proc ::xmppd::s2s::Flush {connid} { - variable $connid - upvar #0 [namespace current]::$connid conn - catch {after cancel $conn(after)} - if {$conn(state) ne "init"} { - set data [lindex $conn(queue) 0] - if {![catch {WriteTo $conn(chan) $data} err]} { - Pop conn(queue) +proc ::xmppd::s2s::Flush {Session} { + upvar #0 $Session session + if {![info exists session]} {return} + if {[info exists session(channel)]} { + upvar #0 $session(channel) channel + catch {after cancel $session(after)} + if {$session(state) ne "init"} { + set data [lindex $session(queue) 0] + if {![catch {WriteTo $channel(sock) $data} err]} { + Pop session(queue) + } } } - if {[llength $conn(queue)] != 0} { - set conn(after) [after 1000 [list [namespace current]::Flush $connid]] + if {[llength $session(queue)] != 0} { + set session(after) \ + [after 1000 [list [namespace current]::Flush $Session]] } return } @@ -303,40 +458,17 @@ proc ::xmppd::s2s::Pop {varname {nth 0}} { return $r } -proc ::xmppd::s2s::Accept {chan clientaddr clientport} { - variable options - Log notice "XMPP s2s accept connect from $clientaddr:$clientport on $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]::Read $chan] -} - - # Raise -- # # Raise a stream error and close the route. # -proc ::xmppd::s2s::Raise {chan type args} { +proc ::xmppd::s2s::Raise {Channel type args} { + # FIX ME - close just the session!? + upvar #0 $Channel channel set xml "" append xml "<$type xmlns='urn:ietf:params:xml:ns:xmpp-streams'/>" - WriteTo $chan $xml - Close $chan + WriteTo $channel(sock) $xml + Close $Channel } # Close -- @@ -346,97 +478,92 @@ proc ::xmppd::s2s::Raise {chan type args} { # FIX ME: we need to clean up the parser state too -- we currently # leak the parsers resources. # -proc ::xmppd::s2s::Close {chan} { - variable $chan - upvar #0 [namespace current]::$chan conn - WriteTo $chan "" - close $chan - unset conn +proc ::xmppd::s2s::Close {Channel} { + # FIX ME - this probably should just close a session. + upvar #0 $Channel channel + WriteTo $channel(sock) "" + OnCloseStream $Channel } # ------------------------------------------------------------------------- -proc ::xmppd::s2s::OnOpenStream {chan args} { +proc ::xmppd::s2s::OnOpenStream {Channel args} { variable options - variable $chan - upvar #0 [namespace current]::$chan conn + variable $Channel + upvar #0 $Channel channel array set attr $args - Log debug "O $chan [array get attr]" - if {$conn(state) ne "init"} { - Log error "- unexpected state \"$conn(state)\" in openstream" - } + Log debug "OPENSTREAM $channel(sock) [array get attr]" - if {$conn(id) eq {}} { + if {[info exists attr(id)]} { - # Outgoing stream. They provide the session id and we provide the key. - - # RFC3920 8.3.3: We must reject if invalid namespace. + # RFC3920 8.3(3): Remote server sends up a unique session id. + # The from and to elements are optional here. + # We must reject invalid namespace. if {![info exists attr(xmlns)] || $attr(xmlns) ne "http://etherx.jabber.org/streams"} { - return [Raise $chan invalid-namespace] + return [Raise $Channel invalid-namespace] } - set conn(id) $attr(id) - - # RFC3920 8.3.4: send the dialback key - set conn(key) [sha1::sha1 [sha1::sha1 [sha1::sha1 $options(secret)]$conn(from)]$conn(id)] + set Session [CreateSession] + upvar #0 $Session session + set session(channel) $Channel + set session(from) $channel(from) + set session(to) $channel(to) + set session(id) $attr(id) + set channel(from) {}; # clean up temporary channel items + set channel(to) {}; # + + # RFC3920 8.3(4): The Originating Server (us) sends a dialback key + # to the Receiving Server (them) + set key [sha1::sha1 $options(secret)] + set key [sha1::sha1 ${key}$session(from)] + set session(key) OUT[sha1::sha1 ${key}$session(id)] set xml "$conn(key)" - set conn(state) dialback - WriteTo $chan $xml + to='$session(to)' from='$session(from)'>$session(key)" + set session(state) dialback + WriteTo $channel(sock) $xml } else { - # RFC3920 8.3.7: check namespace + # RFC3920 8.3(6): The Receiving Server (them) sends the Authoritative + # Server (us) a stream header. From and to are + # optional. We MUST reject invalid namespaces. if {![info exists attr(xmlns)] || $attr(xmlns) ne "http://etherx.jabber.org/streams"} { - return [Raise $chan invalid-namespace] + return [Raise $Channel invalid-namespace] } - # Incoming stream - at this point we may not know who they are. - # But we manage the session id. So send it now. + # RFC3920 8.3(7): The Authoritative Server (us) sends the Receiving + # Server (them) a stream header - with a session id + # We don't have enough info to create a session, so we store the + # id on the channel + set channel(id) [string map {- {}} [uuid::uuid generate]] + set xml "" append xml "" - set conn(state) dialback - WriteTo $chan $xml - + id='$channel(id)' version='1.0'>" + WriteTo $channel(sock) $xml } } -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 {chan code args} { - variable $chan - upvar #0 [namespace current]::$chan conn - Log error "- $chan error $code" - WriteTo $chan "" - catch {close $chan} - catch {unset conn} msg - Log notice "- $chan closed: msg" +proc ::xmppd::s2s::OnCloseStream {Channel} { + upvar #0 $Channel channel + catch {close $channel(sock)} + # FIX ME - how to close the parser? + catch {unset channel} msg + Log notice "- $Channel closed: $msg" } -proc ::xmppd::s2s::NewSession {chan} { - set token [namespace current]::sess[incr uid] - variable $token - upvar #0 $token session - array set session [list id {} key {} from {} to {} \ - queue {} after {} state init \ - chan $chan parser {}] - return $token +proc ::xmppd::s2s::OnError {Channel code args} { + upvar #0 $Channel channel + Log error "- $Channel error $code" + WriteTo $channel(sock) "" + OnCloseStream $Channel } - -proc ::xmppd::s2s::OnInput {chan xmllist} { - variable $chan - upvar #0 [namespace current]::$chan conn +proc ::xmppd::s2s::OnInput {Channel xmllist} { + upvar #0 $Channel channel foreach {cmd attr close value children} $xmllist break array set a {xmlns {} from {} to {}} @@ -451,30 +578,62 @@ proc ::xmppd::s2s::OnInput {chan xmllist} { # RFC3920 8.3: All stanzas MUST include both to and from if {$a(from) eq "" || $a(to) eq ""} { - Raise $chan improper-addressing + Raise $Channel improper-addressing } - + if {$a(xmlns) eq "jabber:server:dialback"} { - # This should be from an incoming stream - # result has the key and from - if {$conn(key) ne ""} {Log error "I GOT IT WRONG"} - set conn(key) $value - if {[info exists a(id)]} {set conn(id) $a(id)} - if {[info exists a(from)]} {set conn(from) $a(from)} - # Find the corresponding outgoing stream (if it exists) - set outid [FindConnection $conn(to) $conn(from)] - if {[llength $outid] > 0} { - variable $outid - upvar #0 [namespace current]::$outid out + + if {[info exists a(type)]} { + # RFC3920 8.3(10): The Receiving Server (them) informs the + # Originating Server (us)of the result. + set Session [FindSession name $a(from) $a(to)] + if {$Session eq {}} { + return [Raise $Channel invalid-from] + } + upvar #0 $Session session + set session(state) $a(type) + return + } + + # RFC3290 8.3(4): The Originating Server (them) sends a + # dialback key to the Receiving Server (us) + # + if {![info exists channel(id)]} { + Log error "Argh - no channel id!!" + return + } + set Session [CreateSession] + upvar #0 $Session session + set session(id) $channel(id) + set session(state) dialback + set session(channel) $Channel + set session(from) $a(from) + set session(to) $a(to) + set session(key) $value + + # We need to send this key on the out channel with the + # out session id, from and to. + set Out [FindSession name $a(to) $a(from)] + if {$Out ne {}} { + upvar #0 $Out out set xml "$conn(key)" - WriteTo $outid $xml + from='$a(to)' to='$a(from)'\ + id='$session(id)'>$session(key)" + upvar #0 $out(channel) ochannel + WriteTo $ochannel(sock) $xml } else { - # We need to create an outbound connection to go with - # this. - Open $a(to) $a(from) + # 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" } + + } else { + Log error "unespected 'result' namespace'" } } verify { @@ -482,29 +641,66 @@ proc ::xmppd::s2s::OnInput {chan xmllist} { # RFC3920 8.3: All stanzas MUST include both to and from if {$a(from) eq "" || $a(to) eq ""} { - Raise $chan improper-addressing + Raise $Channel improper-addressing + } + + set Session [FindSession id $a(id)] + if {$Session eq {}} { + # Raise invalid-id ?? + Log error "Failed to find session for '$a(id)'" + return + } + upvar #0 $Session session + if {$session(from) eq {}} { + set session(from) $a(from) + set session(to) $a(to) } - if {[info exists a(type)]} { - set sid [FindConnection $a(from) $a(to)] - if {[llength $sid] > 0} { - upvar #0 [namespace current]::$sid sess - set sess(state) $a(type) + if {![info exists a(type)]} { + + # RFC3920 8.3(8): The Receiving Server (them) sends the + # Authoritative Server (us) a request for + # verification of a key. This is the id we + # recieved in step 3 and its key. So we are + # validating the out channel using data + # recieved on the in channel. + # Lets check the logic + if {$Channel eq $session(channel)} { + Log error "LOGIC FAILURE" + } + # RFC 3920 8.3(9): Check the key against the out session + set session(state) invalid + if {$session(key) eq $value} { + set session(state) valid } + set xml "" + WriteTo $channel(sock) $xml + } else { - # request to verify a key for a route - find the corresponding - # session and check the id/key pair. - set sid [FindConnection $a(to) $a(from)] - if {[llength $sid] > 0} { - upvar #0 [namespace current]::$sid sess - set type invalid - if {$sess(id) eq $a(id) && $sess(key) eq $value} { - set type valid + + # RFC3920 8.3(10): The Receiving Server (us) informs the + # Originating Server (them) of the result + 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 "" + 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)" } - set xml "" - WriteTo $chan $xml + } else { + Close $Channel } } } @@ -539,6 +735,12 @@ if {!$tcl_interactive} { to='test@tach.tclers.tk' type='groupchat'>\ [wrapper::xmlcrypt $msg]" } + + + set ns [dns::nameservers] + if {[llength $ns] > 0} { + dns::configure -nameserver [lindex $ns 0] -protocol tcp + } } # ------------------------------------------------------------------------- -- 2.23.0