#========================================================================
# Test and debug
#========================================================================

test: binaries libraries
	$(TCLSH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) \
	    -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) {\
		load $(PKG_LIB_FILE) [string totitle $(PACKAGE_NAME)]; \
		source $(srcdir)/library/$(PACKAGE_NAME).tcl}"

shell: binaries libraries
	@$(TCLSH) $(SCRIPT)

gdb:
	$(TCLSH_ENV) $(PKG_ENV) $(GDB) $(TCLSH_PROG) $(SCRIPT)

		    TCLTLS_SSL_LIBS="$SSL_LIBS_PATH -lssl -lcrypto"
		else
		    # Linux and Solaris
		    TCLTLS_SSL_LIBS="$SSL_LIBS_PATH -Wl,-Bstatic -lssl -lcrypto -Wl,-Bdynamic"
		    # HPUX: -Wl,-a,archive ... -Wl,-a,shared_archive
		fi
	fi
	AC_MSG_CHECKING([for SSL libs])
	AC_MSG_RESULT([$TCLTLS_SSL_LIBS])

	dnl Include config variables in --help list and make available to be substituted via AC_SUBST.
	AC_ARG_VAR([TCLTLS_SSL_CFLAGS], [C compiler flags for OpenSSL])
	AC_ARG_VAR([TCLTLS_SSL_INCLUDES], [C compiler include paths for OpenSSL])
	AC_ARG_VAR([TCLTLS_SSL_LIBS], [libraries to pass to the linker for OpenSSL])
])

#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.72 for tls 2.0b1.
#
#
# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation,
# Inc.
#
#
# This configure script is free software; the Free Software Foundation

subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME='tls'
PACKAGE_TARNAME='tls'
PACKAGE_VERSION='2.0b1'
PACKAGE_STRING='tls 2.0b1'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stddef.h>
#ifdef HAVE_STDIO_H

#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
'configure' configures tls 2.0b1 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of tls 2.0b1:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]

    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
tls configure 2.0b1
generated by GNU Autoconf 2.72

Copyright (C) 2023 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit

    ac_configure_args_raw=`      printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;;
esac

cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by tls $as_me 2.0b1, which was
generated by GNU Autoconf 2.72.  Invocation command line was

  $ $0$ac_configure_args_raw

_ACEOF
exec 5>>config.log
{

test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by tls $as_me 2.0b1, which was
generated by GNU Autoconf 2.72.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@

_ACEOF
ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"`
ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"`
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config='$ac_cs_config_escaped'
ac_cs_version="\\
tls config.status 2.0b1
configured by $0, generated by GNU Autoconf 2.72,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2023 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
# set as provided.  These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
# This will also define a special symbol for Windows (BUILD_<PACKAGE_NAME>
# so that we create the export library with the dll.
#-----------------------------------------------------------------------

AC_INIT([tls],[2.0b1])

#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------

# OpenSSL uses as its default names.
#--------------------------------------------------------------------

if test "${TEA_PLATFORM}" = "windows" ; then
    if test "$GCC" = "yes"; then
	TEA_ADD_CFLAGS([${TCLTLS_SSL_CFLAGS} -Wno-deprecated-declarations])
	TEA_ADD_INCLUDES([${TCLTLS_SSL_INCLUDES}])
	TEA_ADD_LIBS([${TCLTLS_SSL_LIBS} ws2_32.lib Crypt32.lib])
    fi
else
	TEA_ADD_CFLAGS([${TCLTLS_SSL_CFLAGS} -Wno-deprecated-declarations])
	TEA_ADD_INCLUDES([${TCLTLS_SSL_INCLUDES}])
	TEA_ADD_LIBS([${TCLTLS_SSL_LIBS}])
fi

This directory contain example files for how to use the TLS package to perform
common functions. These are just a few of the possibilities.

echat.tcl
Example echo chat tool. Start with -server or -client arg to set client/server mode.

gets_blocking_no_variable.tcl
Download a webpage using gets, no variable arg, and blocking I/O.

gets_blocking_with_variable.tcl
Download a webpage using gets, variable arg, and blocking I/O.

gets_nonblocking_no_variable.tcl
Download a webpage using gets, no variable arg, and non-blocking I/O.

gets_nonblocking_with_variable.tcl
Download a webpage using gets, variable arg, and non-blocking I/O.

gets_with_debug_data.tcl
Download a webpage using gets with additional debug output.

http_debug_example.tcl
Download a webpage using http package with additional debug output.

http_get_file.tcl
Download a file using the http package.

http_get_webpage.tcl
Download a webpage using the http package.

http_get_webpage_proxy.tcl
Download a file using the http and autoproxy packages.

read_blocking_webpage.tcl
Download a webpage using read and blocking I/O.

read_nonblocking_webpage.tcl
Download a webpage using read and non-blocking I/O.

#!/usr/bin/env tclsh
#
# Example encrypted echo chat tool
#
# Usage:
#	Server:		tclsh echat.tcl -server
#
#	Client:		tclsh echat.tcl -client
#

package prefer latest
package require tls
package require Tk



#
# Config settings
#
set host localhost
set port 9876
set mode client
set clients [list]
set chan ""

set certsDir	[file join [file dirname [info script]] .. tests certs]
set serverCert	[file join $certsDir server.pem]
set clientCert	[file join $certsDir client.pem]
set caCert	[file join $certsDir ca.pem]
set serverKey	[file join $certsDir server.key]
set clientKey	[file join $certsDir client.key]



########################

#
# Send message
#
proc message_send {var w} {
    set ch [set $var]
    set msg [$w get]
    log $msg sender
    if {$ch ne ""} {
	puts $ch $msg
    }
    $w delete 0 end
}

#
# Receive message
#
proc message_receive {ch} {
    set msg ""
    if {[gets $ch msg] <= 0} {
	if {[eof $ch]} {
	    close $ch
	    exit
	}
    }
    if {[string length $msg] > -1} {
	log $msg receiver
    }
}

#
# Connect with TLS
#
proc client_connect {ch} {
    tls::import $ch -request 1 -require 0
    #tls::import $ch -certfile $::clientCert -cafile $::caCert -keyfile $::clientKey
    tls::handshake $ch
    set time [clock format [clock seconds]]
    log [format "Client connection finished at %s" $time] local
}

#
# Setup client
#
proc client_setup {} {
    global host
    global port
    global chan

    set ch [socket $host $port]
    fconfigure $ch -blocking 0 -buffering line -buffersize 32768 -encoding utf-8 -translation auto
    if {[info tclversion] >= 9.0} {
	fconfigure $ch -keepalive 1 -nodelay 1
    }
    chan event $ch readable [list message_receive $ch]
    after idle [list client_connect $ch]
    set chan $ch
    return $ch
}

#
# Shutdown client
#
proc client_shutdown {ch} {
    close $ch
}

########################

#
# Add client to client list
#
proc add_client {ch} {
    global clients

    if {$ch ni $clients} {
	lappend clients $ch
    }
}

#
# Remove client from client list
#
proc remove_client {ch} {
    global clients

    if {$ch in $clients} {
	set index [lsearch $clients $ch]
	set clients [lreplace $clients $index $index]
    }
}

#
# Send message
#
proc send_all {w} {
    global clients

    set msg [$w get]
    log $msg sender

    foreach client $clients {
	if {[catch {puts $client $msg} err]} {
	    close $client
	    remove_client $client
	}
    }
    $w delete 0 end
}

#
# Echo received messages
#
proc echo {ch} {
    global clients

    if {[gets $ch msg] <= 0} {
	if {[eof $ch]} {
	    close $ch
	    remove_client $ch
	    return
	}
    }
    log $msg receiver

    foreach client $clients {
	if {[catch {puts $client $msg} err]} {
	    close $client
	    remove_client $client
	}
    }
}

#
# Accept client connections
#
proc accept {ch addr port} {
    add_client $ch
    set time [clock format [clock seconds]]

    fconfigure $ch -blocking 0 -buffering line -buffersize 32768 -encoding utf-8 -translation auto
    log [format "Accepted client connection from %s on port %d at %s" $addr $port $time] local

    tls::import $ch -server 1 -certfile $::serverCert -cafile $::caCert -keyfile $::serverKey
    chan event $ch readable [list echo $ch]
    puts $ch [format "Connected to server at %s" $time]
}

#
# Setup server
#
proc server_setup {} {
    global port
    global chan

    set ch [socket -server accept $port]
    fconfigure $ch -blocking 0 -buffering line -buffersize 32768 -encoding utf-8 -translation auto
    if {[info tclversion] >= 9.0} {
	fconfigure $ch -keepalive 1 -nodelay 1
    }
    set chan $ch
    return $ch
}

#
# Shutdown server
#
proc server_shutdown {ch} {
    global clients

    foreach client $clients {
	close $client
    }
    close $ch
}

########################

#
# Log message
#
proc text_update {w msg tag} {
    $w insert end $msg\n $tag
    $w yview moveto 1.0
}

#
# Create GUI
#
proc setup_gui {w mode} {
    wm title $w [format "Chat %s Mode" [string totitle $mode]]

    grid columnconfigure $w 0 -weight 1
    grid rowconfigure $w 0 -weight 1

    # Messages frame
    set f [ttk::frame ${w}msgs]
    grid $f -sticky nsew
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f 0 -weight 1

    set t [text $f.text -yscrollcommand [list $f.vsb set]]
    #  -xscrollcommand [list $f.hsb set]
    #set sh [ttk::scrollbar $f.hsb -command [list $t xview] -orient horizontal]
    set sv [ttk::scrollbar $f.vsb -command [list $t yview] -orient vertical]
    grid $t -row 0 -column 0 -sticky nsew
    grid $sv -row 0 -column 1 -sticky nsew
    #grid $sh -row 1 -column 0 -sticky nsew
    interp alias {} log {} text_update $t

    # Create tags
    $t tag configure sender -background lightblue -foreground black -justify right \
	-lmargin1 100 -lmargin2 100 -lmargincolor white -spacing1 15 -wrap word
    $t tag configure receiver -background lightgray -foreground black -justify left \
	-rmargin 100 -rmargincolor white -spacing1 15 -wrap word
    $t tag configure local -background white -foreground black -justify left \
	-spacing1 15 -wrap word

    # Send frame
    set f [ttk::frame ${w}send]
    grid $f -sticky nsew
    grid columnconfigure $f 0 -weight 1
    grid rowconfigure $f 0 -weight 1

    set e [ttk::entry $f.e -xscrollcommand [list $f.hsb set]]
    if {$mode eq "client"} {
	set cmd [list message_send ::chan $e]
    } else {
	set cmd [list send_all $e]
    }
    set b [ttk::button $f.b -command $cmd -text "Send"]
    bind $e <Return> $cmd
    set sh [ttk::scrollbar $f.hsb -command [list $e xview scroll] -orient horizontal]
    grid $e -row 0 -column 0 -sticky nsew
    grid $b -row 0 -column 1 -sticky nsew
    grid $sh -row 1 -column 0 -sticky nsew

    wm protocol $w WM_DELETE_WINDOW shutdown
}

#
# Shutdown
#
proc shutdown {} {
    global mode

    if {$mode eq "client"} {
	client_shutdown $::chan
    } else {
	server_shutdown $::chan
    }
    exit
}

#
# Start client or server
#
proc main {args} {
    global mode

    if {"-client" in $args} {
	set mode client
	set cmd [list client_setup]
    } else {
	set mode server
	set cmd [list server_setup]
    }
    setup_gui . $mode
    after 1000 $cmd
    vwait done
}

main {*}$::argv

<!-- Generated from file 'tls.man' by tcllib/doctools with format 'html'
   -->
<!-- Copyright &amp;copy; 1999 Matt Newman   -- Copyright &amp;copy; 2004 Starfish Systems   -- Copyright &amp;copy; 2024 Brian O'Hagan
   -->
<!-- tls.n
   -->
<body><div class="doctools">
<h1 class="doctools_title">tls(n) 2.0b1 tls &quot;Tcl TLS extension&quot;</h1>
<div id="name" class="doctools_section"><h2><a name="name">Name</a></h2>
<p>tls - binding to the OpenSSL library for encrypted socket and I/O channel communications</p>
</div>
<div id="toc" class="doctools_section"><h2><a name="toc">Table Of Contents</a></h2>
<ul class="doctools_toc">
<li class="doctools_section"><a href="#toc">Table Of Contents</a></li>
<li class="doctools_section"><a href="#synopsis">Synopsis</a></li>
<li class="doctools_section"><a href="#section1">Description</a></li>
<li class="doctools_section"><a href="#section2">Compatibility</a></li>
<li class="doctools_section"><a href="#section3">Commands</a></li>
<li class="doctools_section"><a href="#section4">Certificate Validation</a>
<ul>
<li class="doctools_subsection"><a href="#subsection1">PKI and Certificates</a></li>
<li class="doctools_subsection"><a href="#subsection2">Summary of command line options</a></li>
<li class="doctools_subsection"><a href="#subsection3">When are command line options needed?</a></li>
</ul>
</li>
<li class="doctools_section"><a href="#section5">Callback Options</a>
<ul>
<li class="doctools_subsection"><a href="#subsection4">Values for Command Callback</a></li>
<li class="doctools_subsection"><a href="#subsection5">Values for Password Callback</a></li>
<li class="doctools_subsection"><a href="#subsection6">Values for Validate Command Callback</a></li>
</ul>
</li>
<li class="doctools_section"><a href="#section6">Debug</a></li>
<li class="doctools_section"><a href="#section7">Examples</a></li>
<li class="doctools_section"><a href="#section8">Special Considerations</a></li>
<li class="doctools_section"><a href="#section9">Error Messages</a></li>
<li class="doctools_section"><a href="#see-also">See Also</a></li>
<li class="doctools_section"><a href="#keywords">Keywords</a></li>
<li class="doctools_section"><a href="#category">Category</a></li>
<li class="doctools_section"><a href="#copyright">Copyright</a></li>
</ul>
</div>
<div id="synopsis" class="doctools_section"><h2><a name="synopsis">Synopsis</a></h2>
<div class="doctools_synopsis">
<ul class="doctools_requirements">
<li>package require <b class="pkgname">Tcl 8.5-</b></li>
<li>package require <b class="pkgname">tls 2.0b1</b></li>
</ul>
<ul class="doctools_syntax">
<li><a href="#1"><b class="cmd">tls::init</b> <span class="opt">?<i class="arg">-option</i>?</span> <span class="opt">?<i class="arg">value</i>?</span> <span class="opt">?<i class="arg">-option value ...</i>?</span></a></li>
<li><a href="#2"><b class="cmd">tls::socket</b> <span class="opt">?<i class="arg">-option</i>?</span> <span class="opt">?<i class="arg">value</i>?</span> <span class="opt">?<i class="arg">-option value ...</i>?</span> <i class="arg">host</i> <i class="arg">port</i></a></li>
<li><a href="#3"><b class="cmd">tls::socket</b> <b class="option">-server</b> <i class="arg">command</i> <span class="opt">?<i class="arg">-option</i>?</span> <span class="opt">?<i class="arg">value</i>?</span> <span class="opt">?<i class="arg">-option value ...</i>?</span> <i class="arg">port</i></a></li>
<li><a href="#4"><b class="cmd">tls::import</b> <i class="arg">channel</i> <span class="opt">?<i class="arg">-option</i>?</span> <span class="opt">?<i class="arg">value</i>?</span> <span class="opt">?<i class="arg">-option value ...</i>?</span></a></li>
<li><a href="#5"><b class="cmd">tls::unimport</b> <i class="arg">channel</i></a></li>
<li><a href="#6"><b class="cmd">tls::handshake</b> <i class="arg">channel</i></a></li>
<li><a href="#7"><b class="cmd">tls::status</b> <span class="opt">?<b class="option">-local</b>?</span> <i class="arg">channel</i></a></li>
<li><a href="#8"><b class="cmd">tls::connection</b> <i class="arg">channel</i></a></li>
<li><a href="#9"><b class="cmd">tls::ciphers</b> <span class="opt">?<i class="arg">protocol</i>?</span> <span class="opt">?<i class="arg">verbose</i>?</span> <span class="opt">?<i class="arg">supported</i>?</span></a></li>
<li><a href="#10"><b class="cmd">tls::protocols</b></a></li>
<li><a href="#11"><b class="cmd">tls::version</b></a></li>
</ul>
</div>
</div>
<div id="section1" class="doctools_section"><h2><a name="section1">Description</a></h2>
<p>This extension provides TCL script access to Secure Socket Layer (SSL)
communications using the Transport Layer Security (TLS) protocol. It provides a
generic binding to <a href="https://www.openssl.org/">OpenSSL</a>, utilizing the
<b class="syscmd">Tcl_StackChannel</b> API in TCL 8.4 or later. These sockets behave exactly
the same as channels created using the built-in <b class="syscmd">socket</b> command, but

provide additional options for controlling the SSL/TLS session.</p>
</div>
<div id="section2" class="doctools_section"><h2><a name="section2">Compatibility</a></h2>

