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