TLS server using TWAPI

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
        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 forever

HaO 2020-08-19: Works like a charm for me. Some observations when adapting TCLTLS in Embedded TCL Web Server for TWAPI:

To convert a pair of PEM certificates, OPENSSL may be used to get the PFX file

openssl pkcs12 -inkey private.pem -in public.pem -export -out privatepublic.pfx

Find certificate

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

bgerror call on TLS negociation

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
    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

This 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:

  • The error may not clearly be attributed to a certain server/client socket
  • The error does not apprear close to the socket procedures
  • No solution for TCLTLS package
  • May only be solved by modifying the global bgerror routine which is impossible for packages. For example, the TCLWS package would need that in the embedded server, but this would interfere on the global level.
  • Opened tickets perhaps to follow: TWAPI RFE 189 , TLS RFE 2c7b748796