<p>This extension is compatible with OpenSSL 1.1.1 or later. It requires Tcl
version 8.5 or later and will work with Tcl 9.0.</p>
</div>
<div id="section3" class="doctools_section"><h2><a name="section3">Commands</a></h2>
<p>The following are the commands provided by the TcLTLS package. See
<span class="sectref"><a href="#section7">Examples</a></span> for example usage and the &quot;<b class="file">demos</b>&quot; directory for
more example usage.</p>
<dl class="doctools_definitions">
<dt><a name="1"><b class="cmd">tls::init</b> <span class="opt">?<i class="arg">-option</i>?</span> <span class="opt">?<i class="arg">value</i>?</span> <span class="opt">?<i class="arg">-option value ...</i>?</span></a></dt>
<dd><p>Optional function to set the default options used by <b class="cmd">tls::socket</b>. If you
call <b class="cmd">tls::import</b> directly, the values set by this command have no effect.
This command supports all of the same options as the <b class="cmd">tls::socket</b> command,
though you should limit your options to only the TLS related ones.</p></dd>
<dt><a name="2"><b class="cmd">tls::socket</b> <span class="opt">?<i class="arg">-option</i>?</span> <span class="opt">?<i class="arg">value</i>?</span> <span class="opt">?<i class="arg">-option value ...</i>?</span> <i class="arg">host</i> <i class="arg">port</i></a></dt>
<dd><p>This is a helper function that utilizes the underlying commands <b class="syscmd">socket</b>
and <b class="cmd">tls::import</b> to create the connection. It behaves the same as the
native TCL <b class="syscmd">socket</b> command, but also supports the <b class="cmd">tls::import</b>
command options with one additional option. It returns the channel handle id
for the new socket. Additional options are:</p>
<dl class="doctools_options">
<dt><b class="option">-autoservername</b> <i class="arg">bool</i></dt>
<dd><p>If <b class="const">true</b>, automatically set the <b class="option">-servername</b> argument to the
<em>host</em> argument. Prior to TclTLS 2.0, the default is <b class="const">false</b>.
Starting in TclTLS 2.0, the default is <b class="const">true</b> unless <b class="option">-servername</b>
is also specified.</p></dd>
</dl></dd>
<dt><a name="3"><b class="cmd">tls::socket</b> <b class="option">-server</b> <i class="arg">command</i> <span class="opt">?<i class="arg">-option</i>?</span> <span class="opt">?<i class="arg">value</i>?</span> <span class="opt">?<i class="arg">-option value ...</i>?</span> <i class="arg">port</i></a></dt>
<dd><p>Same as previous command, but instead creates a server socket for clients to
connect to just like the Tcl <b class="syscmd">socket -server</b> command. It returns the
channel handle id for the new socket.</p></dd>
<dt><a name="4"><b class="cmd">tls::import</b> <i class="arg">channel</i> <span class="opt">?<i class="arg">-option</i>?</span> <span class="opt">?<i class="arg">value</i>?</span> <span class="opt">?<i class="arg">-option value ...</i>?</span></a></dt>
<dd><p>Start TLS encryption on TCL channel <i class="arg">channel</i> via a stacked channel. It
need not be a socket, but must provide bi-directional flow. Also sets session
parameters for SSL handshake. Valid options are:</p>
<dl class="doctools_options">
<dt><b class="option">-alpn</b> <i class="arg">list</i></dt>
<dd><p>List of protocols to offer during Application-Layer Protocol Negotiation
(ALPN). For example: <b class="const">h2</b> and <b class="const">http/1.1</b>, but not <b class="const">h3</b> or
<b class="const">quic</b>. This option is new for TclTLS 1.8.</p></dd>
<dt><b class="option">-cadir</b> <i class="arg">directory</i></dt>
<dd><p>Specifies the directory where the Certificate Authority (CA) certificates are
stored. The default is platform specific and can be set at compile time. The
default location can be overridden by the <b class="variable">SSL_CERT_DIR</b> environment
variable. See <span class="sectref"><a href="#section4">Certificate Validation</a></span> for more details.</p></dd>
<dt><b class="option">-cafile</b> <i class="arg">filename</i></dt>
<dd><p>Specifies the file with the Certificate Authority (CA) certificates to use in
<b class="const">PEM</b> file format. The default is &quot;<b class="file">cert.pem</b>&quot;, in the OpenSSL
directory. The default file can be overridden by the <b class="variable">SSL_CERT_FILE</b> environment
variable. See <span class="sectref"><a href="#section4">Certificate Validation</a></span> for more details.</p></dd>
<dt><b class="option">-castore</b> <i class="arg">URI</i></dt>
<dd><p>Specifies the Uniform Resource Identifier (URI) for the Certificate Authority
(CA) store, which may be a single container or a catalog of containers.
Starting with OpenSSL 3.2 on MS Windows, set to &quot;<b class="const">org.openssl.winstore://</b>&quot;
to use the built-in MS Windows Certificate Store.
See <span class="sectref"><a href="#section4">Certificate Validation</a></span> for more details.
This option is new for TclTLS 1.8.</p></dd>
<dt><b class="option">-certfile</b> <i class="arg">filename</i></dt>
<dd><p>Specifies the name of the file with the certificate to use in PEM format
as the local (client or server) certificate. It also contains the public key.</p></dd>
<dt><b class="option">-cert</b> <i class="arg">string</i></dt>
<dd><p>Specifies the certificate to use as a DER encoded string (X.509 DER).</p></dd>
<dt><b class="option">-cipher</b> <i class="arg">string</i></dt>
<dd><p>Specifies the list of ciphers to use for TLS 1.2 and earlier connections.
String is a colon &quot;<b class="const">:</b>&quot; separated list of ciphers.
Ciphers can be combined using the &quot;<b class="const">+</b>&quot; character.
Prefixes can be used to permanently remove &quot;<b class="const">!</b>&quot;, delete &quot;<b class="const">-</b>&quot;, or
move to the end &quot;<b class="const">+</b>&quot; a specified cipher.
Keywords <b class="const">@STRENGTH</b> (sort by algorithm key length),
<b class="const">@SECLEVEL=</b><em>n</em> (set security level to n), and
<b class="const">DEFAULT</b> (use default cipher list, at start only) can also be specified.
See the <a href="https://docs.openssl.org/master/man1/openssl-ciphers/#options">OpenSSL</a>
documentation for the full list of valid values.</p></dd>
<dt><b class="option">-ciphersuites</b> <i class="arg">string</i></dt>
<dd><p>Specifies the list of cipher suites to use for TLS 1.3 as a colon
&quot;<b class="const">:</b>&quot; separated list of cipher suite names. See the
<a href="https://docs.openssl.org/master/man1/openssl-ciphers/#options">OpenSSL</a>
documentation for the full list of valid values.
This option is new for TclTLS 1.8.</p></dd>
<dt><b class="option">-command</b> <i class="arg">callback</i></dt>
<dd><p>Specifies the callback command to be invoked at several points during the
handshake to pass errors, tracing information, and protocol messages.
See <span class="sectref"><a href="#section5">Callback Options</a></span> for more info.</p></dd>
<dt><b class="option">-dhparams</b> <i class="arg">filename</i></dt>
<dd><p>Specifies the Diffie-Hellman (DH) parameters file.</p></dd>
<dt><b class="option">-keyfile</b> <i class="arg">filename</i></dt>
<dd><p>Specifies the private key file. The default is to use the file
specified by the <b class="option">-certfile</b> option.</p></dd>
<dt><b class="option">-key</b> <i class="arg">string</i></dt>
<dd><p>Specifies the private key to use as a DER encoded string (PKCS#1 DER).</p></dd>
<dt><b class="option">-model</b> <i class="arg">channel</i></dt>
<dd><p>Force this channel to share the same <i class="term">SSL_CTX</i> structure as the
specified <i class="arg">channel</i>, and therefore share config, callbacks, etc.</p></dd>
<dt><b class="option">-password</b> <i class="arg">callback</i></dt>
<dd><p>Specifies the callback command to invoke when OpenSSL needs to obtain a
password. This is typically used to unlock the private key of a certificate.
The callback should return a password string. This option has changed for
TclTLS 1.8. See <span class="sectref"><a href="#section5">Callback Options</a></span> for more info.</p></dd>
<dt><b class="option">-post_handshake</b> <i class="arg">bool</i></dt>
<dd><p>Allow post-handshake session ticket updates. This option is new for TclTLS 1.8.</p></dd>
<dt><b class="option">-request</b> <i class="arg">bool</i></dt>
<dd><p>Request a certificate from the peer during the SSL handshake. This is needed
to do Certificate Validation. Starting in TclTLS 1.8, the default is
<b class="const">true</b> for client connections. Starting in TclTLS 2.0, if set to
<b class="const">false</b> and <b class="option">-require</b> is <b class="const">true</b>, then this will be
overridden to <b class="const">true</b>. See <span class="sectref"><a href="#section4">Certificate Validation</a></span> for
more details.</p></dd>
<dt><b class="option">-require</b> <i class="arg">bool</i></dt>
<dd><p>Require a valid certificate from the peer during the SSL handshake. If this is
set to true, then <b class="option">-request</b> must also be set to true and a either
<b class="option">-cadir</b>, <b class="option">-cafile</b>, <b class="option">-castore</b>, or a platform default
must be provided in order to validate against. The default in TclTLS 1.8 and
earlier versions is <b class="const">false</b> since not all platforms have certificates to
validate against in a form compatible with OpenSSL. Starting in TclTLS 2.0,
the default is <b class="const">true</b> for client connections.
See <span class="sectref"><a href="#section4">Certificate Validation</a></span> for more details.</p></dd>
<dt><b class="option">-security_level</b> <i class="arg">integer</i></dt>
<dd><p>Specifies the security level (value from 0 to 5). The security level affects
the allowed cipher suite encryption algorithms, supported ECC curves,
supported signature algorithms, DH parameter sizes, certificate key sizes
and signature algorithms. The default is 1 prior to OpenSSL 3.2 and 2
thereafter. Level 3 and higher disable support for session tickets and
only accept cipher suites that provide forward secrecy.
This option is new for TclTLS 1.8.</p></dd>
<dt><b class="option">-server</b> <i class="arg">bool</i></dt>
<dd><p>Specifies whether to act as a server and respond with a server handshake when a
client connects and provides a client handshake. The default is <b class="const">false</b>.</p></dd>
<dt><b class="option">-servername</b> <i class="arg">hostname</i></dt>
<dd><p>Specify the peer's hostname. This is used to set the TLS Server Name Indication
(SNI) extension. Set this to the expected servername in the server's certificate
or one of the Subject Alternate Names (SAN). Starting in TclTLS 2.0, this will
default to the host for the <b class="cmd">tls::socket</b> command.</p></dd>
<dt><b class="option">-session_id</b> <i class="arg">binary_string</i></dt>
<dd><p>Specifies the session id to resume a session. Not supported yet.
This option is new for TclTLS 1.8.</p></dd>
<dt><b class="option">-ssl2</b> <i class="arg">bool</i></dt>
<dd><p>Enable use of SSL v2.The default is <b class="const">false</b>.
OpenSSL 1.1+ no longer supports SSL v2, so this may not have any effect.
See the <b class="cmd">tls::protocols</b> command for supported protocols.</p></dd>
<dt><b class="option">-ssl3</b> <i class="arg">bool</i></dt>
<dd><p>Enable use of SSL v3. The default is <b class="const">false</b>. Starting in TclTLS 1.8,
use of SSL v3 if only available via a compile time option.
See the <b class="cmd">tls::protocols</b> command for supported protocols.</p></dd>
<dt><b class="option">-tls1</b> <i class="arg">bool</i></dt>
<dd><p>Enable use of TLS v1. Starting in TclTLS 2.0, the default is <b class="const">false</b>.
Note: TLS 1.0 needs SHA1 to operate, which is only available in security level
0 for Open SSL 3.0+. See the <b class="option">-security_level</b> option.</p></dd>
<dt><b class="option">-tls1.1</b> <i class="arg">bool</i></dt>
<dd><p>Enable use of TLS v1.1. Starting in TclTLS 2.0, the default is <b class="const">false</b>.
Note: TLS 1.1 needs SHA1 to operate, which is only available in security level
0 for Open SSL 3.0+. See the <b class="option">-security_level</b> option.</p></dd>
<dt><b class="option">-tls1.2</b> <i class="arg">bool</i></dt>
<dd><p>Enable use of TLS v1.2. The default is <b class="const">true</b>.</p></dd>
<dt><b class="option">-tls1.3</b> <i class="arg">bool</i></dt>
<dd><p>Enable use of TLS v1.3. The default is <b class="const">true</b>. This is only available
starting with OpenSSL 1.1.1 and TclTLS 1.7.</p></dd>
<dt><b class="option">-validatecommand</b> <i class="arg">callback</i></dt>
<dd><p>Specifies the callback command to invoke to validate the peer certificates
and other config info during the protocol negotiation phase. This can be used
by TCL scripts to perform their own Certificate Validation to supplement the
default validation provided by OpenSSL. The script must return a boolean true
to continue the negotiation. See <span class="sectref"><a href="#section5">Callback Options</a></span> for more info.
This option is new for TclTLS 1.8.</p></dd>
</dl></dd>
<dt><a name="5"><b class="cmd">tls::unimport</b> <i class="arg">channel</i></a></dt>
<dd><p>Compliment to <b class="cmd">tls::import</b>. Used to remove the top level stacked channel
from <i class="arg">channel</i>. This unstacks the encryption of a regular TCL channel. An
error is thrown if TLS is not the top stacked channel type.</p></dd>
<dt><a name="6"><b class="cmd">tls::handshake</b> <i class="arg">channel</i></a></dt>
<dd><p>Forces the TLS negotiation handshake to take place immediately, and returns 0
if handshake is still in progress (non-blocking), or 1 if the handshake was
successful. If the handshake failed, an error will be returned.</p></dd>
<dt><a name="7"><b class="cmd">tls::status</b> <span class="opt">?<b class="option">-local</b>?</span> <i class="arg">channel</i></a></dt>
<dd><p>Returns the current status of an SSL channel. The result is a list of key-value
pairs describing the SSL, certificate, and certificate verification status. If
the SSL handshake has not yet completed, an empty list is returned. If the
<b class="option">-local</b> option is specified, then the local certificate is used. Returned
values include:</p>
<p>SSL Status</p>
<dl class="doctools_definitions">
<dt><b class="variable">alpn</b> <i class="arg">protocol</i></dt>
<dd><p>The protocol selected after Application-Layer Protocol Negotiation (ALPN).
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">cipher</b> <i class="arg">cipher</i></dt>
<dd><p>The current cipher in use for the session.</p></dd>
<dt><b class="variable">peername</b> <i class="arg">name</i></dt>
<dd><p>The peername from the certificate.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">protocol</b> <i class="arg">version</i></dt>
<dd><p>The protocol version used for the connection: SSL2, SSL3, TLS1, TLS1.1, TLS1.2,
TLS1.3, or unknown. This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">sbits</b> <i class="arg">n</i></dt>
<dd><p>The number of bits used for the session key.</p></dd>
<dt><b class="variable">signatureHashAlgorithm</b> <i class="arg">algorithm</i></dt>
<dd><p>The signature hash algorithm.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">signatureType</b> <i class="arg">type</i></dt>
<dd><p>The signature type value.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">verifyDepth</b> <i class="arg">n</i></dt>
<dd><p>Maximum depth for the certificate chain verification. Default is -1, to check all.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">verifyMode</b> <i class="arg">list</i></dt>
<dd><p>List of certificate verification modes.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">verifyResult</b> <i class="arg">result</i></dt>
<dd><p>Certificate verification result.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">ca_names</b> <i class="arg">list</i></dt>
<dd><p>List of the Certificate Authorities used to create the certificate.
This value is new for TclTLS 1.8.</p></dd>
</dl>
<p>Certificate Status</p>
<dl class="doctools_definitions">
<dt><b class="variable">all</b> <i class="arg">string</i></dt>
<dd><p>Dump of all certificate info.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">version</b> <i class="arg">value</i></dt>
<dd><p>The certificate version.</p></dd>
<dt><b class="variable">serialNumber</b> <i class="arg">string</i></dt>
<dd><p>The serial number of the certificate as a hex string.
This value was changed from serial in TclTLS 1.8.</p></dd>
<dt><b class="variable">signature</b> <i class="arg">algorithm</i></dt>
<dd><p>Cipher algorithm used for certificate signature.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">issuer</b> <i class="arg">string</i></dt>
<dd><p>The distinguished name (DN) of the certificate issuer.</p></dd>
<dt><b class="variable">notBefore</b> <i class="arg">date</i></dt>
<dd><p>The beginning date of the certificate validity.</p></dd>
<dt><b class="variable">notAfter</b> <i class="arg">date</i></dt>
<dd><p>The expiration date of the certificate validity.</p></dd>
<dt><b class="variable">subject</b> <i class="arg">string</i></dt>
<dd><p>The distinguished name (DN) of the certificate subject. Fields include: Common
Name (CN), Organization (O), Locality or City (L), State or Province (S), and
Country Name (C).</p></dd>
<dt><b class="variable">issuerUniqueID</b> <i class="arg">string</i></dt>
<dd><p>The issuer unique id.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">subjectUniqueID</b> <i class="arg">string</i></dt>
<dd><p>The subject unique id.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">num_extensions</b> <i class="arg">n</i></dt>
<dd><p>Number of certificate extensions.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">extensions</b> <i class="arg">list</i></dt>
<dd><p>List of certificate extension names.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">authorityKeyIdentifier</b> <i class="arg">string</i></dt>
<dd><p>Authority Key Identifier (AKI) of the Issuing CA certificate that signed the
SSL certificate as a hex string. This value matches the SKI value of the
Intermediate CA certificate.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">subjectKeyIdentifier</b> <i class="arg">string</i></dt>
<dd><p>Subject Key Identifier (SKI) hash of the public key inside the certificate as a
hex string. Used to identify certificates that contain a particular public key.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">subjectAltName</b> <i class="arg">list</i></dt>
<dd><p>List of all of the Subject Alternative Names (SAN) including domain names, sub
domains, and IP addresses that are secured by the certificate.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">ocsp</b> <i class="arg">list</i></dt>
<dd><p>List of all Online Certificate Status Protocol (OCSP) URLs that can be used to
check the validity of this certificate.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">certificate</b> <i class="arg">cert</i></dt>
<dd><p>The PEM encoded certificate.</p></dd>
<dt><b class="variable">signatureAlgorithm</b> <i class="arg">algorithm</i></dt>
<dd><p>Cipher algorithm used for the certificate signature.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">signatureValue</b> <i class="arg">string</i></dt>
<dd><p>Certificate signature as a hex string.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">signatureDigest</b> <i class="arg">version</i></dt>
<dd><p>Certificate signing digest as a hex string.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">publicKeyAlgorithm</b> <i class="arg">algorithm</i></dt>
<dd><p>Certificate signature public key algorithm.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">publicKey</b> <i class="arg">string</i></dt>
<dd><p>Certificate signature public key as a hex string.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">bits</b> <i class="arg">n</i></dt>
<dd><p>Number of bits used for certificate signature key.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">self_signed</b> <i class="arg">boolean</i></dt>
<dd><p>Whether the certificate signature is self signed.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">sha1_hash</b> <i class="arg">hash</i></dt>
<dd><p>The SHA1 hash of the certificate as a hex string.
This value is new for TclTLS 1.8.</p></dd>
<dt><b class="variable">sha256_hash</b> <i class="arg">hash</i></dt>
<dd><p>The SHA256 hash of the certificate as a hex string.
This value is new for TclTLS 1.8.</p></dd>
</dl></dd>
<dt><a name="8"><b class="cmd">tls::connection</b> <i class="arg">channel</i></a></dt>
<dd><p>Returns the current connection status of an SSL channel. The result is a list
of key-value pairs describing the connection.
This command is new for TclTLS 1.8. Returned values include:</p>
<p>SSL Status</p>
<dl class="doctools_definitions">
<dt><b class="variable">state</b> <i class="arg">state</i></dt>
<dd><p>State of the connection.</p></dd>
<dt><b class="variable">servername</b> <i class="arg">name</i></dt>
<dd><p>The name of the connected to server.</p></dd>
<dt><b class="variable">protocol</b> <i class="arg">version</i></dt>

<dd><p>Unique session ticket application data.</p></dd>
<dt><b class="variable">master_key</b> <i class="arg">binary_string</i></dt>
<dd><p>Unique session master key.</p></dd>
<dt><b class="variable">session_cache_mode</b> <i class="arg">mode</i></dt>
<dd><p>Server cache mode (client, server, or both).</p></dd>
</dl></dd>
<dt><a name="9"><b class="cmd">tls::ciphers</b> <span class="opt">?<i class="arg">protocol</i>?</span> <span class="opt">?<i class="arg">verbose</i>?</span> <span class="opt">?<i class="arg">supported</i>?</span></a></dt>
<dd><p>Without any options, it returns a list of all symmetric ciphers for use with the
<i class="arg">-cipher</i> option. With <i class="arg">protocol</i>, only the ciphers supported for that
protocol are returned. See the <b class="cmd">tls::protocols</b> command for the supported
protocols. If <i class="arg">verbose</i> is specified as true then a verbose, human readable
list is returned with additional information on the cipher. If <i class="arg">supported</i>
is specified as true, then only the ciphers supported for protocol will be listed.
The <i class="arg">supported</i> arg is new for TclTLS 1.8.</p></dd>
<dt><a name="10"><b class="cmd">tls::protocols</b></a></dt>
<dd><p>Returns a list of the supported SSL/TLS protocols. Valid values are:
<b class="const">ssl2</b>, <b class="const">ssl3</b>, <b class="const">tls1</b>, <b class="const">tls1.1</b>, <b class="const">tls1.2</b>, and
<b class="const">tls1.3</b>. Exact list depends on OpenSSL version and compile time flags.
This command is new for TclTLS 1.8.</p></dd>
<dt><a name="11"><b class="cmd">tls::version</b></a></dt>
<dd><p>Returns the OpenSSL version string.</p></dd>
</dl>
</div>
<div id="section4" class="doctools_section"><h2><a name="section4">Certificate Validation</a></h2>
<div id="subsection1" class="doctools_subsection"><h3><a name="subsection1">PKI and Certificates</a></h3>
<p>Using the Public Key Infrastructure (PKI), each user creates a private key that
only they know about and a public key they can exchange with others for use in
encrypting and decrypting data. The process is the sender encrypts their data
using their private key and the receiver's public key. The data is then sent
to the receiver. In a similar manner, the receiver uses their private key and
the sender's public key to decrypt the data. This provides data integrity, to
ensure the data can't be viewed or altered during transport. See the
<b class="option">-key</b> and <b class="option">-keyfile</b> options for how to specify the private key.
Also see the <b class="option">-password</b> option for how to provide the password.</p>
<p>In order to provide authentication, i.e. ensuring someone is who they say they
are, the public key and user identification info is stored in a X.509
certificate and that certificate is authenticated (i.e. signed) by a Certificate
Authority (CA). Users can then exchange these certificates during the TLS
initialization process and check them against the root CA certificates to ensure
they are valid. This is handled by OpenSSL via the <b class="option">-request</b> and
<b class="option">-require</b> options. See the <b class="option">-cadir</b>, <b class="option">-cadir</b>, and
<b class="option">-castore</b> options for how to specify where to find the CA certificates.
Optionally, in a future release, they can also be checked against the Certificate
Revocation List (CRL) of revoked certificates. Certificates can also be
self-signed, but they are by default not trusted unless you add them to your
certificate store.</p>
<p>Typically when visiting web sites, only the client needs to check the server's
certificate to ensure it is valid. The server doesn't need to check the client
certificate unless you need to authenticate with them to login, etc. See the

directory. On Linux/Unix systems, this is usually &quot;<b class="file">/etc/ssl/ca-bundle.pem</b>&quot;.
The default file can be overridden by the <b class="variable">SSL_CERT_FILE</b> environment
variable.</p></dd>
<dt><b class="option">-castore</b> <i class="arg">URI</i></dt>
<dd><p>Specifies the Uniform Resource Identifier (URI) for the Certificate Authority
(CA) store, which may be a single container or a catalog of containers.
Starting with OpenSSL 3.2 on MS Windows, set to &quot;<b class="const">org.openssl.winstore://</b>&quot;
to use the built-in MS Windows Certificate Store. Starting in TclTLS 2.0, this
is the default if <b class="option">-cadir</b>, <b class="option">-cadir</b>, and <b class="option">-castore</b> are
not specified. This store only supports root certificate stores.</p></dd>

<dt><b class="option">-request</b> <i class="arg">bool</i></dt>
<dd><p>Request a certificate from the peer during the SSL handshake. This is needed
to do Certificate Validation. Starting in TclTLS 1.8, the default is
<b class="const">true</b> for client connections. Starting in TclTLS 2.0, if set to
<b class="const">false</b> and <b class="option">-require</b> is <b class="const">true</b>, then this will be
overridden to <b class="const">true</b>. In addition, the client can manually inspect and
accept or reject each certificate using the <b class="option">-validatecommand</b> option.</p></dd>
<dt><b class="option">-require</b> <i class="arg">bool</i></dt>
<dd><p>Require a valid certificate from the peer during the SSL handshake. If this is
set to true, then <b class="option">-request</b> must also be set to true and a either
<b class="option">-cadir</b>, <b class="option">-cafile</b>, <b class="option">-castore</b>, or a platform default
must be provided in order to validate against. The default in TclTLS 1.8 and
earlier versions is <b class="const">false</b> since not all platforms have certificates to
validate against in a form compatible with OpenSSL. Starting in TclTLS 2.0,
the default is <b class="const">true</b> for client connections.</p></dd>
</dl>
</div>
<div id="subsection3" class="doctools_subsection"><h3><a name="subsection3">When are command line options needed?</a></h3>
<p>In TclTLS 1.8 and earlier versions, certificate validation is
<em>NOT</em> enabled by default. This limitation is due to the lack of a common
cross platform database of Certificate Authority (CA) provided certificates to
validate against. Many Linux systems natively support OpenSSL and thus have
these certificates installed as part of the OS, but MacOS and MS Windows do not.
Staring in TclTLS 2.0, the default for client connections has been changed to
require certificate validation by default. In order to use the <b class="option">-require</b>
option, one of the following must be true:</p>
<ul class="doctools_itemized">
<li><p>On Linux and Unix systems with OpenSSL already installed or if the CA
certificates are available in PEM format, and if they are stored in the
standard locations, or if the <b class="variable">SSL_CERT_DIR</b> or <b class="variable">SSL_CERT_FILE</b>
environment variables are set, then <b class="option">-cadir</b>, <b class="option">-cadir</b>,
and <b class="option">-castore</b> aren't needed.</p></li>
<li><p>If OpenSSL is not installed in the default location, or when using Mac OS
or MS Windows and OpenSSL is installed, the <b class="variable">SSL_CERT_DIR</b> and/or
<b class="variable">SSL_CERT_FILE</b> environment variables or the one of the <b class="option">-cadir</b>,
<b class="option">-cadir</b>, or <b class="option">-castore</b> options must be defined.</p></li>
<li><p>On MS Windows, starting in OpenSSL 3.2, it is now possible to access the
built-in Windows Certificate Store from OpenSSL. This can be utilized by
setting the <b class="option">-castore</b> option to &quot;<b class="const">org.openssl.winstore://</b>&quot;.
In TclTLS 2.0, this is the default value if <b class="option">-cadir</b>,
<b class="option">-cadir</b>, and <b class="option">-castore</b> are not specified.</p></li>
<li><p>If OpenSSL is not installed or the CA certificates are not available in PEM
format, the CA certificates must be downloaded and installed with the user
software. The CURL team makes them available at
<a href="https://curl.se/docs/caextract.html">CA certificates extracted
from Mozilla</a> in the &quot;<b class="file">cacert.pem</b>&quot; file. You must then either set the
<b class="variable">SSL_CERT_DIR</b> and/or <b class="variable">SSL_CERT_FILE</b> environment variables or the
<b class="option">-cadir</b> or <b class="option">-cafile</b> options to the CA cert file's install
location. It is your responsibility to keep this file up to date.</p></li>
</ul>
</div>
</div>
<div id="section5" class="doctools_section"><h2><a name="section5">Callback Options</a></h2>
<p>As previously described, each channel can be given their own callbacks
to handle intermediate processing by the OpenSSL library, using the
<b class="option">-command</b>, <b class="option">-password</b>, and <b class="option">-validate_command</b> options
passed to either of <b class="cmd">tls::socket</b> or <b class="cmd">tls::import</b>.
Unlike previous versions of TclTLS, only if the callback generates an error,
will the <b class="syscmd">bgerror</b> command be invoked with the error information.</p>
<div id="subsection4" class="doctools_subsection"><h3><a name="subsection4">Values for Command Callback</a></h3>

continue the connection, it should return 2. This callback is new for TclTLS 1.8.</p>
<dl class="doctools_options">
<dt><b class="option">alpn</b> <i class="arg">channelId protocol match</i></dt>
<dd><p>For servers, this form of callback is invoked when the client ALPN extension is
received. If <i class="arg">match</i> is true, then <i class="arg">protocol</i> is the first
<b class="option">-alpn</b> protocol option in common to both the client and server.
If not, the first client specified protocol is used. This callback is called
after the Hello and SNI callbacks.</p></dd>
<dt><b class="option">hello</b> <i class="arg">channelId servername session_id</i></dt>
<dd><p>For servers, this form of callback is invoked during client hello message
processing. The purpose is so the server can select the appropriate certificate
to present to the client, and to make other configuration adjustments relevant
to that server name and its configuration. It is called before the SNI and ALPN
callbacks.</p></dd>
<dt><b class="option">sni</b> <i class="arg">channelId servername</i></dt>
<dd><p>For servers, this form of callback is invoked when the Server Name Indication
(SNI) extension is received. The <i class="arg">servername</i> argument is the client
provided server name specified in the <b class="option">-servername</b> option. The
purpose is so when a server supports multiple names, the right certificate
can be used. It is called after the Hello callback but before the ALPN
callback.</p></dd>
<dt><b class="option">verify</b> <i class="arg">channelId depth cert status error</i></dt>
<dd><p>This form of callback is invoked by OpenSSL when a new certificate is received
from the peer. It allows the client to check the certificate verification
results and choose whether to continue or not. It is called for each
certificate in the certificate chain. This callback was moved from
<b class="option">-command</b> in TclTLS 1.8. The arguments are:</p>

attempting to call <b class="cmd">tls::password</b>. The difference between these two
behaviors is a consequence of maintaining compatibility with earlier
implementations.</p>
<p><em>The use of the reference callbacks <b class="cmd">tls::callback</b>, <b class="cmd">tls::password</b>,
and <b class="cmd">tls::validate_command</b> is not recommended. They may be removed from future releases.</em></p>
</div>
</div>
<div id="section6" class="doctools_section"><h2><a name="section6">Debug</a></h2>
<p>For most debugging needs, the <b class="option">-callback</b> option can be used to provide
sufficient insight and information on the TLS handshake and progress. If
further troubleshooting insight is needed, the compile time option
<b class="option">--enable-debug</b> can be used to get detailed execution flow status.</p>
<p>TLS key logging can be enabled by setting the environment variable
<b class="variable">SSLKEYLOGFILE</b> to the name of the file to log to. Then whenever TLS key
material is generated or received it will be logged to the file. This is useful
for logging key data for network logging tools to use to decrypt the data.</p>
<p>The <b class="variable">tls::debug</b> variable provides some additional control over the
debug logging in the <b class="cmd">tls::callback</b>, <b class="cmd">tls::password</b>, and
<b class="cmd">tls::validate_command</b> default handlers in &quot;<b class="file">tls.tcl</b>&quot;.
The default value is 0 with higher values producing more diagnostic output,
and will also force the verify method in <b class="cmd">tls::callback</b> to accept the
certificate, even if it is invalid when the <b class="option">-validatecommand</b>
option is set to <b class="cmd">tls::validate_command</b>.</p>
<p><em>The use of the variable <b class="variable">tls::debug</b> is not recommended.
It may be removed from future releases.</em></p>
</div>
<div id="section7" class="doctools_section"><h2><a name="section7">Examples</a></h2>
<p>The following are example scripts to download a webpage and file using the
http package. See <span class="sectref"><a href="#section4">Certificate Validation</a></span> for when the
<b class="option">-cadir</b>, <b class="option">-cafile</b>, and <b class="option">-castore</b> options are also
needed. See the &quot;<b class="file">demos</b>&quot; directory for more example scripts.</p>
<p>Example #1: Download a web page</p>
<pre class="doctools_example">
package require http
package require tls
set url &quot;https://www.tcl.tk/&quot;
http::register https 443 [list ::tls::socket -autoservername 1 -require 1]
# Get URL

    puts [format "Error %s" [http::status $token]]
}
# Cleanup
close $ch
::http::cleanup $token
</pre>
</div>
<div id="section8" class="doctools_section"><h2><a name="section8">Special Considerations</a></h2>
<p>The capabilities of this package can vary enormously based upon how the
linked to OpenSSL library was configured and built. New versions may obsolete
older protocol versions, add or remove ciphers, change default values, etc.
Use the <b class="cmd">tls::protocols</b> command to obtain the supported
protocol versions.</p>
</div>
<div id="section9" class="doctools_section"><h2><a name="section9">Error Messages</a></h2>
<p>Some OpsnSSl error messages have cryptic meanings. This is a list of messages
along with their true meaning.</p>
<dl class="doctools_definitions">
<dt><i class="arg">packet length too long</i></dt>
<dd><p>Client has tried to connect to a HTTP server on the plain-text port instead of the SSL/TLS port.</p></dd>
<dt><i class="arg">unexpected eof while reading</i></dt>
<dd><p>Peer has closed the connection without sending the &quot;close notify&quot; shutdown alert.</p></dd>
<dt><i class="arg">wrong version number</i></dt>
<dd><p>Client has tried to connect to a non-HTTP server on a non-TLS (i.e. plain text) port.</p></dd>
</dl>
</div>
<div id="see-also" class="doctools_section"><h2><a name="see-also">See Also</a></h2>
<p><a href="https://www.openssl.org/">OpenSSL</a>, http, socket</p>
</div>
<div id="keywords" class="doctools_section"><h2><a name="keywords">Keywords</a></h2>
<p>I/O, IP Address, OpenSSL, SSL, TCP, TLS, TclTLS, asynchronous I/O, bind, certificate, channel, connection, domain name, host, https, network, network address, socket, tls</p>
</div>

