From: Pat Thoyts Date: Sat, 20 Nov 2004 14:25:00 +0000 (+0000) Subject: Yet more work. About to start supporting multiple sessions per channel. X-Git-Tag: xmppd-1-0-0~3 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=5d96b8ddd68232b73d63d53ebe25f5df5ad00b78;p=tclxmppd.git Yet more work. About to start supporting multiple sessions per channel. --- diff --git a/ChangeLog b/ChangeLog index d74e1b2..59ce529 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2004-11-20 Pat Thoyts + + * s2s.tcl: Still in progress. This version nicely keeps each + stream (in/out) separated but manages to use the same callbacks + quite simple. We are successully dealing with the outbound + connections (jabberd2 is happy) but we are not managing to handle + the inbound ones properly. This is because both all.tclers.tk and + tach.tclers.tk are coming in on the same channel. So we have to be + able to hook up multiple sessions per channel. + 2004-11-19 Pat Thoyts * s2s.tcl: Still not complete. Reconfigured big time. diff --git a/s2s.tcl b/s2s.tcl index e9c4845..01aee5f 100644 --- a/s2s.tcl +++ b/s2s.tcl @@ -1,17 +1,21 @@ # s2s.tcl - Copyright (C) 2004 Pat Thoyts # +# A Tcl implementation of the Jabber server-to-server protocol. +# See http://www.jabber.org/ # +# RFC 3920 [http://www.ietf.org/rfc3921.txt] -- CHECK +# RFC 3921 [http://www.ietf.org/rfc3921.txt] # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- -package require tls -package require wrapper -package require uuid -package require sha1 -package require logger +package require wrapper; # jabberlib +package require uuid; # tcllib +package require sha1; # tcllib +package require logger; # tcllib +#package require tls #package require Tclresolver namespace eval ::xmppd {} @@ -31,17 +35,24 @@ namespace eval ::xmppd::s2s { port 5269 loglevel debug } - set options(jid) [info hostname] + #set options(jid) [info hostname] } variable log if {![info exists log]} { set log [logger::init s2s] ${log}::setlevel $options(loglevel) + namespace eval $log { + variable logfile + set logfile [open s2s.log a+] + fconfigure $logfile -buffering line + puts $logfile [string repeat - 72] + } proc ${log}::stdoutcmd {level text} { variable service - #puts "\[[clock format [clock seconds] -format {%H:%M:%S}]\ - # $service $level\] $text" + variable logfile + set ts [clock format [clock seconds] -format {%H:%M:%S}] + puts $logfile "\[$ts\] $level $text" puts stderr $text } } @@ -144,7 +155,7 @@ proc ::xmppd::s2s::route {args} { } set data [lindex $args 0] if {[string length $data] < 1} { - Log warning "[lindex [info level 0] 0] no data to send!" + Log warn "[lindex [info level 0] 0] no data to send!" return } @@ -185,10 +196,10 @@ proc ::xmppd::s2s::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 + foreach connid [info vars [namespace current]::sock*] { + upvar #0 $connid conn if {$conn(from) eq $from && $conn(to) eq $to} { - return $connid + return [namespace tail $connid] } } return {} @@ -214,12 +225,13 @@ 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 localhost 55269] ;# FIX ME + 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) 0 + set conn(id) {} set conn(state) init set conn(queue) {} set conn(after) {} @@ -239,23 +251,24 @@ proc ::xmppd::s2s::Write {chan} { variable $chan upvar #0 [namespace current]::$chan conn fileevent $chan writable {} - set xml "" + set xml "" + append xml "" WriteTo $chan $xml } - proc ::xmppd::s2s::Read {chan} { variable $chan upvar #0 [namespace current]::$chan conn - if {[eof $chan]} { + if {[eof $conn(chan)]} { fileevent $chan readable {} + Log warn "- EOF on $chan" # delete parser # clean up session # remove route } - set xml [read $chan] + set xml [read $conn(chan)] Log debug "< $chan $xml" wrapper::parse $conn(parser) $xml } @@ -263,10 +276,10 @@ proc ::xmppd::s2s::Read {chan} { proc ::xmppd::s2s::Flush {connid} { variable $connid upvar #0 [namespace current]::$connid conn - after cancel $conn(after) + catch {after cancel $conn(after)} if {$conn(state) ne "init"} { set data [lindex $conn(queue) 0] - if {![catch {WriteTo $conn(out) $data} err]} { + if {![catch {WriteTo $conn(chan) $data} err]} { Pop conn(queue) } } @@ -314,6 +327,33 @@ proc ::xmppd::s2s::Accept {chan clientaddr clientport} { fileevent $chan readable [list [namespace current]::Read $chan] } + +# Raise -- +# +# Raise a stream error and close the route. +# +proc ::xmppd::s2s::Raise {chan type args} { + set xml "" + append xml "<$type xmlns='urn:ietf:params:xml:ns:xmpp-streams'/>" + WriteTo $chan $xml + Close $chan +} + +# Close -- +# +# Shut down a route. We close the channel and clear up our state. +# +# 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::OnOpenStream {chan args} { @@ -330,24 +370,37 @@ proc ::xmppd::s2s::OnOpenStream {chan args} { if {$conn(id) eq {}} { # Outgoing stream. They provide the session id and we provide the key. - # + + # RFC3920 8.3.3: We must reject if invalid namespace. + if {![info exists attr(xmlns)] + || $attr(xmlns) ne "http://etherx.jabber.org/streams"} { + return [Raise $chan 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 xml "$conn(key)" set conn(state) dialback - WriteTo $conn(out) $xml + WriteTo $chan $xml } else { - # Incoming stream - at this point we don't know who they are. But we manage the - # session id. So send it now. + # RFC3920 8.3.7: check namespace + if {![info exists attr(xmlns)] + || $attr(xmlns) ne "http://etherx.jabber.org/streams"} { + return [Raise $chan invalid-namespace] + } + + # Incoming stream - at this point we may not 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 + WriteTo $chan $xml } } @@ -363,57 +416,96 @@ proc ::xmppd::s2s::OnCloseStream {chan} { proc ::xmppd::s2s::OnError {chan code args} { variable $chan upvar #0 [namespace current]::$chan conn - puts stderr "- $chan error $code" + Log error "- $chan error $code" WriteTo $chan "" catch {close $chan} catch {unset conn} msg Log notice "- $chan 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::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 {xmlns {} from {} to {}} array set a $attr + switch -exact -- $cmd { features { Log debug "- features $xmllist" } result { Log debug "- result $xmllist" + + # RFC3920 8.3: All stanzas MUST include both to and from + if {$a(from) eq "" || $a(to) eq ""} { + Raise $chan 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 ""} {error "I GOT IT WRONG"} + if {$conn(key) ne ""} {Log error "I GOT IT WRONG"} set conn(key) $value - set conn(id) $a(id) - set conn(from) $a(id) + 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 {$outid ne {}} { + if {[llength $outid] > 0} { variable $outid - upvar #0 $outid out + upvar #0 [namespace current]::$outid out set xml "$conn(key)" WriteTo $outid $xml + } else { + # We need to create an outbound connection to go with + # this. + Open $a(to) $a(from) } } } verify { - if {![info exists a(-type)]} { - #set xml "" - #writeto $chan $xml + Log debug "- verify $xmllist" + + # RFC3920 8.3: All stanzas MUST include both to and from + if {$a(from) eq "" || $a(to) eq ""} { + Raise $chan improper-addressing + } + + 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) + } } else { - Log debug "- verify $xmllist" + # 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 + } + set xml "" + WriteTo $chan $xml + } } } default { @@ -428,13 +520,25 @@ if {!$tcl_interactive} { } else { - xmppd::s2s::start - set presence {} - set unpresence {} + catch {xmppd::s2s::start} + #set presence {} + #set unpresence {} namespace import -force xmppd::s2s::* - xmppd::s2s::route -from uknml2375.renishaw.com -to bugzilla.renishaw.com \ + #xmppd::s2s::route -from uknml2375.renishaw.com -to bugzilla.renishaw.com \ {} + 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 \ + "\ + [wrapper::xmlcrypt $msg]" + } } # -------------------------------------------------------------------------