From: Pat Thoyts <patthoyts@users.sourceforge.net>
Date: Sat, 17 Oct 2020 09:50:09 +0000 (+0100)
Subject: s2c: use default tls protocol options with new tls package
X-Git-Url: http://privyetmir.co.uk/gitweb?a=commitdiff_plain;h=fd053ef7d25b4a8d6b2d2d65dc3846c4ee63f896;p=tclxmppd.git

s2c: use default tls protocol options with new tls package

Pass in the cadir/cafile options to make use of certificate verification
and let the current default settings for available protocols apply to
enable tls1.1 and above as currently appropriate
---

diff --git a/s2c.tcl b/s2c.tcl
index fbe8436..864dd12 100644
--- a/s2c.tcl
+++ b/s2c.tcl
@@ -382,8 +382,10 @@ proc ::xmppd::s2c::SASLCallback {Channel context command args} {
     variable options
     upvar #0 $Channel channel
     switch -exact -- $command {
+        login { return [lindex $args 0] }
+        username { return [lindex $args 0] }
         password {
-            #Log debug "SASL retrieve password for authid [lindex $args 0] '$args'"
+            Log debug "SASL retrieve password for authid [lindex $args 0] '$args'"
             set channel(jid) [lindex $args 0]@[cget -domain]
             return [eval [linsert $args 0 [cget -s2c:authenticate]]]
         }
@@ -412,6 +414,20 @@ proc ::xmppd::s2c::SASLFailure {Channel msg} {
     Close $Channel
 }
 
+proc ::xmppd::s2c::OnTlsImport {cmd args} {
+    switch -exact -- $cmd {
+        info {
+            lassign $args chan major minor msg
+            Log debug "tls import $chan $major $minor \"$msg\""
+        }
+        verify {
+            lassign $args chan depth cert status err
+            Log debug "tls import verify: $chan $depth $cert $status $err"
+            return 1; # cert is valid
+        }
+    }
+}
+
 proc ::xmppd::s2c::OnInput {Channel xmllist} {
     variable options
     upvar #0 $Channel channel
@@ -433,8 +449,13 @@ proc ::xmppd::s2c::OnInput {Channel xmllist} {
                 WriteTo $Channel $xml
                 flush $channel(sock)
                 wrapper::reset $channel(parser)
-                tls::import $channel(sock) -server 1 -tls1 1 -ssl3 1 -ssl2 0 \
-                    -keyfile [cget -keyfile] -certfile [cget -certfile]
+                tls::import $channel(sock) \
+                    -server 1 \
+                    -command [list [namespace current]::OnTlsImport] \
+                    -cadir [cget -cadir] \
+                    -cafile "" \
+                    -keyfile [cget -keyfile] \
+                    -certfile [cget -certfile]
             }
         }
 
@@ -551,7 +572,7 @@ proc ::xmppd::s2c::Routing {Channel xmllist} {
         Log debug "Routing calling local handler"
         CallHandler $Channel $xmllist
     } else {
-        Log debug "Routing route $from $to"
+        Log debug "Routing route '$from' '$to'"
         xmppd::route $from $to [wrapper::createxml $xmllist]
     }
 }