[comment {-*- tcl -*- doctools manpage}]
[comment {To convert this to another documentation format use the dtplite
          script from tcllib: dtplite -o tls.n nroff tls.man
                              dtplite -o tls.html html tls.man
}]
[manpage_begin tls n 2.0b1]
[category tls]
[copyright {1999 Matt Newman}]
[copyright {2004 Starfish Systems}]
[copyright {2024 Brian O'Hagan}]
[keywords tls I/O "IP Address" OpenSSL SSL TCP TLS "asynchronous I/O" bind certificate channel connection "domain name" host "https" "network address" network socket TclTLS]
[moddesc {Tcl TLS extension}]
[see_also http socket [uri https://www.openssl.org/ OpenSSL]]
[titledesc {binding to the OpenSSL library for encrypted socket and I/O channel communications}]
[require Tcl 8.5-]
[require tls 2.0b1]
[description]

This extension provides TCL script access to Secure Socket Layer (SSL)
communications using the Transport Layer Security (TLS) protocol. It provides a
generic binding to [uri "https://www.openssl.org/" OpenSSL], utilizing the
[syscmd Tcl_StackChannel] API in TCL 8.4 or later. These sockets behave exactly
the same as channels created using the built-in [syscmd socket] command, but
provide additional options for controlling the SSL/TLS session.

[section Compatibility]
This extension is compatible with OpenSSL 1.1.1 or later. It requires Tcl
version 8.5 or later and will work with Tcl 9.0.

[section Commands]




The following are the commands provided by the TcLTLS package. See
[sectref Examples] for example usage and the [file demos] directory for
more example usage.

[list_begin definitions]

[call [cmd tls::init] [opt [arg -option]] [opt [arg value]] [opt [arg "-option value ..."]]]

Optional function to set the default options used by [cmd tls::socket]. If you
call [cmd tls::import] directly, the values set by this command have no effect.
This command supports all of the same options as the [cmd tls::socket] command,
though you should limit your options to only the TLS related ones.

[call [cmd tls::socket] [opt [arg -option]] [opt [arg value]] [opt [arg "-option value ..."]] [arg host] [arg port]]

This is a helper function that utilizes the underlying commands [syscmd socket]
and [cmd tls::import] to create the connection. It behaves the same as the
native TCL [syscmd socket] command, but also supports the [cmd tls::import]
command options with one additional option. It returns the channel handle id
for the new socket. Additional options are:

[list_begin options]

[opt_def -autoservername [arg bool]]
If [const true], automatically set the [option -servername] argument to the
[emph host] argument. Prior to TclTLS 2.0, the default is [const false].
Starting in TclTLS 2.0, the default is [const true] unless [option -servername]
is also specified.

[list_end]

[call [cmd tls::socket] [option -server] [arg command] [opt [arg -option]] [opt [arg value]] [opt [arg "-option value ..."]] [arg port]]

Same as previous command, but instead creates a server socket for clients to
connect to just like the Tcl [syscmd "socket -server"] command. It returns the
channel handle id for the new socket.

[call [cmd tls::import] [arg channel] [opt [arg -option]] [opt [arg value]] [opt [arg "-option value ..."]]]

Start TLS encryption on TCL channel [arg channel] via a stacked channel. It
need not be a socket, but must provide bi-directional flow. Also sets session
parameters for SSL handshake. Valid options are:

[list_begin options]

[opt_def -alpn [arg list]]
List of protocols to offer during Application-Layer Protocol Negotiation
(ALPN). For example: [const h2] and [const http/1.1], but not [const h3] or
[const quic]. This option is new for TclTLS 1.8.

[opt_def -cadir [arg directory]]
Specifies the directory where the Certificate Authority (CA) certificates are
stored. The default is platform specific and can be set at compile time. The
default location can be overridden by the [var SSL_CERT_DIR] environment
variable. See [sectref "Certificate Validation"] for more details.

[opt_def -cafile [arg filename]]
Specifies the file with the Certificate Authority (CA) certificates to use in
[const PEM] file format. The default is [file cert.pem], in the OpenSSL
directory. The default file can be overridden by the [var SSL_CERT_FILE] environment
variable. See [sectref "Certificate Validation"] for more details.

[opt_def -castore [arg URI]]
Specifies the Uniform Resource Identifier (URI) for the Certificate Authority
(CA) store, which may be a single container or a catalog of containers.
Starting with OpenSSL 3.2 on MS Windows, set to "[const "org.openssl.winstore://"]"
to use the built-in MS Windows Certificate Store.
See [sectref "Certificate Validation"] for more details.
This option is new for TclTLS 1.8.

[opt_def -certfile [arg filename]]
Specifies the name of the file with the certificate to use in PEM format
as the local (client or server) certificate. It also contains the public key.

[opt_def -cert [arg string]]
Specifies the certificate to use as a DER encoded string (X.509 DER).

documentation for the full list of valid values.

[opt_def -ciphersuites [arg string]]
Specifies the list of cipher suites to use for TLS 1.3 as a colon
"[const :]" separated list of cipher suite names. See the
[uri "https://docs.openssl.org/master/man1/openssl-ciphers/#options" OpenSSL]
documentation for the full list of valid values.
This option is new for TclTLS 1.8.

[opt_def -command [arg callback]]
Specifies the callback command to be invoked at several points during the
handshake to pass errors, tracing information, and protocol messages.
See [sectref "Callback Options"] for more info.

[opt_def -dhparams [arg filename]]
Specifies the Diffie-Hellman (DH) parameters file.

[opt_def -keyfile [arg filename]]
Specifies the private key file. The default is to use the file
specified by the [option -certfile] option.

[opt_def -key [arg string]]
Specifies the private key to use as a DER encoded string (PKCS#1 DER).

[opt_def -model [arg channel]]
Force this channel to share the same [term SSL_CTX] structure as the
specified [arg channel], and therefore share config, callbacks, etc.

[opt_def -password [arg callback]]
Specifies the callback command to invoke when OpenSSL needs to obtain a
password. This is typically used to unlock the private key of a certificate.
The callback should return a password string. This option has changed for
TclTLS 1.8. See [sectref "Callback Options"] for more info.

[opt_def -post_handshake [arg bool]]
Allow post-handshake session ticket updates. This option is new for TclTLS 1.8.

[opt_def -request [arg bool]]
Request a certificate from the peer during the SSL handshake. This is needed
to do Certificate Validation. Starting in TclTLS 1.8, the default is
[const true] for client connections. Starting in TclTLS 2.0, if set to
[const false] and [option -require] is [const true], then this will be
overridden to [const true]. See [sectref "Certificate Validation"] for
more details.

[opt_def -require [arg bool]]
Require a valid certificate from the peer during the SSL handshake. If this is
set to true, then [option -request] must also be set to true and a either
[option -cadir], [option -cafile], [option -castore], or a platform default
must be provided in order to validate against. The default in TclTLS 1.8 and
earlier versions is [const false] since not all platforms have certificates to
validate against in a form compatible with OpenSSL. Starting in TclTLS 2.0,
the default is [const true] for client connections.
See [sectref "Certificate Validation"] for more details.

[opt_def -security_level [arg integer]]
Specifies the security level (value from 0 to 5). The security level affects
the allowed cipher suite encryption algorithms, supported ECC curves,
supported signature algorithms, DH parameter sizes, certificate key sizes
and signature algorithms. The default is 1 prior to OpenSSL 3.2 and 2
thereafter. Level 3 and higher disable support for session tickets and
only accept cipher suites that provide forward secrecy.
This option is new for TclTLS 1.8.

[opt_def -server [arg bool]]
Specifies whether to act as a server and respond with a server handshake when a
client connects and provides a client handshake. The default is [const false].

[opt_def -servername [arg hostname]]
Specify the peer's hostname. This is used to set the TLS Server Name Indication
(SNI) extension. Set this to the expected servername in the server's certificate
or one of the Subject Alternate Names (SAN). Starting in TclTLS 2.0, this will
default to the host for the [cmd tls::socket] command.

[opt_def -session_id [arg binary_string]]
Specifies the session id to resume a session. Not supported yet.
This option is new for TclTLS 1.8.

[opt_def -ssl2 [arg bool]]
Enable use of SSL v2.The default is [const false].
OpenSSL 1.1+ no longer supports SSL v2, so this may not have any effect.
See the [cmd tls::protocols] command for supported protocols.

[opt_def -ssl3 [arg bool]]
Enable use of SSL v3. The default is [const false]. Starting in TclTLS 1.8,
use of SSL v3 if only available via a compile time option.
See the [cmd tls::protocols] command for supported protocols.

[opt_def -tls1 [arg bool]]
Enable use of TLS v1. Starting in TclTLS 2.0, the default is [const false].
Note: TLS 1.0 needs SHA1 to operate, which is only available in security level
0 for Open SSL 3.0+. See the [option -security_level] option.

[opt_def -tls1.1 [arg bool]]
Enable use of TLS v1.1. Starting in TclTLS 2.0, the default is [const false].
Note: TLS 1.1 needs SHA1 to operate, which is only available in security level
0 for Open SSL 3.0+. See the [option -security_level] option.

[opt_def -tls1.2 [arg bool]]
Enable use of TLS v1.2. The default is [const true].

[opt_def -tls1.3 [arg bool]]
Enable use of TLS v1.3. The default is [const true]. This is only available
starting with OpenSSL 1.1.1 and TclTLS 1.7.

[opt_def -validatecommand [arg callback]]
Specifies the callback command to invoke to validate the peer certificates
and other config info during the protocol negotiation phase. This can be used
by TCL scripts to perform their own Certificate Validation to supplement the
default validation provided by OpenSSL. The script must return a boolean true
to continue the negotiation. See [sectref "Callback Options"] for more info.
This option is new for TclTLS 1.8.

[list_end]

[call [cmd tls::unimport] [arg channel]]

Compliment to [cmd tls::import]. Used to remove the top level stacked channel
from [arg channel]. This unstacks the encryption of a regular TCL channel. An

SSL Status

[list_begin definitions]

[def "[var alpn] [arg protocol]"]
The protocol selected after Application-Layer Protocol Negotiation (ALPN).
This value is new for TclTLS 1.8.

[def "[var cipher] [arg cipher]"]
The current cipher in use for the session.

[def "[var peername] [arg name]"]
The peername from the certificate.
This value is new for TclTLS 1.8.

[def "[var protocol] [arg version]"]
The protocol version used for the connection: SSL2, SSL3, TLS1, TLS1.1, TLS1.2,
TLS1.3, or unknown. This value is new for TclTLS 1.8.

[def "[var sbits] [arg n]"]
The number of bits used for the session key.

[def "[var signatureHashAlgorithm] [arg algorithm]"]
The signature hash algorithm.
This value is new for TclTLS 1.8.

[def "[var signatureType] [arg type]"]
The signature type value.
This value is new for TclTLS 1.8.

[def "[var verifyDepth] [arg n]"]
Maximum depth for the certificate chain verification. Default is -1, to check all.
This value is new for TclTLS 1.8.

[def "[var verifyMode] [arg list]"]
List of certificate verification modes.
This value is new for TclTLS 1.8.

[def "[var verifyResult] [arg result]"]
Certificate verification result.
This value is new for TclTLS 1.8.

[def "[var ca_names] [arg list]"]
List of the Certificate Authorities used to create the certificate.
This value is new for TclTLS 1.8.

[list_end]

Certificate Status

[list_begin definitions]

[def "[var all] [arg string]"]
Dump of all certificate info.
This value is new for TclTLS 1.8.

[def "[var version] [arg value]"]
The certificate version.

[def "[var serialNumber] [arg string]"]
The serial number of the certificate as a hex string.
This value was changed from serial in TclTLS 1.8.

[def "[var signature] [arg algorithm]"]
Cipher algorithm used for certificate signature.
This value is new for TclTLS 1.8.

[def "[var issuer] [arg string]"]
The distinguished name (DN) of the certificate issuer.

[def "[var notBefore] [arg date]"]
The beginning date of the certificate validity.

[def "[var notAfter] [arg date]"]
The expiration date of the certificate validity.

[def "[var subject] [arg string]"]
The distinguished name (DN) of the certificate subject. Fields include: Common
Name (CN), Organization (O), Locality or City (L), State or Province (S), and
Country Name (C).

[def "[var issuerUniqueID] [arg string]"]
The issuer unique id.
This value is new for TclTLS 1.8.

[def "[var subjectUniqueID] [arg string]"]
The subject unique id.
This value is new for TclTLS 1.8.

[def "[var num_extensions] [arg n]"]
Number of certificate extensions.
This value is new for TclTLS 1.8.

[def "[var extensions] [arg list]"]
List of certificate extension names.
This value is new for TclTLS 1.8.

[def "[var authorityKeyIdentifier] [arg string]"]
Authority Key Identifier (AKI) of the Issuing CA certificate that signed the
SSL certificate as a hex string. This value matches the SKI value of the
Intermediate CA certificate.
This value is new for TclTLS 1.8.

[def "[var subjectKeyIdentifier] [arg string]"]
Subject Key Identifier (SKI) hash of the public key inside the certificate as a
hex string. Used to identify certificates that contain a particular public key.
This value is new for TclTLS 1.8.

[def "[var subjectAltName] [arg list]"]
List of all of the Subject Alternative Names (SAN) including domain names, sub
domains, and IP addresses that are secured by the certificate.
This value is new for TclTLS 1.8.

[def "[var ocsp] [arg list]"]
List of all Online Certificate Status Protocol (OCSP) URLs that can be used to
check the validity of this certificate.
This value is new for TclTLS 1.8.

[def "[var certificate] [arg cert]"]
The PEM encoded certificate.

[def "[var signatureAlgorithm] [arg algorithm]"]
Cipher algorithm used for the certificate signature.
This value is new for TclTLS 1.8.

[def "[var signatureValue] [arg string]"]
Certificate signature as a hex string.
This value is new for TclTLS 1.8.

[def "[var signatureDigest] [arg version]"]
Certificate signing digest as a hex string.
This value is new for TclTLS 1.8.

[def "[var publicKeyAlgorithm] [arg algorithm]"]
Certificate signature public key algorithm.
This value is new for TclTLS 1.8.

[def "[var publicKey] [arg string]"]
Certificate signature public key as a hex string.
This value is new for TclTLS 1.8.

[def "[var bits] [arg n]"]
Number of bits used for certificate signature key.
This value is new for TclTLS 1.8.

[def "[var self_signed] [arg boolean]"]
Whether the certificate signature is self signed.
This value is new for TclTLS 1.8.

[def "[var sha1_hash] [arg hash]"]
The SHA1 hash of the certificate as a hex string.
This value is new for TclTLS 1.8.

[def "[var sha256_hash] [arg hash]"]
The SHA256 hash of the certificate as a hex string.
This value is new for TclTLS 1.8.

[list_end]

[call [cmd tls::connection] [arg channel]]

Returns the current connection status of an SSL channel. The result is a list
of key-value pairs describing the connection.
This command is new for TclTLS 1.8. Returned values include:

[para]

SSL Status

[list_begin definitions]

[def "[var session_cache_mode] [arg mode]"]
Server cache mode (client, server, or both).

[list_end]

[call [cmd tls::ciphers] [opt [arg protocol]] [opt [arg verbose]] [opt [arg supported]]]

Without any options, it returns a list of all symmetric ciphers for use with the
[arg -cipher] option. With [arg protocol], only the ciphers supported for that
protocol are returned. See the [cmd tls::protocols] command for the supported
protocols. If [arg verbose] is specified as true then a verbose, human readable
list is returned with additional information on the cipher. If [arg supported]
is specified as true, then only the ciphers supported for protocol will be listed.
The [arg supported] arg is new for TclTLS 1.8.

[call [cmd tls::protocols]]

Returns a list of the supported SSL/TLS protocols. Valid values are:
[const ssl2], [const ssl3], [const tls1], [const tls1.1], [const tls1.2], and
[const tls1.3]. Exact list depends on OpenSSL version and compile time flags.
This command is new for TclTLS 1.8.

[call [cmd tls::version]]

Returns the OpenSSL version string.

[list_end]

In order to provide authentication, i.e. ensuring someone is who they say they
are, the public key and user identification info is stored in a X.509
certificate and that certificate is authenticated (i.e. signed) by a Certificate
Authority (CA). Users can then exchange these certificates during the TLS
initialization process and check them against the root CA certificates to ensure
they are valid. This is handled by OpenSSL via the [option -request] and
[option -require] options. See the [option -cadir], [option -cadir], and
[option -castore] options for how to specify where to find the CA certificates.
Optionally, in a future release, they can also be checked against the Certificate
Revocation List (CRL) of revoked certificates. Certificates can also be
self-signed, but they are by default not trusted unless you add them to your
certificate store.
[para]
Typically when visiting web sites, only the client needs to check the server's
certificate to ensure it is valid. The server doesn't need to check the client
certificate unless you need to authenticate with them to login, etc. See the
[option -cert] and [option -certfile] options if you need to provide a certificate.


[subsection "Summary of command line options"]

The following options are used for peer certificate validation:

[list_begin options]

[opt_def -cadir [arg directory]]
Specifies the directory where the Certificate Authority (CA) certificates are
stored. The default is platform specific, but is usually [file /etc/ssl/certs] on
Linux/Unix systems. The default location can be overridden by the
[var SSL_CERT_DIR] environment variable.

[opt_def -cafile [arg filename]]
Specifies the file with the Certificate Authority (CA) certificates to use in
[const PEM] file format. The default is [file cert.pem], in the OpenSSL
directory. On Linux/Unix systems, this is usually [file /etc/ssl/ca-bundle.pem].
The default file can be overridden by the [var SSL_CERT_FILE] environment
variable.

[opt_def -castore [arg URI]]
Specifies the Uniform Resource Identifier (URI) for the Certificate Authority
(CA) store, which may be a single container or a catalog of containers.
Starting with OpenSSL 3.2 on MS Windows, set to "[const "org.openssl.winstore://"]"
to use the built-in MS Windows Certificate Store. Starting in TclTLS 2.0, this
is the default if [option -cadir], [option -cadir], and [option -castore] are
not specified. This store only supports root certificate stores.


[opt_def -request [arg bool]]
Request a certificate from the peer during the SSL handshake. This is needed
to do Certificate Validation. Starting in TclTLS 1.8, the default is
[const true] for client connections. Starting in TclTLS 2.0, if set to
[const false] and [option -require] is [const true], then this will be
overridden to [const true]. In addition, the client can manually inspect and
accept or reject each certificate using the [option -validatecommand] option.

[opt_def -require [arg bool]]
Require a valid certificate from the peer during the SSL handshake. If this is
set to true, then [option -request] must also be set to true and a either
[option -cadir], [option -cafile], [option -castore], or a platform default
must be provided in order to validate against. The default in TclTLS 1.8 and
earlier versions is [const false] since not all platforms have certificates to
validate against in a form compatible with OpenSSL. Starting in TclTLS 2.0,
the default is [const true] for client connections.

[list_end]

[subsection "When are command line options needed?"]

In TclTLS 1.8 and earlier versions, certificate validation is
[emph NOT] enabled by default. This limitation is due to the lack of a common
cross platform database of Certificate Authority (CA) provided certificates to
validate against. Many Linux systems natively support OpenSSL and thus have
these certificates installed as part of the OS, but MacOS and MS Windows do not.
Staring in TclTLS 2.0, the default for client connections has been changed to
require certificate validation by default. In order to use the [option -require]
option, one of the following must be true:

[list_begin itemized]

[item]
On Linux and Unix systems with OpenSSL already installed or if the CA
certificates are available in PEM format, and if they are stored in the
standard locations, or if the [var SSL_CERT_DIR] or [var SSL_CERT_FILE]
environment variables are set, then [option -cadir], [option -cadir],
and [option -castore] aren't needed.

[item]
If OpenSSL is not installed in the default location, or when using Mac OS
or MS Windows and OpenSSL is installed, the [var SSL_CERT_DIR] and/or
[var SSL_CERT_FILE] environment variables or the one of the [option -cadir],
[option -cadir], or [option -castore] options must be defined.

[item]
On MS Windows, starting in OpenSSL 3.2, it is now possible to access the
built-in Windows Certificate Store from OpenSSL. This can be utilized by
setting the [option -castore] option to "[const org.openssl.winstore://]".
In TclTLS 2.0, this is the default value if [option -cadir],
[option -cadir], and [option -castore] are not specified.

[item]
If OpenSSL is not installed or the CA certificates are not available in PEM
format, the CA certificates must be downloaded and installed with the user
software. The CURL team makes them available at
[uri "https://curl.se/docs/caextract.html" "CA certificates extracted
from Mozilla"] in the [file cacert.pem] file. You must then either set the

[list_begin options]

[opt_def alpn [arg "channelId protocol match"]]
For servers, this form of callback is invoked when the client ALPN extension is
received. If [arg match] is true, then [arg protocol] is the first
[option -alpn] protocol option in common to both the client and server.
If not, the first client specified protocol is used. This callback is called
after the Hello and SNI callbacks.

[opt_def hello [arg "channelId servername session_id"]]
For servers, this form of callback is invoked during client hello message
processing. The purpose is so the server can select the appropriate certificate
to present to the client, and to make other configuration adjustments relevant
to that server name and its configuration. It is called before the SNI and ALPN
callbacks.

[opt_def sni [arg "channelId servername"]]
For servers, this form of callback is invoked when the Server Name Indication
(SNI) extension is received. The [arg servername] argument is the client
provided server name specified in the [option -servername] option. The
purpose is so when a server supports multiple names, the right certificate
can be used. It is called after the Hello callback but before the ALPN
callback.

[opt_def verify [arg "channelId depth cert status error"]]
This form of callback is invoked by OpenSSL when a new certificate is received
from the peer. It allows the client to check the certificate verification
results and choose whether to continue or not. It is called for each
certificate in the certificate chain. This callback was moved from

option is set to [cmd tls::validate_command].

[para]

[emph "The use of the variable [var tls::debug] is not recommended.
It may be removed from future releases."]

[section "Examples"]

The following are example scripts to download a webpage and file using the
http package. See [sectref "Certificate Validation"] for when the
[option -cadir], [option -cafile], and [option -castore] options are also
needed. See the [file demos] directory for more example scripts.

[para]

Example #1: Download a web page

[example {

}]

[section "Special Considerations"]

The capabilities of this package can vary enormously based upon how the
linked to OpenSSL library was configured and built. New versions may obsolete
older protocol versions, add or remove ciphers, change default values, etc.
Use the [cmd tls::protocols] command to obtain the supported
protocol versions.

[section "Error Messages"]

Some OpsnSSl error messages have cryptic meanings. This is a list of messages
along with their true meaning.

[list_begin definitions]

[def [arg "packet length too long"]]
Client has tried to connect to a HTTP server on the plain-text port instead of the SSL/TLS port.

[def [arg "unexpected eof while reading"]]
Peer has closed the connection without sending the "close notify" shutdown alert.

[def [arg "wrong version number"]]
Client has tried to connect to a non-HTTP server on a non-TLS (i.e. plain text) port.

[list_end]

[manpage_end]

'\"
'\" Generated from file 'tls\&.man' by tcllib/doctools with format 'nroff'
'\" Copyright (c) 1999 Matt Newman
'\" Copyright (c) 2004 Starfish Systems
'\" Copyright (c) 2024 Brian O'Hagan
'\"
.TH "tls" n 2\&.0b1 tls "Tcl TLS extension"
.\" The -*- nroff -*- definitions below are for supplemental macros used
.\" in Tcl/Tk manual entries.
.\"
.\" .AP type name in/out ?indent?
.\"	Start paragraph describing an argument to a library procedure.
.\"	type is type of argument (int, etc.), in/out is either "in", "out",
.\"	or "in/out" to describe whether procedure reads or modifies arg,

..
.BS
.SH NAME
tls \- binding to the OpenSSL library for encrypted socket and I/O channel communications
.SH SYNOPSIS
package require \fBTcl 8\&.5-\fR
.sp
package require \fBtls 2\&.0b1\fR
.sp
\fBtls::init\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR?
.sp
\fBtls::socket\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR? \fIhost\fR \fIport\fR
.sp
\fBtls::socket\fR \fB-server\fR \fIcommand\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR? \fIport\fR
.sp

.sp
\fBtls::protocols\fR
.sp
\fBtls::version\fR
.sp
.BE
.SH DESCRIPTION
This extension provides TCL script access to Secure Socket Layer (SSL)
communications using the Transport Layer Security (TLS) protocol\&. It provides a
generic binding to \fIOpenSSL\fR [https://www\&.openssl\&.org/], utilizing the
\fBTcl_StackChannel\fR API in TCL 8\&.4 or later\&. These sockets behave exactly
the same as channels created using the built-in \fBsocket\fR command, but
provide additional options for controlling the SSL/TLS session\&.
.SH COMPATIBILITY
This extension is compatible with OpenSSL 1\&.1\&.1 or later\&. It requires Tcl
version 8\&.5 or later and will work with Tcl 9\&.0\&.
.SH COMMANDS
The following are the commands provided by the TcLTLS package\&. See


\fBExamples\fR for example usage and the "\fIdemos\fR" directory for
more example usage\&.
.TP
\fBtls::init\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR?
Optional function to set the default options used by \fBtls::socket\fR\&. If you
call \fBtls::import\fR directly, the values set by this command have no effect\&.
This command supports all of the same options as the \fBtls::socket\fR command,
though you should limit your options to only the TLS related ones\&.
.TP
\fBtls::socket\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR? \fIhost\fR \fIport\fR
This is a helper function that utilizes the underlying commands \fBsocket\fR
and \fBtls::import\fR to create the connection\&. It behaves the same as the
native TCL \fBsocket\fR command, but also supports the \fBtls::import\fR
command options with one additional option\&. It returns the channel handle id
for the new socket\&. Additional options are:
.RS
.TP
\fB-autoservername\fR \fIbool\fR
If \fBtrue\fR, automatically set the \fB-servername\fR argument to the
\fIhost\fR argument\&. Prior to TclTLS 2\&.0, the default is \fBfalse\fR\&.
Starting in TclTLS 2\&.0, the default is \fBtrue\fR unless \fB-servername\fR
is also specified\&.
.RE
.TP
\fBtls::socket\fR \fB-server\fR \fIcommand\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR? \fIport\fR
Same as previous command, but instead creates a server socket for clients to
connect to just like the Tcl \fBsocket -server\fR command\&. It returns the
channel handle id for the new socket\&.
.TP
\fBtls::import\fR \fIchannel\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR?
Start TLS encryption on TCL channel \fIchannel\fR via a stacked channel\&. It
need not be a socket, but must provide bi-directional flow\&. Also sets session
parameters for SSL handshake\&. Valid options are:
.RS
.TP
\fB-alpn\fR \fIlist\fR
List of protocols to offer during Application-Layer Protocol Negotiation
(ALPN)\&. For example: \fBh2\fR and \fBhttp/1\&.1\fR, but not \fBh3\fR or
\fBquic\fR\&. This option is new for TclTLS 1\&.8\&.
.TP
\fB-cadir\fR \fIdirectory\fR
Specifies the directory where the Certificate Authority (CA) certificates are
stored\&. The default is platform specific and can be set at compile time\&. The
default location can be overridden by the \fBSSL_CERT_DIR\fR environment
variable\&. See \fBCertificate Validation\fR for more details\&.
.TP
\fB-cafile\fR \fIfilename\fR
Specifies the file with the Certificate Authority (CA) certificates to use in
\fBPEM\fR file format\&. The default is "\fIcert\&.pem\fR", in the OpenSSL
directory\&. The default file can be overridden by the \fBSSL_CERT_FILE\fR environment
variable\&. See \fBCertificate Validation\fR for more details\&.
.TP
\fB-castore\fR \fIURI\fR
Specifies the Uniform Resource Identifier (URI) for the Certificate Authority
(CA) store, which may be a single container or a catalog of containers\&.
Starting with OpenSSL 3\&.2 on MS Windows, set to "\fBorg\&.openssl\&.winstore://\fR"
to use the built-in MS Windows Certificate Store\&.
See \fBCertificate Validation\fR for more details\&.
This option is new for TclTLS 1\&.8\&.
.TP
\fB-certfile\fR \fIfilename\fR
Specifies the name of the file with the certificate to use in PEM format
as the local (client or server) certificate\&. It also contains the public key\&.
.TP
\fB-cert\fR \fIstring\fR
Specifies the certificate to use as a DER encoded string (X\&.509 DER)\&.

documentation for the full list of valid values\&.
.TP
\fB-ciphersuites\fR \fIstring\fR
Specifies the list of cipher suites to use for TLS 1\&.3 as a colon
"\fB:\fR" separated list of cipher suite names\&. See the
\fIOpenSSL\fR [https://docs\&.openssl\&.org/master/man1/openssl-ciphers/#options]
documentation for the full list of valid values\&.
This option is new for TclTLS 1\&.8\&.
.TP
\fB-command\fR \fIcallback\fR
Specifies the callback command to be invoked at several points during the
handshake to pass errors, tracing information, and protocol messages\&.
See \fBCallback Options\fR for more info\&.
.TP
\fB-dhparams\fR \fIfilename\fR
Specifies the Diffie-Hellman (DH) parameters file\&.
.TP
\fB-keyfile\fR \fIfilename\fR
Specifies the private key file\&. The default is to use the file
specified by the \fB-certfile\fR option\&.
.TP
\fB-key\fR \fIstring\fR
Specifies the private key to use as a DER encoded string (PKCS#1 DER)\&.
.TP
\fB-model\fR \fIchannel\fR
Force this channel to share the same \fISSL_CTX\fR structure as the
specified \fIchannel\fR, and therefore share config, callbacks, etc\&.
.TP
\fB-password\fR \fIcallback\fR
Specifies the callback command to invoke when OpenSSL needs to obtain a
password\&. This is typically used to unlock the private key of a certificate\&.
The callback should return a password string\&. This option has changed for
TclTLS 1\&.8\&. See \fBCallback Options\fR for more info\&.
.TP
\fB-post_handshake\fR \fIbool\fR
Allow post-handshake session ticket updates\&. This option is new for TclTLS 1\&.8\&.
.TP
\fB-request\fR \fIbool\fR
Request a certificate from the peer during the SSL handshake\&. This is needed
to do Certificate Validation\&. Starting in TclTLS 1\&.8, the default is
\fBtrue\fR for client connections\&. Starting in TclTLS 2\&.0, if set to
\fBfalse\fR and \fB-require\fR is \fBtrue\fR, then this will be
overridden to \fBtrue\fR\&. See \fBCertificate Validation\fR for
more details\&.
.TP
\fB-require\fR \fIbool\fR
Require a valid certificate from the peer during the SSL handshake\&. If this is
set to true, then \fB-request\fR must also be set to true and a either
\fB-cadir\fR, \fB-cafile\fR, \fB-castore\fR, or a platform default
must be provided in order to validate against\&. The default in TclTLS 1\&.8 and
earlier versions is \fBfalse\fR since not all platforms have certificates to
validate against in a form compatible with OpenSSL\&. Starting in TclTLS 2\&.0,
the default is \fBtrue\fR for client connections\&.
See \fBCertificate Validation\fR for more details\&.
.TP
\fB-security_level\fR \fIinteger\fR
Specifies the security level (value from 0 to 5)\&. The security level affects
the allowed cipher suite encryption algorithms, supported ECC curves,
supported signature algorithms, DH parameter sizes, certificate key sizes
and signature algorithms\&. The default is 1 prior to OpenSSL 3\&.2 and 2
thereafter\&. Level 3 and higher disable support for session tickets and
only accept cipher suites that provide forward secrecy\&.
This option is new for TclTLS 1\&.8\&.
.TP
\fB-server\fR \fIbool\fR
Specifies whether to act as a server and respond with a server handshake when a
client connects and provides a client handshake\&. The default is \fBfalse\fR\&.
.TP
\fB-servername\fR \fIhostname\fR
Specify the peer's hostname\&. This is used to set the TLS Server Name Indication
(SNI) extension\&. Set this to the expected servername in the server's certificate
or one of the Subject Alternate Names (SAN)\&. Starting in TclTLS 2\&.0, this will
default to the host for the \fBtls::socket\fR command\&.
.TP
\fB-session_id\fR \fIbinary_string\fR
Specifies the session id to resume a session\&. Not supported yet\&.
This option is new for TclTLS 1\&.8\&.
.TP
\fB-ssl2\fR \fIbool\fR
Enable use of SSL v2\&.The default is \fBfalse\fR\&.
OpenSSL 1\&.1+ no longer supports SSL v2, so this may not have any effect\&.
See the \fBtls::protocols\fR command for supported protocols\&.
.TP
\fB-ssl3\fR \fIbool\fR
Enable use of SSL v3\&. The default is \fBfalse\fR\&. Starting in TclTLS 1\&.8,
use of SSL v3 if only available via a compile time option\&.
See the \fBtls::protocols\fR command for supported protocols\&.
.TP
\fB-tls1\fR \fIbool\fR
Enable use of TLS v1\&. Starting in TclTLS 2\&.0, the default is \fBfalse\fR\&.
Note: TLS 1\&.0 needs SHA1 to operate, which is only available in security level
0 for Open SSL 3\&.0+\&. See the \fB-security_level\fR option\&.
.TP
\fB-tls1\&.1\fR \fIbool\fR
Enable use of TLS v1\&.1\&. Starting in TclTLS 2\&.0, the default is \fBfalse\fR\&.
Note: TLS 1\&.1 needs SHA1 to operate, which is only available in security level
0 for Open SSL 3\&.0+\&. See the \fB-security_level\fR option\&.
.TP
\fB-tls1\&.2\fR \fIbool\fR
Enable use of TLS v1\&.2\&. The default is \fBtrue\fR\&.
.TP
\fB-tls1\&.3\fR \fIbool\fR
Enable use of TLS v1\&.3\&. The default is \fBtrue\fR\&. This is only available
starting with OpenSSL 1\&.1\&.1 and TclTLS 1\&.7\&.
.TP
\fB-validatecommand\fR \fIcallback\fR
Specifies the callback command to invoke to validate the peer certificates
and other config info during the protocol negotiation phase\&. This can be used
by TCL scripts to perform their own Certificate Validation to supplement the
default validation provided by OpenSSL\&. The script must return a boolean true
to continue the negotiation\&. See \fBCallback Options\fR for more info\&.
This option is new for TclTLS 1\&.8\&.
.RE
.TP
\fBtls::unimport\fR \fIchannel\fR
Compliment to \fBtls::import\fR\&. Used to remove the top level stacked channel
from \fIchannel\fR\&. This unstacks the encryption of a regular TCL channel\&. An
error is thrown if TLS is not the top stacked channel type\&.
.TP

values include:
.sp
SSL Status
.RS
.TP
\fBalpn\fR \fIprotocol\fR
The protocol selected after Application-Layer Protocol Negotiation (ALPN)\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBcipher\fR \fIcipher\fR
The current cipher in use for the session\&.
.TP
\fBpeername\fR \fIname\fR
The peername from the certificate\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBprotocol\fR \fIversion\fR
The protocol version used for the connection: SSL2, SSL3, TLS1, TLS1\&.1, TLS1\&.2,
TLS1\&.3, or unknown\&. This value is new for TclTLS 1\&.8\&.
.TP
\fBsbits\fR \fIn\fR
The number of bits used for the session key\&.
.TP
\fBsignatureHashAlgorithm\fR \fIalgorithm\fR
The signature hash algorithm\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBsignatureType\fR \fItype\fR
The signature type value\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBverifyDepth\fR \fIn\fR
Maximum depth for the certificate chain verification\&. Default is -1, to check all\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBverifyMode\fR \fIlist\fR
List of certificate verification modes\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBverifyResult\fR \fIresult\fR
Certificate verification result\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBca_names\fR \fIlist\fR
List of the Certificate Authorities used to create the certificate\&.
This value is new for TclTLS 1\&.8\&.
.RE
.IP
Certificate Status
.RS
.TP
\fBall\fR \fIstring\fR
Dump of all certificate info\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBversion\fR \fIvalue\fR
The certificate version\&.
.TP
\fBserialNumber\fR \fIstring\fR
The serial number of the certificate as a hex string\&.
This value was changed from serial in TclTLS 1\&.8\&.
.TP
\fBsignature\fR \fIalgorithm\fR
Cipher algorithm used for certificate signature\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBissuer\fR \fIstring\fR
The distinguished name (DN) of the certificate issuer\&.
.TP
\fBnotBefore\fR \fIdate\fR
The beginning date of the certificate validity\&.
.TP
\fBnotAfter\fR \fIdate\fR
The expiration date of the certificate validity\&.
.TP
\fBsubject\fR \fIstring\fR
The distinguished name (DN) of the certificate subject\&. Fields include: Common
Name (CN), Organization (O), Locality or City (L), State or Province (S), and
Country Name (C)\&.
.TP
\fBissuerUniqueID\fR \fIstring\fR
The issuer unique id\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBsubjectUniqueID\fR \fIstring\fR
The subject unique id\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBnum_extensions\fR \fIn\fR
Number of certificate extensions\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBextensions\fR \fIlist\fR
List of certificate extension names\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBauthorityKeyIdentifier\fR \fIstring\fR
Authority Key Identifier (AKI) of the Issuing CA certificate that signed the
SSL certificate as a hex string\&. This value matches the SKI value of the
Intermediate CA certificate\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBsubjectKeyIdentifier\fR \fIstring\fR
Subject Key Identifier (SKI) hash of the public key inside the certificate as a
hex string\&. Used to identify certificates that contain a particular public key\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBsubjectAltName\fR \fIlist\fR
List of all of the Subject Alternative Names (SAN) including domain names, sub
domains, and IP addresses that are secured by the certificate\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBocsp\fR \fIlist\fR
List of all Online Certificate Status Protocol (OCSP) URLs that can be used to
check the validity of this certificate\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBcertificate\fR \fIcert\fR
The PEM encoded certificate\&.
.TP
\fBsignatureAlgorithm\fR \fIalgorithm\fR
Cipher algorithm used for the certificate signature\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBsignatureValue\fR \fIstring\fR
Certificate signature as a hex string\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBsignatureDigest\fR \fIversion\fR
Certificate signing digest as a hex string\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBpublicKeyAlgorithm\fR \fIalgorithm\fR
Certificate signature public key algorithm\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBpublicKey\fR \fIstring\fR
Certificate signature public key as a hex string\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBbits\fR \fIn\fR
Number of bits used for certificate signature key\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBself_signed\fR \fIboolean\fR
Whether the certificate signature is self signed\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBsha1_hash\fR \fIhash\fR
The SHA1 hash of the certificate as a hex string\&.
This value is new for TclTLS 1\&.8\&.
.TP
\fBsha256_hash\fR \fIhash\fR
The SHA256 hash of the certificate as a hex string\&.
This value is new for TclTLS 1\&.8\&.
.RE
.TP
\fBtls::connection\fR \fIchannel\fR
Returns the current connection status of an SSL channel\&. The result is a list
of key-value pairs describing the connection\&.
This command is new for TclTLS 1\&.8\&. Returned values include:
.sp
SSL Status
.RS
.TP
\fBstate\fR \fIstate\fR
State of the connection\&.
.TP

Unique session master key\&.
.TP
\fBsession_cache_mode\fR \fImode\fR
Server cache mode (client, server, or both)\&.
.RE
.TP
\fBtls::ciphers\fR ?\fIprotocol\fR? ?\fIverbose\fR? ?\fIsupported\fR?
Without any options, it returns a list of all symmetric ciphers for use with the
\fI-cipher\fR option\&. With \fIprotocol\fR, only the ciphers supported for that
protocol are returned\&. See the \fBtls::protocols\fR command for the supported
protocols\&. If \fIverbose\fR is specified as true then a verbose, human readable
list is returned with additional information on the cipher\&. If \fIsupported\fR
is specified as true, then only the ciphers supported for protocol will be listed\&.
The \fIsupported\fR arg is new for TclTLS 1\&.8\&.
.TP
\fBtls::protocols\fR
Returns a list of the supported SSL/TLS protocols\&. Valid values are:
\fBssl2\fR, \fBssl3\fR, \fBtls1\fR, \fBtls1\&.1\fR, \fBtls1\&.2\fR, and
\fBtls1\&.3\fR\&. Exact list depends on OpenSSL version and compile time flags\&.
This command is new for TclTLS 1\&.8\&.
.TP
\fBtls::version\fR
Returns the OpenSSL version string\&.
.PP
.SH "CERTIFICATE VALIDATION"
.SS "PKI AND CERTIFICATES"
Using the Public Key Infrastructure (PKI), each user creates a private key that

In order to provide authentication, i\&.e\&. ensuring someone is who they say they
are, the public key and user identification info is stored in a X\&.509
certificate and that certificate is authenticated (i\&.e\&. signed) by a Certificate
Authority (CA)\&. Users can then exchange these certificates during the TLS
initialization process and check them against the root CA certificates to ensure
they are valid\&. This is handled by OpenSSL via the \fB-request\fR and
\fB-require\fR options\&. See the \fB-cadir\fR, \fB-cadir\fR, and
\fB-castore\fR options for how to specify where to find the CA certificates\&.
Optionally, in a future release, they can also be checked against the Certificate
Revocation List (CRL) of revoked certificates\&. Certificates can also be
self-signed, but they are by default not trusted unless you add them to your
certificate store\&.
.PP
Typically when visiting web sites, only the client needs to check the server's
certificate to ensure it is valid\&. The server doesn't need to check the client

The default file can be overridden by the \fBSSL_CERT_FILE\fR environment
variable\&.
.TP
\fB-castore\fR \fIURI\fR
Specifies the Uniform Resource Identifier (URI) for the Certificate Authority
(CA) store, which may be a single container or a catalog of containers\&.
Starting with OpenSSL 3\&.2 on MS Windows, set to "\fBorg\&.openssl\&.winstore://\fR"
to use the built-in MS Windows Certificate Store\&. Starting in TclTLS 2\&.0, this
is the default if \fB-cadir\fR, \fB-cadir\fR, and \fB-castore\fR are
not specified\&. This store only supports root certificate stores\&.

.TP
\fB-request\fR \fIbool\fR
Request a certificate from the peer during the SSL handshake\&. This is needed
to do Certificate Validation\&. Starting in TclTLS 1\&.8, the default is
\fBtrue\fR for client connections\&. Starting in TclTLS 2\&.0, if set to
\fBfalse\fR and \fB-require\fR is \fBtrue\fR, then this will be
overridden to \fBtrue\fR\&. In addition, the client can manually inspect and
accept or reject each certificate using the \fB-validatecommand\fR option\&.
.TP
\fB-require\fR \fIbool\fR
Require a valid certificate from the peer during the SSL handshake\&. If this is
set to true, then \fB-request\fR must also be set to true and a either
\fB-cadir\fR, \fB-cafile\fR, \fB-castore\fR, or a platform default
must be provided in order to validate against\&. The default in TclTLS 1\&.8 and
earlier versions is \fBfalse\fR since not all platforms have certificates to
validate against in a form compatible with OpenSSL\&. Starting in TclTLS 2\&.0,
the default is \fBtrue\fR for client connections\&.
.PP
.SS "WHEN ARE COMMAND LINE OPTIONS NEEDED?"
In TclTLS 1\&.8 and earlier versions, certificate validation is
\fINOT\fR enabled by default\&. This limitation is due to the lack of a common
cross platform database of Certificate Authority (CA) provided certificates to
validate against\&. Many Linux systems natively support OpenSSL and thus have
these certificates installed as part of the OS, but MacOS and MS Windows do not\&.
Staring in TclTLS 2\&.0, the default for client connections has been changed to
require certificate validation by default\&. In order to use the \fB-require\fR
option, one of the following must be true:
.IP \(bu
On Linux and Unix systems with OpenSSL already installed or if the CA
certificates are available in PEM format, and if they are stored in the
standard locations, or if the \fBSSL_CERT_DIR\fR or \fBSSL_CERT_FILE\fR
environment variables are set, then \fB-cadir\fR, \fB-cadir\fR,
and \fB-castore\fR aren't needed\&.
.IP \(bu
If OpenSSL is not installed in the default location, or when using Mac OS
or MS Windows and OpenSSL is installed, the \fBSSL_CERT_DIR\fR and/or
\fBSSL_CERT_FILE\fR environment variables or the one of the \fB-cadir\fR,
\fB-cadir\fR, or \fB-castore\fR options must be defined\&.
.IP \(bu
On MS Windows, starting in OpenSSL 3\&.2, it is now possible to access the
built-in Windows Certificate Store from OpenSSL\&. This can be utilized by
setting the \fB-castore\fR option to "\fBorg\&.openssl\&.winstore://\fR"\&.
In TclTLS 2\&.0, this is the default value if \fB-cadir\fR,
\fB-cadir\fR, and \fB-castore\fR are not specified\&.
.IP \(bu
If OpenSSL is not installed or the CA certificates are not available in PEM
format, the CA certificates must be downloaded and installed with the user
software\&. The CURL team makes them available at
\fICA certificates extracted
from Mozilla\fR [https://curl\&.se/docs/caextract\&.html] in the "\fIcacert\&.pem\fR" file\&. You must then either set the
\fBSSL_CERT_DIR\fR and/or \fBSSL_CERT_FILE\fR environment variables or the

continue the connection, it should return 2\&. This callback is new for TclTLS 1\&.8\&.
.TP
\fBalpn\fR \fIchannelId protocol match\fR
For servers, this form of callback is invoked when the client ALPN extension is
received\&. If \fImatch\fR is true, then \fIprotocol\fR is the first
\fB-alpn\fR protocol option in common to both the client and server\&.
If not, the first client specified protocol is used\&. This callback is called
after the Hello and SNI callbacks\&.
.TP
\fBhello\fR \fIchannelId servername session_id\fR
For servers, this form of callback is invoked during client hello message
processing\&. The purpose is so the server can select the appropriate certificate
to present to the client, and to make other configuration adjustments relevant
to that server name and its configuration\&. It is called before the SNI and ALPN
callbacks\&.
.TP
\fBsni\fR \fIchannelId servername\fR
For servers, this form of callback is invoked when the Server Name Indication
(SNI) extension is received\&. The \fIservername\fR argument is the client
provided server name specified in the \fB-servername\fR option\&. The
purpose is so when a server supports multiple names, the right certificate
can be used\&. It is called after the Hello callback but before the ALPN
callback\&.
.TP
\fBverify\fR \fIchannelId depth cert status error\fR
This form of callback is invoked by OpenSSL when a new certificate is received
from the peer\&. It allows the client to check the certificate verification
results and choose whether to continue or not\&. It is called for each
certificate in the certificate chain\&. This callback was moved from

The default value is 0 with higher values producing more diagnostic output,
and will also force the verify method in \fBtls::callback\fR to accept the
certificate, even if it is invalid when the \fB-validatecommand\fR
option is set to \fBtls::validate_command\fR\&.
.PP
\fIThe use of the variable \fBtls::debug\fR is not recommended\&.
It may be removed from future releases\&.\fR
.SH EXAMPLES
The following are example scripts to download a webpage and file using the
http package\&. See \fBCertificate Validation\fR for when the
\fB-cadir\fR, \fB-cafile\fR, and \fB-castore\fR options are also
needed\&. See the "\fIdemos\fR" directory for more example scripts\&.
.PP
Example #1: Download a web page
.CS



package require http

::http::cleanup $token

.CE
.SH "SPECIAL CONSIDERATIONS"
The capabilities of this package can vary enormously based upon how the
linked to OpenSSL library was configured and built\&. New versions may obsolete
older protocol versions, add or remove ciphers, change default values, etc\&.
Use the \fBtls::protocols\fR command to obtain the supported
protocol versions\&.
.SH "ERROR MESSAGES"
Some OpsnSSl error messages have cryptic meanings\&. This is a list of messages
along with their true meaning\&.
.TP
\fIpacket length too long\fR
Client has tried to connect to a HTTP server on the plain-text port instead of the SSL/TLS port\&.
.TP
\fIunexpected eof while reading\fR
Peer has closed the connection without sending the "close notify" shutdown alert\&.
.TP
\fIwrong version number\fR
Client has tried to connect to a non-HTTP server on a non-TLS (i\&.e\&. plain text) port\&.
.PP
.SH "SEE ALSO"
\fIOpenSSL\fR [https://www\&.openssl\&.org/], http, socket
.SH KEYWORDS
I/O, IP Address, OpenSSL, SSL, TCP, TLS, TclTLS, asynchronous I/O, bind, certificate, channel, connection, domain name, host, https, network, network address, socket, tls
.SH CATEGORY
tls
.SH COPYRIGHT
.nf
Copyright (c) 1999 Matt Newman
Copyright (c) 2004 Starfish Systems
Copyright (c) 2024 Brian O'Hagan

.fi

/*
 * TLS Channel - This extension provides a encrypted communication channel
 * using the TLS or SSL protocols. It can be layered on top of any
 * bi-directional Tcl_Channel.
 *
 * This was initially built (almost) from scratch based upon observation of
 * OpenSSL 0.9.2B.
 *
 * Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
 * some modifications:
 *	Copyright (C) 2000 Ajuba Solutions
 *	Copyright (C) 2002 ActiveState Corporation
 *	Copyright (C) 2004 Starfish Systems
 *	Copyright (C) 2023-2025 Brian O'Hagan
 *
 * Additional credit is due for Andreas Kupries (a.kupries@westend.com), for
 * providing the Tcl_ReplaceChannel mechanism and working closely with me
 * to enhance it to support full fileevent semantics.
 *
 * Also work done by the follow people provided the impetus to do this "right":
 *	tclSSL (Colin McCormack, Shared Technology)

 *	1 = Command returned success or eval returned TCL_OK
 *
 * Side effects:
 *	Evaluates callback command
 *
 *-------------------------------------------------------------------
 */

static int
EvalCallback(
    Tcl_Interp *interp,		/* Tcl interpreter */
    State *statePtr,		/* Client state for TLS socket */
    Tcl_Obj *cmdPtr)		/* Command to eval as a Tcl object */
{
    int code, ok = 0;

 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 *-------------------------------------------------------------------
 */

static void
InfoCallback(
    const SSL *ssl,		/* SSL context */
    int where,			/* Source of info */
    int ret)			/* message enum */
{
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);

 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 *-------------------------------------------------------------------
 */

#ifndef OPENSSL_NO_SSL_TRACE
static void
MessageCallback(
    int write_p,		/* Message 0=received, 1=sent */
    int version,		/* TLS version */
    int content_type,		/* Protocol content type */
    const void *buf,		/* Protocol message */

 *
 * Side effects:
 *	The err field of the currently operative State is set
 *	  to a string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */

static int
VerifyCallback(
    int ok,			/* Verify result */
    X509_STORE_CTX *ctx)	/* CTX context */
{
    Tcl_Obj *cmdPtr;
    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());

 *
 * Side effects:
 *	The err field of the currently operative State is set to a
 *	string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */

void
Tls_Error(
    State *statePtr,		/* Client state for TLS socket */
    const char *msg)		/* Error message */
{
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr, *listPtr;

 *	Write received key data to log file.
 *
 * Side effects:
 *	none
 *
 *-------------------------------------------------------------------
 */

void KeyLogCallback(
    const SSL *ssl,		/* Client state for TLS socket */
    const char *line)		/* Key data to be logged */
{
    char *str = getenv(SSLKEYLOGFILE);
    FILE *fd;

 *	Calls callback (if defined)
 *
 * Returns:
 *	Password size in bytes or -1 for an error.
 *
 *-------------------------------------------------------------------
 */

static int
PasswordCallback(
    char *buf,			/* Pointer to buffer to store password in */
    int size,			/* Buffer length in bytes */
    int rwflag,			/* Whether password is needed for read or write */
    void *udata)		/* Client state for TLS socket */
{

 *
 * Return codes:
 *	0 = error where session will be immediately removed from the internal cache.
 *	1 = success where app retains session in session cache, and must call SSL_SESSION_free() when done.
 *
 *-------------------------------------------------------------------
 */

static int
SessionCallback(
    SSL *ssl,			/* SSL context */
    SSL_SESSION *session)	/* Session context */
{
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Interp *interp	= statePtr->interp;

 *	SSL_TLSEXT_ERR_ALERT_FATAL: There was no overlap between the client's
 *	    supplied list and the server configuration. The connection will be aborted.
 *	SSL_TLSEXT_ERR_NOACK: ALPN protocol not selected, e.g., because no ALPN
 *	    protocols are configured for this connection. The connection continues.
 *
 *-------------------------------------------------------------------
 */

static int
ALPNCallback(
    SSL *ssl,			/* SSL context */
    const unsigned char **out,	/* Return buffer to store selected protocol */
    unsigned char *outlen,	/* Return buffer size */
    const unsigned char *in,	/* Peer provided protocols */
    unsigned int inlen,		/* Peer buffer size */

 *
 * Return codes:
 *	SSL_TLSEXT_ERR_OK: NPN protocol selected. The connection continues.
 *	SSL_TLSEXT_ERR_NOACK: NPN protocol not selected. The connection continues.
 *
 *-------------------------------------------------------------------
 */

#ifdef USE_NPN
static int
NPNCallback(
    const SSL *ssl,		/* SSL context */
    const unsigned char **out,	/* Return buffer to store selected protocol */
    unsigned int *outlen,	/* Return buffer size */
    void *arg)			/* Client state for TLS socket */

/*
 *-------------------------------------------------------------------
 *
 * SNI Callback for Servers --
 *
 *	Perform server-side SNI hostname selection after receiving SNI extension
 *	in Client Hello. Called after hello callback but before ALPN callback.
 *	This callback is mostly superseded by the ClientHello callback. Used to
 *	acknowledge the server name requested by the client.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 * Return codes:
 *	SSL_TLSEXT_ERR_OK: SNI hostname is accepted. The connection continues.
 *	SSL_TLSEXT_ERR_ALERT_FATAL: SNI hostname is not accepted. The connection
 *	    is aborted. Default for alert is SSL_AD_UNRECOGNIZED_NAME.
 *	SSL_TLSEXT_ERR_ALERT_WARNING: SNI hostname is not accepted, warning alert
 *	    sent (not supported in TLSv1.3). The connection continues.
 *	SSL_TLSEXT_ERR_NOACK: SNI hostname is not accepted and not acknowledged,
 *	    e.g. if SNI has not been configured. The connection continues.
 *
 *-------------------------------------------------------------------
 */

static int
SNICallback(
    const SSL *ssl,		/* SSL context */
    int *alert,			/* Returned alert message */
    void *arg)			/* Client state for TLS socket */
{
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code, res;
    const char *servername = NULL;

    dprintf("Called");

    if (ssl == NULL || arg == NULL) {
	return SSL_TLSEXT_ERR_NOACK;
    }

    /* Only works for TLS 1.2 and earlier */
    if (SSL_get_servername_type(ssl) == TLSEXT_NAMETYPE_host_name) {
	servername = SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name);
    }
    if (!servername || servername[0] == '\0') {
	return SSL_TLSEXT_ERR_NOACK;
    }

    if (statePtr->vcmd == (Tcl_Obj*)NULL) {
	return SSL_TLSEXT_ERR_OK;
    }

 * Return codes:
 *	SSL_CLIENT_HELLO_RETRY: suspend the handshake, and the handshake function will return immediately
 *	SSL_CLIENT_HELLO_ERROR: failure, terminate connection. Set alert to error code.
 *	SSL_CLIENT_HELLO_SUCCESS: success
 *
 *-------------------------------------------------------------------
 */

static int
HelloCallback(
    SSL *ssl,			/* SSL context */
    int *alert,			/* Returned alert message */
    void *arg)			/* Client state for TLS socket */
{
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code, res;
    const char *servername;
    const unsigned char *p, *session_id;
    size_t len, remaining, len2;

    dprintf("Called");

    if (statePtr->vcmd == (Tcl_Obj*)NULL) {
	return SSL_CLIENT_HELLO_SUCCESS;
    } else if (ssl == (const SSL *)NULL || arg == NULL) {
	return SSL_CLIENT_HELLO_ERROR;
    }

    /* Get server name */
    if (SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining)) {
	/* Check if there is sufficient data to extract */
	if (remaining <= 2) {
	    *alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER;
	    return SSL_CLIENT_HELLO_ERROR;
	}

	/* Extract the length of the supplied list of names. */
	len = (*(p++) << 8);
	len += *(p++);
	if (len + 2 != remaining) {
	    *alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER;
	    return SSL_CLIENT_HELLO_ERROR;
	}
	remaining = len;

	/* The list in practice only has a single element, so we only consider the first one. */
	if (remaining == 0 || *p++ != TLSEXT_NAMETYPE_host_name) {
	    *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
	    return SSL_CLIENT_HELLO_ERROR;
	}
	remaining--;

	/* Now we can finally pull out the byte array with the actual hostname. */
	if (remaining <= 2) {
	    *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
	    return SSL_CLIENT_HELLO_ERROR;
	}
	len = (*(p++) << 8);
	len += *(p++);
	if (len + 2 > remaining) {
	    *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
	    return SSL_CLIENT_HELLO_ERROR;
	}
	remaining = len;
	servername = (const char *)p;
    } else {
	servername = "";
	len = 0;
    }

    /* Get session id from Client Hello */
    len2 = SSL_client_hello_get0_session_id(ssl, &session_id);

    /* Create command to eval with fn, chan, server name, and session id */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (Tcl_Size) len));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (Tcl_Size) len2));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
    if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) {
	res = SSL_CLIENT_HELLO_RETRY;
	*alert = SSL_R_TLSV1_ALERT_USER_CANCELLED;
    } else if (code == 1) {

 *	A standard Tcl result list.
 *
 * Side effects:
 *	constructs and destroys SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */

static const char *protocols[] = {
    "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL
};
enum protocol {
    TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE
};

    char *CAstore		= NULL;
    char *DHparams		= NULL;
    char *model			= NULL;
    char *servername		= NULL;	/* hostname for Server Name Indication */
    char *session_id		= NULL;
    Tcl_Obj *alpn		= NULL;
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 0, tls1_1 = 0, tls1_2 = 1, tls1_3 = 1;
    int proto = 0, level = -1;
    int verify = 0, require = -1, request = -1, post_handshake = 0;

    dprintf("Called");

#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
    tls1 = 0;
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)

	OPTOBJ("-validatecommand", vcmd);
	OPTOBJ("-vcmd", vcmd);

	OPTBAD("option", "-alpn, -cadir, -cafile, -castore, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -post_handshake, -request, -require, -security_level, -server, -servername, -session_id, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, -tls1.3, or -validatecommand");

	return TCL_ERROR;
    }

    /* For client, request and require default to true, server default is false */
    if (!server) {
	if (request == -1)	request = 1;
	if (require == -1)	require = 1;
    } else {
	if (request == -1)	request = 0;
	if (require == -1)	require = 0;
    }

    if (require)		request = 1;
    if (request)		verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require)	verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (request && post_handshake) verify |= SSL_VERIFY_POST_HANDSHAKE;
    if (!verify)		verify = SSL_VERIFY_NONE;

    proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
    proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);
    proto |= (tls1 ? TLS_PROTO_TLS1 : 0);
    proto |= (tls1_1 ? TLS_PROTO_TLS1_1 : 0);
    proto |= (tls1_2 ? TLS_PROTO_TLS1_2 : 0);
    proto |= (tls1_3 ? TLS_PROTO_TLS1_3 : 0);

	}
    }

    /* Enable Application-Layer Protocol Negotiation. Examples are: http/1.0,
	http/1.1, h2, h3, ftp, imap, pop3, xmpp-client, xmpp-server, mqtt, irc, etc. */
    if (alpn) {
	/* Convert a TCL list into a protocol-list in wire-format */
	unsigned char *protos = NULL, *p;
	unsigned int protos_len = 0;
	Tcl_Size cnt, i;
	int res = TCL_OK;
	Tcl_Obj **list;

	if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}

	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);
	    if (len > 255) {
		Tcl_AppendResult(interp, "ALPN protocol names too long", (char *)NULL);
		Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);

		res = TCL_ERROR;
		goto done;
	    }
	    protos_len += 1 + (int) len;
	}

	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (i = 0, p = protos; i < cnt; i++) {
	    char *str = Tcl_GetStringFromObj(list[i], &len);
	    *p++ = (unsigned char) len;
	    memcpy(p, str, (size_t) len);
	    p += len;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* Note: This function reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
	    res = TCL_ERROR;
	}

done:	for (i = 0; i < cnt; i++) {
	    Tcl_IncrRefCount(list[i]);
	    Tcl_DecrRefCount(list[i]);
	}

	if (res != TCL_OK) {
	    Tls_Free((tls_free_type *) statePtr);
	    if (protos != NULL) {
		ckfree(protos);
	    }
	    return TCL_ERROR;
	}

	/* Store protocols list */
	statePtr->protos = protos;
	statePtr->protos_len = protos_len;
    } else {

	if (request && post_handshake && tls1_3) {
	    SSL_verify_client_post_handshake(statePtr->ssl);
	}

	/* Set server mode */
	statePtr->flags |= TLS_TCL_SERVER;
	SSL_set_accept_state(statePtr->ssl);

    } else {
	/* Client callbacks */
#ifdef USE_NPN
	if (statePtr->protos != NULL && tls1_2 == 0 && tls1_3 == 0) {
	    SSL_CTX_set_next_proto_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr);
	}
#endif

 *	Number of certificates loaded or 0 for none.
 *
 * Side effects:
 *	Loads CA certificates
 *
 *-------------------------------------------------------------------
 */

static int
TlsLoadClientCAFileFromMemory(
    Tcl_Interp *interp,		/* Tcl interpreter */
    SSL_CTX *ctx,		/* CTX context */
    Tcl_Obj *file)		/* CA certificates filename */
{
    BIO  *bio  = NULL;

    if ((ciphersuites != NULL) && !SSL_CTX_set_ciphersuites(ctx, ciphersuites)) {
	Tcl_AppendResult(interp, "Set cipher suites failed: No valid ciphers", (char *)NULL);
	SSL_CTX_free(ctx);
	return NULL;
    }

    /* set automatic curve selection */
#if OPENSSL_VERSION_NUMBER < 0x30000000L
    SSL_CTX_set_ecdh_auto(ctx, 1);
#endif

    /* Set security level */
    if (level > -1 && level < 6) {
	/* SSL_set_security_level */
	SSL_CTX_set_security_level(ctx, level);
    }

	/* Set file of CA certificates in PEM format.  */
	if (CAfile != NULL) {
	    Tcl_Obj *cafileobj = Tcl_NewStringObj(CAfile, -1);
	    Tcl_IncrRefCount(cafileobj);

	    Tcl_Obj *fsinfo = Tcl_FSFileSystemInfo(cafileobj);
	    if (fsinfo) {
		Tcl_Obj *fstype = NULL;
		Tcl_IncrRefCount(fsinfo);


		Tcl_ListObjIndex(interp, fsinfo, 0, &fstype);
		Tcl_IncrRefCount(fstype);

		if (Tcl_StringMatch("native", Tcl_GetString(fstype))) {
		    if (!SSL_CTX_load_verify_file(ctx, F2N(CAfile, &ds))) {
			abort++;
		    }
		    Tcl_DStringFree(&ds);

		    /* Set list of CAs to send to client when requesting a client certificate */
		    STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds));
		    if (certNames != NULL) {
			SSL_CTX_set_client_CA_list(ctx, certNames);
		    }
		    Tcl_DStringFree(&ds);

		} else {
		    /* Load certificate into memory */
		    if (!TlsLoadClientCAFileFromMemory(interp, ctx, cafileobj)) {
			abort++;
		    }
		}
		Tcl_DecrRefCount(fstype);
		Tcl_DecrRefCount(fsinfo);

	    } else {
		abort++; /* Path is not recognized */
	    }
	    Tcl_DecrRefCount(cafileobj);
	}

 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */

static int
StatusObjCmd(
    TCL_UNUSED(ClientData),	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Arg count */
    Tcl_Obj *const objv[])	/* Arguments as Tcl objects */
{

 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */

static int
VersionObjCmd(
    TCL_UNUSED(ClientData),	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    TCL_UNUSED(int),		/* objc - Arg count */
    TCL_UNUSED(Tcl_Obj *const *)) /* objv - Arguments as Tcl objects */
{

 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */

static int
MiscObjCmd(
    TCL_UNUSED(ClientData),	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Arg count */
    Tcl_Obj *const objv[])	/* Arguments as Tcl objects */
{
    static const char *commands [] = { "req", "strreq", NULL };
    enum command { C_REQ, C_STRREQ, C_DUMMY };
    int cmd, isStr;
    char buffer[16384];
    int res = TCL_OK;

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
	return TCL_ERROR;
    }

	    X509 *cert=NULL;
	    X509_NAME *name=NULL;
	    Tcl_Obj **listv;
	    Tcl_Size listc, i;

	    BIO *out=NULL;

	    Tcl_Obj *k_C=NULL,*k_ST=NULL,*k_L=NULL,*k_O=NULL,*k_OU=NULL,*k_CN=NULL,*k_Email=NULL;
	    char *keyout,*pemout,*str;
	    int keysize,serial=0,days=365;

#if OPENSSL_VERSION_NUMBER < 0x30000000L
	    BIGNUM *bne = NULL;
	    RSA *rsa = NULL;
#else

	    if (objc>=6) {
		if (Tcl_ListObjGetElements(interp, objv[5], &listc, &listv) != TCL_OK) {
		    return TCL_ERROR;
		}

		if ((listc%2) != 0) {
		    Tcl_SetResult(interp,"Information list must have even number of arguments",NULL);
		    res = TCL_ERROR;
		}
		for (i=0; i<listc; i+=2) {
		    str=Tcl_GetString(listv[i]);
		    if (strcmp(str,"days")==0) {
			if (Tcl_GetIntFromObj(interp,listv[i+1],&days)!=TCL_OK) {
			    res = TCL_ERROR;
			    break;
			}
		    } else if (strcmp(str,"serial")==0) {
			if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK) {
			    res = TCL_ERROR;
			    break;
			}
		    } else if (strcmp(str,"C")==0) {
			k_C = listv[i+1];
			Tcl_IncrRefCount(k_C);
		    } else if (strcmp(str,"ST")==0) {
			k_ST = listv[i+1];
			Tcl_IncrRefCount(k_ST);
		    } else if (strcmp(str,"L")==0) {
			k_L = listv[i+1];
			Tcl_IncrRefCount(k_L);
		    } else if (strcmp(str,"O")==0) {
			k_O = listv[i+1];
			Tcl_IncrRefCount(k_O);
		    } else if (strcmp(str,"OU")==0) {
			k_OU = listv[i+1];
			Tcl_IncrRefCount(k_OU);
		    } else if (strcmp(str,"CN")==0) {
			k_CN = listv[i+1];
			Tcl_IncrRefCount(k_CN);
		    } else if (strcmp(str,"Email")==0) {
			k_Email = listv[i+1];
			Tcl_IncrRefCount(k_Email);
		    } else {
			Tcl_SetResult(interp,"Unknown parameter",NULL);
			res = TCL_ERROR;
			break;
		    }
		}
		for (i=0; i<listc; i+=2) {
		    Tcl_IncrRefCount(listv[i]);
		    Tcl_DecrRefCount(listv[i]);
		}
		if (res != TCL_OK) {
		    goto done;
		}
	    }

#if OPENSSL_VERSION_NUMBER < 0x30000000L
	    bne = BN_new();
	    rsa = RSA_new();
	    pkey = EVP_PKEY_new();

	    ctx = EVP_PKEY_CTX_new(pkey,NULL);
	    if (pkey == NULL || ctx == NULL || !EVP_PKEY_keygen_init(ctx) ||
		!EVP_PKEY_CTX_set_rsa_keygen_bits(ctx, keysize) || !EVP_PKEY_keygen(ctx, &pkey)) {
		EVP_PKEY_free(pkey);
		EVP_PKEY_CTX_free(ctx);
#endif
		Tcl_SetResult(interp,"Error generating private key",NULL);
		res = TCL_ERROR;
		goto done;

	    } else {
		const unsigned char *string;
		Tcl_Size len;

		if (isStr) {
		    out=BIO_new(BIO_s_mem());
		    PEM_write_bio_PrivateKey(out,pkey,NULL,NULL,0,NULL,NULL);
		    i=BIO_read(out,buffer,sizeof(buffer)-1);
		    i=(i<0) ? 0 : i;
		    buffer[i]='\0';
		    Tcl_SetVar(interp,keyout,buffer,0);

		if ((cert=X509_new())==NULL) {
		    Tcl_SetResult(interp,"Error generating certificate request",NULL);
		    EVP_PKEY_free(pkey);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
		    BN_free(bne);
#endif
		    res = TCL_ERROR;
		    goto done;
		}

		X509_set_version(cert,2);
		ASN1_INTEGER_set(X509_get_serialNumber(cert),serial);
		X509_gmtime_adj(X509_getm_notBefore(cert),0);
		X509_gmtime_adj(X509_getm_notAfter(cert),(long)60*60*24*days);
		X509_set_pubkey(cert,pkey);

		name=X509_get_subject_name(cert);

		if (k_C != NULL) {
		    string = (const unsigned char *) Tcl_GetStringFromObj(k_C, &len);
		} else {
		    string = NULL;
		    len = 0;
		}
		X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, string, (int) len, -1, 0);

		if (k_ST != NULL) {
		    string = (const unsigned char *) Tcl_GetStringFromObj(k_ST, &len);
		} else {
		    string = NULL;
		    len = 0;
		}
		X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, string, (int) len, -1, 0);

		if (k_L != NULL) {
		    string = (const unsigned char *) Tcl_GetStringFromObj(k_L, &len);
		} else {
		    string = NULL;
		    len = 0;
		}
		X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, string, (int) len, -1, 0);

		if (k_O != NULL) {
		    string = (const unsigned char *) Tcl_GetStringFromObj(k_O, &len);
		} else {
		    string = NULL;
		    len = 0;
		}
		X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, string, (int) len, -1, 0);

		if (k_OU != NULL) {
		    string = (const unsigned char *) Tcl_GetStringFromObj(k_OU, &len);
		} else {
		    string = NULL;
		    len = 0;
		}
		X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, string, (int) len, -1, 0);

		if (k_CN != NULL) {
		    string = (const unsigned char *) Tcl_GetStringFromObj(k_CN, &len);
		} else {
		    string = NULL;
		    len = 0;
		}
		X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, string, (int) len, -1, 0);

		if (k_Email != NULL) {
		    string = (const unsigned char *) Tcl_GetStringFromObj(k_Email, &len);
		} else {
		    string = NULL;
		    len = 0;
		}
		X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, string, (int) len, -1, 0);

		X509_set_subject_name(cert,name);

		if (!X509_sign(cert,pkey,EVP_sha256())) {
		    X509_free(cert);
		    EVP_PKEY_free(pkey);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
		    BN_free(bne);
#endif
		    Tcl_SetResult(interp,"Error signing certificate",NULL);
		    res = TCL_ERROR;
		    goto done;
		}

		if (isStr) {
		    out=BIO_new(BIO_s_mem());
		    PEM_write_bio_X509(out,cert);
		    i=BIO_read(out,buffer,sizeof(buffer)-1);
		    i=(i<0) ? 0 : i;

		X509_free(cert);
		EVP_PKEY_free(pkey);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
		BN_free(bne);
#endif
	    }
done:	    if (k_C != NULL) {
		Tcl_DecrRefCount(k_C);
	    }
	    if (k_ST != NULL) {
		Tcl_DecrRefCount(k_ST);
	    }
	    if (k_L != NULL) {
		Tcl_DecrRefCount(k_L);
	    }
	    if (k_O != NULL) {
		Tcl_DecrRefCount(k_O);
	    }
	    if (k_OU != NULL) {
		Tcl_DecrRefCount(k_OU);
	    }
	    if (k_CN != NULL) {
		Tcl_DecrRefCount(k_CN);
	    }
	    if (k_Email != NULL) {
		Tcl_DecrRefCount(k_Email);
	    }
	}
	break;
    default:
	break;
    }
    return res;
}

/********************/
/* Init             */
/********************/






























/*
 *-------------------------------------------------------------------
 *
 * Tls_Clean --
 *
 *	This procedure cleans up when a SSL socket based channel
 *	is closed and its reference count falls below 1.  This should
 *	be called synchronously by the CloseProc, not in the
 *	EventuallyFree callback.
 *
 * Results:
 *	none
 *
 * Side effects:
 *	Frees all the state
 *
 *-------------------------------------------------------------------
 */

void Tls_Clean(
    State *statePtr)		/* Client state for TLS socket */
{
    dprintf("Called");

    /*
     * we're assuming here that we're single-threaded
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = NULL;
	Tcl_Release((ClientData) statePtr);
    }

    /* Remove callbacks */
    if (statePtr->callback) {
	Tcl_DecrRefCount(statePtr->callback);
	statePtr->callback = NULL;
    }

	dprintf("SSL_CTX_free(%p)", statePtr->ctx);
	SSL_CTX_free(statePtr->ctx);
	statePtr->ctx = NULL;
    }

    dprintf("Returning");
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Free --
 *
 *	This procedure cleans up when a SSL socket based channel
 *	is closed and its reference count falls below 1
 *
 * Results:
 *	none
 *
 * Side effects:
 *	Frees all the state
 *
 *-------------------------------------------------------------------
 */

void
Tls_Free(
    tls_free_type *blockPtr)	/* Client state for TLS socket */
{
    State *statePtr = (State *)blockPtr;

    dprintf("Called");

    Tls_Clean(statePtr);
    ckfree(blockPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Build Info Command --
 *
 *	Create command to return build info for package.

 *	A standard TCL result
 *
 * Side effects:
 *	Shutdown SSL library
 *
 *------------------------------------------------------*
 */

void TlsLibShutdown(
    ClientData clientData)	/* Not used */
{
    dprintf("Called");

    BIO_cleanup();
}

 *	A standard Tcl result
 *
 * Side effects:
 *	Initializes SSL library
 *
 *------------------------------------------------------*
 */

static int TlsLibInit() {
    static int initialized = 0;

    dprintf("Called");

    if (!initialized) {
	/* Initialize BOTH libcrypto and libssl. */

 *	Same as of 'Tls_Init'
 *
 * Side effects:
 *	Same as of 'Tls_Init'
 *
 *-------------------------------------------------------------------
 */

DLLEXPORT int Tls_SafeInit(
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    dprintf("Called");
    return Tls_Init(interp);
}

/*
 * Provides Custom BIO layer to interface OpenSSL with TCL. These functions
 * directly interface between the TCL IO channel and BIO buffers.
 *
 * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 * Copyright (C) 2024-2025 Brian O'Hagan
 *
 */

/*
Normal
		tlsBIO.c			tlsIO.c
 +------+                        +-----+                                 +---+
 |      |Tcl_WriteRaw<--BioOutput| SSL |BIO_write<--TlsOutputProc <--puts|   |
 |socket|      <encrypted>       | BIO |            <unencrypted>        |App|
 |      |Tcl_ReadRaw --> BioInput|     |BIO_Read -->TlsInputProc --> read|   |
 +------+                        +-----+                                 +---+


Fast Path
						tlsIO.c
  +------+             +-----+                                    +-----+
  |      |<-- write <--| SSL |BIO_write <-- TlsOutputProc <-- puts|     |
  |socket| <encrypted> | BIO |            <unencrypted>           | App |
  |      |-->  read -->|     |BIO_Read  --> TlsInputProc -->  read|     |
  +------+             +-----+                                    +-----+
*/

#include "tlsInt.h"
#include <openssl/bio.h>

/* Define BIO methods structure */
static BIO_METHOD *BioMethods = NULL;



/*
 *-----------------------------------------------------------------------------
 *
 * BIOShouldRetry --
 *
 *	Determine if an operation should be retried for non-fatal errors after
 *	next select/(e)poll.
 *
 * Results:
 *	1 = retry, 0 = no retry
 *
 * Side effects:
 *	None
 *
 * Notes:
 *	We check the same codes as BIO_sock_should_retry and
 *	BIO_sock_non_fatal_error (EWOULDBLOCK, ENOTCONN, EINTR, EAGAIN, EPROTO,
 *	EINPROGRESS, and EALREADY) except for ENOTCONN. Newer FreeBSDs return
 *	ENOTCONN instead of EAGAIN/EWOULDBLOCK when trying to send on a
 *	non-blocking socket which is not yet fully connected. While TCL core
 *	uses EWOULDBLOCK if the connect is still in progress, it uses ENOTCONN
 *	if it failed. So we skip it.
 *
 *-----------------------------------------------------------------------------
 */

static int BIOShouldRetry(int code) {
    int res = 0;
    dprintf("BIOShouldRetry %d=%s", code, Tcl_ErrnoMsg(code));

    /* Check for non-blocking retry-able error codes, but skip ENOTCONN */



    if (code == EWOULDBLOCK || code == EINPROGRESS || code == EALREADY || 
	code == EAGAIN || code == EPROTO || code == EINTR) {
	res = 1;
    }

    dprintf("BIOShouldRetry %d=%s, retry=%d", code, Tcl_ErrnoMsg(code), res);

    return res;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioOutput --
 *
 *	This function is used to get encrypted data from the BIO in buf and
 *	write it to the channel. This function will be called in response to
 *	the tlsIO calling the BIO_write_ex() or BIO_write() functions.
 *
 * Results:
 *	Returns the number of bytes written to channel, 0 for EOF, or -1 for
 *	error.
 *
 * Side effects:
 *	Writes BIO data to channel.

}

/*
 *-----------------------------------------------------------------------------
 *
 * BioInput --
 *
 *	This function is used to read encrypted data from the channel and pass
 *	it to the BIO in buf. This function will be called in response to the
 *	tlsIO calling the BIO_read_ex() or BIO_read() functions.
 *
 * Results:
 *	Returns the number of bytes read from channel, 0 for EOF, or -1 for
 *	error.
 *
 * Side effects:
 *	Reads channel data into BIO or sets retry flags.







 *
 *-----------------------------------------------------------------------------
 */

static int BioInput(BIO *bio, char *buf, int bufLen) {
    Tcl_Size ret = 0;
    int is_eof, tclErrno, is_blocked;

    /* Read data from underlying channel */
    ret = Tcl_ReadRaw(chan, buf, (Tcl_Size) bufLen);

    is_eof = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();
    is_blocked = Tcl_InputBlocked(chan);

    dprintf("[chan=%p] BioInput(buf len=%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; blocked=%d; tclErrno=%d: %s]",
	(void *) chan, bufLen, ret, is_eof, is_blocked, tclErrno, Tcl_ErrnoMsg(tclErrno));

    if (ret > 0) {
	dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret);

    } else if (ret == 0) {
	if (is_eof) {

 * BioPuts --
 *
 *	This function is used to read a NULL terminated string from the BIO and
 *	write it to the channel. This function will be called in response to
 *	the application calling the BIO_puts() function.
 *
 * Results:
 *	Returns the number of bytes read from channel, 0 for EOF, or -1 for
 *	error.
 *
 * Side effects:
 *	Writes data to channel or sets retry flags.
 *
 *-----------------------------------------------------------------------------
 */

static int BioPuts(BIO *bio, const char *str) {
    dprintf("BioPuts(%p) \"%s\"", bio, str);

    return BioOutput(bio, str, (int) strlen(str));
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioCtrl --
 *
 *	This function is used to process control messages in the BIO. This
 *	function will be called in response to the application calling the
 *	BIO_ctrl() function. Several functions wrap BIO_ctrl() such as
 *	BIO_eof, BIO_flush, BIO_pending, BIO_wpending, etc.
 *
 * Results:
 *	Function dependent
 *
 * Side effects:
 *	Function dependent
 *

    dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) bio, cmd, num, ptr);

    switch (cmd) {
	case BIO_CTRL_RESET:
		/* opt - Resets BIO to initial state. Implements BIO_reset. */
		dprintf("Got BIO_CTRL_RESET");
		/* Return 1 for success (0 for file BIOs) and -1 for failure. */
		ret = 0;
		break;
	case BIO_CTRL_EOF:
		/* opt - Returns whether EOF has been reached. Implements BIO_eof. */
		dprintf("Got BIO_CTRL_EOF");
		/* Returns 1 if EOF has been reached, 0 if not, or <0 for failure. */
		ret = ((chan) ? (Tcl_Eof(chan) || BIO_test_flags(bio, BIO_FLAGS_IN_EOF)) : 1);
		break;
	case BIO_CTRL_INFO:
		/* opt - extra info on BIO. Implements BIO_get_mem_data. */
		dprintf("Got BIO_CTRL_INFO");
		ret = 0;
		break;
	case BIO_CTRL_SET:
		/* man - set the 'IO' parameter. */
		dprintf("Got BIO_CTRL_SET");
		ret = 0;
		break;
	case BIO_CTRL_GET:
		/* man - get the 'IO' parameter. */
		dprintf("Got BIO_CTRL_GET ");
		ret = 0;
		break;
	case BIO_CTRL_PUSH:
		/* opt - internal, used to signify change. Implements BIO_push. */
		dprintf("Got BIO_CTRL_PUSH");
		ret = 0;
		break;
	case BIO_CTRL_POP:
		/* opt - internal, used to signify change. Implements BIO_pop. */
		dprintf("Got BIO_CTRL_POP");
		ret = 0;
		break;
	case BIO_CTRL_GET_CLOSE:
		/* man - Get the close on BIO_free() flag set by BIO_CTRL_SET_CLOSE. Implements BIO_get_close. */
		dprintf("Got BIO_CTRL_CLOSE");
		/* Returns BIO_CLOSE, BIO_NOCLOSE, or <0 for failure. */
		ret = BIO_get_shutdown(bio);
		break;
	case BIO_CTRL_SET_CLOSE:
		/* man - Set the close on BIO_free() flag. Implements BIO_set_close. */
		dprintf("Got BIO_SET_CLOSE");
		BIO_set_shutdown(bio, num);
		/* Returns 1 on success or <=0 for failure. */
		ret = 1;
		break;
	case BIO_CTRL_PENDING:
		/* opt - Return number of bytes in chan waiting to be read. Implements BIO_pending. */
		dprintf("Got BIO_CTRL_PENDING");
		/* Return the amount of pending data or 0 for error. */
		ret = ((chan) ? Tcl_InputBuffered(chan) : 0);
		dprintf("rbio pending=%ld", ret);
		break;
	case BIO_CTRL_FLUSH:
		/* opt - Flush any buffered output. Implements BIO_flush. */
		dprintf("Got BIO_CTRL_FLUSH");
		/* Use Tcl_WriteRaw instead of Tcl_Flush to operate on right chan in stack. */
		/* Returns 1 for success, <=0 for error/retry. */
		ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);

		break;
	case BIO_CTRL_DUP:
		/* man - extra stuff for 'duped' BIO. Implements BIO_dup_state. */
		dprintf("Got BIO_CTRL_DUP");
		ret = 1;
		break;
	case BIO_CTRL_WPENDING:
		/* opt - Return number of bytes in chan still to be written. Implements BIO_wpending. */
		dprintf("Got BIO_CTRL_WPENDING");
		/* Return the amount of pending data or 0 for error */
		ret = ((chan) ? Tcl_OutputBuffered(chan) : 0);
		dprintf("wbio pending=%ld", ret);
		break;
	case BIO_CTRL_SET_CALLBACK:
		/* opt - Sets an informational callback. Implements BIO_set_info_callback. */
		ret = 0;
		break;
	case BIO_CTRL_GET_CALLBACK:
		/* opt - Get and return the info callback. Implements BIO_get_info_callback. */
		ret = 0;
		break;

	case BIO_C_FILE_SEEK:
		/* Not used for sockets. Tcl_Seek only works on top chan. Implements BIO_seek(). */
		dprintf("Got BIO_C_FILE_SEEK");
		ret = 0; /* Return 0 success and -1 for failure */
		break;
	case BIO_C_FILE_TELL:
		/* Not used for sockets. Tcl_Tell only works on top chan. Implements BIO_tell(). */
		dprintf("Got BIO_C_FILE_TELL");
		ret = 0; /* Return 0 success and -1 for failure */
		break;
	case BIO_C_SET_FD:
		/* Implements BIO_set_fd */
		dprintf("Unsupported call: BIO_C_SET_FD");
		ret = -1;
		break;
	case BIO_C_GET_FD:
		/* Implements BIO_get_fd() */
		dprintf("Unsupported call: BIO_C_GET_FD");
		ret = -1;
		break;

#if OPENSSL_VERSION_NUMBER >= 0x30000000L
	case BIO_CTRL_GET_KTLS_SEND:
		/* Implements BIO_get_ktls_send */
		dprintf("Got BIO_CTRL_GET_KTLS_SEND");
		/* Returns 1 if the BIO is using the Kernel TLS data-path for sending, 0 if not. */
		ret = 0;
		break;


	case BIO_CTRL_GET_KTLS_RECV:
		/* Implements BIO_get_ktls_recv */
		dprintf("Got BIO_CTRL_GET_KTLS_RECV");
		/* Returns 1 if the BIO is using the Kernel TLS data-path for receiving, 0 if not. */
		ret = 0;
		break;
#endif
	default:
		dprintf("Got unknown control command (%i)", cmd);
		ret = 0;
		break;

 * BioNew --
 *
 *	This function is used to create a new instance of the BIO. This
 *	function will be called in response to the application calling the
 *	BIO_new() function.
 *
 * Results:
 *	Returns boolean success result (1=success, 0=failure).
 *
 * Side effects:
 *	Initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */

 * BioFree --
 *
 *	This function is used to destroy an instance of a BIO. This function
 *	will be called in response to the application calling the BIO_free()
 *	function.
 *
 * Results:
 *	Returns boolean success result (1=success, 0=failure).
 *
 * Side effects:
 *	De-initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */

static int BioFree(BIO *bio) {
    dprintf("BioFree(%p) called", bio);

    if (bio == NULL) {
	return 0;
    }

    /* Clear flags if set to BIO_CLOSE (close I/O stream when the BIO is freed) */
    if (BIO_get_shutdown(bio)) {
	BIO_set_data(bio, NULL);

	BIO_clear_flags(bio, -1);
	BIO_set_init(bio, 0);
    }
    return 1;
}

/*
 *-----------------------------------------------------------------------------
 *

#endif

    dprintf("BIO_new_tcl() called");

    /* Create custom BIO method */
    if (BioMethods == NULL) {
	/* BIO_TYPE_BIO = (19|BIO_TYPE_SOURCE_SINK) -- half a BIO pair */
	/* custom = BIO_get_new_index() | BIO_TYPE_SOURCE_SINK */

	BioMethods = BIO_meth_new(BIO_TYPE_BIO, "tcl");
	if (BioMethods == NULL) {
	    dprintf("Memory allocation error");

	    return NULL;
	}
	/* Not used BIO_meth_set_write_ex */

/*
 * Provides IO functions to interface between the BIO buffers and TCL
 * applications when using stacked channels.
 *
 * Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 * Copyright (C) 2000 Ajuba Solutions
 * Copyright (C) 2024-2025 Brian O'Hagan
 *
 * Additional credit is due for Andreas Kupries (a.kupries@westend.com), for
 * providing the Tcl_ReplaceChannel mechanism and working closely with me
 * to enhance it to support full fileevent semantics.
 *
 * Also work done by the follow people provided the impetus to do this "right":
 *	tclSSL (Colin McCormack, Shared Technology)
 *	SSLtcl (Peter Antman)
 *
 */

/*
Normal
		tlsBIO.c			tlsIO.c
 +------+                        +-----+                                 +---+
 |      |Tcl_WriteRaw<--BioOutput| SSL |BIO_write<--TlsOutputProc <--puts|   |
 |socket|      <encrypted>       | BIO |            <unencrypted>        |App|
 |      |Tcl_ReadRaw --> BioInput|     |BIO_Read -->TlsInputProc --> read|   |
 +------+                        +-----+                                 +---+


Fast Path
						tlsIO.c
  +------+             +-----+                                    +-----+
  |      |<-- write <--| SSL |BIO_write <-- TlsOutputProc <-- puts|     |
  |socket| <encrypted> | BIO |            <unencrypted>           | App |
  |      |-->  read -->|     |BIO_Read  --> TlsInputProc -->  read|     |
  +------+             +-----+                                    +-----+
*/

#include "tlsInt.h"
#include <errno.h>

/*
 *-----------------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level to set the channel to
 *	blocking or nonblocking mode. Called by the generic I/O layer whenever
 *	the Tcl_SetChannelOption() function is used with option -blocking. Each
 *	stacked channel is configured individually.
 *
 * Results:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsBlockModeProc(
    ClientData instanceData,	/* Connection state info */
    int mode)			/* Blocking or non-blocking mode */
{
    State *statePtr = (State *) instanceData;

    dprintf("Called with mode %d", mode);

    if (mode == TCL_MODE_NONBLOCKING) {
	statePtr->flags |= TLS_TCL_ASYNC;
    } else {
	statePtr->flags &= ~(TLS_TCL_ASYNC);
    }
    return 0;

 *	type specific cleanup when a SSL socket based channel is closed. Called
 *	by the generic I/O layer whenever the Tcl_Close() function is used.
 *
 * Results:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Closes the socket for the channel.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsCloseProc(
    ClientData instanceData,	/* Connection state info */
    Tcl_Interp *interp)		/* Tcl interpreter to report errors to */
{
    State *statePtr = (State *) instanceData;

    dprintf("Close(%p)", (void *) statePtr);

    /* Send "close notify" shutdown notification. Will return 0 if in progress,
	and 1 when complete. Only closes the write direction of the connection;
	the read direction is closed by the peer. Does not affect the socket 
	state. Don't call after fatal error. */
    if (statePtr->ssl != NULL && !(statePtr->flags & TLS_TCL_FATAL_ERROR)) {
	BIO_flush(statePtr->bio);
	SSL_shutdown(statePtr->ssl);
    }

    /* Tls_Free calls Tls_Clean */
    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
    return 0;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsClose2Proc --
 *
 *	Similar to TlsCloseProc, but allows for separate close of the read or
 *	write side of the channel. We don't support these since TLS is a
 *	bi-directional protocol.
 *
 * Results:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Closes the socket for the channel.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsClose2Proc(
    ClientData instanceData,	/* Connection state info */
    Tcl_Interp *interp,		/* Tcl interpreter to report errors to */
    int flags)			/* Flags to close read/write side of channel */
{
    State *statePtr = (State *) instanceData;

    dprintf("Called with flags %d", flags);

    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
	return TlsCloseProc(instanceData, interp);
    }
    return EINVAL;
}

/*
 *-----------------------------------------------------------------------------
 *
 * Tls_WaitForConnect --
 *
 *	Perform connect (client) or accept (server) function. Also performs
 *	equivalent of handshake function.
 *
 * Result:
 *	1 if successful, 0 if waiting for connect, and -1 if failed. Sets
 *	errorCodePtr to a POSIX error code if an error occurred, or 0 if not.
 *
 * Side effects:
 *	Performs SSL_accept or SSL_connect.
 *
 *-----------------------------------------------------------------------------
 */
int Tls_WaitForConnect(
    State *statePtr,			/* Connection state info */
    int *errorCodePtr,			/* Storage for error code to return */
    int handshakeFailureIsPermanent)	/* Is the connect failure permanent */
{
    unsigned long backingError;
    int err, rc;

    *errorCodePtr = 0;

    dprintf("WaitForConnect(%p)", (void *) statePtr);
    dprintf("Called with handshakeFailureIsPermanent %d", handshakeFailureIsPermanent);
    dprintFlags(statePtr);

    /* Can also check SSL_is_init_finished(ssl) */
    if (!(statePtr->flags & TLS_TCL_INIT)) {
	dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
	return 1;
    }

    /* Different types of operations have different requirements for SSL being established. */
    if (statePtr->flags & TLS_TCL_FATAL_ERROR) {




	if (handshakeFailureIsPermanent) {
	    dprintf("Asked to wait for a TLS handshake that has already failed.  Returning fatal error");
	    *errorCodePtr = ECONNABORTED;
	} else {
	    dprintf("Asked to wait for a TLS handshake that has already failed.  Returning soft error");
	    *errorCodePtr = ECONNRESET;
	}
	return -1;
    }


    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If accept or connect
     * return -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.
     */
    ERR_clear_error();
    BIO_clear_retry_flags(statePtr->bio);

    /* Not initialized yet! Also calls SSL_do_handshake(). */
    if (statePtr->flags & TLS_TCL_SERVER) {
	dprintf("Calling SSL_accept()");
	rc = SSL_accept(statePtr->ssl);

    } else {
	dprintf("Calling SSL_connect()");
	rc = SSL_connect(statePtr->ssl);
    }














    err = SSL_get_error(statePtr->ssl, rc);
    backingError = ERR_get_error();




    if (rc <= 0) {



	dprintf("Accept/connect failed: is EOF=%d, should retry=%d, retry read=%d, retry write=%d, other=%d",





	    BIO_eof(statePtr->bio),





	    BIO_should_retry(statePtr->bio), BIO_should_read(statePtr->bio),


	    BIO_should_write(statePtr->bio), BIO_should_io_special(statePtr->bio));







    }

    /* Based on error, do retry or abort */




    switch (err) {
	case SSL_ERROR_NONE:
	    /* The TLS/SSL I/O operation completed successfully */
	    dprintf("SSL_ERROR_NONE");
	    *errorCodePtr = 0;
	    break;

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred,
	       usually a protocol error. This includes certificate validation
	       errors. */
	    dprintf("SSL_ERROR_SSL: Fatal SSL protocol error occurred");
	    if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr,
		    X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
	    }
	    if (backingError != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }
	    *errorCodePtr = ECONNABORTED;
	    statePtr->flags |= TLS_TCL_FATAL_ERROR;
	    statePtr->flags |= TLS_TCL_EOF;
	    return -1;

	case SSL_ERROR_WANT_READ:
	    /* More data must be read from the underlying BIO layer in order to
	       complete the actual SSL_*() operation.  */
	    dprintf("SSL_ERROR_WANT_READ: EAGAIN");
	    BIO_set_retry_read(statePtr->bio);
	    *errorCodePtr = EAGAIN;

	    statePtr->want |= TCL_READABLE;
	    return 0;

	case SSL_ERROR_WANT_WRITE:
	    /* There is data in the SSL buffer that must be written to the
	       underlying BIO in order to complete the SSL_*() operation. */
	    dprintf("SSL_ERROR_WANT_WRITE: EAGAIN");
	    BIO_set_retry_write(statePtr->bio);
	    *errorCodePtr = EAGAIN;

	    statePtr->want |= TCL_WRITABLE;
	    return 0;

	case SSL_ERROR_WANT_X509_LOOKUP:
	    /* The operation did not complete because an application callback
	       set by SSL_CTX_set_client_cert_cb() has asked to be called again. */
	    dprintf("SSL_ERROR_WANT_X509_LOOKUP: EAGAIN");
	    BIO_set_retry_special(statePtr->bio);
	    BIO_set_retry_reason(statePtr->bio, BIO_RR_SSL_X509_LOOKUP);
	    *errorCodePtr = EAGAIN;

	    return 0;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */
	    dprintf("SSL_ERROR_SYSCALL: Fatal I/O error occurred");

	    if (backingError == 0 && rc == 0) {
		dprintf("EOF reached")
		*errorCodePtr = ECONNRESET;
		Tls_Error(statePtr, "(unexpected) EOF reached");

	    } else if (backingError == 0 && rc == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
		Tls_Error(statePtr, Tcl_ErrnoMsg(*errorCodePtr));

	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = Tcl_GetErrno();
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }

	    statePtr->flags |= TLS_TCL_FATAL_ERROR;
	    statePtr->flags |= TLS_TCL_EOF;
	    return -1;

	case SSL_ERROR_ZERO_RETURN:
	    /* Peer has cleanly closed the connection by sending the close_notify
	       alert. Can't read, but can write. Need to return an EOF, so the
	       channel is closed which will send an SSL_shutdown(). */
	    dprintf("SSL_ERROR_ZERO_RETURN: Peer has closed the connection");
	    *errorCodePtr = ECONNRESET;
	    statePtr->flags |= TLS_TCL_EOF;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    return -1;

	case SSL_ERROR_WANT_CONNECT:
	    /* The operation did not complete and connect would have blocked.
	       Retry again after connection is established. */
	    dprintf("SSL_ERROR_WANT_CONNECT: EAGAIN");
	    BIO_set_retry_special(statePtr->bio);
	    BIO_set_retry_reason(statePtr->bio, BIO_RR_CONNECT);
	    *errorCodePtr = EAGAIN;

	    return 0;

	case SSL_ERROR_WANT_ACCEPT:
	    /* The operation did not complete and accept would have blocked.
	       Retry again after connection is established. */
	    dprintf("SSL_ERROR_WANT_ACCEPT: EAGAIN");
	    BIO_set_retry_special(statePtr->bio);
	    BIO_set_retry_reason(statePtr->bio, BIO_RR_ACCEPT);
	    *errorCodePtr = EAGAIN;

	    return 0;

	case SSL_ERROR_WANT_ASYNC:
	    /* Used with flag SSL_MODE_ASYNC, op didn't complete because an
	       async engine is still processing data */
	case SSL_ERROR_WANT_ASYNC_JOB:
	    /* The asynchronous job could not be started because there were no

/*
 *-----------------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *	This procedure is invoked by the generic I/O layer to read data from
 *	the BIO whenever the Tcl_Read, Tcl_ReadChars, Tcl_Gets, and Tcl_GetsObj
 *	functions are used. Equivalent to SSL_read_ex and SSL_read.
 *
 * Results:
 *	Returns the number of bytes read or -1 on error. Sets errorCodePtr to
 *	a POSIX error code if an error occurred, or 0 if successful.
 *
 * Side effects:
 *	Reads data from SSL/BIO.
 *
 * Notes:
 *	Data is received in whole blocks known as records from the peer. A 
 *	whole record is processed (e.g. decrypted) in one go and is buffered by
 *	OpenSSL until it is read by the application via a call to SSL_read() or
 *	BIO_read() in our case. SSL_pending() returns the number of bytes which
 *	have been processed, buffered, and are available inside ssl for
 *	immediate read. SSL_has_pending() returns 1 if data is buffered
 *	(whether processed or unprocessed) and 0 otherwise.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsInputProc(
    ClientData instanceData,	/* Connection state info */
    char *buf,			/* Buffer to store data read from BIO */
    int bufSize,		/* Buffer size in bytes */
    int *errorCodePtr)		/* Storage for error code to return */
{
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int bytesRead, err;
    *errorCodePtr = 0;

    dprintf("Read %d bytes", bufSize);

    /* Abort if the user verify callback is still running to avoid triggering
     * another call before the current one is complete. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Callback is running, reading 0 bytes");
	return 0;
    }

    /* Abort if EOF already detected. Can't read, but can write. */
    if (statePtr->flags & TLS_TCL_FATAL_ERROR || statePtr->flags & TLS_TCL_EOF) {
	dprintf("EOF already detected, abort read");
	return 0;
    }

    /* If not initialized, do connect. Can also check SSL_is_init_finished(). */
    if (statePtr->flags & TLS_TCL_INIT) {
	int tlsConnect;

	dprintf("Calling Tls_WaitForConnect");

	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
	if (tlsConnect < 0) {
	    /* Failure, so abort */
	    dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)", tlsConnect, *errorCodePtr);

	    bytesRead = -1;
	    if (*errorCodePtr == ECONNRESET) {
		dprintf("Got connection reset");
		/* Soft EOF */
		*errorCodePtr = 0;
		bytesRead = 0;
		statePtr->flags |= TLS_TCL_EOF;
	    }
	    return bytesRead;
	} else if (tlsConnect == 0) {
	    /* Try again */
	    bytesRead = -1;
	    return bytesRead;
	}
    }

    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If BIO_read
     * returns -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.
     */

/*    dprintf("BIO_read: Chan pending=%dd", BIO_pending(statePtr->bio));*/



    ERR_clear_error();
    BIO_clear_retry_flags(statePtr->bio);
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);

    /* Same as SSL_want, but also checks the error queue */
    err = SSL_get_error(statePtr->ssl, bytesRead);
    backingError = ERR_get_error();

    if (bytesRead <= 0) {







	dprintf("Read failed: is EOF=%d, should retry=%d, retry read=%d, retry write=%d, other=%d",
	    BIO_eof(statePtr->bio),


	    BIO_should_retry(statePtr->bio), BIO_should_read(statePtr->bio),







	    BIO_should_write(statePtr->bio), BIO_should_io_special(statePtr->bio));


    }

    /* Based on error, do retry or abort */
    switch (err) {
	case SSL_ERROR_NONE:
	    /* I/O operation completed */
	    dprintf("SSL_ERROR_NONE");
	    dprintBuffer(buf, bytesRead);
	    break;

	    if (ERR_GET_REASON(backingError) == SSL_R_UNEXPECTED_EOF_WHILE_READING) {
		dprintf("(Unexpected) EOF reached")
		*errorCodePtr = 0;
		bytesRead = 0;
		Tls_Error(statePtr, "EOF reached");
	    }
#endif
	    statePtr->flags |= TLS_TCL_FATAL_ERROR;
	    statePtr->flags |= TLS_TCL_EOF;
	    break;

	case SSL_ERROR_WANT_READ:
	    /* Operation did not complete due to not enough data was available.
	       Retry again later. */
	    dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;

		/* Unexpected EOF from the peer for OpenSSL 1.1 */
		dprintf("(Unexpected) EOF reached")
		*errorCodePtr = 0;
		bytesRead = 0;
		Tls_Error(statePtr, "EOF reached");

	    } else if (backingError == 0 && bytesRead == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());

		*errorCodePtr = Tcl_GetErrno();
		bytesRead = -1;
		Tls_Error(statePtr, Tcl_ErrnoMsg(*errorCodePtr));

	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = Tcl_GetErrno();
		bytesRead = -1;
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }
	    statePtr->flags |= TLS_TCL_FATAL_ERROR;
	    statePtr->flags |= TLS_TCL_EOF;
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    /* Peer has cleanly closed the connection by sending the close_notify
	       alert. Can't read, but can write. Need to return an EOF, so the
	       channel is closed which will send an SSL_shutdown(). */
	    dprintf("SSL_ERROR_ZERO_RETURN: Peer has closed the connection");
	    *errorCodePtr = 0;
	    bytesRead = 0;
	    statePtr->flags |= TLS_TCL_EOF;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:
	    /* Used with flag SSL_MODE_ASYNC, operation didn't complete because
	       an async engine is still processing data. */
	    dprintf("Got SSL_ERROR_WANT_ASYNC, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    bytesRead = 0;
	    break;

	default:
	    /* Other error */
	    dprintf("Other error, abort");
	    *errorCodePtr = 0;
	    bytesRead = 0;

	    break;
    }

    dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
    return bytesRead;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	This procedure is invoked by the generic I/O layer to write data to the
 *	BIO whenever the the Tcl_Write(), Tcl_WriteChars, and Tcl_WriteObj
 *	functions are used. Equivalent to SSL_write_ex and SSL_write.
 *
 * Results:
 *	Returns the number of bytes written or -1 on error. Sets errorCodePtr
 *	to a POSIX error code if an error occurred, or 0 if successful.
 *
 * Side effects:
 *	Writes data to SSL/BIO.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsOutputProc(
    ClientData instanceData,	/* Connection state info */
    const char *buf,		/* Buffer with data to write to BIO */
    int toWrite,		/* Size of data to write in bytes */
    int *errorCodePtr)		/* Storage for error code to return */
{
    unsigned long backingError;
    State *statePtr = (State *) instanceData;
    int written, err;
    *errorCodePtr = 0;

    dprintf("Write %d bytes", toWrite);
    dprintBuffer(buf, toWrite);

    /* Abort if the user verify callback is still running to avoid triggering
     * another call before the current one is complete. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Don't process output while callbacks are running");
	written = -1;
	*errorCodePtr = EAGAIN;
	return -1;
    }

    /* Abort if connection has failed. */
    if (statePtr->flags & TLS_TCL_FATAL_ERROR) {
	dprintf("EOF already detected, abort write");
	return 0;
    }

    /* If not initialized, do connect. Can also check SSL_is_init_finished(). */
    if (statePtr->flags & TLS_TCL_INIT) {
	int tlsConnect;

	dprintf("Calling Tls_WaitForConnect");

	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 1);
	if (tlsConnect < 0) {
	    dprintf("Got an error waiting to connect (tlsConnect = %i, *errorCodePtr = %i)",
		tlsConnect, *errorCodePtr);

	    written = -1;
	    if (*errorCodePtr == ECONNRESET) {
		dprintf("Got connection reset");
		/* Soft EOF */
		*errorCodePtr = 0;
		written = 0;
		statePtr->flags |= TLS_TCL_EOF;
	    }
	    return written;
	} else if (tlsConnect == 0) {
	    /* Try again */
	    written = -1;
	    return written;
	}

	    Tls_Error(statePtr, "Flush failed");

	    *errorCodePtr = EIO;
	    written = 0;
	    return -1;
	}


	*errorCodePtr = 0;
	written = 0;
	return 0;
    }

    /*
     * We need to clear the SSL error stack now because we sometimes reach
     * this function with leftover errors in the stack.  If BIO_write
     * returns -1 and intends EAGAIN, there is a leftover error, it will be
     * misconstrued as an error, not EAGAIN.
     */

    dprintf("BIO_write: BIO pending=%d, Chan pending=%d", BIO_wpending(statePtr->bio), Tcl_OutputBuffered(statePtr->self));



    ERR_clear_error();
    BIO_clear_retry_flags(statePtr->bio);
    written = BIO_write(statePtr->bio, buf, toWrite);
    dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);

    /* Same as SSL_want, but also checks the error queue */
    err = SSL_get_error(statePtr->ssl, written);
    backingError = ERR_get_error();

    if (written <= 0) {


	dprintf("Write failed: is EOF=%d, should retry=%d, retry read=%d, retry write=%d, other=%d",





	    BIO_eof(statePtr->bio),

	    BIO_should_retry(statePtr->bio), BIO_should_read(statePtr->bio),





	    BIO_should_write(statePtr->bio), BIO_should_io_special(statePtr->bio));




    } else {
	BIO_flush(statePtr->bio);
    }

    /* Based on error, do retry or abort */
    switch (err) {
	case SSL_ERROR_NONE:
	    /* I/O operation completed */
	    dprintf("SSL_ERROR_NONE");
	    if (written < 0) {
		written = 0;
	    }

	    } else if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr,
		    X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
	    } else {
		Tls_Error(statePtr, "Unknown SSL error");
	    }
	    *errorCodePtr = ECONNABORTED;
	    statePtr->flags |= TLS_TCL_FATAL_ERROR;
	    statePtr->flags |= TLS_TCL_EOF;
	    written = -1;
	    break;

	case SSL_ERROR_WANT_READ:
	    /* Operation did not complete due to not enough data was available.
	       Retry again later with same data. */
	    dprintf("Got SSL_ERROR_WANT_READ, mapping it to EAGAIN");

	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = Tcl_GetErrno();
		written = -1;
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    }
	    statePtr->flags |= TLS_TCL_FATAL_ERROR;
	    statePtr->flags |= TLS_TCL_EOF;
	    break;

	case SSL_ERROR_ZERO_RETURN:
	    /* Peer has cleanly closed the connection by sending the close_notify
	       alert. Can't read, but can write. Need to return an EOF, so the
	       channel is closed which will send an SSL_shutdown(). */
	    dprintf("SSL_ERROR_ZERO_RETURN: Peer has closed the connection");
	    *errorCodePtr = 0;
	    written = 0;
	    statePtr->flags |= TLS_TCL_EOF;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_WANT_ASYNC:
	    /* Used with flag SSL_MODE_ASYNC, operation didn't complete because
	       an async engine is still processing data. */
	    dprintf("Got SSL_ERROR_WANT_ASYNC, mapping this to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = 0;
	    break;

	default:
	    /* Other error */
	    dprintf("Other error, abort");
	    *errorCodePtr = 0;
	    written = 0;
	    break;
    }

    dprintf("Output(%d) -> %d", toWrite, written);
    return written;
}

