The following short example from miguel demonstrates the use of TWAPI for communicating over SSL/TLS on Windows.
#
# Create [ssocket], an ssl-enabled clone of the [socket] command
#
# The credentials should be in cert.pfx in the same folder as this script, the
# file cert.pwd should contain the password.
#
# At the bottom of the file we create an echo-server using ssocket.
#
apply [list {} {
set base [file normalize [file dir [info script]]]
set fbase [file join $base cert]
set ::auto_path [linsert $::auto_path 0 [file join $base twapi-bin]]
if {![catch {puts "twapi [package require twapi_crypto]"}] \
&& [file exists $fbase.pfx]} {
# adapted from tls_init_echo_server_creds
# http://sourceforge.net/p/twapi/code/ci/default/tree/twapi/tests/tlsecho.tcl
set init_creds [list fbase {
set f [open $fbase.pfx rb]
set pfx [read $f]
close $f
set f [open $fbase.pwd r]
set pwd [gets $f]
close $f
# Set up the store containing the certificates
set certStore [cert_temporary_store -pfx $pfx \
-password [conceal $pwd]]
# Set up the client and server credentials
# Note: the substring should identify your certified url
set serverCert [cert_store_find_certificate $certStore \
subject_substring hunter]
set creds [sspi_schannel_credentials \
-certificates [list $serverCert] \
-protocols [list ssl3 tls1.1 tls1.2]]
set creds [sspi_acquire_credentials \
-credentials $creds \
-package unisp -role server]
cert_release $serverCert
cert_store_release $certStore
return $creds
} ::twapi]
interp alias {} ssocket {} ::twapi::tls_socket \
-credentials [::apply $init_creds $fbase]
} else {
return -code error "NO TLS"
}
}]
##################
## The echo server
##################
# An echo server - just to test the tls connection
proc answer {chan h p} {
if {[set request [gets $chan]] eq {}} return
puts $chan "Received request: '$request'"
close $chan
}
set port 1234
ssocket -server answer $port
vwait foreverHaO 2020-08-19: Works like a charm for me. Some observations when adapting TCLTLS in Embedded TCL Web Server for TWAPI:
openssl pkcs12 -inkey private.pem -in public.pem -export -out privatepublic.pfx
For me, the following command included in the upper example
cert_store_find_certificate $certStore subject_substring hunter
returned the empty string to say that the certificate was not found.
I don't know what a substring in this context is. I only had a common name and replacing "hunter" by my common name did not succeed. Searching any certificate did the job for me:
cert_store_find_certificate $certStore any
If anything goes wrong within TLS negociation, in some situations a bgerror is called. This is due to the way, the stacked channel subsystem handles those errors.
A typicall error example is a socket close while negociating. Thats my typical test case: just open a channel and close it.
The error trace is as follows:
% set errorInfo
Unexpected EOF during TLS negotiation (NEGOTIATING)
while executing
"throw {TWAPI TLS NEGOTIATE EOF} "Unexpected EOF during TLS negotiation (NEGOTIATING)""
(procedure "_negotiate2" line 16)
invoked from within
"_negotiate2 $chan"
(procedure "rethrow" line 2)
invoked from within
"rethrow"
invoked from within
"trap {
_negotiate2 $chan
} onerror {} {
variable _channels
if {[info exists _channels($chan)]} {
if {[dict get..."
(procedure "_negotiate" line 3)
invoked from within
"_negotiate $chan"
(procedure "::twapi::tls_background_error" line 9)
invoked from within
"::twapi::tls_background_error $result $ropts"
(procedure "_negotiate_from_handler" line 22)
invoked from within
"_negotiate_from_handler $chan"
(procedure "::twapi::tls::_so_read_handler" line 7)
invoked from within
"::twapi::tls::_so_read_handler rc1"
% set errorCode
TWAPI TLS NEGOTIATE EOFThis is annoying for me, as my application opens an error box, but the error is more on the other side of the channel. I would prefer an error, I may clearly attribute to the socket and handle it in a different way than general background errors.
In consequence, I am filtering those errors by the error code:
interp bgerror {} myBGError
proc myBGError {errorMsg errorDict} {
set errorCode [dict get $errDict -errorcode]
if {[string match "TWAPI TLS *" $errorCode]} {
# TLS negociation error
puts stderr "TLS Negociation failed: $errorMsg"
} else {
tk_messageBox -message "Error $errorMsg"
}
}TWAPI 4.5.2 has a new command prefix, that those errors may be handled in a particular way. I use that to be sure that the error code starts with "TWAPI TLS":
if {0 != [llength [info commands twapi::tls_background_error]]} {
proc ::twapi::tls_background_error {result ropts} {
if {![string match "TWAPI TLS *" [dict get $ropts -errorcode]]} {
dict set ropts -errorcode\
[concat {TWAPI TLS} [dict get $ropts -errorcode]]
}
return -options $ropts $result
}
}There are still some issues here: