Posted to tcl by bohagan at Fri Jul 05 01:50:49 GMT 2024view pretty
proc callback_handler {fn chan args} {
switch $fn {
"error" {
# New
lassign $args message
}
"info" {
# Updated
set type ""
lassign $args major minor message type
}
"message" {
# New
lassign $args direction version content_type message
}
"session" {
# New
lassign $args session_id ticket lifetime
}
"verify" {
# Obsolete
return [validate_handler verify $chan {*}$args]
}
default {
}
}
}
proc password_handler {{fn password} {rwflag 0} {size 0}} {
}
proc validate_handler {fn chan args} {
switch $fn {
"alpn" {
# new - server obly
lassign $args protocol match
}
"hello" {
# new - server only
lassign $args servername
}
"sni" {
# new - server only
lassign $args servername
}
"verify" {
# Moved
lassign $args depth cert status error
}
default {
}
}
return 1
}
set cmd [list tls::import $chan -command callback_handler]
if {[package vsatisfies [package provide tls] 1.8]} {
lappend cmd -password password_handler -validatecommand validate_handler
}
eval $cmd