/*
 *-----------------------------------------------------------------------------
 *
 * Tls_GetParent --
 *
 *	Get parent channel for a stacked channel.
 *
 * Results:
 *	Tcl_Channel or NULL if None
 *
 *-----------------------------------------------------------------------------
 */
Tcl_Channel Tls_GetParent(
    State *statePtr,		/* Connection state info */
    int maskFlags)		/* Which flags to process */
{

				 * NULL to get all options and their values. */
    const char *optionValue)	/* Value for option. */
{
    State *statePtr = (State *) instanceData;
    Tcl_Channel parent = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverSetOptionProc *setOptionProc;

    dprintf("Called to set option %s to value %s", optionName, optionValue);

    /* Pass to parent */
    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
    if (setOptionProc != NULL) {
	return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return Tcl_BadChannelOption(interp, optionName, "");
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *	Get a option's value for a SSL socket based channel, or a list of all
 *	options and their values. Called by the generic I/O layer whenever the
 *	Tcl_GetChannelOption() function is used.
 *
 *
 * Results:
 *	TCL_OK if successful or TCL_ERROR if failed. Sets optionValue to
 *	the option's value.
 *
 * Side effects:
 *	None
 *
 *-----------------------------------------------------------------------------
 */
static int
TlsGetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value for,
				 * or NULL to get all options and their values. */
    Tcl_DString *optionValue)	/* Where to store the computed value initialized by caller. */
{
    State *statePtr = (State *) instanceData;
    Tcl_Channel parent = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverGetOptionProc *getOptionProc;

    dprintf("Called to get option %s", optionName);

    /* Pass to parent */
    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));
    if (getOptionProc != NULL) {
	return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp,
	    optionName, optionValue);
    } else if (optionName == (char*) NULL) {

}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsChannelHandlerTimer --
 *
 *	Called by the notifier via a timer, to generate read/write events to
 *	flush out data waiting in channel buffers. Called by TlsWatchProc to
 *	periodically check for new events. Used to generate events when data is
 *	buffered in BIO and there are no underlying channel events.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Creates notification event.
 *
 *-----------------------------------------------------------------------------
 */
