jabberd: handle ping and update the tls support

diff --git a/tests/jabberd.tcl b/tests/jabberd.tcl
index b38ccfb16eb6c6edb9fa07c5889d0463c17060fe..059d6260d0581cb546e9e9154c5f3498e2bcdb58 100644 (file)
--- a/tests/jabberd.tcl
+++ b/tests/jabberd.tcl
@@ -16,13 +16,17 @@ package require xmppd::s2s
 package require xmppd::s2c
 package require xmppd::sm
 
 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 {
 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]]
             # 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]
                 }
                                     [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 "<iq id='$a(id)' to='$a(from)' from='$a(to)' type='result'/>"
+                    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
             }
 
                 return
             }
 


@@ -90,19 +116,23 @@ proc Log {level msg} { puts stderr "$level: $msg" }
 
 proc LoadConfig {} {
     # FIX ME: should load from a .conf file
 
 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 \
     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
         -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]
 }
 
     xmppd::register feature session [xmppd::xmlns session]
 }