From 1159cd60428a46e9d1c751ebaf1a8655b65f33cc Mon Sep 17 00:00:00 2001 From: Pat Thoyts Date: Sat, 17 Oct 2020 11:04:18 +0100 Subject: [PATCH] jabberd: handle ping and update the tls support --- tests/jabberd.tcl | 40 +++++++++++++++++++++++++++++++++++----- 1 file changed, 35 insertions(+), 5 deletions(-) diff --git a/tests/jabberd.tcl b/tests/jabberd.tcl index b38ccfb..059d626 100644 --- a/tests/jabberd.tcl +++ b/tests/jabberd.tcl @@ -16,13 +16,17 @@ package require xmppd::s2s package require xmppd::s2c package require xmppd::sm -# handler gets called with the xmllist from wrapper. +# Handle stanzas addressed to this server. +# input is xmllist from wrapper for the stanza to process. proc Handler {xmllist} { array set a [list to [xmppd::cget -domain] from {} id {}] array set a [wrapper::getattrlist $xmllist] switch -exact -- [set type [wrapper::gettag $xmllist]] { iq { + set query [lindex [wrapper::getchildren $xmllist] 0] + Log info "JABBERD: iq: $query" + # RFC3921 3: Session Establishment set sx [wrapper::getchildswithtagandxmlns $xmllist \ session [xmppd::xmlns session]] @@ -40,7 +44,29 @@ proc Handler {xmllist} { [list [list internal-server-error [list xmlns [xmppd::xmlns stanzas]] 1 {} {}]]] set r [list iq [list type error to $a(from) from $a(to) id $a(id)] 1 {} $rc] } - xmppd::route $a(to) $a(from) [wrapper::createxml $r] + xmppd::route $a(to) $a(from) [wrapper::createxml $r] + return + } + # XEP-0199: XMPP Ping + if {$a(to) eq [xmppd::cget -domain]} { + set ping [wrapper::getchildswithtagandxmlns $xmllist \ + ping [xmppd::xmlns ping]] + if {[llength $ping] > 0} { + Log debug "PING [array get a]" + set xml "" + xmppd::route $a(to) $a(from) $xml + return + } + } + + set priv [wrapper::getchildswithtagandxmlns $xmllist query [xmppd::xmlns privacy]] + if {[llength $priv] > 0} { + set rc {} + lappend rc [list error {type cancel code 404} 0 {} \ + [list [list item-not-found [list xmlns [xmppd::xmlns stanzas]] 1 {} {}]]] + lappend rc [lindex $priv 0] + set r [list iq [list type error to $a(from) from $a(to) id $a(id)] 0 {} $rc] + xmppd::route $a(to) $a(from) [wrapper::createxml $r] return } @@ -90,19 +116,23 @@ proc Log {level msg} { puts stderr "$level: $msg" } proc LoadConfig {} { # FIX ME: should load from a .conf file - set cert [file join [file dirname [info script]] jabberd.pem] + set key [file normalize [file join [file dirname [info script]] jabberd.key]] + set cert [file normalize [file join [file dirname [info script]] jabberd.crt]] set db [file join [file dirname [info script]] jabberd.db] xmppd::configure \ -domain patthoyts.tk \ -loglevel debug \ -logfile xmppd.log \ -certfile $cert \ - -keyfile $cert \ + -keyfile $key \ + -cadir /etc/ssl/certs \ + -cafile /etc/ssl/certs/ca-certificates.crt \ -s2c:handler ::Handler \ -s2c:authenticate ::xmppd::sm::authuser \ -sm:db:type Sqlite \ -sm:database $db - + + # register stream features xmppd::register feature session [xmppd::xmlns session] } -- 2.23.0