static void TlsChannelHandlerTimer(
    ClientData clientData)	/* Socket state. */
{
    State *statePtr = (State *) clientData;
    int mask = statePtr->want; /* Init to SSL_ERROR_WANT_READ and SSL_ERROR_WANT_WRITE */

    dprintf("Called with mask 0x%02x", mask);

    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	statePtr->timer = (Tcl_TimerToken) NULL;
	Tcl_Release((ClientData) statePtr);
    }

    /* Check for amount of data pending in IO or BIO write buffer */
    if (Tcl_OutputBuffered(statePtr->self) || BIO_wpending(statePtr->bio)) {
	dprintf("[chan=%p] BIO writable", statePtr->self);

	mask |= TCL_WRITABLE;
    }

    /* Check for amount of data pending in IO or BIO read buffer */
    if (Tcl_InputBuffered(statePtr->self) || BIO_pending(statePtr->bio)) {
	dprintf("[chan=%p] BIO readable", statePtr->self);

	mask |= TCL_READABLE;
    }

    /* Notify the generic IO layer that mask events have occurred on the channel */
    if (mask > 0) {
	dprintf("Notifying ourselves with mask=%d", mask);
	Tcl_NotifyChannel(statePtr->self, mask);
    } else {
	dprintf("No notification");
    }
    statePtr->want = 0;
    return;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
 *	Set up the event notifier to watch for events of interest from this
 *	channel. Called by the generic I/O layer whenever the user (or the
 *	system) announces its (dis)interest in events on the channel. This is
 *	called repeatedly.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Sets up or clears a time-based notifier so that future events on the
 *	channel will be seen by TCL.
 *
 *-----------------------------------------------------------------------------
 */
static void
TlsWatchProc(
    ClientData instanceData,	/* Connection state info */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
{
    Tcl_Channel parent;
    State *statePtr = (State *) instanceData;
    Tcl_DriverWatchProc *watchProc;


    dprintf("Called with mask 0x%02x and want 0x%02x", mask, statePtr->want);
    dprintFlags(statePtr);

    /* Abort if the user verify callback is still running to avoid triggering
     * another call before the current one is complete. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Callback is on-going, doing nothing");
	return;
    }

    /* Get channel to monitor for events */
    parent = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    dprintf("Parent: chan buffer=%d, input buffer=%d, output buffer=%d", \
	Tcl_ChannelBuffered(parent), Tcl_InputBuffered(parent), Tcl_OutputBuffered(parent));

    /* Abort if connect failed */
    if (statePtr->flags & TLS_TCL_FATAL_ERROR) {
	dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");
	dprintf("Unregistering interest in the lower channel");

	watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent));
	watchProc(Tcl_GetChannelInstanceData(parent), 0);
	statePtr->watchMask = 0;
	return;

     * 'interest' to the mask if we want to, but this transformation has no
     * such interest. It just passes the request down, unchanged.
     */
    dprintf("Registering our interest in the lower channel (chan=%p)", (void *) parent);
    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent));
    watchProc(Tcl_GetChannelInstanceData(parent), mask);










    /* Schedule next event if data is pending, otherwise cease events for now */
    if (!(mask & TCL_READABLE)) {
	/* Remove timer, if any */
	if (statePtr->timer != (Tcl_TimerToken) NULL) {
	    dprintf("A timer was found, deleting it");
	    Tcl_DeleteTimerHandler(statePtr->timer);
	    statePtr->timer = (Tcl_TimerToken) NULL;
	    Tcl_Release((ClientData) statePtr);
	}

    /* Don't check for pending data here, will check for want in timer callback */
    } else {
	/* Add timer, if none */
	if (statePtr->timer == (Tcl_TimerToken) NULL) {
	    dprintf("Creating a new timer since data appears to be waiting");
	    Tcl_Preserve((ClientData) statePtr);
	    statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
	}
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
 *	This procedure is invoked by the generic IO level to retrieve an OS
 *	specific handle associated with the channel. Not used for transforms.
 *
 * Results:
 *	The appropriate Tcl_File handle or NULL if None
 *
 * Side effects:
 *	None
 *
 *-----------------------------------------------------------------------------
 */
static int TlsGetHandleProc(
    ClientData instanceData,	/* Socket state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Handle associated with the channel */
{
    State *statePtr = (State *) instanceData;

    dprintf("Called with direction 0x%02x", direction);

    return Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH),
	direction, handlePtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *	This procedure is invoked by the generic IO level to notify the channel
 *	that an event has occurred on the underlying channel. It is used by
 *	stacked channel drivers that wish to be notified of events that occur
 *	on the underlying (stacked) channel.
 *
 * Results:
 *	Returns mask value to indicate none of the events were serviced.
 *
 * Side effects:
 *	May call Tls_WaitForConnect and/or delete timer.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsNotifyProc(
    ClientData instanceData,	/* Socket state. */
    int mask)			/* type of event that occurred: OR-ed
				 * combination of TCL_READABLE or TCL_WRITABLE */

	    dprintf("Tls_WaitForConnect returned an error");
	}
    }

    /*
     * Delete an existing timer. It was not fired, yet we are here, so the
     * below channel generated such an event and we don't need to. The renewal
     * of the interest after the execution of channel handlers will eventually
     * cause us to recreate the timer (in TlsWatchProc).
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
	Tcl_Release((ClientData) statePtr);
    }

    /*
     * An event occurred in the underlying channel. This transformation doesn't
     * process such events thus returns the incoming mask unchanged.
     */
    dprintf("Returning %i", mask);
    return mask;
}

/*
 *-----------------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *	Defines the TLS channel driver handlers for this channel type.
 *
 * Results:
 *	Returns a pointer to Tcl_ChannelType structure.
 *
 * Side effects:
 *	None
 *
 *-----------------------------------------------------------------------------
 */
static const Tcl_ChannelType tlsChannelType = {
    "tls",			/* Type name */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TlsCloseProc,		/* Close proc */

#include <openssl/rand.h>
#include <openssl/opensslv.h>

/* Windows needs to know which symbols to export. */
#ifdef BUILD_tls
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
#endif /* BUILD_tls */

/* Handle TCL 8.6 CONST changes */
#ifndef CONST86
#   if TCL_MAJOR_VERSION > 8
#	define CONST86 const
#   else
#	define CONST86

	dprintfBuffer_p = &dprintfBuffer[0]; \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():%s->flags=0", __FILE__, __LINE__, __func__, #statePtr); \
	if (((statePtr)->flags & TLS_TCL_ASYNC) == TLS_TCL_ASYNC) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_ASYNC"); }; \
	if (((statePtr)->flags & TLS_TCL_SERVER) == TLS_TCL_SERVER) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_SERVER"); }; \
	if (((statePtr)->flags & TLS_TCL_INIT) == TLS_TCL_INIT) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_INIT"); }; \
	if (((statePtr)->flags & TLS_TCL_DEBUG) == TLS_TCL_DEBUG) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_DEBUG"); }; \
	if (((statePtr)->flags & TLS_TCL_CALLBACK) == TLS_TCL_CALLBACK) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_CALLBACK"); }; \
	if (((statePtr)->flags & TLS_TCL_FATAL_ERROR) == TLS_TCL_FATAL_ERROR) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FATAL_ERROR"); }; \
	if (((statePtr)->flags & TLS_TCL_FASTPATH) == TLS_TCL_FASTPATH) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_FASTPATH"); }; \
	fprintf(stderr, "%s\n", dprintfBuffer); \
}
#else
#define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); }
#define dprintBuffer(bufferName, bufferLength) /**/
#define dprintFlags(statePtr) /**/

 */
#define TLS_TCL_ASYNC		(1<<0)	/* Non-blocking mode */
#define TLS_TCL_SERVER		(1<<1)	/* Server-Side */
#define TLS_TCL_INIT		(1<<2)	/* Initializing connection */
#define TLS_TCL_DEBUG		(1<<3)	/* Show debug tracing */
#define TLS_TCL_CALLBACK	(1<<4)	/* In a callback, prevent update
					 * looping problem. [Bug 1652380] */
#define TLS_TCL_FATAL_ERROR	(1<<5)	/* Set on handshake failure or other fatal erros. All
					 * further I/O will result in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH 	(1<<6)	/* The parent channel is being used
					 * directly by the SSL library. */
#define TLS_TCL_EOF	 	(1<<7)	/* At EOF. Can't read, but can write. */
#define TLS_TCL_DELAY (5)

/*
 * This structure describes the per-instance state of an SSL channel.
 *
 * The SSL processing context is maintained here, in the ClientData
 */

const Tcl_ChannelType *Tls_ChannelType(void);
Tcl_Channel	Tls_GetParent(State *statePtr, int maskFlags);

Tcl_Obj		*Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert, int all);
Tcl_Obj		*Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer);
void		Tls_Error(State *statePtr, const char *msg);
void		Tls_Free(tls_free_type *blockPtr);

int		Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);

BIO		*BIO_new_tcl(State* statePtr, int flags);
int		BIO_cleanup();

#define PTR2INT(x) ((int) ((intptr_t) (x)))

#endif /* _TLSINT_H */

	# If an "-autoservername" option is found, honor it
	if {[info exists argsArray(-autoservername)] && $argsArray(-autoservername)} {
	    if {![info exists argsArray(-servername)]} {
		set argsArray(-servername) $host
		lappend iopts -servername $host
	    }
	}

	# Use host as SNI server name without -autoservername and -servername args
	if {![info exists argsArray(-autoservername)] && 
		![info exists argsArray(-servername)]} {
	    set argsArray(-servername) $host
	    lappend iopts -servername $host
	}

	lappend sopts $host $port
    }
    #
    # Create TCP/IP socket
    #
    set chan [eval $socketCmd $sopts]

# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.test" when running tcltest
# in this directory.
#




set path [file normalize [file dirname [file join [pwd] [info script]]]]

set auto_path [linsert $auto_path 0 [file dirname $path] $path]

if {"::tcltest" ni [namespace children]} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# Add user provided args such as -load
tcltest::configure {*}$argv -testdir $path
#tcltest::configure -verbose tpse

# Print stats at end
set ::tcltest::testSingleFile false
#tcltest::configure -singleproc 1

# Get common functions, if any
if {[file exists [file join $path common.tcl]]} {
    source -encoding utf-8 [file join $path common.tcl]
}








#
# Run all tests in current and any sub directories with an all.tcl file.
#
set ::exitCode 0
if {[package vsatisfies [package require tcltest] 2.5-]} {
    if {[::tcltest::runAllTests] == 1} {
	set ::exitCode 1
    }

} else {
    # Hook to determine if any of the tests failed. Then we can exit with the
    # proper exit code: 0=all passed, 1=one or more failed
    proc tcltest::cleanupTestsHook {} {
	variable numTests
	set ::exitCode [expr {$numTests(Total) == 0 || $numTests(Failed) > 0}]
    }
    ::tcltest::runAllTests
}

# Return exit code for use by test frameworks: 0=all passed, 1=one or more failed
if {[info exists env(ERROR_ON_FAILURES)]} {
    exit $::exitCode
} else {
    exit 0
}

# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package prefer latest,,,,,,,,,
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,source [file join [file dirname [info script]] common.tcl],,,,,,,,,
,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc badssl {url} {set port 443;lassign [split $url "":""] url port;if {$port eq """"} {set port 443};set cmd [list tls::socket -autoservername 1 -require 1];if {[info exists ::env(SSL_CERT_FILE)]} {lappend cmd -cafile $::env(SSL_CERT_FILE)};lappend cmd $url $port;set ch [eval $cmd];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}",,,,,,,,,

BadSSL,no-subject,,,badssl no-subject.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,null,,,badssl null.badssl.com,,glob,handshake failed: * alert handshake failure,,,1
BadSSL,pinning-test,,,badssl pinning-test.badssl.com,,,,,,
BadSSL,preact-cli,,,badssl preact-cli.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,preloaded-hsts,,,badssl preloaded-hsts.badssl.com,,,,,,
BadSSL,rc4-md5,,,badssl rc4-md5.badssl.com,,glob,handshake failed: * alert handshake failure,,,1
BadSSL,rc4,,,badssl rc4.badssl.com,,glob,handshake failed: * alert handshake failure,,,1
BadSSL,revoked,,,badssl revoked.badssl.com,,,,,,
BadSSL,rsa2048,,,badssl rsa2048.badssl.com,,,,,,
BadSSL,rsa4096,,,badssl rsa4096.badssl.com,,,,,,
BadSSL,rsa8192,,,badssl rsa8192.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,self-signed,old_api,,badssl self-signed.badssl.com,,,"handshake failed: certificate verify failed due to ""self signed certificate""",,,1
BadSSL,self-signed,new_api,,badssl self-signed.badssl.com,,,"handshake failed: certificate verify failed due to ""self-signed certificate""",,,1
BadSSL,sha1-2016,,,badssl sha1-2016.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,sha1-2017,old_api,,badssl sha1-2017.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1

# Auto generated test cases for badssl.csv

# Load Tcl Test package
if {[lsearch [namespace children] ::tcltest] == -1} {
	package require tcltest
	namespace import ::tcltest::*
}

set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]

package prefer latest
package require tls

# Constraints
source [file join [file dirname [info script]] common.tcl]

# Helper functions
proc badssl {url} {set port 443;lassign [split $url ":"] url port;if {$port eq ""} {set port 443};set cmd [list tls::socket -autoservername 1 -require 1];if {[info exists ::env(SSL_CERT_FILE)]} {lappend cmd -cafile $::env(SSL_CERT_FILE)};lappend cmd $url $port;set ch [eval $cmd];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}

# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package prefer latest,,,,,,,,,
command,package require tls,,,,,,,,,
command,,,,,,,,,,
command,# Make sure path includes location of OpenSSL executable,,,,,,,,,
command,"if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin "";""] $::env(path)]}",,,,,,,,,
command,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3],,,,,,,,,

# Auto generated test cases for ciphers.csv

# Load Tcl Test package
if {[lsearch [namespace children] ::tcltest] == -1} {
	package require tcltest
	namespace import ::tcltest::*
}

set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]

package prefer latest
package require tls

# Make sure path includes location of OpenSSL executable
if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin ";"] $::env(path)]}

# Constraints
set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3]

#!/usr/bin/env tclsh

# Common Constraints
package prefer latest
package require tls

# Supported protocols
set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3]
foreach protocol $protocols {
    ::tcltest::testConstraint $protocol 0
    ::tcltest::testConstraint !$protocol 1

#!/usr/bin/env tclsh

set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]]
package prefer latest
package require tls

proc creadable {s} {
    puts "LINE=[gets $s]"
    after 2000
    file delete -force $::keyfile
    file delete -force $::certfile
    exit
}

proc myserv {s args} {
    fileevent $s readable [list creadable $s]
}

close [file tempfile keyfile keyfile]
close [file tempfile certfile certfile]

tls::misc req 1024 $keyfile $certfile [list C CCC ST STTT L LLLL O OOOO OU OUUUU CN CNNNN Email some@email.com days 730 serial 12]

tls::socket -require 0 -keyfile $keyfile -certfile $certfile -server myserv 12300

puts "Now run keytest2.tcl"
vwait forever

#!/usr/bin/env tclsh

set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]]
package prefer latest
package require tls

set s [tls::socket -require 0 127.0.0.1 12300]
puts $s "A line"
flush $s
puts [join [tls::status $s] \n]
exit

# Copyright (c) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# load tls package
package prefer latest
package require tls

# Initialize message delimiter

# Initialize command array
catch {unset command}
set command(0) ""
set callerSocket ""

# Detect whether we should print out connection messages etc.

	catch {puts $fd "skey: $serverKey"}
	puts $fd "--- Server executing the following for socket $s:"
	puts $fd $l
	puts $fd "---"
	close $fd
    }
    set callerSocket $s
    set ::errorInfo ""
    if {[catch {uplevel "#0" $l} msg]} {
    	if {0} {
	    set fd [open remoteServer.log a]
	    puts $fd "error: $msg"
	    close $fd
	}
	set code error
    } else {
	set code success
    }
    #return [list $code $::errorInfo $msg]
    return [list $code $msg]
}

proc __readAndExecute__ {s} {
    global command VERBOSE

    set l [gets $s]
    if {$l eq "--Marker--Marker--Marker--"} {

proc __accept__ {s a p} {
    global VERBOSE

    if {$VERBOSE} {
	puts "Server accepts new connection from $a:$p on $s"
    }
    tls::handshake $s

    fconfigure $s -buffering line -translation crlf
    fileevent $s readable [list __readAndExecute__ $s]
}

set serverIsSilent 0
for {set i 0} {$i < $argc} {incr i} {
    if {[lindex $argv $i] eq "-serverIsSilent"} {
	set serverIsSilent 1
	break
    }
}
if {![info exists serverPort]} {
    if {[info exists env(serverPort)]} {
	set serverPort $env(serverPort)
    }
}
if {![info exists serverPort]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[lindex $argv $i] eq "-port"} {
	    if {$i < $argc - 1} {
		set serverPort [lindex $argv [expr {$i + 1}]]
	    }
	    break
	}
    }
}
if {![info exists serverPort]} {
    set serverPort 8048
}

if {![info exists serverAddress]} {
    if {[info exists env(serverAddress)]} {
	set serverAddress $env(serverAddress)
    }
}
if {![info exists serverAddress]} {
    for {set i 0} {$i < $argc} {incr i} {
	if {[lindex $argv $i] eq "-address"} {
	    if {$i < $argc - 1} {
		set serverAddress [lindex $argv [expr {$i + 1}]]
	    }
	    break
	}
    }
}
if {![info exists serverAddress]} {
    set serverAddress 0.0.0.0

}

set certsDir	[file join [file dirname [info script]] certs]
set serverCert	[file join $certsDir server.pem]
set caCert	[file join $certsDir cacert.pem]
set serverKey	[file join $certsDir server.key]
if {[catch {set serverSocket \
	[tls::socket -require 0 -myaddr $serverAddress -server __accept__ \
	-cafile $caCert -certfile $serverCert -keyfile $serverKey \
	$serverPort]} msg]} {
    puts "Server on $serverAddress:$serverPort cannot start: $msg"
} else {
    puts ready
    vwait __server_wait_variable__
}

#!/usr/bin/env tclsh

package prefer latest
package require tls

set dir			[file join [file dirname [info script]] ../tests/certs]
set OPTS(-cafile)	[file join $dir ca.pem]
set OPTS(-cert)		[file join $dir client.pem]
set OPTS(-key)		[file join $dir client.key]

set OPTS(-host)		localhost
set OPTS(-port)		2468
set OPTS(-debug)	1
set OPTS(-count)	8
set OPTS(-parallel)	1
set OPTS(-require)	0

foreach {key val} $argv {
    if {![info exists OPTS($key)]} {
	puts stderr "Usage: $argv0 ?options?\
		\n\t-debug     boolean   Debugging on or off ($OPTS(-debug))\
		\n\t-cafile    file      Cert. Auth. File ($OPTS(-cafile))\
		\n\t-client    file      Client Cert ($OPTS(-cert))\
		\n\t-ckey      file      Client Key ($OPTS(-key))\
		\n\t-count     num       No of sync. connections to make per client ($OPTS(-count))\
		\n\t-parallel  num       No of parallel clients to run ($OPTS(-parallel))\
		\n\t-host      hostname  Server hostname ($OPTS(-host))\
		\n\t-port      num       Server port ($OPTS(-port))\
		\n\t-require   boolean   Require Certificate ($OPTS(-require))"
	exit
    }
    set OPTS($key) $val
}

if {$OPTS(-parallel) > 1} {
    # If they wanted parallel, we just spawn ourselves several times

	vwait OPTS(openports)
	if {$OPTS(openports) == 0} {
	    exit 0
	}
    }
}

tls::init -cafile $OPTS(-cafile) -certfile $OPTS(-cert) -keyfile $OPTS(-key) -require $OPTS(-require)

go

#!/usr/bin/env tclsh

package prefer latest
package require tls

set dir			[file join [file dirname [info script]] ../tests/certs]
set OPTS(-cafile)	[file join $dir ca.pem]
set OPTS(-cert)		[file join $dir server.pem]
set OPTS(-key)		[file join $dir server.key]

set OPTS(-port)	2468
set OPTS(-debug) 1
set OPTS(-require) 1

foreach {key val} $argv {
    if {![info exists OPTS($key)]} {
	puts stderr "Usage: $argv0 ?options?\
		\n\t-debug    boolean  Debugging on or off ($OPTS(-debug))\
		\n\t-cafile   file     Cert. Auth. File ($OPTS(-cafile))\
		\n\t-cert     file     Server Cert ($OPTS(-cert))\
		\n\t-key      file     Server Key ($OPTS(-key))\
		\n\t-require  boolean  Require Certificate ($OPTS(-require))\
		\n\t-port     num      Port to listen on ($OPTS(-port))"
	exit
    }
    set OPTS($key) $val
}

# Catch  any background errors.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# The build dir is added as the first element of $PATH
# Load the tls package
package prefer latest
package require tls

set tlsServerPort 8048

# Specify where the certificates are

set certsDir	[file join [file dirname [info script]] certs]

# platforms that do not support exec, the remote server must be started
# by the user before running the tests.

set remoteProcChan ""
set commandSocket ""
if {$doTestsWithRemoteServer} {
    catch {close $commandSocket}
    if {[catch {set commandSocket [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP $remoteServerPort]}] != 0} {
	if {[info commands exec] eq ""} {
	    set noRemoteTestReason "can't exec"
	    set doTestsWithRemoteServer 0
	} else {
	    set remoteServerIP 127.0.0.1
	    set remoteFile [file join [pwd] remote.tcl]
	    if {[catch {set remoteProcChan \
		    [open "|[list $::tcltest::tcltest $remoteFile \
		    -serverIsSilent -port $remoteServerPort \
		    -address $remoteServerIP]" w+]} msg] == 0} {
		after 1000
		if {[catch {set commandSocket [tls::socket -require 0 \
                	-cafile $caCert -certfile $clientCert -keyfile $clientKey \
			$remoteServerIP $remoteServerPort]} msg] == 0} {
		    fconfigure $commandSocket -translation crlf -buffering line
		} else {
		    set noRemoteTestReason $msg
		    set doTestsWithRemoteServer 0
		}
	    } else {

test tlsIO-2.1 {tcp connection} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set timer [after 2000 [list set x timed_out]]
    }
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
    puts $f {
	proc accept {file addr port} {
	    global x
	    set x done
            close $file
	}
	puts ready

test tlsIO-2.2 {tcp connection with client port specified} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8829 \]"
    puts $f {
	proc accept {sock addr port} {
            global x
            puts "[gets $sock] $port"
            close $sock
            set x done
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f x
    global port
    if {[catch {tls::socket -myport $port -require 0 \
	-certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8829} sock]} {
        set x $sock
	catch {close [tls::socket 127.0.0.1 8829]}
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    }
    close $f
    set x
} [list ready "hello $port"]

test tlsIO-2.3 {tcp connection with client interface specified} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8830 \]"
    puts $f {
	proc accept {sock addr port} {
            global x
            puts "[gets $sock] $addr"
            close $sock
            set x done
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f x
    if {[catch {tls::socket -myaddr 127.0.0.1 -require 0 \
	-certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8830} sock]} {
        set x $sock
    } else {
        puts $sock hello
	catch {flush $sock}
        lappend x [gets $f]
        close $sock
    }
    close $f
    set x
} {ready {hello 127.0.0.1}}

test tlsIO-2.4 {tcp connection with server interface specified} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr localhost 8831 \]"
    puts $f {
	proc accept {sock addr port} {
            global x
            puts "[gets $sock]"
            close $sock
            set x done
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f x
    if {[catch {tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey localhost 8831} sock]} {
        set x $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    }
    close $f
    set x
} {ready hello}

test tlsIO-2.5 {tcp connection with redundant server port} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8832 \]"
    puts $f {
	proc accept {sock addr port} {
            global x
            puts "[gets $sock]"
            close $sock
            set x done
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f x
    if {[catch {tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8832} sock]} {
        set x $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    }
    close $f
    set x
} {ready hello}

test tlsIO-2.6 {tcp connection} {socket} {
    set status ok
    if {![catch {set sock [tls::socket -require 0 127.0.0.1 8833]}]} {
	if {![catch {gets $sock}]} {
	    set status broken
	}
	close $sock
    }
    set status
} ok

test tlsIO-2.7 {echo server, one line} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8834 \]"
    puts $f {
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
	    fconfigure $s -translation lf -buffering line
        }
	proc echo {s} {
	     set l [gets $s]

	after cancel $timer
	close $f
	puts done
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f
    set s [tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8834]
    fconfigure $s -buffering line -translation lf
    puts $s "hello abcdefghijklmnop"
    after 1000
    set x [gets $s]
    close $s
    set y [gets $f]
    close $f
    list $x $y
} {{hello abcdefghijklmnop} done}

test tlsIO-2.8 {echo server, loop 50 times, single connection} {socket stdio} {
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
    	package require tls
    }
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8835 \]"
    puts $f {
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	proc echo {s} {
	     global i
             set l [gets $s]
             if {[eof $s]} {
                 global x
                 close $s
                 set x done
             } else {
	         incr i
                 puts $s $l
             }
	}
	set i 0
	puts ready
	set timer [after 20000 [list set x done]]
	vwait x
	after cancel $timer
	close $f
	puts "done $i"
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f
    set s [tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8835]
    fconfigure $s -buffering line
    catch {
	for {set x 0} {$x < 50} {incr x} {
	    puts $s "hello abcdefghijklmnop"
	    gets $s
	}
    }
    close $s
    catch {set x [gets $f]}
    close $f
    set x
} {done 50}

test tlsIO-2.9 {socket conflict} {socket stdio} {
    set s [tls::socket -server accept -require 0 8828]
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts -nonewline $f {
	package require tls
	tls::socket -server accept -require 0 8828
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f
    after 100
    set x [list [catch {close $f} msg] [string range $msg 0 43]]
    close $s
    set x
} {1 {couldn't open socket: address already in use}}

test tlsIO-2.10 {close on accept, accepted socket lives} {socket} {
    set done 0
    set timer [after 20000 [list set done timed_out]]
    set ss [tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert \
	-keyfile $serverKey 8830]
    proc accept {s a p} {
	global ss
	close $ss
	fileevent $s readable "readit $s"
	fconfigure $s -trans lf
    }
    proc readit {s} {
	global done
	gets $s
	close $s
	set done 1
    }
    set cs [tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey localhost 8830]
    close $cs

    vwait done
    after cancel $timer
    set done
} 1

test tlsIO-2.11 {detecting new data} {socket} {
    proc accept {s a p} {
	global sock
	# when doing an in-process client/server test, both sides need
	# to be non-blocking for the TLS handshake.  Also make sure
	# to return the channel to line buffering mode.
	fconfigure $s -blocking 0 -buffering line
	set sock $s
	fileevent $s readable [list do_handshake $s]
    }

    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8400]
    set sock ""
    set s2 [tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8400]
    # when doing an in-process client/server test, both sides need
    # to be non-blocking for the TLS handshake  Also make sure to
    # return the channel to line buffering mode (TLS sets it to 'none').
    fconfigure $s2 -blocking 0 -buffering line
    vwait sock
    puts $s2 one

    # There is a debug assertion on Windows/SSL that causes a crash when the
    # certificate isn't specified.
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set timer [after 2000 [list set x timed_out]]
	set f [tls::socket -server accept -require 0 8828]
	proc accept {file addr port} {
	    global x
	    set x done
            close $file
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
	puts $x
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f x
    if {[catch {tls::socket -require 0 127.0.0.1 8828} msg]} {
        set x $msg
    } else {
        lappend x [gets $f]
        close $msg
    }
    lappend x [gets $f]
    close $f
    set x
} {ready done {}}

test tlsIO-3.1 {socket conflict} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
    }
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
    puts $f {
	puts ready
	gets stdin
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    gets $f
    set x [list [catch {tls::socket -server accept -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey 8828} msg] \

		$msg]
    puts $f bye
    close $f
    set x
} {1 {couldn't open socket: address already in use}}

test tlsIO-3.2 {server with several clients} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set t1 [after 30000 [list set x timed_out]]
	set t2 [after 31000 [list set x timed_out]]
	set t3 [after 32000 [list set x timed_out]]
	set counter 0
    }
    puts $f "set s \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
    puts $f {
	proc accept {s a p} {
	    fileevent $s readable [list echo $s]
	    fconfigure $s -buffering line
	}
	proc echo {s} {
	     global x

	after cancel $t3
	close $s
	puts $x
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    set x [gets $f]
    set s1 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 8828]
    fconfigure $s1 -buffering line
    set s2 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 8828]
    fconfigure $s2 -buffering line
    set s3 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 8828]
    fconfigure $s3 -buffering line
    for {set i 0} {$i < 100} {incr i} {
	puts $s1 hello,tlsIO-3.2,s1
	gets $s1
	puts $s2 hello,tlsIO-3.2,s2

    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	gets stdin
    }
    puts $f "set s \[tls::socket -require 0 -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]"
    puts $f {
	fconfigure $s -buffering line
	for {set i 0} {$i < 100} {incr i} {
	    puts $s hello
	    gets $s
	}
	close $s

        if {[eof $s]} {
            close $s
            set x done
        } else {
            puts $s $l
        }
    }
    set t1 [after 30000 [list set x timed_out]]
    set t2 [after 31000 [list set x timed_out]]
    set t3 [after 32000 [list set x timed_out]]
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828]

    puts $p1 open
    puts $p2 open
    puts $p3 open
    vwait x
    vwait x
    vwait x
    after cancel $t1

    close $p2
    close $p3
    set l
} {{p1 bye done} {p2 bye done} {p3 bye done}}

test tlsIO-4.2 {byte order problems, socket numbers, htons} {socket} {
    set x ok
    if {[catch {tls::socket -server dodo -require 0 0x3000} msg]} {
	set x $msg
    } else {
	close $msg
    }
    set x
} ok

test tlsIO-5.1 {byte order problems, socket numbers, htons} \
	{socket unixOnly notRoot} {
    set x {couldn't open socket: not owner}
    if {![catch {tls::socket -server dodo -require 0 0x1} msg]} {
        set x {htons problem, should be disallowed, are you running as SU?}
	close $msg
    }
    set x
} {couldn't open socket: not owner}
test tlsIO-5.2 {byte order problems, socket numbers, htons} {socket} {
    set x {couldn't open socket: port number too high}
    if {![catch {tls::socket -server dodo -require 0 0x10000} msg]} {
	set x {port resolution problem, should be disallowed}
	close $msg
    }
    set x
} {couldn't open socket: port number too high}
test tlsIO-5.3 {byte order problems, socket numbers, htons} \
	{socket unixOnly notRoot} {
    set x {couldn't open socket: not owner}
    if {![catch {tls::socket -server dodo -require 0 21} msg]} {
	set x {htons problem, should be disallowed, are you running as SU?}
	close $msg
    }
    set x
} {couldn't open socket: not owner}

test tlsIO-6.1 {accept callback error} {socket stdio} {

    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    proc bgerror args {
	global x
	set x $args
    }
    proc accept {s a p} {expr 10 / 0}
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8848]
    puts $f hello
    close $f
    set timer [after 10000 [list set x timed_out]]
    vwait x
    after cancel $timer
    close $s
    rename bgerror {}
    set x
} {{divide by zero}}

test tlsIO-7.1 {testing socket specific options} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
    }
    puts $f [list tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820]
    puts $f {
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 [list set x timed_out]]
	vwait x
	after cancel $timer
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f
    set s [tls::socket \

test tlsIO-7.2 {testing socket specific options} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
    }
    puts $f "tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8821"
    puts $f {
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 [list set x timed_out]]
	vwait x
	after cancel $timer
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f
    set s [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 8821]
    set p [fconfigure $s -sockname]
    close $s
    close $f
    set l ""
    lappend l [llength $p]
    lappend l [lindex $p 0]
    lappend l [string equal [lindex $p 2] 8821]
} {3 127.0.0.1 0}

test tlsIO-7.3 {testing socket specific options} {socket} {
    set s [tls::socket -server accept -require 0 \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey 8822]

    set l [llength [fconfigure $s]]
    close $s
    update
    # A bug fixed in fconfigure for 8.3.4+ make this return 14 normally,
    # but 12 in older versions.
    expr {$l >= 12 && (($l % 2) == 0)}
} 1

# bug report #5812 fconfigure doesn't return value for '-sockname'

test tlsIO-7.4 {testing socket specific options} {socket} {
    set s [tls::socket -server accept -require 0 \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey 8823]

    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set s1 [tls::socket \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
    	localhost 8823]
    set timer [after 10000 [list set x timed_out]]
    vwait x
    after cancel $timer
    close $s
    close $s1
    set l ""
    lappend l [lindex $x 2] [llength $x]
} {8823 3}

# bug report #5812 fconfigure doesn't return value for '-sockname'

test tlsIO-7.5 {testing socket specific options} {socket unixOrPc} {
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8829]

    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set s1 [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 8829]
    set timer [after 10000 [list set x timed_out]]
    vwait x
    after cancel $timer
    close $s
    close $s1
    set l ""
    lappend l [lindex $x 0] [lindex $x 2] [llength $x]
} {127.0.0.1 8829 3}

test tlsIO-8.1 {testing -async flag on sockets} {socket} {
    # NOTE: This test may fail on some Solaris 2.4 systems.
    # See notes in Tcl's socket.test.
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8830]

    proc accept {s a p} {
	global x
	# when doing an in-process client/server test, both sides need
	# to be non-blocking for the TLS handshake.  Also make sure
	# to return the channel to line buffering mode.
	fconfigure $s -blocking 0 -buffering line
	puts $s bye
	# Only OpenSSL 0.9.5a on Windows seems to need the after (delayed)
	# close, but it works just the same for all others. -hobbs
	after 500 close $s
	set x done
    }
    set s1 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    -async localhost 8830]
    # when doing an in-process client/server test, both sides need
    # to be non-blocking for the TLS handshake  Also make sure to
    # return the channel to line buffering mode (TLS sets it to 'none').
    fconfigure $s1 -blocking 0 -buffering line
    vwait x
    # TLS handshaking needs one byte from the client...
    puts $s1 a
    # need update to complete TLS handshake in-process
    update
    fconfigure $s1 -blocking 1
    set z [gets $s1]
    close $s
    close $s1
    set z
} bye


test tlsIO-9.1 {testing spurious (0 byte read) events} {socket} {
    set len 0
    set spurious 0
    set done 0
    proc readlittle {s} {
	global spurious done len
	set l [read $s 1]
	if {[string length $l] == 0} {

	}
    }
    proc accept {s a p} {
	fconfigure $s -blocking 0
	fileevent $s readable [list do_handshake $s readable readlittle \
		-buffering none]
    }
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8831]

    set c [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    localhost 8831]
    # This differs from socket-9.1 in that both sides need to be
    # non-blocking because of TLS' required handshake
    fconfigure $c -blocking 0
    puts -nonewline $c 01234567890123456789012345678901234567890123456789
    flush $c

    set timer [after 10000 [list set done timed_out]]
    after 1000 [list close $c]
    vwait done
    after cancel $timer


    catch {close $s}
    list $spurious $len
} {0 50}

test tlsIO-9.2 {testing async write, fileevents, flush on close} {socket} {
    set firstblock [string repeat a 31]
    set secondblock [string repeat b 65535]

    proc writedata {s} {
	global secondblock
	dputs "send \"[string replace $secondblock 10 end-3 ...]\" \
		([string length $secondblock]) down $s"
	puts -nonewline $s $secondblock
	close $s
    }
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8839]

    set c [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    localhost 8839]
    fconfigure $c -blocking 0 -trans lf -buffering line
    set count 0
    puts $c hello
    proc readit {s} {
	global count done
	set data [read $s]
	dputs "read \"[string replace $data 10 end-3 ...]\" \
		([string length $data]) from $s"
	incr count [string length $data]
	if {[eof $s]} {
	    close $s
	    set done 1
	}
    }
    fileevent $c readable [list readit $c]
    set done 0
    set timer [after 10000 [list set done timed_out]]
    vwait done
    after cancel $timer
    catch {close $c}
    catch {close $s}
    list $count $done
} {65566 1}

test tlsIO-9.3 {testing EOF stickyness} {unexplainedFailure socket} {
    # HOBBS: never worked correctly
    proc count_to_eof {s} {
	global count done timer

	close $s
    }
    proc accept {s a p} {
	fconfigure $s -blocking 0 -buffering line -translation lf
	fileevent $s writable [list do_handshake $s writable write_then_close \
		-buffering line -translation lf]
    }
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8833]

    set c [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    localhost 8833]
    fconfigure $c -blocking 0 -buffering line -translation lf
    fileevent $c readable "count_to_eof $c"
    set timer [after 2000 timerproc]
    vwait done
    close $s
    set count
} {eof is sticky}

removeFile script

test tlsIO-10.1 {testing socket accept callback error handling} {socket} {
    set goterror 0
    proc bgerror args {global goterror; set goterror 1}
    set s [tls::socket -server accept -require 0 -cafile $caCert 8898]
    proc accept {s a p} {close $s; error}
    set c [tls::socket -require 0 -cafile $caCert 127.0.0.1 8898]
    vwait goterror
    close $s
    close $c
    set goterror
} 1

test tlsIO-11.1 {tcp connection} {socket doTestsWithRemoteServer} {
    sendCertValues
    sendCommand {
	set socket9_1_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8834]
	proc accept {s a p} {
	    tls::handshake $s
	    puts $s done
	    close $s
	}
    }
    set s [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8834]
    set r [gets $s]
    close $s
    sendCommand {close $socket9_1_test_server}
    set r
} done

test tlsIO-11.2 {client specifies its port} {socket doTestsWithRemoteServer} {
    if {[info exists port]} {
	incr port
    } else {
	set port [expr {$tlsServerPort + [pid]%1024}]
    }
    sendCertValues
    sendCommand {
	set socket9_2_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8835]
	proc accept {s a p} {
	    tls::handshake $s
	    puts $s $p
	    close $s
	}
    }
    set s [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    -myport $port $remoteServerIP 8835]
    set r [gets $s]
    close $s
    sendCommand {close $socket9_2_test_server}
    if {$r == $port} {
	set result ok
    } else {
	set result broken
    }
    set result
} ok

test tlsIO-11.3 {trying to connect, no server} {socket doTestsWithRemoteServer} {
    set status ok
    if {![catch {set s [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIp 8836]}]} {
	if {![catch {gets $s}]} {
	    set status broken
	}
	close $s
    }
    set status
} ok

test tlsIO-11.4 {remote echo, one line} {socket doTestsWithRemoteServer} {
    sendCertValues
    sendCommand {
	set socket10_6_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]

	proc accept {s a p} {
	    tls::handshake $s
	    fileevent $s readable [list echo $s]
	    fconfigure $s -buffering line -translation crlf
	}
	proc echo {s} {
	    set l [gets $s]
	    if {[eof $s]} {
		close $s
	    } else {
		puts $s $l
	    }
	}
    }
    set f [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    fconfigure $f -translation crlf -buffering line
    puts $f hello
    set r [gets $f]
    close $f
    sendCommand {close $socket10_6_test_server}
    set r
} hello

test tlsIO-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} {
    sendCertValues
    sendCommand {
	set socket10_7_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
	proc accept {s a p} {
	    tls::handshake $s
	    fileevent $s readable [list echo $s]
	    fconfigure $s -buffering line -translation crlf
	}
	proc echo {s} {
	    set l [gets $s]
	    if {[eof $s]} {
		close $s
	    } else {
		puts $s $l
	    }
	}
    }
    set f [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    fconfigure $f -translation crlf -buffering line
    for {set cnt 0} {$cnt < 50} {incr cnt} {
	puts $f "hello, $cnt"
	if {[gets $f] ne "hello, $cnt"} {
	    break

if {$tcl_platform(platform) eq "macintosh"} {
    set conflictResult {0 8836}
} else {
    set conflictResult {1 {couldn't open socket: address already in use}}
}

test tlsIO-11.6 {socket conflict} {socket doTestsWithRemoteServer} {
    set s1 [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]

    if {[catch {set s2 [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]} msg]} {

	set result [list 1 $msg]
    } else {
	set result [list 0 [lindex [fconfigure $s2 -sockname] 2]]
	close $s2
    }
    close $s1
    set result
} $conflictResult

test tlsIO-11.7 {server with several clients} {socket doTestsWithRemoteServer} {
    sendCertValues
    sendCommand {
	set socket10_9_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]

	proc accept {s a p} {
	    fconfigure $s -buffering line
	    fileevent $s readable [list echo $s]
	}
	proc echo {s} {
	    set l [gets $s]
	    if {[eof $s]} {
		close $s
	    } else {
		puts $s $l
	    }
	}
    }
    set s1 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    fconfigure $s1 -buffering line
    set s2 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    fconfigure $s2 -buffering line
    set s3 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    fconfigure $s3 -buffering line
    for {set i 0} {$i < 100} {incr i} {
	puts $s1 hello,tlsIO-11.7,s1
	gets $s1
	puts $s2 hello,tlsIO-11.7,s2

    set i
} 100

test tlsIO-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
    sendCertValues
    sendCommand {
	tls::init -certfile $serverCert -cafile $caCert -keyfile $serverKey
	set s1 [tls::socket -server "accept 4003" -require 0 4003]
	set s2 [tls::socket -server "accept 4004" -require 0 4004]
	set s3 [tls::socket -server "accept 4005" -require 0 4005]
	proc handshake {s mp} {
	    if {[eof $s]} {
		close $s
	    } elseif {[catch {tls::handshake $s} result]} {
		# Some errors are normal.
	    } elseif {$result == 1} {
		# Handshake complete
		fileevent $s readable ""
		puts $s $mp
		close $s
	    }
	}
	proc accept {mp s a p} {
	    # These have to accept non-blocking, because the handshaking
	    # order isn't deterministic
	    fconfigure $s -blocking 0 -buffering line
	    fileevent $s readable [list handshake $s $mp]
	}
    }
    tls::init -certfile $clientCert -cafile $caCert -keyfile $clientKey
    set s1 [tls::socket -require 0 $remoteServerIP 4003]
    set s2 [tls::socket -require 0 $remoteServerIP 4004]
    set s3 [tls::socket -require 0 $remoteServerIP 4005]
    set l ""
    lappend l [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \
	[gets $s3] [gets $s3] [eof $s3]
    close $s1
    close $s2
    close $s3
    sendCommand {
	close $s1
	close $s2
	close $s3
    }
    set l
} {4003 {} 1 4004 {} 1 4005 {} 1}

test tlsIO-11.9 {accept callback error} {socket doTestsWithRemoteServer} {
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]

    proc accept {s a p} {expr 10 / 0}
    proc bgerror args {
	global x
	set x $args
    }
    sendCertValues
    if {[catch {sendCommand {
	    set peername [fconfigure $callerSocket -peername]
	    set s [tls::socket -require 0 \
		    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
		    [lindex $peername 0] 8836]
	    close $s
    	 }} msg]} {
	close $s
	error $msg
    }
    set timer [after 10000 [list set x timed_out]]
    vwait x
    after cancel $timer
    close $s
    rename bgerror {}
    set x
} {{divide by zero}}

test tlsIO-11.10 {testing socket specific options} {socket doTestsWithRemoteServer} {
    sendCertValues
    sendCommand {
	set socket10_12_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]

	proc accept {s a p} {close $s}
    }
    set s [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    set p [fconfigure $s -peername]
    set n [fconfigure $s -sockname]
    set l ""
    lappend l [lindex $p 2] [llength $p] [llength $p]
    close $s
    sendCommand {close $socket10_12_test_server}
    set l
} {8836 3 3}

test tlsIO-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
    # remote equivalent of 9.1
    sendCertValues
    sendCommand {
	set socket_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
	proc handshake {s} {
	    if {[eof $s]} {
		close $s
	    } elseif {[catch {tls::handshake $s} result]} {
		# Some errors are normal.
	    } elseif {$result == 1} {

		close $s
		set done 1
	    }
	} else {
	    incr len [string length $l]
	}
    }
    set c [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    # Get the buffering corrected
    fconfigure $c -buffering line
    # Put a byte into the client pipe to trigger TLS handshaking
    puts $c a
    fileevent $c readable [list readlittle $c]
    set timer [after 10000 [list set done timed_out]]
    vwait done
    after cancel $timer
    sendCommand {close $socket_test_server}
    list $spurious $len
} {0 2690}

test tlsIO-11.12 {testing EOF stickyness} {unexplainedFailure socket doTestsWithRemoteServer} {

    proc timed_out {} {
	global c done
	set done {timed_out, EOF is not sticky}
	close $c
    }
    sendCertValues
    sendCommand {
	set socket10_14_test_server [tls::socket -server accept  -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]

	proc accept {s a p} {
	    tls::handshake $s
	    after 100 close $s
	}
    }
    set c [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    fileevent $c readable "count_up $c"
    set after_id [after 1000 timed_out]
    vwait done
    sendCommand {close $socket10_14_test_server}
    set done

	    set done 1
	}
    }
    sendCertValues
    sendCommand {
	set firstblock [string repeat a 31]
	set secondblock [string repeat b 65535]
	set l [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8845]

	proc accept {s a p} {
	    tls::handshake $s
	    fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
		    -buffering line
	    fileevent $s readable "readable $s"
	}
	proc readable {s} {

	}
	proc writedata {s} {
	    global secondblock
	    puts -nonewline $s $secondblock
	    close $s
	}
    }
    set s [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8845]
    fconfigure $s -blocking 0 -translation lf -buffering line
    set count 0
    puts $s hello
    fileevent $s readable "readit $s"
    set timer [after 10000 [list set done timed_out]]
    vwait done
    after cancel $timer
    sendCommand {close $l}
    set count
} 65566

proc getdata {type file} {

    set f [open script2 w]
    puts $f [list set tclsh $::tcltest::tcltest]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
    }
    puts $f "set f \[tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828\]"
    puts $f {
	proc accept { file addr port } {
	    close $file
	}
	exec $tclsh script1 &
	close $f
	after 1000 exit
	vwait forever
    }
    close $f

    # Launch script2 and wait 5 seconds

    exec $::tcltest::tcltest script2 &
    after 5000 { set ok_to_proceed 1 }
    vwait ok_to_proceed

    # If we can still connect to the server, the socket got inherited.

    if {[catch {tls::socket -require 0 \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
   	 127.0.0.1 8828} msg]} {
	set x {server socket was not inherited}
    } else {
	close $msg
	set x {server socket was inherited}
    }

    set f [open script2 w]
    puts $f [list set tclsh $::tcltest::tcltest]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
    }
    puts $f "set f \[tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	    -keyfile $clientKey 127.0.0.1 8829\]"
    puts $f {
	exec $tclsh script1 &
	puts $f testing
	flush $f
	after 1000 exit
	vwait forever
    }
    close $f

    # Create the server socket

    set server [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8829]

    proc accept { file host port } {
	# When the client connects, establish the read handler
	global server
	close $server
	fconfigure $file -blocking 0
	fileevent $file readable [list do_handshake $file readable \
		[list getdata client] -buffering line]

    set f [open script2 w]
    puts $f [list set tclsh $::tcltest::tcltest]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
    }
    puts $f "set f \[tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8930\]"
    puts $f {
	proc accept { file host port } {
	    global tclsh
	    fconfigure $file -buffering line
	    puts $file {test data on socket}
	    exec $tclsh script1 &

    # the socket stays open

    exec $::tcltest::tcltest script2 &

    after 2000 set ok_to_proceed 1
    vwait ok_to_proceed

    set f [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    127.0.0.1 8930]
    fconfigure $f -buffering full -blocking 0
    # We need to put a byte into the read queue, otherwise the
    # TLS handshake doesn't finish
    puts $f a; flush $f
    fileevent $f readable [list getdata accepted $f]

	{socket testthread} {
    # HOBBS: never tested
    removeFile script
    threadReap

    makeFile {
    	package require tls
	set f [tls::socket -server accept -require 0 8828]
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	proc echo {s} {
	     global i
             set l [gets $s]

    } script

    # create a thread
    set serverthread [testthread create { source script } ]
    update

    after 1000
    set s [tls::socket -require 0 127.0.0.1 8828]
    fconfigure $s -buffering line

    catch {
	puts $s "hello"
	gets $s result
    }
    close $s

	}
    }
    proc accept {s a p} {
	fconfigure $s -blocking 0
	fileevent $s readable [list do_handshake $s readable readlittle \
		-buffering none]
    }
    set s [tls::socket -server accept -require 0 \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey 8838]

    set c [tls::socket -require 0 -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    localhost 8838]
    # only the client gets tls::import
    set res [tls::unimport $c]
    list $res [catch {close $c} err] $err \
	[catch {close $s} err] $err
} {{} 0 {} 0 {}}

test tls-bug58-1.0 {test protocol negotiation failure} {socket} {
    # Following code is based on what was reported in bug #58. Prior
    # to fix the program would crash with a segfault.
    proc accept {sock args} {
        fconfigure $sock -blocking 0;
        fileevent $sock readable [list Handshake $sock]
    }
    proc Handshake {sock} {
        set ::done HAND
        catch {tls::handshake $sock} msg
        set ::done $msg
    }
    # NOTE: when doing an in-process client/server test, both sides need
    # to be non-blocking for the TLS handshake

    # Server - Only accept TLS 1.3
    set s [tls::socket -server accept -request 0 -require 0 \
        -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	-ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 0 -tls1.3 1 8837]

    # Client - Only propose TLS1.2
    set c [tls::socket -async -cafile $caCert -request 0 -require 0 \
	-ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 1 -tls1.3 0 localhost 8837]
    fconfigure $c -blocking 0
    puts $c a ; flush $c
    after 5000 [list set ::done timeout]
    vwait ::done
    switch -exact -- $::done {
        "handshake failed: wrong ssl version" -
        "handshake failed: unsupported protocol" {