TclTLS
Changes On Branch trunk
Login
HomeTimelineBranchesTagsTicketsWiki
Hide Diff Patch Side-by-Side Diff

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tls-2.0 Excluding Merge-Ins

This is equivalent to a diff from 521ce8a625 to 4dfbd811b4

2025-10-17
07:18
close fork Leaf check-in: 4dfbd811b4 user: jan.nijtmans tags: trunk, main, tls-2.0
07:16
Minor spacing check-in: e831e54d8b user: jan.nijtmans tags: trunk, main, tls-2.0
03:14
Simplified logic for adding static libraries to TCLTLS_SSL_LIBS check-in: 85b45fc6e0 user: bohagan tags: trunk, main, tls-2.0
2025-02-01
23:36
Made changes to dereference objects returned by Tcl_ListObjIndex and Tcl_ListObjGetElements for TCL 9 abstract lists check-in: 74ebe7ccce user: bohagan tags: trunk, main, tls-2.0
2025-01-06
21:50
Added compatibility notes to documentation Leaf check-in: 521ce8a625 user: bohagan tags: trunk, main
2025-01-02
23:58
More documentation updates in prep for 2.0 release check-in: 44384307bd user: bohagan tags: trunk, main

Changes to Makefile.in.

︙
290
291
292
293
294
295
296
297


298
299
300
301
302
303
304
305
306
307
308
309
310


311
312
313
314
315
316
317

290
291
292
293
294
295
296

297
298
299
300
301
302
303
304
305
306
307
308
309
310

311
312
313
314
315
316
317
318
319








-
+
+












-
+
+








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

test: binaries libraries
	$(TCLSH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) \
	    -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \
		[list load `@CYGPATH@ $(PKG_LIB_FILE)` [string totitle $(PACKAGE_NAME)]]"
		[list 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)

gdb-test: binaries libraries
	$(TCLSH_ENV) $(PKG_ENV) $(GDB) \
	    --args $(TCLSH_PROG) `@CYGPATH@ $(srcdir)/tests/all.tcl` \
	    $(TESTFLAGS) -singleproc 1 \
	    -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \
		[list load `@CYGPATH@ $(PKG_LIB_FILE)` [string totitle $(PACKAGE_NAME)]]"
		[list load $(PKG_LIB_FILE) [string totitle $(PACKAGE_NAME)]]; \
		source $(srcdir)/library/$(PACKAGE_NAME).tcl}"

valgrind: binaries libraries
	$(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(TCLSH_PROG) \
	    `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS)

valgrindshell: binaries libraries
	$(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(TCLSH_PROG) $(SCRIPT)
︙
367
368
369
370
371
372
373
374

375
376
377
378
379
380
381

369
370
371
372
373
374
375

376
377
378
379
380
381
382
383








-
+








# We need to enumerate the list of .c to .o lines here.
#
# In the following lines, $(srcdir) refers to the toplevel directory
# containing your extension.  If your sources are in a subdirectory,
# you will have to modify the paths to reflect this:
#
# sample.$(OBJEXT): $(srcdir)/generic/sample.c
# 	$(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
#	$(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
#
# Setting the VPATH variable to a list of paths will cause the makefile
# to look into these paths when resolving .c to .obj dependencies.
# As necessary, add $(srcdir):$(srcdir)/compat:....
#========================================================================

VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx
︙

Changes to README.txt.

︙
12
13
14
15
16
17
18









19
20
21
22
23
24
25

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34








+
+
+
+
+
+
+
+
+








===========

This extension works by creating a layered TCL Channel on top of an existing
bi-directional channel created by the TLS socket command. All existing socket
functionality is supported in addition to several new options. Both client and
server modes are supported.


Features
========

The package provides:
- Encrypted TCP communications layered on TCL channels.
- Status of encrypted channels.
- View X.509 certificate contents.


Documentation
=============

See the doc directory for the full usage documentation.
︙

Changes to acinclude.m4.

︙
206
207
208
209
210
211
212
213

214
215

216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231

232

233
234
235
236
237
238
239
240
241
242
243
244
245
246



247
248
249
250
251
252
253
254
255
256
257
258
259
260




261
262
263
264
265
266
267




















268



269
270
271
272
273
274

206
207
208
209
210
211
212

213
214

215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236






237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263







264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293








-
+

-
+
















+

+


-
-
-
-
-
-






+
+
+














+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+







				opensslpkgconfigdir=''
			fi
		]
	)
	AC_MSG_CHECKING([for OpenSSL pkgconfig])
	AC_MSG_RESULT($opensslpkgconfigdir)

	dnl Use pkg-config to find OpenSSL if not already found 
	dnl Use pkg-config to find OpenSSL if not already found
	if test -n "$PKG_CONFIG" -a -z "$openssldir" -a -z "$opensslincludedir" -a -z "$openssllibdir"; then
	    USE_PKG_CONFIG=`"${PKG_CONFIG}" --list-all | grep openssl`
	    USE_PKG_CONFIG=`"${PKG_CONFIG}" --list-all | grep openssl | uniq`

	    dnl Use pkg-config to find the library names
	    if test -n "$USE_PKG_CONFIG"; then
		dnl Temporarily update PKG_CONFIG_PATH
		PKG_CONFIG_PATH_SAVE="${PKG_CONFIG_PATH}"
		if test -n "$opensslpkgconfigdir"; then
			if ! test -f "${opensslpkgconfigdir}/openssl.pc"; then
				AC_MSG_ERROR([Unable to locate ${opensslpkgconfigdir}/openssl.pc])
			fi

			PKG_CONFIG_PATH="${opensslpkgconfigdir}:${PKG_CONFIG_PATH}"
			export PKG_CONFIG_PATH
		fi

		pkgConfigExtraArgs=''
		if test "$SHARED_BUILD" == "0" -o "$TCLEXT_TLS_STATIC_SSL" == 'yes'; then
			# Skip since sometimes will include extra libraries
			pkgConfigExtraArgs='--static'
			pkgConfigExtraArgs=''
		fi

		if test -z "$TCLTLS_SSL_LIBS"; then
			TCLTLS_SSL_LIBS="$SSL_LIBS_PATH `${PKG_CONFIG} openssl --libs $pkgConfigExtraArgs`" || AC_MSG_ERROR([Unable to get OpenSSL Configuration])
			if test "${TCLEXT_TLS_STATIC_SSL}" == 'yes'; then
				TCLTLS_SSL_LIBS="-Wl,-Bstatic $TCLTLS_SSL_LIBS -Wl,-Bdynamic"
			fi
		fi
		if test -z "$TCLTLS_SSL_CFLAGS"; then
			TCLTLS_SSL_CFLAGS="`"${PKG_CONFIG}" openssl --cflags-only-other $pkgConfigExtraArgs`" || AC_MSG_ERROR([Unable to get OpenSSL Configuration])
		fi
		if test -z "$TCLTLS_SSL_INCLUDES"; then
			TCLTLS_SSL_INCLUDES="`"${PKG_CONFIG}" openssl --cflags-only-I $pkgConfigExtraArgs`" || AC_MSG_ERROR([Unable to get OpenSSL Configuration])
		fi
		if test -z "$TCLTLS_SSL_LIBS"; then
			TCLTLS_SSL_LIBS="`${PKG_CONFIG} openssl --libs $pkgConfigExtraArgs`" || AC_MSG_ERROR([Unable to get OpenSSL Configuration])
		fi
		PKG_CONFIG_PATH="${PKG_CONFIG_PATH_SAVE}"
	    fi
	fi

	dnl Use fall-back settings for OpenSSL include and library paths
	if test -z "$TCLTLS_SSL_CFLAGS"; then
		TCLTLS_SSL_CFLAGS=""
	fi
	if test -z "$TCLTLS_SSL_INCLUDES"; then
		if test -f /usr/include/openssl/ssl.h; then
			TCLTLS_SSL_INCLUDES="-I/usr/include"
		fi
	fi
	if test -z "$TCLTLS_SSL_LIBS"; then
		TCLTLS_SSL_LIBS="-lssl -lcrypto"
	fi
	
	dnl Set for static libraries
		if test "$TCLEXT_TLS_STATIC_SSL" == 'no'; then
		    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
	if test "$TCLEXT_TLS_STATIC_SSL" == 'yes'; then
		system="`uname -s`"
		case $system in
			AIX*)
				TCLTLS_SSL_LIBS="-Wl,-bstatic $TCLTLS_SSL_LIBS -Wl,-bdynamic";;
			BSD*|OpenBSD*)
				TCLTLS_SSL_LIBS="-Wl,-Bstatic $TCLTLS_SSL_LIBS -Wl,-Bdynamic";;
			CYGWIN_*|MINGW32_*|MINGW64_*|MSYS_*)
				TCLTLS_SSL_LIBS="-Wl,-Bstatic $TCLTLS_SSL_LIBS -Wl,-Bdynamic";;
			Darwin-*)
				TCLTLS_SSL_LIBS="$TCLTLS_SSL_LIBS";;
			HP-UX-*)
				TCLTLS_SSL_LIBS="-Wl,-a,archive $TCLTLS_SSL_LIBS -Wl,-a,shared_archive";;
			IRIX-*)
				TCLTLS_SSL_LIBS="-Wl,-B, static $TCLTLS_SSL_LIBS -Wl,-B, dynamic";;
			Solaris*)
				TCLTLS_SSL_LIBS="-Bstatic $TCLTLS_SSL_LIBS -Bdynamic";;
			Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*)
				TCLTLS_SSL_LIBS="-Wl,-Bstatic $TCLTLS_SSL_LIBS -Wl,-Bdynamic";;
		esac
	fi
	TCLTLS_SSL_LIBS="$SSL_LIBS_PATH $TCLTLS_SSL_LIBS"
	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])
])

Changes to configure. 

1
2
3

4
5
6
7
8
9
10

1
2

3
4
5
6
7
8
9
10



-
+








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


606
607
608
609
610
611
612

597
598
599
600
601
602
603


604
605
606
607
608
609
610
611
612








-
-
+
+








subdirs=
MFLAGS=
MAKEFLAGS=

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

# Factoring default headers for most tests.
ac_includes_default="\
#include <stddef.h>
#ifdef HAVE_STDIO_H
︙
1338
1339
1340
1341
1342
1343
1344
1345

1346
1347
1348
1349
1350
1351
1352

1338
1339
1340
1341
1342
1343
1344

1345
1346
1347
1348
1349
1350
1351
1352








-
+








#
# 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.
'configure' configures tls 2.0b2 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.
︙
1400
1401
1402
1403
1404
1405
1406
1407

1408
1409
1410
1411
1412
1413
1414

1400
1401
1402
1403
1404
1405
1406

1407
1408
1409
1410
1411
1412
1413
1414








-
+









  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of tls 2.0b1:";;
     short | recursive ) echo "Configuration of tls 2.0b2:";;
   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]
︙
1526
1527
1528
1529
1530
1531
1532
1533

1534
1535
1536
1537
1538
1539
1540

1526
1527
1528
1529
1530
1531
1532

1533
1534
1535
1536
1537
1538
1539
1540








-
+








    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
tls configure 2.0b2
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
︙
1833
1834
1835
1836
1837
1838
1839
1840

1841
1842
1843
1844
1845
1846
1847

1833
1834
1835
1836
1837
1838
1839

1840
1841
1842
1843
1844
1845
1846
1847








-
+








    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
It was created by tls $as_me 2.0b2, which was
generated by GNU Autoconf 2.72.  Invocation command line was

  $ $0$ac_configure_args_raw

_ACEOF
exec 5>>config.log
{
︙
2808
2809
2810
2811
2812
2813
2814
2815
2816


2817
2818
2819
2820


2821
2822
2823
2824


2825
2826
2827
2828
2829
2830
2831

2808
2809
2810
2811
2812
2813
2814


2815
2816
2817
2818


2819
2820
2821
2822


2823
2824
2825
2826
2827
2828
2829
2830
2831








-
-
+
+


-
-
+
+


-
-
+
+








			`ls -d ${exec_prefix}/lib 2>/dev/null` \
			`ls -d ${prefix}/lib 2>/dev/null` \
			`ls -d /usr/local/lib 2>/dev/null` \
			`ls -d /usr/contrib/lib 2>/dev/null` \
			`ls -d /usr/pkg/lib 2>/dev/null` \
			`ls -d /usr/lib 2>/dev/null` \
			`ls -d /usr/lib64 2>/dev/null` \
			`ls -d /usr/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/lib/tcl8.7 2>/dev/null` \
			`ls -d /usr/lib/tcl9.1 2>/dev/null` \
			`ls -d /usr/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/lib/tcl8.6 2>/dev/null` \
			`ls -d /usr/lib/tcl8.5 2>/dev/null` \
			`ls -d /usr/local/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl9.1 2>/dev/null` \
			`ls -d /usr/local/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.6 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.5 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl9.1 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.5 2>/dev/null` \
			; do
		    if test -f "$i/tclConfig.sh" ; then
			ac_cv_c_tclconfig="`(cd $i; pwd)`"
			break
		    fi
︙
4029
4030
4031
4032
4033
4034
4035



4036
4037

4038
4039
4040
4041
4042
4043
4044

4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039

4040
4041
4042
4043
4044
4045
4046
4047








+
+
+

-
+








rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
    CC=$hold_cc
    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $TEA_PLATFORM" >&5
printf "%s\n" "$TEA_PLATFORM" >&6; }

    # The BUILD_$pkg is to define the correct extern storage class
    # handling when making this package
    # To be able to sefely use the package name in a #define, it must not
    # contain anything other than alphanumeric characters and underscores
    SAFE_PKG_NAME=tls

printf "%s\n" "#define BUILD_${PACKAGE_NAME} /**/" >>confdefs.h
printf "%s\n" "#define BUILD_${SAFE_PKG_NAME} /**/" >>confdefs.h

    # Do this here as we have fully defined TEA_PLATFORM now
    if test "${TEA_PLATFORM}" = "windows" ; then
	EXEEXT=".exe"
	CLEANFILES="$CLEANFILES *.lib *.dll *.pdb *.exp"
    fi
︙
6565
6566
6567
6568
6569
6570
6571

6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582

6583
6584
6585
6586
6587
6588
6589

6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585

6586
6587
6588
6589
6590
6591
6592
6593








+










-
+








		    arm64|aarch64)
			MACHINE="ARM64"
			;;
		    ia64)
			MACHINE="IA64"
			;;
		esac
		do64bit_ok=yes
	    fi

	    if test "$GCC" != "yes" ; then
		if test "${SHARED_BUILD}" = "0" ; then
		    runtime=-MT
		else
		    runtime=-MD
		fi
		case "x`echo \${VisualStudioVersion}`" in
		    x1[4-9]*)
			lflags="${lflags} -nodefaultlib:libucrt.lib"
			lflags="${lflags} -nodefaultlib:ucrt.lib"

    vars="ucrt.lib"
    for i in $vars; do
	if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then
	    # Convert foo.lib to -lfoo for GCC.  No-op if not *.lib
	    i=`echo "$i" | sed -e 's/^\([^-].*\)\.[lL][iI][bB]$/-l\1/'`
	fi
︙
6977
6978
6979
6980
6981
6982
6983
6984

6985
6986
6987



6988


6989
6990
6991
6992
6993
6994
6995

6981
6982
6983
6984
6985
6986
6987

6988
6989
6990
6991
6992
6993
6994

6995
6996
6997
6998
6999
7000
7001
7002
7003








-
+



+
+
+
-
+
+








	    SHLIB_CFLAGS="-export-dynamic -fPIC"
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".so"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*)
	CYGWIN_*|MINGW32_*|MINGW64_*|MSYS_*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    if test "${TEA_PLATFORM}" = "unix" -a  "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$(patsubst cyg%.dll,lib%.dll,\$@).a"
	    else
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a"
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a"
	    fi
	    EXEEXT=".exe"
	    do64bit_ok=yes
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
︙
9045
9046
9047
9048
9049
9050
9051








9052
9053



9054
9055
9056
9057
9058
9059
9060
9061
9062
9063
9064
9065
9066
9067
9068
9069
9070
9071
9072
9073
9074
9075
9076




































9077
9078
9079
9080
9081
9082
9083

9053
9054
9055
9056
9057
9058
9059
9060
9061
9062
9063
9064
9065
9066
9067


9068
9069
9070
9071
9072
9073
9074
9075
9076
9077


9078
9079
9080
9081
9082
9083
9084
9085
9086
9087
9088
9089
9090
9091
9092
9093
9094
9095
9096
9097
9098
9099
9100
9101
9102
9103
9104
9105
9106
9107
9108
9109
9110
9111
9112
9113
9114
9115
9116
9117
9118
9119
9120
9121
9122
9123
9124
9125
9126
9127
9128
9129
9130
9131
9132
9133
9134








+
+
+
+
+
+
+
+
-
-
+
+
+







-
-














+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









    #--------------------------------------------------------------------
    # Shared libraries and static libraries have different names.
    # Use the double eval to make sure any variables in the suffix is
    # substituted. (@@@ Might not be necessary anymore)
    #--------------------------------------------------------------------

    if test "$TEA_PLATFORM" = "unix"; then
	PACKAGE_LIB_PREFIX8="lib"
	if test "$EXEEXT" = ".exe" -a "$SHARED_BUILD" != "0"; then
	    PACKAGE_LIB_PREFIX9="cygtcl9"
	else
	    PACKAGE_LIB_PREFIX9="libtcl9"
	fi
    else
    PACKAGE_LIB_PREFIX8="${PACKAGE_LIB_PREFIX}"
    PACKAGE_LIB_PREFIX9="${PACKAGE_LIB_PREFIX}tcl9"
	PACKAGE_LIB_PREFIX8=""
	PACKAGE_LIB_PREFIX9="tcl9"
    fi
    if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then
	PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX9}"
    else
	PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX8}"

printf "%s\n" "#define TCL_MAJOR_VERSION 8" >>confdefs.h

    fi
    if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tk8}" != x; then

printf "%s\n" "#define TK_MAJOR_VERSION 8" >>confdefs.h

    fi
    if test "${TEA_PLATFORM}" = "windows" ; then
	if test "${SHARED_BUILD}" = "1" ; then
	    # We force the unresolved linking of symbols that are really in
	    # the private libraries of Tcl and Tk.
	    if test x"${TK_BIN_DIR}" != x ; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}`\""
	    fi
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\""
	    if test "$GCC" = "yes"; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -static-libgcc"
	    fi
	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking if the linker understands --disable-high-entropy-va" >&5
printf %s "checking if the linker understands --disable-high-entropy-va... " >&6; }
if test ${tcl_cv_ld_high_entropy+y}
then :
  printf %s "(cached) " >&6
else case e in #(
  e)
		hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--disable-high-entropy-va"
		cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main (void)
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"
then :
  tcl_cv_ld_high_entropy=yes
else case e in #(
  e) tcl_cv_ld_high_entropy=no ;;
esac
fi
rm -f core conftest.err conftest.$ac_objext conftest.beam \
    conftest$ac_exeext conftest.$ac_ext
		CFLAGS=$hold_cflags ;;
esac
fi
{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_high_entropy" >&5
printf "%s\n" "$tcl_cv_ld_high_entropy" >&6; }
	    if test $tcl_cv_ld_high_entropy = yes; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--disable-high-entropy-va"
	    fi
	    eval eval "PKG_LIB_FILE8=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	else
	    if test "$GCC" = "yes"; then
		PACKAGE_LIB_PREFIX=lib${PACKAGE_LIB_PREFIX}
︙
9101
9102
9103
9104
9105
9106
9107
9108
9109
9110



9111
9112
9113
9114
9115



9116
9117
9118
9119

9120
9121

9122
9123
9124
9125
9126
9127
9128

9152
9153
9154
9155
9156
9157
9158



9159
9160
9161
9162
9163



9164
9165
9166
9167
9168
9169

9170
9171

9172
9173
9174
9175
9176
9177
9178
9179








-
-
-
+
+
+


-
-
-
+
+
+



-
+

-
+








    else
	RANLIB_STUB="${RANLIB}"
	if test "${SHARED_BUILD}" = "1" ; then
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TCL_STUB_LIB_SPEC}"
	    if test x"${TK_BIN_DIR}" != x ; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TK_STUB_LIB_SPEC}"
	    fi
	    eval eval "PKG_LIB_FILE8=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=lib${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE8=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    RANLIB=:
	else
	    eval eval "PKG_LIB_FILE8=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=lib${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE8=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	fi
	# Some packages build their own stubs libraries
	if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then
	    eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a"
	    eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a"
	else
	    eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}"
	fi
    fi

    # These are escaped so that only CFLAGS is picked up at configure time.
    # The other values will be substituted at make time.
    CFLAGS="${CFLAGS} \${CFLAGS_DEFAULT} \${CFLAGS_WARNING}"
    if test "${SHARED_BUILD}" = "1" ; then
︙
9566
9567
9568
9569
9570
9571
9572
9573

9574
9575
9576
9577
9578
9579
9580
9581
9582
9583
9584
9585
9586
9587

9588

9589
9590
9591
9592
9593
9594
9595
9596
9597
9598
9599
9600
9601
9602



9603
9604
9605
9606
9607
9608
9609
9610
9611
9612
9613
9614
9615



9616
9617
9618
9619
9620
9621
9622




















9623





9624
9625
9626
9627
9628
9629
9630

9617
9618
9619
9620
9621
9622
9623

9624
9625
9626
9627
9628
9629
9630
9631
9632
9633
9634
9635
9636
9637
9638
9639
9640
9641
9642
9643






9644
9645
9646
9647
9648
9649
9650
9651
9652
9653
9654
9655
9656
9657
9658
9659
9660
9661
9662
9663
9664
9665
9666
9667
9668







9669
9670
9671
9672
9673
9674
9675
9676
9677
9678
9679
9680
9681
9682
9683
9684
9685
9686
9687
9688
9689
9690
9691
9692
9693
9694
9695
9696
9697
9698
9699
9700
9701








-
+














+

+


-
-
-
-
-
-






+
+
+













+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+









	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for OpenSSL pkgconfig" >&5
printf %s "checking for OpenSSL pkgconfig... " >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $opensslpkgconfigdir" >&5
printf "%s\n" "$opensslpkgconfigdir" >&6; }

		if test -n "$PKG_CONFIG" -a -z "$openssldir" -a -z "$opensslincludedir" -a -z "$openssllibdir"; then
	    USE_PKG_CONFIG=`"${PKG_CONFIG}" --list-all | grep openssl`
	    USE_PKG_CONFIG=`"${PKG_CONFIG}" --list-all | grep openssl | uniq`

	    	    if test -n "$USE_PKG_CONFIG"; then
				PKG_CONFIG_PATH_SAVE="${PKG_CONFIG_PATH}"
		if test -n "$opensslpkgconfigdir"; then
			if ! test -f "${opensslpkgconfigdir}/openssl.pc"; then
				as_fn_error $? "Unable to locate ${opensslpkgconfigdir}/openssl.pc" "$LINENO" 5
			fi

			PKG_CONFIG_PATH="${opensslpkgconfigdir}:${PKG_CONFIG_PATH}"
			export PKG_CONFIG_PATH
		fi

		pkgConfigExtraArgs=''
		if test "$SHARED_BUILD" == "0" -o "$TCLEXT_TLS_STATIC_SSL" == 'yes'; then
			# Skip since sometimes will include extra libraries
			pkgConfigExtraArgs='--static'
			pkgConfigExtraArgs=''
		fi

		if test -z "$TCLTLS_SSL_LIBS"; then
			TCLTLS_SSL_LIBS="$SSL_LIBS_PATH `${PKG_CONFIG} openssl --libs $pkgConfigExtraArgs`" || as_fn_error $? "Unable to get OpenSSL Configuration" "$LINENO" 5
			if test "${TCLEXT_TLS_STATIC_SSL}" == 'yes'; then
				TCLTLS_SSL_LIBS="-Wl,-Bstatic $TCLTLS_SSL_LIBS -Wl,-Bdynamic"
			fi
		fi
		if test -z "$TCLTLS_SSL_CFLAGS"; then
			TCLTLS_SSL_CFLAGS="`"${PKG_CONFIG}" openssl --cflags-only-other $pkgConfigExtraArgs`" || as_fn_error $? "Unable to get OpenSSL Configuration" "$LINENO" 5
		fi
		if test -z "$TCLTLS_SSL_INCLUDES"; then
			TCLTLS_SSL_INCLUDES="`"${PKG_CONFIG}" openssl --cflags-only-I $pkgConfigExtraArgs`" || as_fn_error $? "Unable to get OpenSSL Configuration" "$LINENO" 5
		fi
		if test -z "$TCLTLS_SSL_LIBS"; then
			TCLTLS_SSL_LIBS="`${PKG_CONFIG} openssl --libs $pkgConfigExtraArgs`" || as_fn_error $? "Unable to get OpenSSL Configuration" "$LINENO" 5
		fi
		PKG_CONFIG_PATH="${PKG_CONFIG_PATH_SAVE}"
	    fi
	fi

		if test -z "$TCLTLS_SSL_CFLAGS"; then
		TCLTLS_SSL_CFLAGS=""
	fi
	if test -z "$TCLTLS_SSL_INCLUDES"; then
		if test -f /usr/include/openssl/ssl.h; then
			TCLTLS_SSL_INCLUDES="-I/usr/include"
		fi
	fi
	if test -z "$TCLTLS_SSL_LIBS"; then
		TCLTLS_SSL_LIBS="-lssl -lcrypto"
	fi

		if test "$TCLEXT_TLS_STATIC_SSL" == 'no'; then
		    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
		if test "$TCLEXT_TLS_STATIC_SSL" == 'yes'; then
		system="`uname -s`"
		case $system in
			AIX*)
				TCLTLS_SSL_LIBS="-Wl,-bstatic $TCLTLS_SSL_LIBS -Wl,-bdynamic";;
			BSD*|OpenBSD*)
				TCLTLS_SSL_LIBS="-Wl,-Bstatic $TCLTLS_SSL_LIBS -Wl,-Bdynamic";;
			CYGWIN_*|MINGW32_*|MINGW64_*|MSYS_*)
				TCLTLS_SSL_LIBS="-Wl,-Bstatic $TCLTLS_SSL_LIBS -Wl,-Bdynamic";;
			Darwin-*)
				TCLTLS_SSL_LIBS="$TCLTLS_SSL_LIBS";;
			HP-UX-*)
				TCLTLS_SSL_LIBS="-Wl,-a,archive $TCLTLS_SSL_LIBS -Wl,-a,shared_archive";;
			IRIX-*)
				TCLTLS_SSL_LIBS="-Wl,-B, static $TCLTLS_SSL_LIBS -Wl,-B, dynamic";;
			Solaris*)
				TCLTLS_SSL_LIBS="-Bstatic $TCLTLS_SSL_LIBS -Bdynamic";;
			Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*)
				TCLTLS_SSL_LIBS="-Wl,-Bstatic $TCLTLS_SSL_LIBS -Wl,-Bdynamic";;
		esac
	fi
	TCLTLS_SSL_LIBS="$SSL_LIBS_PATH $TCLTLS_SSL_LIBS"
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for SSL libs" >&5
printf %s "checking for SSL libs... " >&6; }
	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $TCLTLS_SSL_LIBS" >&5
printf "%s\n" "$TCLTLS_SSL_LIBS" >&6; }






#--------------------------------------------------------------------
︙
9644
9645
9646
9647
9648
9649
9650
9651

9652
9653
9654
9655
9656
9657
9658

9715
9716
9717
9718
9719
9720
9721

9722
9723
9724
9725
9726
9727
9728
9729








-
+








    vars="${TCLTLS_SSL_INCLUDES}"
    for i in $vars; do
	PKG_INCLUDES="$PKG_INCLUDES $i"
    done



    vars="${TCLTLS_SSL_LIBS}"
    vars="${TCLTLS_SSL_LIBS} ws2_32.lib Crypt32.lib"
    for i in $vars; do
	if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then
	    # Convert foo.lib to -lfoo for GCC.  No-op if not *.lib
	    i=`echo "$i" | sed -e 's/^\([^-].*\)\.[lL][iI][bB]$/-l\1/'`
	fi
	PKG_LIBS="$PKG_LIBS $i"
    done
︙
10289
10290
10291
10292
10293
10294
10295
10296

10297
10298
10299
10300
10301
10302
10303

10360
10361
10362
10363
10364
10365
10366

10367
10368
10369
10370
10371
10372
10373
10374








-
+








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
This file was extended by tls $as_me 2.0b2, 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 $@
︙
10344
10345
10346
10347
10348
10349
10350
10351

10352
10353
10354
10355
10356
10357
10358

10415
10416
10417
10418
10419
10420
10421

10422
10423
10424
10425
10426
10427
10428
10429








-
+









_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
tls config.status 2.0b2
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."
︙

Changes to configure.ac.

︙
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26

12
13
14
15
16
17
18

19
20
21
22
23
24
25
26








-
+








# 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])
AC_INIT([tls],[2.0b2])

#--------------------------------------------------------------------
# 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.
#--------------------------------------------------------------------
︙
169
170
171
172
173
174
175
176

177
178
179
180
181
182
183

169
170
171
172
173
174
175

176
177
178
179
180
181
182
183








-
+








# 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}])
	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
︙

Changes to demos/README.txt. 

1
2
3



4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

24
25
26

27
28
29
30
31
32
33
34
35
36

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

26
27
28

29
30
31
32
33
34
35
36
37
38
39




+
+
+



















-
+


-
+











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 webpage using the http package.
Download a file using the http package.

http_get_webpage.tcl
Download a file using the http package.
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.

Added demos/echat.tcl. 






















































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#!/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] -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








Changes to demos/gets_blocking_no_variable.tcl.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9
10
11
12
13
14







+








#################################################
#
# Example 1: Blocking channel gets with no variable
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls

set host "www.google.com"
set port 443
set path "/"
set protocol "http/1.1"




︙







Changes to demos/gets_blocking_with_variable.tcl.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9
10
11
12
13
14







+








#################################################
#
# Example 2: Blocking channel gets with variable
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls

set host "www.google.com"
set port 443
set path "/"
set protocol "http/1.1"




︙







Changes to demos/gets_nonblocking_no_variable.tcl.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9
10
11
12
13
14







+








#################################################
#
# Example 3: Non-blocking channel gets with no variable
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls

set host "www.google.com"
set port 443
set path "/"
set protocol "http/1.1"




︙


70
71
72
73
74
75
76
77


71
72
73
74
75
76
77

78








-
+


    vwait ::wait
    catch {close $ch}
}

set data ""
gets_non_blocking_no_variable $host $port $path $protocol
save_file "gets_non_blocking_no_variable.txt" $data
save_file "gets_nonblocking_no_variable.txt" $data








Changes to demos/gets_nonblocking_with_variable.tcl.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9
10
11
12
13
14







+








#################################################
#
# Example 4: Non-blocking channel gets with variable
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls

set host "www.google.com"
set port 443
set path "/"
set protocol "http/1.1"




︙


69
70
71
72
73
74
75
76

77

70
71
72
73
74
75
76

77
78








-
+



    vwait ::wait
    catch {close $ch}
}

set data ""
gets_non_blocking_with_variable $host $port $path $protocol
save_file "gets_non_blocking_with_variable.txt" $data
save_file "gets_nonblocking_with_variable.txt" $data









Changes to demos/gets_with_debug_data.tcl.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9
10
11
12
13
14







+








#################################################
#
# Example 4: Non-blocking channel gets with variable
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls

set host "www.google.com"
set port 443
set path "/"
set protocol "http/1.1"




︙







Changes to demos/http_debug_example.tcl.



1
2
3
4
5
6

7
8
9
10
11

12
13
14
15
16
17
18

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19







+




-
+








#################################################
#
# Download webpage using HTTP package with debug output
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls
package require http

set url "https://www.tcl.tk/"
set url "https://www.tcl-lang.org/"
set port 443
set protocol "http/1.1"

# Register https protocol handler with http package
http::register https 443 [list ::tls::socket -autoservername 1 -require 1 -alpn [list [string tolower $protocol]] \
    -command ::tls::callback -password ::tls::password -validatecommand ::tls::validate_command]





︙







Changes to demos/http_get_file.tcl.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9
10
11
12
13
14







+








#################################################
#
# Download file using HTTP package
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls
package require http

set url "https://wiki.tcl-lang.org/sitemap.xml"
set protocol "http/1.1"
set filename [file tail $url]




︙







Changes to demos/http_get_webpage.tcl.



1
2
3
4
5
6

7
8
9
10
11

12
13
14
15
16
17
18

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
19







+




-
+








#################################################
#
# Download webpage using HTTP package
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls
package require http

set url "https://www.tcl.tk/"
set url "https://www.tcl-lang.org/"
set port 443
set protocol "http/1.1"

# Register https protocol handler with http package
http::register https 443 [list ::tls::socket -autoservername 1 -require 1 -alpn [list [string tolower $protocol]]]

# Get webpage




︙







Changes to demos/http_get_webpage_proxy.tcl.



1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20

21
22
23
24
25
26
27

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28














+






-
+








#################################################
#
# Download webpage using HTTP and proxy packages.
#
# Process:
# - Connect to the proxy
# - Send HTTP "CONNECT $targeturl HTTP/1.1".
# - Proxy responds with HTTP protocol response.
# - Do tls::import
# - Start handdshaking
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls
package require http
package require autoproxy
autoproxy::init

set url "https://www.tcl.tk/"
set url "https://www.tcl-lang.org/"
set port 443
set protocol "http/1.1"

# Set these if not set by OS/Platform
if 0 {
    autoproxy::configure -basic -proxy_host example.com -proxy_port 880 -username user -password password
}




︙







Changes to demos/read_blocking_webpage.tcl.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9
10
11
12
13
14







+








#################################################
#
# Read using blocking channel
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls

set host "www.google.com"
set port 443
set path "/"
set protocol "http/1.1"




︙







Changes to demos/read_nonblocking_webpage.tcl.



1
2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5
6
7
8
9
10
11
12
13
14







+








#################################################
#
# Read using blocking channel
#
#################################################

package prefer latest
package require Tcl 8.6-
package require tls

set host "www.google.com"
set port 443
set path "/"
set protocol "http/1.1"




︙







Changes to doc/tls.html.




︙


96
97
98
99
100
101
102
103

104
105
106
107
108
109
110

96
97
98
99
100
101
102

103
104
105
106
107
108
109
110








-
+








<!-- 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>
<h1 class="doctools_title">tls(n) 2.0b2 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>




︙


124
125
126
127
128
129
130

131
132
133
134
135
136
137
138
139
140
141

142
143
144
145
146
147
148

149



150
151
152
153
154





155
156
157
158
159
160
161
162
163
164






165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180

181
182
183
184

185
186

187
188
189
190
191
192
193
194
195
196
197



198


199
200
201
202
203
204
205

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

142
143
144
145
146
147
148

149
150
151
152
153





154
155
156
157
158
159
160
161
162






163
164
165
166
167
168

169
170
171
172
173
174

175
176
177
178
179
180
181
182

183
184
185
186

187
188

189
190
191
192
193
194
195
196
197



198
199
200
201
202
203
204
205
206
207
208
209
210








+










-
+






-
+

+
+
+
-
-
-
-
-
+
+
+
+
+




-
-
-
-
-
-
+
+
+
+
+
+
-






-
+







-
+



-
+

-
+








-
-
-
+
+
+

+
+








<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>
<li>package require <b class="pkgname">tls 2.0b2</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="#5"><b class="cmd">tls::starttls</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="#6"><b class="cmd">tls::handshake</b> <i class="arg">channel</i></a></li>
<li><a href="#7"><b class="cmd">tls::shutdown</b> <i class="arg">channel</i></a></li>
<li><a href="#8"><b class="cmd">tls::unimport</b> <i class="arg">channel</i></a></li>
<li><a href="#9"><b class="cmd">tls::unstack</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>
<li><a href="#10"><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="#11"><b class="cmd">tls::connection</b> <i class="arg">channel</i></a></li>
<li><a href="#12"><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="#13"><b class="cmd">tls::protocols</b></a></li>
<li><a href="#14"><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 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 and higher.
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
<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>
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 the
<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 TLS related ones.</p></dd>
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>
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.</p>
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, 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>
<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></dd>
<dt><a name="5"><b class="cmd">tls::starttls</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




︙


247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271



272
273
274
275
276
277
278
279
280

281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297

298
299
300
301
302
303
304
305
306
307
308
309
310
311
312

313
314
315
316

317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337









338

339
340
341
342
343


344
345
346
347
348
349
350

252
253
254
255
256
257
258

259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274


275
276
277
278
279
280
281
282
283
284
285

286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

303
304
305
306
307
308
309
310
311
312
313
314
315
316
317

318
319
320
321

322
323
324
325
326
327
328
329
330
331
332
333
334
335




336
337
338
339
340
341
342
343
344
345
346
347
348

349
350
351
352


353
354
355
356
357
358
359
360
361








-
+















-
-
+
+
+








-
+
















-
+














-
+



-
+













-
-
-
-




+
+
+
+
+
+
+
+
+
-
+



-
-
+
+








<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 <i class="arg">-certfile</i> option.</p></dd>
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>. 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>.
<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>.
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>
default to the host from 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 <i class="arg">-security_level</i> option.</p></dd>
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 <i class="arg">-security_level</i> option.</p></dd>
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::shutdown</b> <i class="arg">channel</i></a></dt>
<dd></dd>
<dt><a name="8"><b class="cmd">tls::unimport</b> <i class="arg">channel</i></a></dt>
<dd></dd>
<dt><a name="9"><b class="cmd">tls::unstack</b> <i class="arg">channel</i></a></dt>
<dd><p>This terminates the SSL/TLS session by sending the &quot;close_notify&quot; message and
removes the top level stacked channel from <i class="arg">channel</i>, but it does not close
the socket. It is the compliment to <b class="cmd">tls::import</b> by ending encryption of
a TCL channel. An error is thrown if TLS is not the top stacked channel type.</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>
<dt><a name="10"><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>
<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>




︙


453
454
455
456
457
458
459
460

461
462
463
464
465
466
467

464
465
466
467
468
469
470

471
472
473
474
475
476
477
478








-
+








<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>
<dt><a name="11"><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>




︙


524
525
526
527
528
529
530
531

532
533
534
535
536
537
538
539

540
541
542
543
544

545
546
547
548
549
550
551

535
536
537
538
539
540
541

542
543
544
545
546
547
548
549

550
551
552
553
554

555
556
557
558
559
560
561
562








-
+







-
+




-
+








<dt><b class="variable">ticket_app_data</b> <i class="arg">binary_string</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>
<dt><a name="12"><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>
<dt><a name="13"><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>
<dt><a name="14"><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




︙


559
560
561
562
563
564
565
566

567
568
569
570
571
572
573

570
571
572
573
574
575
576

577
578
579
580
581
582
583
584








-
+








<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 tp specify where to find the CA certificates.
<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




︙


589
590
591
592
593
594
595
596

597
598
599
600
601
602
603
604




605
606
607
608
609
610
611
612

613
614
615
616
617
618
619
620
621
622
623



624
625
626
627
628
629
630
631
632
633
634
635

636
637
638
639
640
641
642

600
601
602
603
604
605
606

607

608
609
610




611
612
613
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
629
630



631
632
633
634
635
636
637
638
639
640
641
642
643
644

645
646
647
648
649
650
651
652








-
+
-



-
-
-
-
+
+
+
+







-
+








-
-
-
+
+
+











-
+








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. See
not specified. This store only supports root certificate stores.</p></dd>
<span class="sectref"><a href="#section4">Certificate Validation</a></span> for more details.</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>. 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 <i class="arg">-validatecommand</i> option.</p></dd>
<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>.</p></dd>
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, this 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>
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 utilized by
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




︙


748
749
750
751
752
753
754
755
756


757
758
759
760
761
762
763
764
765

766
767

768
769
770
771
772
773
774

758
759
760
761
762
763
764


765
766
767
768
769
770
771
772
773
774

775
776

777
778
779
780
781
782
783
784








-
-
+
+








-
+

-
+








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 ALPN callbacks.</p></dd>
<dt><b class="option">hello</b> <i class="arg">channelId servername</i></dt>
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&lt;/b&gt;</b> option. The
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
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>




︙


868
869
870
871
872
873
874
875

876




















877
878
879
880
881
882
883

878
879
880
881
882
883
884

885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913








-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








::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> commands to obtain the supported
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">handshake failed: certificate verify failed due to &quot;unable to get local issuer certificate&quot;</i></dt>
<dd><p>The certificates in the CA file or certificate store either do not have one or
more issuers of the certificates you are validating or they have expired.
Usually this means you need an updated CAcert file.</p></dd>
<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>The peer has closed the connection without sending the &quot;close notify&quot; shutdown
alert. Some servers will terminate the connection after the file or webpage has
been sent without sending the &quot;close notify&quot; message. In this case, it should
not result in a loss of data.</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>




︙







Changes to doc/tls.man.



1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24






25
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50

51
52

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68



69
70


71
72
73
74
75
76
77

1
2
3
4
5

6
7
8
9
10
11
12
13
14
15

16
17
18






19
20
21
22
23
24

25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40
41
42

43
44
45
46
47
48

49
50

51
52
53
54
55
56
57
58
59
60
61
62
63
64



65
66
67
68
69
70
71
72
73
74
75
76
77
78






-
+









-
+


-
-
-
-
-
-
+
+
+
+
+
+
-







-
+










-
+





-
+

-
+













-
-
-
+
+
+


+
+








[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]
[manpage_begin tls n 2.0b2]
[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]
[require tls 2.0b2]
[description]

This extension provides TCL script access to secure socket 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 and higher.
These sockets behave exactly the same as channels created using the built-in
[syscmd socket] command, but provide additional options for controlling
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.
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 the
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 TLS related ones.
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]
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.
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, 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.
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 ..."]]]

[call [cmd tls::starttls] [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]





︙


132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161



162
163
164
165
166
167
168
169
170
171

172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191

192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210

211
212
213
214
215

216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245











246
247
248
249
250
251
252


253
254
255
256
257
258
259

133
134
135
136
137
138
139

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160


161
162
163
164
165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211

212
213
214
215
216

217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235






236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257


258
259
260
261
262
263
264
265
266








-
+




















-
-
+
+
+









-
+



















-
+


















-
+




-
+


















-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+





-
-
+
+








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 [arg -certfile] option.
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]. Starting in TclTLS 2.0, If set to [const false] and
[option -require] is [const true], then this will be overridden to [const true].
[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].
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.
default to the host from 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 [arg -security_level] option.
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 [arg -security_level] option.
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
error is thrown if TLS is not the top stacked channel type.

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

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.

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

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

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

This terminates the SSL/TLS session by sending the "close_notify" message and
removes the top level stacked channel from [arg channel], but it does not close
the socket. It is the compliment to [cmd tls::import] by ending encryption of
a TCL channel. An error is thrown if TLS is not the top stacked channel type.

[call [cmd tls::status] [opt [option -local]] [arg channel]]

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
[option -local] option is specified, then the local certificate is used. Returned
values include:
[option -local] option is specified, then the local certificate is used.
Returned values include:

[para]

SSL Status

[list_begin definitions]





︙


566
567
568
569
570
571
572
573

574
575
576
577
578
579
580

573
574
575
576
577
578
579

580
581
582
583
584
585
586
587








-
+








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 tp specify where to find the CA certificates.
[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




︙


603
604
605
606
607
608
609
610

611
612
613
614
615
616
617
618
619




620
621
622
623
624
625
626
627
628

629
630
631
632
633
634
635
636
637
638
639
640
641



642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660

661
662
663
664
665
666
667

610
611
612
613
614
615
616

617

618
619
620
621




622
623
624
625
626
627
628
629
630
631
632
633

634
635
636
637
638
639
640
641
642
643
644



645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665

666
667
668
669
670
671
672
673








-
+
-




-
-
-
-
+
+
+
+








-
+










-
-
-
+
+
+


















-
+









[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. See
not specified. This store only supports root certificate stores.
[sectref "Certificate Validation"] for more details.

[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]. 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 [arg -validatecommand] option.
[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].
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, this has been changed to require certificate validation
by default. In order to use the [option -require] option, one of the following
must be true:
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 utilized by
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




︙


813
814
815
816
817
818
819
820

821
822

823
824
825
826
827
828
829
830
831
832

833
834

835
836
837
838
839
840
841

819
820
821
822
823
824
825

826
827

828
829
830
831
832
833
834
835
836
837

838
839

840
841
842
843
844
845
846
847








-
+

-
+









-
+

-
+








[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 ALPN callbacks.
after the Hello and SNI callbacks.

[opt_def hello [arg "channelId servername"]]
[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</b>] option. The
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
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




︙


979
980
981
982
983
984
985
986

987
988



























989

985
986
987
988
989
990
991

992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022








-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


}]

[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] commands to obtain the supported
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 "handshake failed: certificate verify failed due to \"unable to get local issuer certificate\""]]
The certificates in the CA file or certificate store either do not have one or
more issuers of the certificates you are validating or they have expired.
Usually this means you need an updated CAcert file.

[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"]]
The peer has closed the connection without sending the "close notify" shutdown
alert. Some servers will terminate the connection after the file or webpage has
been sent without sending the "close notify" message. In this case, it should
not result in a loss of data.

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








Changes to doc/tls.n.



1
2
3
4
5
6
7

8
9
10
11
12
13
14

1
2
3
4
5
6

7
8
9
10
11
12
13
14







-
+








'\"
'\" 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"
.TH "tls" n 2\&.0b2 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,




︙


274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
289
290






291
292
293

294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312






313
314
315
316
317
318

319
320
321
322
323
324
325
326

327
328
329
330
331

332
333

334
335
336
337
338
339
340
341
342
343
344
345
346



347
348


349
350
351
352
353
354
355

274
275
276
277
278
279
280

281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298

299
300
301
302
303
304
305
306
307
308
309
310
311
312






313
314
315
316
317
318

319
320
321
322

323
324
325
326
327
328
329
330

331
332
333
334
335

336
337

338
339
340
341
342
343
344
345
346
347
348



349
350
351
352
353
354
355
356
357
358
359
360
361
362








-
+









+
+
+
+
+
+


-
+













-
-
-
-
-
-
+
+
+
+
+
+
-




-
+







-
+




-
+

-
+










-
-
-
+
+
+


+
+








..
.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
package require \fBtls 2\&.0b2\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
\fBtls::import\fR \fIchannel\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR?
.sp
\fBtls::starttls\fR \fIchannel\fR ?\fI-option\fR? ?\fIvalue\fR? ?\fI-option value \&.\&.\&.\fR?
.sp
\fBtls::handshake\fR \fIchannel\fR
.sp
\fBtls::shutdown\fR \fIchannel\fR
.sp
\fBtls::unimport\fR \fIchannel\fR
.sp
\fBtls::handshake\fR \fIchannel\fR
\fBtls::unstack\fR \fIchannel\fR
.sp
\fBtls::status\fR ?\fB-local\fR? \fIchannel\fR
.sp
\fBtls::connection\fR \fIchannel\fR
.sp
\fBtls::ciphers\fR ?\fIprotocol\fR? ?\fIverbose\fR? ?\fIsupported\fR?
.sp
\fBtls::protocols\fR
.sp
\fBtls::version\fR
.sp
.BE
.SH DESCRIPTION
This extension provides TCL script access to secure socket 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 and higher\&.
These sockets behave exactly the same as channels created using the built-in
\fBsocket\fR command, but provide additional options for controlling
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\&.
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 the
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 TLS related ones\&.
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
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\&.
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, 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\&.
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?
.TP
\fBtls::starttls\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




︙


408
409
410
411
412
413
414
415

416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437



438
439
440
441
442
443
444
445
446
447

448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467

468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486

487
488
489
490
491

492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518










519
520
521
522
523
524


525
526
527
528
529
530
531

415
416
417
418
419
420
421

422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442


443
444
445
446
447
448
449
450
451
452
453
454

455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474

475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493

494
495
496
497
498

499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516





517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535


536
537
538
539
540
541
542
543
544








-
+




















-
-
+
+
+









-
+



















-
+


















-
+




-
+

















-
-
-
-
-





+
+
+
+
+
+
+
+
+
+




-
-
+
+








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 \fI-certfile\fR option\&.
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\&. 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\&.
\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\&.
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\&.
default to the host from 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 \fI-security_level\fR option\&.
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 \fI-security_level\fR option\&.
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
\fBtls::handshake\fR \fIchannel\fR
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\&.
.TP
\fBtls::shutdown\fR \fIchannel\fR
.TP
\fBtls::unimport\fR \fIchannel\fR
.TP
\fBtls::unstack\fR \fIchannel\fR
This terminates the SSL/TLS session by sending the "close_notify" message and
removes the top level stacked channel from \fIchannel\fR, but it does not close
the socket\&. It is the compliment to \fBtls::import\fR by ending encryption of
a TCL channel\&. An error is thrown if TLS is not the top stacked channel type\&.
.TP
\fBtls::status\fR ?\fB-local\fR? \fIchannel\fR
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
\fB-local\fR option is specified, then the local certificate is used\&. Returned
values include:
\fB-local\fR option is specified, then the local certificate is used\&.
Returned 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\&.




︙


815
816
817
818
819
820
821
822

823
824
825
826
827
828
829

828
829
830
831
832
833
834

835
836
837
838
839
840
841
842








-
+








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 tp specify where to find the CA certificates\&.
\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




︙


847
848
849
850
851
852
853
854

855
856
857
858
859
860
861
862
863




864
865
866
867
868
869
870
871
872

873
874
875
876
877
878
879
880
881
882



883
884
885
886
887
888
889
890
891
892
893
894
895
896

897
898
899
900
901
902
903

860
861
862
863
864
865
866

867

868
869
870
871




872
873
874
875
876
877
878
879
880
881
882
883

884
885
886
887
888
889
890
891



892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907

908
909
910
911
912
913
914
915








-
+
-




-
-
-
-
+
+
+
+








-
+







-
-
-
+
+
+













-
+








.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\&. See
not specified\&. This store only supports root certificate stores\&.
\fBCertificate Validation\fR for more details\&.
.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\&. 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 \fI-validatecommand\fR option\&.
\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\&.
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, this 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:
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 utilized by
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




︙


1023
1024
1025
1026
1027
1028
1029
1030

1031
1032

1033
1034
1035
1036
1037
1038
1039
1040
1041
1042

1043
1044

1045
1046
1047
1048
1049
1050
1051

1035
1036
1037
1038
1039
1040
1041

1042
1043

1044
1045
1046
1047
1048
1049
1050
1051
1052
1053

1054
1055

1056
1057
1058
1059
1060
1061
1062
1063








-
+

-
+









-
+

-
+








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 ALPN callbacks\&.
after the Hello and SNI callbacks\&.
.TP
\fBhello\fR \fIchannelId servername\fR
\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</b>\fR option\&. The
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
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




︙


1170
1171
1172
1173
1174
1175
1176
1177

1178






















1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191

1182
1183
1184
1185
1186
1187
1188

1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225








-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














::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 commands to obtain the supported
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
\fIhandshake failed: certificate verify failed due to "unable to get local issuer certificate"\fR
The certificates in the CA file or certificate store either do not have one or
more issuers of the certificates you are validating or they have expired\&.
Usually this means you need an updated CAcert file\&.
.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
The peer has closed the connection without sending the "close notify" shutdown
alert\&. Some servers will terminate the connection after the file or webpage has
been sent without sending the "close notify" message\&. In this case, it should
not result in a loss of data\&.
.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








Changes to generic/tls.c.



1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21














-
+








/*
 * 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 Brian O'Hagan
 *	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)




︙


29
30
31
32
33
34
35




36
37
38
39
40
41
42

29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46








+
+
+
+








#include <stdio.h>
#include <stdlib.h>
#include <openssl/ssl.h>
#include <openssl/crypto.h>
#include <openssl/opensslconf.h>
#include <openssl/rsa.h>
#include <openssl/safestack.h>
#if OPENSSL_VERSION_NUMBER < 0x30000000L
    #include <openssl/bn.h>
    #include <openssl/dh.h>
#endif

/* Min OpenSSL version */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
#error "Only OpenSSL v1.1.1 or later is supported"
#endif






︙


80
81
82
83
84
85
86
87

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104

105
106
107
108
109
110
111

112
113
114
115
116
117
118

84
85
86
87
88
89
90

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

108
109
110
111
112
113
114

115
116
117
118
119
120
121
122








-
+
















-
+






-
+








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

    dprintf("Called");

    Tcl_Preserve((void *) interp);
    Tcl_Preserve((void *) statePtr);

    /* Eval callback with success for ok or return value 1, fail for error or return value 0 */
    Tcl_ResetResult(interp);
    code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    dprintf("EvalCallback: %d", code);
    dprintf("EvalCallback code: %d", code);
    if (code == TCL_OK) {
	/* Check result for return value */
	Tcl_Obj *result = Tcl_GetObjResult(interp);
	if (result == NULL || Tcl_GetIntFromObj(interp, result, &ok) != TCL_OK) {
	    ok = 1;
	}
	dprintf("Result: %d", ok);
	dprintf("Result boolean: %d", ok);
    } else {
	/* Error - reject the certificate */
	dprintf("Tcl_BackgroundError");
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
	Tcl_BackgroundError(interp);
#else
	Tcl_BackgroundException(interp, code);




︙


135
136
137
138
139
140
141
142

143
144
145
146
147
148
149

139
140
141
142
143
144
145

146
147
148
149
150
151
152
153








-
+








 *	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);




︙


212
213
214
215
216
217
218
219

220
221
222
223
224
225
226
227
228
229
230
231
232
233
234

235
236
237
238
239
240
241

216
217
218
219
220
221
222

223
224
225
226
227
228
229
230
231
232
233
234
235
236
237

238
239
240
241
242
243
244
245








-
+














-
+








 *	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 */
    size_t len,			/* Protocol message length */
    SSL *ssl,			/* SSL context */
    void *arg)			/* Client state for TLS socket */
{
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    char *ver, *type;
    const char *ver, *type;
    BIO *bio;
    char buffer[15000];
    Tcl_Size blen = 0;
    buffer[0] = 0;

    dprintf("Called");





︙


362
363
364
365
366
367
368
369

370
371
372
373
374
375
376

366
367
368
369
370
371
372

373
374
375
376
377
378
379
380








-
+








 *
 * 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());




︙


432
433
434
435
436
437
438
439

440
441
442
443
444
445
446

436
437
438
439
440
441
442

443
444
445
446
447
448
449
450








-
+








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




︙


490
491
492
493
494
495
496
497

498
499

500
501
502
503
504
505
506

494
495
496
497
498
499
500

501
502

503
504
505
506
507
508
509
510








-
+

-
+








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

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

    dprintf("Called");





︙


527
528
529
530
531
532
533
534

535
536
537
538
539
540
541

531
532
533
534
535
536
537

538
539
540
541
542
543
544
545








-
+








 *	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 */
{




︙


612
613
614
615
616
617
618
619

620
621
622
623
624
625
626

616
617
618
619
620
621
622

623
624
625
626
627
628
629
630








-
+








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




︙


685
686
687
688
689
690
691
692

693
694
695
696
697
698
699

689
690
691
692
693
694
695

696
697
698
699
700
701
702
703








-
+








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




︙


707
708
709
710
711
712
713
714

715
716
717
718
719
720
721

711
712
713
714
715
716
717

718
719
720
721
722
723
724
725








-
+








    dprintf("Called");

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

    /* Select protocol */
    if (SSL_select_next_proto((unsigned char **) out, outlen, statePtr->protos, statePtr->protos_len,
    if (SSL_select_next_proto((unsigned char **) out, outlen, statePtr->protos, (unsigned)statePtr->protos_len,
	in, inlen) == OPENSSL_NPN_NEGOTIATED) {
	/* Match found */
	res = SSL_TLSEXT_ERR_OK;
    } else {
	/* OPENSSL_NPN_NO_OVERLAP = No overlap, so use first item from client protocol list */
	res = SSL_TLSEXT_ERR_NOACK;
    }




︙


760
761
762
763
764
765
766
767

768
769
770
771
772
773
774

764
765
766
767
768
769
770

771
772
773
774
775
776
777
778








-
+








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




︙


797
798
799
800
801
802
803


804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822

823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841

842


843
844
845
846
847
848
849

801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827

828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848

849
850
851
852
853
854
855
856
857








+
+


















-
+



















+
-
+
+








/*
 *-------------------------------------------------------------------
 *
 * 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);
	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;
    }




︙


892
893
894
895
896
897
898
899

900
901
902
903
904
905
906
907
908
909
910
911
912


913
914
915
916
917
918
919
920
921
922
923
924
925
926







927
928
929
930
931
932
933
934
935








936
937
938
939
940
941
942






943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958






















959
960
961
962
963

964
965
966
967
968
969
970

900
901
902
903
904
905
906

907
908
909
910
911
912
913
914
915
916
917
918


919
920
921
922
923
924
925
926
927
928
929





930
931
932
933
934
935
936
937








938
939
940
941
942
943
944
945
946






947
948
949
950
951
952
953















954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988








-
+











-
-
+
+









-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+








 * 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;
    size_t len, remaining;
    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 names */
    if (!SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining) || remaining <= 2) {
	*alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER;
	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;
	/* Extract the length of the supplied list of names. */
	len = (size_t)(*(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--;
	/* 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;

    /* Create command to eval with fn, chan, and server name args */
	/* 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 = (size_t)(*(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) {




︙


993
994
995
996
997
998
999
1000

1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021


1022
1023
1024
1025
1026


1027
1028


1029
1030
1031

























































1032
1033
1034

1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096



1097
1098
1099
1100
1101
1102
1103

1011
1012
1013
1014
1015
1016
1017

1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037


1038
1039
1040
1041
1042


1043
1044
1045
1046
1047
1048



1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115



















































1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130








-
+



















-
-
+
+



-
-
+
+


+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





+
+
+








 *	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
};

static int
CiphersObjCmd(
    TCL_UNUSED(ClientData),	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Arg count */
    Tcl_Obj *const objv[])	/* Arguments as Tcl objects */
{
    Tcl_Obj *objPtr = NULL;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    char buf[BUFSIZ];
    int index, verbose = 0, use_supported = 0;
    const SSL_METHOD *method;
    int index, verbose = 0, use_supported = 0, version = 0;
    const SSL_METHOD *method = TLS_method();

    dprintf("Called");

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?");
    if ((objc < 1) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?protocol? ?verbose? ?supported?");
	return TCL_ERROR;
    }

    if (objc > 1) {
    if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }
	if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	} else {
	    switch ((enum protocol)index) {
		case TLS_SSL2:
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
		    version = -1;
#else
		    version = SSL2_VERSION;
#endif
		    break;
		case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
		    version = -1;
#else
		    version = SSL3_VERSION;
#endif
		    break;
		case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
		    version = -1;
#else
		    version = TLS1_VERSION;
#endif
		    break;
		case TLS_TLS1_1:
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
		    version = -1;
#else
		    version = TLS1_1_VERSION;
#endif
		    break;
		case TLS_TLS1_2:
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
		    version = -1;
#else
		    version = TLS1_2_VERSION;
#endif
		    break;
		case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
		    version = -1;
#else
		    version = TLS1_3_VERSION;
#endif
		    break;
		default:
		    version = -1;
		}
        }

	if (version < 0) {
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	    return TCL_ERROR;
	}
    }

    if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) {
	return TCL_ERROR;
    }

    if ((objc > 3) && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK) {
	return TCL_ERROR;
    }

    ERR_clear_error();

    switch ((enum protocol)index) {
	case TLS_SSL2:
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	    return TCL_ERROR;
#else
	    method = SSLv2_method(); break;
#endif
	case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	    return TCL_ERROR;
#else
	    method = SSLv3_method(); break;
#endif
	case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	    return TCL_ERROR;
#else
	    method = TLSv1_method(); break;
#endif
	case TLS_TLS1_1:
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	    return TCL_ERROR;
#else
	    method = TLSv1_1_method(); break;
#endif
	case TLS_TLS1_2:
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	    return TCL_ERROR;
#else
	    method = TLSv1_2_method(); break;
#endif
	case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	    return TCL_ERROR;
#else
	    method = TLS_method();
	    SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
	    SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
	    break;
#endif
	default:
	    method = TLS_method();
	    break;
    }

    ctx = SSL_CTX_new(method);
    if (ctx == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
	return TCL_ERROR;
    }

    SSL_CTX_set_min_proto_version(ctx, version);
    SSL_CTX_set_max_proto_version(ctx, version);

    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }




︙


1136
1137
1138
1139
1140
1141
1142


1143
1144
1145
1146
1147
1148
1149

1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178








+
+








		    Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8);
		}
	    }
	}
	if (use_supported) {
	    sk_SSL_CIPHER_free(sk);
	}
    } else {
	objPtr = Tcl_NewStringObj("",0);
    }
    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}




︙


1348
1349
1350
1351
1352
1353
1354
1355

1356
1357
1358
1359
1360
1361
1362

1377
1378
1379
1380
1381
1382
1383

1384
1385
1386
1387
1388
1389
1390
1391








-
+








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




︙


1421
1422
1423
1424
1425
1426
1427










1428
1429
1430
1431
1432

1433
1434
1435
1436
1437
1438
1439

1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474
1475
1476
1477
1478








+
+
+
+
+
+
+
+
+
+




-
+








	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 == 0)		verify = SSL_VERIFY_NONE;
    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);




︙


1610
1611
1612
1613
1614
1615
1616
1617
1618


1619
1620

1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635


1636
1637

1638
1639
1640
1641

1642
1643
1644


1645
1646
1647
1648
1649
1650
1651
1652

1653
1654









1655

1656


1657
1658
1659
1660
1661
1662
1663

1649
1650
1651
1652
1653
1654
1655


1656
1657
1658

1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672


1673
1674
1675

1676
1677
1678
1679

1680
1681


1682
1683
1684
1685
1686
1687
1688
1689
1690

1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704

1705
1706
1707
1708
1709
1710
1711
1712
1713








-
-
+
+

-
+













-
-
+
+

-
+



-
+

-
-
+
+







-
+


+
+
+
+
+
+
+
+
+

+
-
+
+








	}
    }

    /* 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, *p;
	unsigned int protos_len = 0;
	unsigned char *protos = NULL, *p;
	size_t protos_len = 0;
	Tcl_Size cnt, i;
	int j;
	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);
		Tls_Free((tls_free_type *) statePtr);
		return TCL_ERROR;
		res = TCL_ERROR;
		goto done;
	    }
	    protos_len += 1 + (int) len;
	    protos_len += 1 + (size_t)len;
	}

	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	protos = (unsigned char *)ckalloc(protos_len);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (j = 0, p = protos; j < cnt; j++) {
	    char *str = Tcl_GetStringFromObj(list[j], &len);
	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)) {
	if (SSL_set_alpn_protos(statePtr->ssl, protos, (unsigned)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);
		ckfree(protos);
	    }
	    return TCL_ERROR;
	}

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




︙


1705
1706
1707
1708
1709
1710
1711

1712
1713
1714
1715
1716
1717
1718

1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769








+








	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




︙


1843
1844
1845
1846
1847
1848
1849
1850

1851
1852
1853
1854
1855
1856
1857

1894
1895
1896
1897
1898
1899
1900

1901
1902
1903
1904
1905
1906
1907
1908








-
+








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




︙


1876
1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887
1888
1889
1890

1927
1928
1929
1930
1931
1932
1933

1934
1935
1936
1937
1938
1939
1940
1941








-
+








    if (Tcl_ReadChars(in, buf, -1, 0) < 0) {
	Tcl_Close(interp, in);
	goto cleanup;
    }
    Tcl_Close(interp, in);

    data = (const void *) Tcl_GetByteArrayFromObj(buf, &len);
    bio = BIO_new_mem_buf(data, len);
    bio = BIO_new_mem_buf(data, (int)len);
    if (bio == NULL) {
	goto cleanup;
    }

    /* Where the certs go */
    store = SSL_CTX_get_cert_store(ctx);
    if (store == NULL) {




︙


1982
1983
1984
1985
1986
1987
1988

1989

1990
1991

1992
1993
1994
1995
1996
1997
1998
1999

2000
2001

2002
2003
2004
2005
2006
2007
2008


2009
2010
2011
2012
2013

2014
2015
2016
2017
2018
2019
2020
2021
2022
2023

2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045


2046
2047
2048
2049
2050
2051


2052
2053
2054
2055


2056
2057
2058


2059
2060


2061
2062
2063
2064
2065
2066


2067
2068
2069
2070


2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092


2093
2094

2095
2096
2097

2098
2099
2100

2101
2102
2103
2104
2105











2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117

2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138

2139
2140
2141

2142
2143
2144
2145
2146
2147
2148

2149
2150
2151
2152
2153


2154

2155
2156
2157
2158
2159
2160
2161
2162

2163
2164
2165
2166


2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187

2188

2189
2190
2191
2192



























2193
2194
2195
2196
2197


2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211

2212
2213
2214
2215
2216
2217
2218

2033
2034
2035
2036
2037
2038
2039
2040

2041
2042
2043
2044
2045
2046
2047





2048


2049







2050
2051



2052

2053




2054





2055






















2056
2057


2058



2059
2060




2061
2062


2063
2064
2065


2066
2067


2068



2069
2070




2071
2072



2073


















2074
2075
2076

2077
2078


2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103








2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115

2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127

2128
2129
2130
2131
2132
2133
2134

2135
2136
2137
2138
2139

2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150

2151
2152
2153
2154

2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165

2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177

2178
2179
2180
2181

2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211


2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226

2227
2228
2229
2230
2231
2232
2233
2234








+
-
+


+



-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
+
+
-
-
-

-
+
-
-
-
-

-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-

-
-
-
+
+
-
-
-
-
+
+
-
-

+
+
-
-
+
+
-
-

-
-
-
+
+
-
-
-
-
+
+
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+

-
+

-
-
+



+





+
+
+
+
+
+
+
+
+
+
+




-
-
-
-
-
-
-
-
+











-









+


-
+






-
+




-
+
+

+







-
+



-
+
+









-











+
-
+



-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+













-
+








    char *ciphersuites,		/* List of cipher suites */
    int level,			/* Security level */
    char *DHparams)		/* DH parameters */
{
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
    uint64_t off = 0;
    int off = 0, abort = 0;
    int abort = 0;
    int load_private_key;
    const SSL_METHOD *method;
    method = isServer ? TLS_server_method() : TLS_client_method();

    dprintf("Called");

    if (!proto) {
	Tcl_AppendResult(interp, "no valid protocol selected", (char *)NULL);
	return NULL;
    }

    /* Get user defined allowed protocols */
    /* create SSL context */
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
#if OPENSSL_VERSION_NUMBER < 0x10100000L
    if (ENABLED(proto, TLS_PROTO_SSL2)) {
	Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
#if !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    if (!(proto & TLS_PROTO_SSL2))
	Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
	off |= SSL_OP_NO_SSLv2;
    if (ENABLED(proto, TLS_PROTO_TLS1)) {
	Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
	Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *)NULL);
	return NULL;
    }

#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
	Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
	Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *)NULL);
	return NULL;
    }
#endif
    if (proto == 0) {
	/* Use full range */
	SSL_CTX_set_min_proto_version(ctx, 0);
	SSL_CTX_set_max_proto_version(ctx, 0);
    }

    switch (proto) {
#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    case TLS_PROTO_SSL2:
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3)
    if (!(proto & TLS_PROTO_SSL3))
	method = isServer ? SSLv2_server_method() : SSLv2_client_method();
	break;
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD)
    case TLS_PROTO_SSL3:
	method = isServer ? SSLv3_server_method() : SSLv3_client_method();
	off |= SSL_OP_NO_SSLv3;

	break;
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
    case TLS_PROTO_TLS1:
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1)
    if (!(proto & TLS_PROTO_TLS1))
	method = isServer ? TLSv1_server_method() : TLSv1_client_method();
	break;
#endif
	off |= SSL_OP_NO_TLSv1;

#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
    case TLS_PROTO_TLS1_1:
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1)
    if (!(proto & TLS_PROTO_TLS1_1))
	method = isServer ? TLSv1_1_server_method() : TLSv1_1_client_method();
	break;
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    case TLS_PROTO_TLS1_2:
	method = isServer ? TLSv1_2_server_method() : TLSv1_2_client_method();
	off |= SSL_OP_NO_TLSv1_1;

	break;
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    case TLS_PROTO_TLS1_3:
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2)
    if (!(proto & TLS_PROTO_TLS1_2))
	/* Use the generic method and constraint range after context is created */
	method = isServer ? TLS_server_method() : TLS_client_method();
	break;
#endif
    default:
	/* Negotiate highest available SSL/TLS version */
	method = isServer ? TLS_server_method() : TLS_client_method();
#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
	off |= (ENABLED(proto, TLS_PROTO_SSL2)   ? 0 : SSL_OP_NO_SSLv2);
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3)
	off |= (ENABLED(proto, TLS_PROTO_SSL3)   ? 0 : SSL_OP_NO_SSLv3);
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1)
	off |= (ENABLED(proto, TLS_PROTO_TLS1)   ? 0 : SSL_OP_NO_TLSv1);
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1);
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
	off |= SSL_OP_NO_TLSv1_2;

#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3);
    if (!(proto & TLS_PROTO_TLS1_3))
#endif
	break;
    }
	off |= SSL_OP_NO_TLSv1_3;

    ERR_clear_error();

    /* Create context */
    ctx = SSL_CTX_new(method);
    if (!ctx) {
	return NULL;
    }

    /* Specify allowed protocol range */
    if (!proto) {
	SSL_CTX_set_min_proto_version(ctx, TLS1_2_VERSION);
	SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
    } else {
	SSL_CTX_set_min_proto_version(ctx, 0); /* Support all */
	SSL_CTX_set_max_proto_version(ctx, 0);
	SSL_CTX_set_options(ctx, off);	/* Disable specific protocol versions */
    }

    /* Set crypyo key log file */
    if (getenv(SSLKEYLOGFILE)) {
	SSL_CTX_set_keylog_callback(ctx, KeyLogCallback);
    }

#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    if (proto == TLS_PROTO_TLS1_3) {
	SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION);
	SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION);
    }
#endif

    /* Force cipher selection order by server */
    /* Force client cipher selection order to set by server */
    if (!isServer) {
	SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
    }

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_algorithms(); /* Load ciphers and digests */
#endif

    SSL_CTX_set_app_data(ctx, (void*)interp);	/* remember the interpreter */
    SSL_CTX_set_options(ctx, SSL_OP_ALL);	/* Enable all SSL bug workarounds */
    SSL_CTX_set_options(ctx, SSL_OP_NO_COMPRESSION);	/* Disable compression even if supported */
    SSL_CTX_set_options(ctx, off);		/* Disable specified protocol versions */

    /* Allow writes to report success when less than all records have been written */
    SSL_CTX_set_mode(ctx, SSL_MODE_ENABLE_PARTIAL_WRITE);

    /* Disable attempts to try to process the next record instead of returning after a
       non-app record. Avoids hangs in blocking mode, when using SSL_read() and a
       non-application record was sent without any application data. */
    /*SSL_CTX_clear_mode(ctx, SSL_MODE_AUTO_RETRY);*/

    /* Set number of sessions to cache */
    SSL_CTX_sess_set_cache_size(ctx, 128);

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

    /* set automatic curve selection */
    /* Set automatic curve selection */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
    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 some callbacks */
    /* Set get password callback */
    SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback);
    SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr);

    /* read a Diffie-Hellman parameters file, or use the built-in one */
    /* Set Diffie-Hellman parameters from file, or use the built-in one.
     * Used by servers requiring ephemeral DH keys. */
    Tcl_DStringInit(&ds);
#ifdef OPENSSL_NO_DH
    if (DHparams != NULL) {
	Tcl_AppendResult(interp, "DH parameter support not available", (char *)NULL);
	SSL_CTX_free(ctx);
	return NULL;
    }
#else
    {
	DH* dh;
	if (DHparams != NULL) {
	    BIO *bio;

	    bio = BIO_new_file(F2N(DHparams, &ds), "r");
	    if (!bio) {
		Tcl_DStringFree(&ds);
		Tcl_AppendResult(interp, "Could not find DH parameters file", (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }

#if OPENSSL_VERSION_NUMBER < 0x30000000L
	    dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL);
	    DH* dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL);
	    BIO_free(bio);
	    Tcl_DStringFree(&ds);
	    if (!dh) {
		Tcl_AppendResult(interp, "Could not read DH parameters from file", (char *)NULL);
		Tcl_AppendResult(interp, "Could not read DH parameters from file: ",
		    GET_ERR_REASON(), (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    if (!SSL_CTX_set_tmp_dh(ctx, dh)) {
		Tcl_AppendResult(interp, "Could not set DH parameters from file: ",
		    GET_ERR_REASON(), (char *)NULL);
		DH_free(dh);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    DH_free(dh);
	    dprintf("Diffie-Hellman initialized with %d bit key", 8 * DH_size(dh));
#else
	    EVP_PKEY *dh = PEM_read_bio_Parameters(bio, NULL);
	    BIO_free(bio);
	    Tcl_DStringFree(&ds);
	    if (!dh) {
		Tcl_AppendResult(interp, "Could not read DH parameters from file: ",
		    GET_ERR_REASON(), (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    if (!SSL_CTX_set0_tmp_dh_pkey(ctx, dh)) {
		Tcl_AppendResult(interp, "Could not set DH parameters from file: ",
		    GET_ERR_REASON(), (char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    SSL_CTX_set_tmp_dh(ctx, dh);
	    DH_free(dh);
	    dprintf("Diffie-Hellman initialized with %d bit key", 8 * EVP_PKEY_get_size(dh));
#endif

	} else {
	    /* Use well known DH parameters that have built-in support in OpenSSL */
	    if (!SSL_CTX_set_dh_auto(ctx, 1)) {
		Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(),
			(char *)NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	}
    }
#endif

    /* set our certificate */
    /* Set our certificate */
    load_private_key = 0;
    if (certfile != NULL) {
	load_private_key = 1;

	if (SSL_CTX_use_certificate_file(ctx, F2N(certfile, &ds), SSL_FILETYPE_PEM) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp, "unable to set certificate file ", certfile, ": ",




︙


2239
2240
2241
2242
2243
2244
2245
2246

2247
2248
2249
2250
2251
2252
2253

2255
2256
2257
2258
2259
2260
2261

2262
2263
2264
2265
2266
2267
2268
2269








-
+








		    GET_ERR_REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
#endif
	}
    }

    /* set our private key */
    /* Set our private key */
    if (load_private_key) {
	if (keyfile == NULL && key == NULL) {
	    keyfile = certfile;
	}

	if (keyfile != NULL) {
	    /* get the private key associated with this certificate */




︙


2339
2340
2341
2342
2343
2344
2345

2346
2347
2348
2349

2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369

2370
2371
2372
2373
2374
2375
2376

2355
2356
2357
2358
2359
2360
2361
2362
2363
2364

2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394








+


-

+




















+








	/* 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_Obj *fstype = NULL;
		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);
	}




︙


2392
2393
2394
2395
2396
2397
2398
2399

2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415


2416
2417
2418
2419
2420
2421
2422

2410
2411
2412
2413
2414
2415
2416

2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432

2433
2434
2435
2436
2437
2438
2439
2440
2441








-
+















-
+
+








 *	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 */
{
    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;
    const unsigned char *proto;
    unsigned int len;
    int nid, res;
    int nid;
    long res;

    dprintf("Called");

    if (objc < 2 || objc > 3 || (objc == 3 && !strcmp(Tcl_GetString(objv[1]), "-local"))) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	return TCL_ERROR;
    }




︙


2436
2437
2438
2439
2440
2441
2442

2443



2444
2445
2446
2447
2448
2449
2450

2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473








+

+
+
+








	Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }
    statePtr = (State *) Tcl_GetChannelInstanceData(chan);

    /* Get certificate for peer or self */
    if (objc == 2) {
#if OPENSSL_VERSION_NUMBER < 0x30000000L
	peer = SSL_get_peer_certificate(statePtr->ssl);
#else
	peer = SSL_get1_peer_certificate(statePtr->ssl);
#endif
    } else {
	peer = SSL_get_certificate(statePtr->ssl);
    }
    /* Get X509 certificate info */
    if (peer) {
	objPtr = Tls_NewX509Obj(interp, peer, 1);
	if (objc == 2) {




︙


2696
2697
2698
2699
2700
2701
2702

2703



2704
2705
2706
2707
2708
2709
2710

2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737








+

+
+
+








	LAPPEND_STR(interp, objPtr, "npn", (char *) proto, (Tcl_Size) ulen);
#endif

	/* Resumable session */
	LAPPEND_BOOL(interp, objPtr, "resumable", SSL_SESSION_is_resumable(session));

	/* Session start time (seconds since epoch) */
#if OPENSSL_VERSION_NUMBER < 0x30300000L
	LAPPEND_LONG(interp, objPtr, "start_time", SSL_SESSION_get_time(session));
#else
	LAPPEND_WIDE(interp, objPtr, "start_time", SSL_SESSION_get_time_ex(session));
#endif

	/* Timeout value - SSL_CTX_get_timeout (in seconds) */
	LAPPEND_LONG(interp, objPtr, "timeout", SSL_SESSION_get_timeout(session));

	/* Session id - TLSv1.2 and below only */
	session_id = SSL_SESSION_get_id(session, &ulen);
	LAPPEND_BARRAY(interp, objPtr, "session_id", session_id, (Tcl_Size) ulen);




︙


2749
2750
2751
2752
2753
2754
2755
2756

2757
2758
2759
2760
2761
2762
2763

2776
2777
2778
2779
2780
2781
2782

2783
2784
2785
2786
2787
2788
2789
2790








-
+








	LAPPEND_STR(interp, objPtr, "expansion", "none", -1);
#endif
    }

    /* Server info */
    {
	long mode = SSL_CTX_get_session_cache_mode(statePtr->ctx);
	char *msg;
	const char *msg;

	if (mode & SSL_SESS_CACHE_OFF) {
	    msg = "off";
	} else if (mode & SSL_SESS_CACHE_CLIENT) {
	    msg = "client";
	} else if (mode & SSL_SESS_CACHE_SERVER) {
	    msg = "server";




︙


2799
2800
2801
2802
2803
2804
2805
2806

2807
2808
2809
2810
2811
2812
2813

2826
2827
2828
2829
2830
2831
2832

2833
2834
2835
2836
2837
2838
2839
2840








-
+








 *	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 */
{




︙


2830
2831
2832
2833
2834
2835
2836
2837

2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848

2849
2850
2851
2852
2853
2854
2855

2857
2858
2859
2860
2861
2862
2863

2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883








-
+











+








 *	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;
    }




︙


2867
2868
2869
2870
2871
2872
2873
2874

2875
2876
2877
2878
2879
2880
2881

2895
2896
2897
2898
2899
2900
2901

2902
2903
2904
2905
2906
2907
2908
2909








-
+








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

	    BIO *out=NULL;

	    const char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
	    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




︙


2900
2901
2902
2903
2904
2905
2906
2907

2908
2909
2910
2911
2912
2913




2914
2915
2916




2917
2918


2919
2920


2921
2922


2923
2924


2925
2926


2927
2928


2929
2930


2931
2932
2933


2934







2935
2936
2937
2938
2939
2940
2941

2928
2929
2930
2931
2932
2933
2934

2935
2936
2937
2938
2939


2940
2941
2942
2943
2944


2945
2946
2947
2948
2949

2950
2951
2952

2953
2954
2955

2956
2957
2958

2959
2960
2961

2962
2963
2964

2965
2966
2967

2968
2969
2970
2971

2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988








-
+




-
-
+
+
+
+

-
-
+
+
+
+

-
+
+

-
+
+

-
+
+

-
+
+

-
+
+

-
+
+

-
+
+


-
+
+

+
+
+
+
+
+
+








	    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);
		    return TCL_ERROR;
		    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)
			    return TCL_ERROR;
			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)
			    return TCL_ERROR;
			if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK) {
			    res = TCL_ERROR;
			    break;
			}
		    } else if (strcmp(str,"C")==0) {
			k_C=Tcl_GetString(listv[i+1]);
			k_C = listv[i+1];
			Tcl_IncrRefCount(k_C);
		    } else if (strcmp(str,"ST")==0) {
			k_ST=Tcl_GetString(listv[i+1]);
			k_ST = listv[i+1];
			Tcl_IncrRefCount(k_ST);
		    } else if (strcmp(str,"L")==0) {
			k_L=Tcl_GetString(listv[i+1]);
			k_L = listv[i+1];
			Tcl_IncrRefCount(k_L);
		    } else if (strcmp(str,"O")==0) {
			k_O=Tcl_GetString(listv[i+1]);
			k_O = listv[i+1];
			Tcl_IncrRefCount(k_O);
		    } else if (strcmp(str,"OU")==0) {
			k_OU=Tcl_GetString(listv[i+1]);
			k_OU = listv[i+1];
			Tcl_IncrRefCount(k_OU);
		    } else if (strcmp(str,"CN")==0) {
			k_CN=Tcl_GetString(listv[i+1]);
			k_CN = listv[i+1];
			Tcl_IncrRefCount(k_CN);
		    } else if (strcmp(str,"Email")==0) {
			k_Email=Tcl_GetString(listv[i+1]);
			k_Email = listv[i+1];
			Tcl_IncrRefCount(k_Email);
		    } else {
			Tcl_SetResult(interp,"Unknown parameter",NULL);
			return TCL_ERROR;
			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();




︙


2949
2950
2951
2952
2953
2954
2955
2956



2957



2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973

2974
2975
2976
2977
2978
2979
2980
2981


2982
2983
2984
2985
2986
2987
2988
2989
2990
2991






2992
2993
2994
2995
2996
2997
2998

















































2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009


3010
3011
3012
3013
3014
3015
3016

2996
2997
2998
2999
3000
3001
3002

3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024

3025
3026
3027
3028
3029
3030
3031
3032

3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050







3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109

3110
3111
3112
3113
3114
3115
3116
3117
3118








-
+
+
+

+
+
+















-
+







-
+
+










+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
+
+








	    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);
		return TCL_ERROR;
		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);
		    BIO_flush(out);
		    BIO_free(out);
		} else {
		    out=BIO_new(BIO_s_file());
		    BIO_write_filename(out,keyout);
		    PEM_write_bio_PrivateKey(out,pkey,NULL,NULL,0,NULL,NULL);
		    /* PEM_write_bio_RSAPrivateKey(out, rsa, NULL, NULL, 0, NULL, NULL); */
		    BIO_free_all(out);
	 	}
		}

		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
		    return TCL_ERROR;
		    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, (const unsigned char *) k_C, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (const unsigned char *) k_ST, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (const unsigned char *) k_L, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (const unsigned char *) k_O, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (const unsigned char *) k_OU, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, (const unsigned char *) k_CN, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, (const unsigned char *) k_Email, -1, -1, 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);
		    return TCL_ERROR;
		    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;




︙


3027
3028
3029
3030
3031
3032
3033





















3034
3035
3036
3037
3038
3039

3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093

3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104

3105
3106
3107
3108
3109
3110
3111

3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161

3162
3163
3164
3165
3166
3167
3168





























3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186

3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















-
+











+









		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 TCL_OK;
    return res;
}

/********************/
/* Init             */
/********************/

/*
 *-------------------------------------------------------------------
 *
 * 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);
}

/*
 *-------------------------------------------------------------------
 *
 * 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;
    }




︙


3144
3145
3146
3147
3148
3149
3150





























3151
3152
3153
3154
3155
3156
3157

3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








	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.




︙


3245
3246
3247
3248
3249
3250
3251
3252

3253
3254

3255
3256
3257
3258
3259
3260
3261

3369
3370
3371
3372
3373
3374
3375

3376
3377

3378
3379
3380
3381
3382
3383
3384
3385








-
+

-
+








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

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

    BIO_cleanup();
}

/*




︙


3269
3270
3271
3272
3273
3274
3275
3276

3277
3278
3279
3280
3281
3282
3283

3393
3394
3395
3396
3397
3398
3399

3400
3401
3402
3403
3404
3405
3406
3407








-
+








 *	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. */




︙


3346
3347
3348
3349
3350
3351
3352





3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365

3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483

3484


3485
3486
3487
3488
3489
3490
3491








+
+
+
+
+


-

-
-








	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "::tls::ciphers", CiphersObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::connection", ConnectionInfoObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::handshake", HandshakeObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::import", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::shutdown", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::starttls", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::unimport", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::unstack", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "::tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    BuildInfoCommand(interp);

    if (interp && Tcl_Eval(interp, tlsTclInitScript) != TCL_OK) {
	return TCL_ERROR;
    }





︙


3377
3378
3379
3380
3381
3382
3383
3384

3385
3386
3387
3388
3389
3390

3503
3504
3505
3506
3507
3508
3509

3510
3511
3512
3513
3514
3515
3516








-
+







 *	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);
}








Changes to generic/tlsBIO.c.



1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17







18
19
20
21
22
23
24
25
26







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43


44
45
46
47
48
49
50









51
52
53
54
55
56
57
58

59
60
61
62


63
64
65
66

67
68
69
70
71
72
73
74
75
76
77
78



79
80
81
82
83
84
85

1
2
3
4
5

6
7
8
9
10







11
12
13
14
15
16
17
18
19







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41


42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

67




68
69
70
71
72

73
74
75
76
77
78
79
80
81
82



83
84
85
86
87
88
89
90
91
92






-
+




-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+















-
-
+
+







+
+
+
+
+
+
+
+
+







-
+
-
-
-
-
+
+



-
+









-
-
-
+
+
+








/*
 * 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 Brian O'Hagan
 * Copyright (C) 2024-2025 Brian O'Hagan
 *
 */

/*
				Normal
		tlsBIO.c				tlsIO.c
 +------+                        +---+                                 +---+
 |      |Tcl_WriteRaw<--BioOutput|SSL|BIO_write<--TlsOutputProc<--Write|   |
 |socket|      <encrypted>       |BIO|            <unencrypted>        |App|
 |      |Tcl_ReadRaw --> BioInput|   |BIO_Read -->TlsInputProc --> Read|   |
 +------+                        +---+                                 +---+
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 <-- Write|     |
  |socket| <encrypted> | BIO |            <unencrypted>            | App |
  |      |<--  read <--|     |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 should retry operation based on error code. Same
 *	conditions as BIO_sock_should_retry function.
 *	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));

    if (code == EAGAIN || code == EWOULDBLOCK || code == ENOTCONN || code == EPROTO ||
    /* Check for non-blocking retry-able error codes, but skip ENOTCONN */
#ifdef _WIN32
	code == WSAEWOULDBLOCK ||
#endif
	code == EINTR || code == EINPROGRESS || code == EALREADY) {
    if (code == EWOULDBLOCK || code == EINPROGRESS || code == EALREADY || 
	code == EAGAIN || code == EPROTO || code == EINTR) {
	res = 1;
    }

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

    return res;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BioOutput --
 *
 *	This function is used to read encrypted data from the BIO and write it
 *	into the socket. This function will be called in response to the
 *	application calling the BIO_write_ex() or BIO_write() functions.
 *	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.




︙


141
142
143
144
145
146
147
148
149
150



151
152
153
154
155
156
157

158
159
160
161
162
163
164
165
166
167
168
169
170
171

148
149
150
151
152
153
154



155
156
157
158
159
160
161
162
163

164







165
166
167
168
169
170
171








-
-
-
+
+
+






-
+
-
-
-
-
-
-
-








}

/*
 *-----------------------------------------------------------------------------
 *
 * BioInput --
 *
 *	This function is used to read encrypted data from the socket and
 *	write it into the BIO. This function will be called in response to the
 *	application calling the BIO_read_ex() or BIO_read() functions.
 *	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.
 *	Reads channel data into BIO or sets retry flags.
 *
 * 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. 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 BioInput(BIO *bio, char *buf, int bufLen) {
    Tcl_Size ret = 0;
    int is_eof, tclErrno, is_blocked;




︙


185
186
187
188
189
190
191
192

193
194
195
196
197
198
199

185
186
187
188
189
190
191

192
193
194
195
196
197
198
199








-
+








    /* 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(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; blocked=%d; tclErrno=%d: %s]",
    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) {




︙


228
229
230
231
232
233
234
235


236
237
238

239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256


257
258
259
260
261
262
263

228
229
230
231
232
233
234

235
236
237
238

239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256

257
258
259
260
261
262
263
264
265








-
+
+


-
+

















-
+
+








 * 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 written to channel or 0 for error.
 *	Returns the number of bytes read from channel, 0 for EOF, or -1 for
 *	error.
 *
 * Side effects:
 *	Writes data to channel.
 *	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.
 *	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
 *




︙


271
272
273
274
275
276
277
278

279
280
281
282
283
284

285
286
287
288

289
290
291
292
293

294
295
296
297
298

299
300
301
302
303

304
305
306
307
308

309
310
311
312
313

314
315

316
317
318
319

320
321
322


323
324
325
326

327
328

329

330
331
332
333
334

335
336
337
338
339
340

341
342
343
344
345

346
347
348

349
350
351

352
353
354
355

356
357
358
359
360

361
362
363
364
365

366
367
368
369
370
371
372
373
374
375
376
377
378
379
380

381
382
383
384

385
386
387
388
389
390
391
392

393
394
395
396
397
398
399

273
274
275
276
277
278
279

280
281
282
283
284
285

286
287
288
289

290
291
292
293
294

295
296
297
298
299

300
301
302
303
304

305
306
307
308
309

310
311
312
313
314

315
316

317
318
319
320

321
322


323
324
325
326
327

328
329

330
331
332
333
334
335
336

337
338
339

340
341

342
343
344
345
346

347
348
349
350
351
352
353

354
355
356
357

358
359
360
361
362

363
364
365
366
367

368
369
370
371
372
373
374
375
376
377
378
379
380
381
382

383
384
385
386

387
388
389


390
391
392

393
394
395
396
397
398
399
400








-
+





-
+



-
+




-
+




-
+




-
+




-
+




-
+

-
+



-
+

-
-
+
+



-
+

-
+

+




-
+


-


-
+




-
+



+


-
+



-
+




-
+




-
+














-
+



-
+


-
-



-
+









    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 */
		/* 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 */
		/* 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 */
		/* 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 */
		/* man - set the 'IO' parameter. */
		dprintf("Got BIO_CTRL_SET");
		ret = 0;
		break;
	case BIO_CTRL_GET:
		/* man - get the 'IO' parameter */
		/* 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 */
		/* 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 */
		/* 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 */
		/* 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 */
		/* 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 */
		/* 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 */
		BIO_set_shutdown(bio, (int)num);
		/* Returns 1 on success or <=0 for failure. */
		ret = 1;
		break;
	case BIO_CTRL_PENDING:
		/* opt - Return number of bytes in BIO waiting to be read. Implements BIO_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 */
		/* 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 */
		/* 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);
		/*ret = BioOutput(bio, NULL, 0);*/
		break;
	case BIO_CTRL_DUP:
		/* man - extra stuff for 'duped' BIO. Implements BIO_dup_state */
		/* 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 BIO still to be written. Implements BIO_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 */
		/* 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 */
		/* 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() */
		/* 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() */
		/* 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 && defined(BIO_CTRL_GET_KTLS_SEND)
#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 */
		/* Returns 1 if the BIO is using the Kernel TLS data-path for sending, 0 if not. */
		ret = 0;
		break;
#endif
#if OPENSSL_VERSION_NUMBER >= 0x30000000L && defined(BIO_CTRL_GET_KTLS_RECV)
	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 */
		/* 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;




︙


408
409
410
411
412
413
414
415

416
417
418
419
420
421
422

409
410
411
412
413
414
415

416
417
418
419
420
421
422
423








-
+








 * 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)
 *	Returns boolean success result (1=success, 0=failure).
 *
 * Side effects:
 *	Initializes BIO structure.
 *
 *-----------------------------------------------------------------------------
 */





︙


439
440
441
442
443
444
445
446

447
448
449

450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465

466
467
468
469
470
471
472

440
441
442
443
444
445
446

447
448
449

450
451
452
453
454
455
456
457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
472
473








-
+


-
+














-

+








 * 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
 *	Returns boolean success result (1=success, 0=failure).
 *
 * Side effects:
 *	Initializes BIO structure.
 *	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_set_init(bio, 0);
	BIO_clear_flags(bio, -1);
	BIO_set_init(bio, 0);
    }
    return 1;
}

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




︙


494
495
496
497
498
499
500
501

502
503
504
505
506
507
508
509

495
496
497
498
499
500
501

502

503
504
505
506
507
508
509








-
+
-








#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 */
	/* BIO_TYPE_CONNECT = (12|BIO_TYPE_SOURCE_SINK|BIO_TYPE_DESCRIPTOR) */
	/* custom = BIO_get_new_index() | BIO_TYPE_SOURCE_SINK */
	/* BIO_TYPE_ACCEPT  = (13|BIO_TYPE_SOURCE_SINK|BIO_TYPE_DESCRIPTOR) */
	BioMethods = BIO_meth_new(BIO_TYPE_BIO, "tcl");
	if (BioMethods == NULL) {
	    dprintf("Memory allocation error");

	    return NULL;
	}
	/* Not used BIO_meth_set_write_ex */




︙







Changes to generic/tlsIO.c.



1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26







27
28
29
30
31
32
33
34
35







36
37
38
39
40
41
42
43
44
45
46

47
48


49
50
51
52
53
54
55
56
57
58
59
60
61
62


63
64
65
66
67
68
69

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19







20
21
22
23
24
25
26
27
28







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

46
47

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72







-
+












-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+










-
+

-
+
+














+
+








/*
 * 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 Brian O'Hagan
 * 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<--Write|   |
 |socket|      <encrypted>       |BIO|            <unencrypted>        |App|
 |      |Tcl_ReadRaw --> BioInput|   |BIO_Read -->TlsInputProc --> Read|   |
 +------+                        +---+                                 +---+
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 <-- Write|     |
  |socket| <encrypted> | BIO |            <unencrypted>            | App |
  |      |<--  read <--|     |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 channel to
 *	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.
 *	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;




︙


78
79
80
81
82
83
84
85

86
87
88
89
90
91

92
93
94
95

96
97
98
99
100
101






102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117









118
119
120
121
122
123
124
125
126
127

128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145


146
147
148

149
150
151
152
153
154
155
156
157

158
159

160
161
162

163
164
165
166
167
168
169
170

171

172
173
174
175
176
177
178
179
180
181
182
183
184
185
186

187
188
189
190
191
192
193

194
195
196
197

198
199
200
201

202
203
204

205
206
207
208
209
210
211
212
213
214


215
216
217

218
219

220
221

222


223
224

225
226
227
228
229
230
231

81
82
83
84
85
86
87

88
89
90
91
92
93

94
95
96
97

98
99





100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119


120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136


137

138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153

154
155
156
157

158
159
160
161
162
163
164
165
166

167


168
169
170
171
172
173
174
175
176
177
178
179
180
181

182




183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200

201
202
203
204

205
206
207
208

209
210
211

212

213
214
215
216
217
218
219


220
221



222


223
224
225
226

227
228
229

230
231
232
233
234
235
236
237








-
+





-
+



-
+

-
-
-
-
-
+
+
+
+
+
+














-
-
+
+
+
+
+
+
+
+
+








-
-
+
-
















-
+
+


-
+








-
+
-
-
+



+








+
-
+
-
-
-
-











+






-
+



-
+



-
+


-
+
-







-
-
+
+
-
-
-
+
-
-
+


+
-
+
+

-
+








 *	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 of the channel.
 *	Closes the socket for the channel.
 *
 *-----------------------------------------------------------------------------
 */
static int TlsCloseProc(
    ClientData instanceData,	/* Connection state info */
    Tcl_Interp *interp)		/* Tcl interpreter to report errors to */
    TCL_UNUSED(Tcl_Interp *))		/* Tcl interpreter to report errors to */
{
    State *statePtr = (State *) instanceData;

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

    /* Send shutdown notification. Will return 0 while in process, then 1 when
       complete. Only closes the write direction of the connection; the read
       direction is closed by the peer. Does not affect socket state. Don't
       call after fatal error. */
    if (statePtr->ssl != NULL && !(statePtr->flags & TLS_TCL_HANDSHAKE_FAILED)) {
    /* 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_INIT) &&
	    !(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 read and write
 *	side of channel.
 *	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);
    dprintf("TlsClose2Proc(%p)", (void *) statePtr);

    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 wait for connect, and -1 if failed.
 *	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:
 *	Issues SSL_accept or SSL_connect
 *	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;
    unsigned long err;
    int err, rc = 0;
    int bioShouldRetry;
    int ret, rc, reason, is_fatal, bioShouldRetry, io_err;
    *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_HANDSHAKE_FAILED) {
    if (statePtr->flags & TLS_TCL_FATAL_ERROR) {
	/*
	 * Different types of operations have different requirements
	 * SSL being established
	 */
	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;
    }

    for (;;) {
	Tcl_SetErrno(0);
	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()");
	    err = SSL_accept(statePtr->ssl);
	    ret = SSL_accept(statePtr->ssl);

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

	/* 1=successful, 0=not successful and shut down, <0=fatal error */
	if (err > 0) {
	if (ret > 0) {
	    dprintf("Accept or connect was successful");

	    err = BIO_flush(statePtr->bio);
	    if (BIO_flush(statePtr->bio) <= 0) {
	    if (err <= 0) {
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	} else {
	    dprintf("Accept or connect failed");
	}

	/* Same as SSL_want, but also checks the error queue */
	rc = SSL_get_error(statePtr->ssl, err);
	backingError = ERR_get_error();
	rc = SSL_get_error(statePtr->ssl, ret);
	err = ERR_get_error();
	if (rc != SSL_ERROR_NONE) {
	    dprintf("Got error: %i (rc = %i)", err, rc);
	    dprintf("Got error: %s", ERR_reason_error_string(backingError));
	reason = ERR_GET_REASON(err);
	}

	is_fatal = ERR_FATAL_ERROR(err);
	/* The retry flag is set by the BIO_set_retry_* functions */
	bioShouldRetry = BIO_should_retry(statePtr->bio);
	io_err = Tcl_GetErrno();
	dprintf("bioShouldRetry = %d", bioShouldRetry);
	dprintf("Connect: ret=%d, rc=%d, err=%ld, reason=%d, is_fatal=%d, lib=%s, msg=%s, bioShouldRetry=%d, errno=%d, id=%s, msg=%s", \
	    ret, rc, err, reason, is_fatal, ERR_lib_error_string(err), ERR_reason_error_string(err), bioShouldRetry, io_err, Tcl_ErrnoId(), Tcl_ErrnoMsg(io_err));

	if (err <= 0) {
	if (ret <= 0) {
	    if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT) {
		bioShouldRetry = 1;
	    } else if (rc == SSL_ERROR_WANT_READ) {
		bioShouldRetry = 1;
		statePtr->want |= TCL_READABLE;
	    } else if (rc == SSL_ERROR_WANT_WRITE) {
		bioShouldRetry = 1;




︙


246
247
248
249
250
251
252

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270


271

272
273


274
275
276
277
278
279

280
281
282
283
284
285
286
287
288
289

290
291
292
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307
308
309
310


311
312
313
314
315

316
317
318
319
320

321
322
323
324

325
326
327
328

329

330
331
332

333
334
335
336
337
338
339
340

341
342
343
344
345
346
347

348
349
350
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365
366
367
368

252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275


276
277
278
279


280
281
282
283
284
285
286

287
288
289

290
291
292
293
294
295

296
297
298

299
300
301
302
303
304

305
306
307
308

309
310
311
312
313
314

315
316
317
318
319
320

321
322
323
324
325
326
327
328
329
330

331
332
333
334
335
336

337
338


339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354

355
356
357
358

359
360
361
362
363

364
365
366
367

368
369
370
371
372
373
374








+
















-
-
+
+

+
-
-
+
+





-
+


-






-
+


-






-
+



-






-
+
+




-
+





+



-
+




+
-
+

-
-
+








+






-
+



-





-
+



-








	    }
	}

	dprintf("We have either completely established the session or completely failed it -- there is no more need to ever retry it though");
	break;
    }

    /* Based on error, do retry or abort */
    switch (rc) {
	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));
	    if (err != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(err));
	    }
	    *errorCodePtr = ECONNABORTED;
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *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");
	    dprintf("SSL_ERROR_WANT_READ: EAGAIN");
	    BIO_set_retry_read(statePtr->bio);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(SSL_ERROR_WANT_READ, 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");
	    dprintf("SSL_ERROR_WANT_WRITE: EAGAIN");
	    BIO_set_retry_write(statePtr->bio);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(SSL_ERROR_WANT_WRITE, 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");
	    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;
	    dprintf("ERR(SSL_ERROR_WANT_X509_LOOKUP, 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 && err == 0) {
	    if (err == 0 && ret == 0) {
		/* Unexpected EOF for 1.1.1 */
		dprintf("EOF reached")
		*errorCodePtr = ECONNRESET;
		Tls_Error(statePtr, "(unexpected) EOF reached");

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

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

	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    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");
	    dprintf("SSL_ERROR_WANT_CONNECT: EAGAIN");
	    BIO_set_retry_special(statePtr->bio);
	    BIO_set_retry_reason(statePtr->bio, BIO_RR_CONNECT);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(SSL_ERROR_WANT_CONNECT, 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");
	    dprintf("SSL_ERROR_WANT_ACCEPT: EAGAIN");
	    BIO_set_retry_special(statePtr->bio);
	    BIO_set_retry_reason(statePtr->bio, BIO_RR_ACCEPT);
	    *errorCodePtr = EAGAIN;
	    dprintf("ERR(SSL_ERROR_WANT_ACCEPT, 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




︙


393
394
395
396
397
398
399
400
401


402
403
404
405

406
407
408

409

410
411
412







413
414
415
416
417
418
419
420
421
422

423
424

425
426
427

428
429
430
431
432
433
434
435










436
437


438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453

454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471




472
473
474
475
476
477


478
479
480
481
482



483
484
485



486
487
488
489
490
491





492
493
494
495



496
497
498
499

500
501


502
503
504
505
506
507
508
509




510
511
512
513
514
515
516
517
518
519
520
521


522
523
524
525
526
527
528
529
530
531
532
533

534
535
536
537


538


539


540
541
542
543
544
545
546

399
400
401
402
403
404
405


406
407
408
409
410

411
412
413

414
415
416



417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432

433
434

435
436
437

438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456


457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489




490
491
492
493


494
495
496
497
498
499
500
501



502
503
504



505
506
507






508
509
510
511
512




513
514
515




516


517
518
519







520
521
522
523
524
525
526
527
528
529
530
531
532
533


534
535
536
537
538
539
540
541
542
543
544
545
546

547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566








-
-
+
+



-
+


-
+

+
-
-
-
+
+
+
+
+
+
+









-
+

-
+


-
+








+
+
+
+
+
+
+
+
+
+
-
-
+
+
















+














-
-
-
-
+
+
+
+
-
-




+
+


-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
+
-
-
+
+

-
-
-
-
-
-
-
+
+
+
+










-
-
+
+











-
+




+
+

+
+

+
+









/*
 *-----------------------------------------------------------------------------
 *
 * 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.
 *	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 none.
 *	a POSIX error code if an error occurred, or 0 if successful.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *	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.
 *	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;
    unsigned long err;
    State *statePtr = (State *) instanceData;
    int bytesRead, err;
    int bytesRead, rc, reason, is_fatal, bioShouldRetry, io_err;
    *errorCodePtr = 0;

    dprintf("Read(%d)", bufSize);
    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 connection has failed or EOF already detected. Can't read, but can write. */
    if (statePtr->flags & TLS_TCL_FATAL_ERROR) {
	dprintf("Fatal error already detected, abort read");
	*errorCodePtr = 0;
	return 0;
    } else if (statePtr->flags & TLS_TCL_EOF) {
	dprintf("EOF already detected, abort read");
	*errorCodePtr = 0;
	return 0;
    }
    /* If not initialized, do connect */
    /* Can also check SSL_is_init_finished(ssl) */

    /* 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.
     *
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_read specially (as advised in the RSA docs).  TLS's lower level BIO
     * functions play with the retry flags though, and this seems to work
     */
    dprintf("BIO_read eof=%d, buffered=%d, input=%d, output=%d", Tcl_Eof(statePtr->self), Tcl_ChannelBuffered(statePtr->self), \
        Tcl_InputBuffered(statePtr->self), Tcl_OutputBuffered(statePtr->self));    ERR_clear_error();
    Tcl_SetErrno(0);
     * correctly.  Similar fix in TlsOutputProc. - hobbs
     */
    ERR_clear_error();
    BIO_clear_retry_flags(statePtr->bio);
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);
    dprintf("BIO_read eof=%d, buffered=%d, input=%d, output=%d", Tcl_Eof(statePtr->self), Tcl_ChannelBuffered(statePtr->self), \
        Tcl_InputBuffered(statePtr->self), Tcl_OutputBuffered(statePtr->self));

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

    rc = SSL_get_error(statePtr->ssl, bytesRead);
    err = ERR_get_error();
    reason = ERR_GET_REASON(err);
    if (bytesRead <= 0) {
	/* The retry flag is set by the BIO_set_retry_* functions */
	if (BIO_should_retry(statePtr->bio)) {
    is_fatal = ERR_FATAL_ERROR(err);
    /* The retry flag is set by the BIO_set_retry_* functions */
    bioShouldRetry = BIO_should_retry(statePtr->bio);
	    dprintf("Read failed with code=%d, bytes read=%d: should retry", err, bytesRead);
	    /* Some docs imply we should redo the BIO_read now */
	} else {
	    dprintf("Read failed with code=%d, bytes read=%d: error condition", err, bytesRead);
	}

    io_err = Tcl_GetErrno();
    dprintf("Read: bytesRead=%d, rc=%d, err=%ld, reason=%d, is_fatal=%d, lib=%s, msg=%s, bioShouldRetry=%d, errno=%d, id=%s, msg=%s", \
        bytesRead, rc, err, reason, is_fatal, ERR_lib_error_string(err), ERR_reason_error_string(err), bioShouldRetry, io_err, Tcl_ErrnoId(), Tcl_ErrnoMsg(io_err));

    if (bytesRead <= 0) {
	dprintf("BIO is EOF %d", BIO_eof(statePtr->bio));

	/* These are the same as BIO_retry_type */
	if (BIO_should_read(statePtr->bio)) {
	/* The retry flag is set by the BIO_set_retry_* functions */
	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),
	    dprintf("BIO has insufficient data to read and return");
	    statePtr->want |= TCL_READABLE;
	}
	if (BIO_should_write(statePtr->bio)) {
	    BIO_should_write(statePtr->bio), BIO_should_io_special(statePtr->bio));
	    dprintf("BIO has pending data to write");
	    statePtr->want |= TCL_WRITABLE;
	if (BIO_should_retry(statePtr->bio)) {
	    *errorCodePtr = EAGAIN;
	}
	if (BIO_should_io_special(statePtr->bio)) {
	    int reason = BIO_get_retry_reason(statePtr->bio);
	    dprintf("BIO has some special condition other than read or write: code=%d", reason);
	}
    }

    switch (err) {
    }

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

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred,
	       usually a protocol error. */
	    dprintf("SSL_ERROR_SSL: Fatal SSL protocol error occurred");
	    if (backingError != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    if (err != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(err));
	    } 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;
	    bytesRead = -1;

#if OPENSSL_VERSION_NUMBER >= 0x30000000L
	    /* Unexpected EOF from the peer for OpenSSL 3.0+ */
	    if (ERR_GET_REASON(backingError) == SSL_R_UNEXPECTED_EOF_WHILE_READING) {
	    if (ERR_GET_REASON(err) == SSL_R_UNEXPECTED_EOF_WHILE_READING) {
		dprintf("(Unexpected) EOF reached")
		*errorCodePtr = 0;
		bytesRead = 0;
		Tls_Error(statePtr, "EOF reached");
	    } else {
		statePtr->flags |= TLS_TCL_FATAL_ERROR;
	    }
#else
	    statePtr->flags |= TLS_TCL_FATAL_ERROR;
#endif
	    
	    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;




︙


567
568
569
570
571
572
573
574

575
576
577
578
579
580
581
582


583
584
585

586
587
588
589

590
591

592

593

594
595
596
597
598
599
600

601
602

603
604
605
606
607
608
609
610
611
612
613
614

615

616
617
618
619
620
621
622

587
588
589
590
591
592
593

594
595
596
597
598
599
600


601
602

603
604
605
606
607
608

609
610
611
612

613
614
615
616
617
618
619
620
621
622
623
624

625
626
627
628
629
630
631
632
633
634
635
636
637
638

639
640
641
642
643
644
645
646








-
+






-
-
+
+
-


+



-
+


+
-
+

+







+

-
+












+
-
+








	    bytesRead = -1;
	    break;

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

	    if (backingError == 0 && bytesRead == 0) {
	    if (err == 0 && bytesRead == 0) {
		/* 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)",
	    } else if (err == 0 && bytesRead == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		    (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		bytesRead = -1;
		statePtr->flags |= TLS_TCL_FATAL_ERROR;
		Tls_Error(statePtr, Tcl_ErrnoMsg(*errorCodePtr));

	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		dprintf("I/O error occurred (err = %lu)", err);
		*errorCodePtr = Tcl_GetErrno();
		bytesRead = -1;
		statePtr->flags |= TLS_TCL_FATAL_ERROR;
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
		Tls_Error(statePtr, ERR_reason_error_string(err));
	    }
	    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;
	    *errorCodePtr = 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("Unknown error (err = %i), mapping to EOF", err);
	    dprintf("Other error, abort");
	    *errorCodePtr = 0;
	    bytesRead = 0;
	    Tls_Error(statePtr, "Unknown error");
	    break;
    }

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




︙


630
631
632
633
634
635
636
637

638
639
640

641
642
643
644
645
646
647
648
649
650

651
652

653
654
655

656
657
658
659
660
661
662
663
664
665
666






667
668


669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684

685
686
687
688
689
690
691
692
693

694
695
696
697
698

699
700
701
702
703
704
705
706
707
708

709
710
711
712
713
714
715
716
717

718
719
720



721
722
723
724
725
726


727
728
729
730
731



732
733
734



735
736

737
738
739
740
741
742
743






744
745
746

747
748
749

750
751

752
753
754
755
756
757

758

759
760
761
762
763
764
765
766
767
768
769
770
771
772


773
774
775
776
777
778
779


780
781
782
783
784
785
786

654
655
656
657
658
659
660

661
662
663

664
665
666
667
668
669
670
671
672
673

674
675

676
677
678

679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696


697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727

728

729
730
731
732
733
734
735
736
737

738
739
740
741
742
743
744
745
746
747

748



749
750
751


752
753
754
755
756
757
758
759



760
761
762



763
764
765


766







767
768
769
770
771
772



773



774


775
776

777
778
779
780
781

782
783
784
785
786
787
788
789
790
791
792
793
794


795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812








-
+


-
+









-
+

-
+


-
+











+
+
+
+
+
+
-
-
+
+
















+









+


-

-
+








-

+








-
+
-
-
-
+
+
+
-
-




+
+


-
-
-
+
+
+
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
-
-
-
+
-
-
+

-




+
-
+












-
-
+
+







+
+








 *
 *	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 none.
 *	to a POSIX error code if an error occurred, or 0 if successful.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *	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;
    unsigned long err;
    State *statePtr = (State *) instanceData;
    int written, err;
    int written, rc, reason, is_fatal, bioShouldRetry, io_err;
    *errorCodePtr = 0;

    dprintf("Write(%p, %d)", (void *) statePtr, toWrite);
    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("Fatal error already detected, abort write");
	*errorCodePtr = ECONNABORTED;
	return -1;
    }
    /* If not initialized, do connect */
    /* Can also check SSL_is_init_finished(ssl) */

    /* 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;
	}
    }

    /* Flush */
    if (toWrite == 0) {
	dprintf("zero-write");
	err = BIO_flush(statePtr->bio);

	if (err <= 0) {
	if (BIO_flush(statePtr->bio) <= 0) {
	    dprintf("Flushing failed");
	    Tls_Error(statePtr, "Flush failed");

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

	written = 0;
	*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.
     *
     */
     * Alternatively, we may want to handle the <0 return codes from
     * BIO_write specially (as advised in the RSA docs).  TLS's lower level
     * BIO functions play with the retry flags though, and this seems to
    dprintf("BIO_write eof=%d, buffered=%d, input=%d, output=%d", Tcl_Eof(statePtr->self), Tcl_ChannelBuffered(statePtr->self), \
        Tcl_InputBuffered(statePtr->self), Tcl_OutputBuffered(statePtr->self));
    Tcl_SetErrno(0);
     * work correctly.  Similar fix in TlsInputProc. - hobbs
     */
    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);
    dprintf("BIO_write eof=%d, buffered=%d, input=%d, output=%d", Tcl_Eof(statePtr->self), Tcl_ChannelBuffered(statePtr->self), \
        Tcl_InputBuffered(statePtr->self), Tcl_OutputBuffered(statePtr->self));

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

    rc = SSL_get_error(statePtr->ssl, written);
    err = ERR_get_error();
    reason = ERR_GET_REASON(err);
    if (written <= 0) {
	/* The retry flag is set by the BIO_set_retry_* functions */
	if (BIO_should_retry(statePtr->bio)) {
    is_fatal = ERR_FATAL_ERROR(err);
    /* The retry flag is set by the BIO_set_retry_* functions */
    bioShouldRetry = BIO_should_retry(statePtr->bio);
	    dprintf("Write failed with code %d, bytes written=%d: should retry",
		err, written);
    io_err = Tcl_GetErrno();
	} else {
	    dprintf("Write failed with code %d, bytes written=%d: error condition",
		err, written);
	}

	/* These are the same as BIO_retry_type */
	if (BIO_should_read(statePtr->bio)) {
    dprintf("Write: written=%d, rc=%d, err=%ld, reason=%d, is_fatal=%d, lib=%s, msg=%s, bioShouldRetry=%d, errno=%d, id=%s, msg=%s", \
        written, rc, err, reason, is_fatal, ERR_lib_error_string(err), ERR_reason_error_string(err), bioShouldRetry, io_err, Tcl_ErrnoId(), Tcl_ErrnoMsg(io_err));

    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),
	    dprintf("BIO has insufficient data to read and return");
	}
	if (BIO_should_write(statePtr->bio)) {
	    BIO_should_write(statePtr->bio), BIO_should_io_special(statePtr->bio));
	    dprintf("BIO has pending data to write");
	}
	if (BIO_should_io_special(statePtr->bio)) {
	if (BIO_should_retry(statePtr->bio)) {
	    int reason = BIO_get_retry_reason(statePtr->bio);
	    dprintf("BIO has some special condition other than read or write: code=%d", reason);
	    *errorCodePtr = EAGAIN;
	}

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

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

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred,
	       usually a protocol error */
	    dprintf("SSL_ERROR_SSL: Fatal SSL protocol error occurred");
	    if (backingError != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    if (err != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(err));
	    } 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");




︙


808
809
810
811
812
813
814
815

816
817
818
819
820
821

822
823
824

825
826
827
828

829
830

831

832

833
834
835
836
837
838
839
840
841

842
843
844
845
846
847
848
849
850
851
852
853

854



855
856
857
858
859
860
861

834
835
836
837
838
839
840

841
842
843
844
845
846

847
848
849
850
851
852
853
854

855
856
857
858

859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884

885
886
887
888
889
890
891
892
893
894








-
+





-
+



+



-
+


+
-
+

+









+












+
-
+
+
+








	    written = -1;
	    break;

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

	    if (backingError == 0 && written == 0) {
	    if (err == 0 && written == 0) {
		dprintf("EOF reached")
		*errorCodePtr = 0;
		written = 0;
		Tls_Error(statePtr, "EOF reached");

	    } else if (backingError == 0 && written == -1) {
	    } else if (err == 0 && written == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		written = -1;
		statePtr->flags |= TLS_TCL_FATAL_ERROR;
		Tls_Error(statePtr, Tcl_ErrnoMsg(*errorCodePtr));

	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		dprintf("I/O error occurred (err = %lu)", err);
		*errorCodePtr = Tcl_GetErrno();
		written = -1;
		statePtr->flags |= TLS_TCL_FATAL_ERROR;
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
		Tls_Error(statePtr, ERR_reason_error_string(err));
	    }
	    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("unknown error: %d", err);
	    dprintf("Other error, abort");
	    *errorCodePtr = 0;
	    written = 0;
	    Tls_Error(statePtr, "Unknown error");
	    break;
    }

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




︙


909
910
911
912
913
914
915
916

917
918
919
920
921
922
923
924
925
926
927
928
929
930

931
932
933
934
935
936
937
938
939
940
941


942
943
944

945
946

947
948
949
950
951
952
953
954
955
956
957
958
959
960

961
962
963
964
965
966
967

942
943
944
945
946
947
948

949
950
951
952
953
954
955
956
957
958
959
960
961
962

963
964
965
966
967
968
969
970
971
972


973
974
975
976

977
978

979
980
981
982
983
984
985
986
987
988
989
990
991
992

993
994
995
996
997
998
999
1000








-
+













-
+









-
-
+
+


-
+

-
+













-
+








				 * 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");
    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:
 *	A standard Tcl result. The value of the specified option or a list of
 *	all options and their values is returned in the supplied DString.
 *	TCL_OK if successful or TCL_ERROR if failed. Sets optionValue to
 *	the option's value.
 *
 * Side effects:
 *	None.
 *	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");
    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) {




︙


977
978
979
980
981
982
983
984
985
986




987
988
989

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003

1004



1005
1006
1007
1008
1009
1010
1011

1010
1011
1012
1013
1014
1015
1016



1017
1018
1019
1020
1021
1022

1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038

1039
1040
1041
1042
1043
1044
1045
1046
1047
1048








-
-
-
+
+
+
+


-
+














+
-
+
+
+








}

/*
 *-----------------------------------------------------------------------------
 *
 * TlsChannelHandlerTimer --
 *
 *	Called by the notifier via a timer, to flush out data waiting in
 *	channel buffers. called by the generic I/O layer whenever the
 *	Tcl_GetChannelHandle() function is used.
 *	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.
 *	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;
	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;
    }




︙


1031
1032
1033
1034
1035
1036
1037
1038

1039
1040
1041
1042


1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057

1058
1059
1060
1061
1062
1063
1064
1065
1066

1067


1068

1069

1070
1071
1072
1073
1074
1075
1076

1068
1069
1070
1071
1072
1073
1074

1075
1076
1077


1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093

1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109

1110
1111
1112
1113
1114
1115
1116
1117








-
+


-
-
+
+














-
+









+

+
+

+
-
+








 *
 *	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.
 *	None
 *
 * Side effects:
 *	Sets up the time-based notifier so that future events on the channel
 *	will be seen by TCL.
 *	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;
    int pending = 0;

    dprintf("Called with mask 0x%02x", mask);
    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_HANDSHAKE_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;




︙


1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108







1109
1110
1111
1112
1113
1114





1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128

1129
1130
1131

1132
1133
1134
1135
1136
1137
1138
1139
1140


1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157

1158
1159
1160

1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172












1173
1174
1175
1176
1177
1178
1179

1135
1136
1137
1138
1139
1140
1141








1142
1143
1144
1145
1146
1147
1148
1149





1150
1151
1152
1153
1154

1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166

1167
1168
1169

1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197

1198
1199
1200

1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232








-
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-












-
+


-
+









+
+
















-
+


-
+












+
+
+
+
+
+
+
+
+
+
+
+








	((mask & TCL_READABLE) && ((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) ||
	((mask & TCL_WRITABLE) && ((Tcl_OutputBuffered(statePtr->self) > 0) || (BIO_ctrl_wpending(statePtr->bio) > 0))));

    dprintf("IO Want=%d, input buffer=%d, output buffer=%d, BIO pending=%zd, BIO wpending=%zd, pending=%d", \
	statePtr->want, Tcl_InputBuffered(statePtr->self), Tcl_OutputBuffered(statePtr->self), \
	BIO_ctrl_pending(statePtr->bio), BIO_ctrl_wpending(statePtr->bio), pending);

    /* Schedule next event if data is pending, otherwise cease events for now */
    if (!(mask & TCL_READABLE) || pending == 0) {
	/* 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;
	}
    /* 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);
    }

    } else {
	/* Add timer, if none */
	if (statePtr->timer == (Tcl_TimerToken) NULL) {
	    dprintf("Creating a new timer since data appears to be waiting");
	    statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
    /* Add timer, if none */
    if (mask & TCL_READABLE) {
	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.
 *	The appropriate Tcl_File handle or NULL if None
 *
 * Side effects:
 *	None.
 *	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:
 *	Type of event or 0 if failed
 *	Returns mask value to indicate none of the events were serviced.
 *
 * Side effects:
 *	May process the incoming event by itself.
 *	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 */
{
    State *statePtr = (State *) instanceData;
    int errorCode = 0;

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

    /*
     * 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);
    }

    /* 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, returning failed");
	return 0;
    }




︙


1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224

1225
1226
1227

1228
1229
1230

1231
1232
1233
1234
1235
1236
1237

1246
1247
1248
1249
1250
1251
1252











1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265

1266
1267
1268

1269
1270
1271

1272
1273
1274
1275
1276
1277
1278
1279








-
-
-
-
-
-
-
-
-
-
-













-
+


-
+


-
+








		return 0;
	    }

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

    /*
     * Delete an existing timer. It was not fired, yet we are here, so the
     * channel below generated such an event and we don't have 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;
    }

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




︙







Changes to generic/tlsInt.h.




︙


120
121
122
123
124
125
126
127

128
129
130
131
132
133
134

120
121
122
123
124
125
126

127
128
129
130
131
132
133
134








-
+








	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_HANDSHAKE_FAILED) == TLS_TCL_HANDSHAKE_FAILED) { dprintfBuffer_p += sprintf(dprintfBuffer_p, "|TLS_TCL_HANDSHAKE_FAILED"); }; \
	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) /**/




︙


157
158
159
160
161
162
163




164
165
166
167
168
169
170
171
172
173
174

175
176

177



178
179
180
181
182
183
184

157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177

178
179

180
181
182
183
184
185
186
187
188
189
190
191








+
+
+
+










-
+

-
+

+
+
+








    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewBooleanObj(value)); \
}
#define LAPPEND_OBJ(interp, obj, text, tclObj) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, (tclObj != NULL) ? tclObj : Tcl_NewStringObj("", 0)); \
}
#define LAPPEND_WIDE(interp, obj, text, value) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewWideIntObj(value)); \
}

/*
 * Defines for State.flags
 */
#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_HANDSHAKE_FAILED (1<<5) /* Set on handshake failures and once set, all
#define TLS_TCL_FATAL_ERROR	(1<<5)	/* Set on handshake failure or other fatal error. All
					 * further I/O will result in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH 	(1<<6)	/* The parent channel is being used
#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. */

/* Set timer delay */
#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
 */




︙


198
199
200
201
202
203
204
205

206
207
208
209
210
211
212

205
206
207
208
209
210
211

212
213
214
215
216
217
218
219








-
+









	int vflags;		/* Verify flags */
	SSL *ssl;		/* Struct for SSL processing */
	SSL_CTX *ctx;		/* SSL Context */
	BIO *bio;		/* Struct for SSL processing */
	BIO *p_bio;		/* Parent BIO (that is layered on Tcl_Channel) */

	unsigned int protos_len; /* Length of protos */
	size_t protos_len; /* Length of protos */
	unsigned char *protos;	/* List of supported protocols in protocol format */

	const char *err;
} State;

#ifdef USE_TCL_STUBS
#ifndef Tcl_StackChannel




︙


226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241

233
234
235
236
237
238
239

240
241
242
243
244
245
246
247








-









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);
void		Tls_Clean(State *statePtr);
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 */








Changes to generic/tlsX509.c.




︙


42
43
44
45
46
47
48
49
50


51
52
53
54
55
56
57

42
43
44
45
46
47
48


49
50
51
52
53
54
55
56
57








-
-
+
+








    const char *hex = "0123456789abcdef";

    if (resultObj == NULL) {
	return NULL;
    }

    for (int i = 0; i < ilen; i++) {
	*dptr++ = hex[(*iptr>>4)&0xF];
	*dptr++ = hex[(*iptr++)&0xF];
	*dptr++ = (unsigned char)hex[(*iptr>>4)&0xF];
	*dptr++ = (unsigned char)hex[(*iptr++)&0xF];
    }
    return resultObj;
}

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




︙


209
210
211
212
213
214
215
216
217


218
219
220
221
222
223
224

209
210
211
212
213
214
215


216
217
218
219
220
221
222
223
224








-
-
+
+








 *	Purpose string
 *
 * Side effects:
 *	None
 *
 *-----------------------------------------------------------------------------
 */
char *Tls_x509Purpose(X509 *cert) {
    char *purpose = NULL;
const char *Tls_x509Purpose(X509 *cert) {
    const char *purpose = NULL;

    if (X509_check_purpose(cert, X509_PURPOSE_SSL_CLIENT, 0) > 0) {
	purpose = "SSL Client";
    } else if (X509_check_purpose(cert, X509_PURPOSE_SSL_SERVER, 0) > 0) {
	purpose = "SSL Server";
    } else if (X509_check_purpose(cert, X509_PURPOSE_NS_SSL_SERVER, 0) > 0) {
	purpose = "MSS SSL Server";




︙


298
299
300
301
302
303
304
305

306
307
308
309
310
311
312

298
299
300
301
302
303
304

305
306
307
308
309
310
311
312








-
+








    Tcl_Size len;
    char buffer[1024];

    if (resultObj == NULL) {
	return NULL;
    }

    if ((names = X509_get_ext_d2i(cert, nid, NULL, NULL)) != NULL) {
    if ((names = (STACK_OF(GENERAL_NAME) *)X509_get_ext_d2i(cert, nid, NULL, NULL)) != NULL) {
	for (int i=0; i < sk_GENERAL_NAME_num(names); i++) {
	    const GENERAL_NAME *name = sk_GENERAL_NAME_value(names, i);

	    len = BIO_to_Buffer(name && GENERAL_NAME_print(bio, (GENERAL_NAME *) name), bio, buffer, 1024);
	    LAPPEND_STR(interp, resultObj, NULL, buffer, len);
	}
	sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);




︙


392
393
394
395
396
397
398
399

400
401
402
403
404
405
406
407
408
409

410
411
412
413
414
415
416
417
418
419
420

421
422
423
424
425
426
427

392
393
394
395
396
397
398

399
400
401
402
403
404
405
406
407
408

409
410
411
412
413
414
415
416
417
418
419

420
421
422
423
424
425
426
427








-
+









-
+










-
+








    STACK_OF(DIST_POINT) *crl;
    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);

    if (resultObj == NULL) {
	return NULL;
    }

    if ((crl = X509_get_ext_d2i(cert, NID_crl_distribution_points, NULL, NULL)) != NULL) {
    if ((crl = (STACK_OF(DIST_POINT) *)X509_get_ext_d2i(cert, NID_crl_distribution_points, NULL, NULL)) != NULL) {
	for (int i=0; i < sk_DIST_POINT_num(crl); i++) {
	    DIST_POINT *dp = sk_DIST_POINT_value(crl, i);
	    DIST_POINT_NAME *distpoint = dp->distpoint;

	    if (distpoint->type == 0) {
		/* full-name GENERALIZEDNAME */
		for (int j = 0; j < sk_GENERAL_NAME_num(distpoint->name.fullname); j++) {
		    GENERAL_NAME *gen = sk_GENERAL_NAME_value(distpoint->name.fullname, j);
		    int type;
		    ASN1_STRING *uri = GENERAL_NAME_get0_value(gen, &type);
		    ASN1_STRING *uri = (ASN1_STRING *)GENERAL_NAME_get0_value(gen, &type);
		    if (type == GEN_URI) {
			LAPPEND_STR(interp, resultObj, (char *) NULL, (char *) ASN1_STRING_get0_data(uri), (Tcl_Size) ASN1_STRING_length(uri));
		    }
		}
	    } else if (distpoint->type == 1) {
		/* relative-name X509NAME */
		STACK_OF(X509_NAME_ENTRY) *sk_relname = distpoint->name.relativename;
		for (int j = 0; j < sk_X509_NAME_ENTRY_num(sk_relname); j++) {
		    X509_NAME_ENTRY *e = sk_X509_NAME_ENTRY_value(sk_relname, j);
		    ASN1_STRING *d = X509_NAME_ENTRY_get_data(e);
		    LAPPEND_STR(interp, resultObj, (char *) NULL, (char *) ASN1_STRING_data(d), (Tcl_Size) ASN1_STRING_length(d));
		    LAPPEND_STR(interp, resultObj, (char *) NULL, (char *) ASN1_STRING_get0_data(d), (Tcl_Size) ASN1_STRING_length(d));
		}
	    }
	}
	CRL_DIST_POINTS_free(crl);
    }
    return resultObj;
}




︙


479
480
481
482
483
484
485
486

487
488

489
490
491
492
493
494
495

479
480
481
482
483
484
485

486
487

488
489
490
491
492
493
494
495








-
+

-
+








    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    unsigned char *buf;

    if (resultObj == NULL) {
	return NULL;
    }

    if ((ads = X509_get_ext_d2i(cert, NID_info_access, NULL, NULL)) != NULL) {
    if ((ads = (STACK_OF(ACCESS_DESCRIPTION) *)X509_get_ext_d2i(cert, NID_info_access, NULL, NULL)) != NULL) {
	for (int i = 0; i < sk_ACCESS_DESCRIPTION_num(ads); i++) {
	    ad = sk_ACCESS_DESCRIPTION_value(ads, i);
	    ad = (ACCESS_DESCRIPTION *)sk_ACCESS_DESCRIPTION_value(ads, i);
	    if (OBJ_obj2nid(ad->method) == NID_ad_ca_issuers && ad->location) {
		if (ad->location->type == GEN_URI) {
		    Tcl_Size len = (Tcl_Size) ASN1_STRING_to_UTF8(&buf, ad->location->d.uniformResourceIdentifier);
		    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj((char *) buf, len));
		    OPENSSL_free(buf);
		    break;
		}




︙


520
521
522
523
524
525
526
527

528
529

530
531
532
533
534
535
536

520
521
522
523
524
525
526

527
528

529
530
531
532
533
534
535
536








-
+

-
+








    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    BIO *bio = BIO_new(BIO_s_mem());
    int mdnid, pknid, bits;
    Tcl_Size len;
    unsigned int ulen;
    uint32_t xflags;
    unsigned long flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
    flags &= ~ASN1_STRFLGS_ESC_MSB;
    flags &= ~(unsigned long)ASN1_STRFLGS_ESC_MSB;

    char *buffer = ckalloc(BUFSIZ > EVP_MAX_MD_SIZE ? BUFSIZ : EVP_MAX_MD_SIZE);
    char *buffer = (char *)ckalloc(BUFSIZ > EVP_MAX_MD_SIZE ? BUFSIZ : EVP_MAX_MD_SIZE);

    dprintf("Called");

    if (interp == NULL || cert == NULL || bio == NULL || resultObj == NULL || buffer == NULL) {
	Tcl_DecrRefCount(resultObj);
	BIO_free(bio);
	if (buffer != NULL) ckfree(buffer);




︙







Changes to tclconfig/README.txt.



1
2
3
4

5
6
7
8
9
10
11

1
2
3

4
5
6
7
8
9
10
11




-
+








These files comprise the basic building blocks for a Tcl Extension
Architecture (TEA) extension.  For more information on TEA see:

	http://www.tcl.tk/doc/tea/
	https://wiki.tcl-lang.org/page/TEA

This package is part of the Tcl project at SourceForge, but sources
and bug/patch database are hosted on fossil here:

	https://core.tcl-lang.org/tclconfig

This package is a freely available open source package.  You can do




︙







Changes to tclconfig/tcl.m4.




︙


138
139
140
141
142
143
144
145
146


147
148
149
150


151
152
153
154


155
156
157
158
159
160
161

138
139
140
141
142
143
144


145
146
147
148


149
150
151
152


153
154
155
156
157
158
159
160
161








-
-
+
+


-
-
+
+


-
-
+
+








			`ls -d ${exec_prefix}/lib 2>/dev/null` \
			`ls -d ${prefix}/lib 2>/dev/null` \
			`ls -d /usr/local/lib 2>/dev/null` \
			`ls -d /usr/contrib/lib 2>/dev/null` \
			`ls -d /usr/pkg/lib 2>/dev/null` \
			`ls -d /usr/lib 2>/dev/null` \
			`ls -d /usr/lib64 2>/dev/null` \
			`ls -d /usr/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/lib/tcl8.7 2>/dev/null` \
			`ls -d /usr/lib/tcl9.1 2>/dev/null` \
			`ls -d /usr/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/lib/tcl8.6 2>/dev/null` \
			`ls -d /usr/lib/tcl8.5 2>/dev/null` \
			`ls -d /usr/local/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl9.1 2>/dev/null` \
			`ls -d /usr/local/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.6 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.5 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl9.1 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.5 2>/dev/null` \
			; do
		    if test -f "$i/tclConfig.sh" ; then
			ac_cv_c_tclconfig="`(cd $i; pwd)`"
			break
		    fi




︙


221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238

221
222
223
224
225
226
227




228
229
230
231
232
233
234








-
-
-
-








    if test x"${no_tk}" = x ; then
	# we reset no_tk in case something fails here
	no_tk=true
	AC_ARG_WITH(tk,
	    AS_HELP_STRING([--with-tk],
		[directory containing tk configuration (tkConfig.sh)]),
	    [with_tkconfig="${withval}"])
	AC_ARG_WITH(tk8,
	    AS_HELP_STRING([--with-tk8],
		[Compile for Tk8 in Tk9 environment]),
	    [with_tk8="${withval}"])
	AC_MSG_CHECKING([for Tk configuration])
	AC_CACHE_VAL(ac_cv_c_tkconfig,[

	    # First check to see if --with-tkconfig was specified.
	    if test x"${with_tkconfig}" != x ; then
		case "${with_tkconfig}" in
		    */tkConfig.sh )




︙


292
293
294
295
296
297
298
299
300


301
302
303
304
305
306


307
308
309
310


311
312
313
314
315
316
317

288
289
290
291
292
293
294


295
296
297
298
299
300


301
302
303
304


305
306
307
308
309
310
311
312
313








-
-
+
+




-
-
+
+


-
-
+
+








	    if test x"${ac_cv_c_tkconfig}" = x ; then
		for i in `ls -d ${libdir} 2>/dev/null` \
			`ls -d ${exec_prefix}/lib 2>/dev/null` \
			`ls -d ${prefix}/lib 2>/dev/null` \
			`ls -d /usr/local/lib 2>/dev/null` \
			`ls -d /usr/contrib/lib 2>/dev/null` \
			`ls -d /usr/pkg/lib 2>/dev/null` \
			`ls -d /usr/lib/tk9.0 2>/dev/null` \
			`ls -d /usr/lib/tk8.7 2>/dev/null` \
			`ls -d /usr/lib/tk9.1 2>/dev/null` \
			`ls -d /usr/lib/tk9.0 2>/dev/null` \
			`ls -d /usr/lib/tk8.6 2>/dev/null` \
			`ls -d /usr/lib/tk8.5 2>/dev/null` \
			`ls -d /usr/lib 2>/dev/null` \
			`ls -d /usr/lib64 2>/dev/null` \
			`ls -d /usr/local/lib/tk9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tk8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tk9.1 2>/dev/null` \
			`ls -d /usr/local/lib/tk9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tk8.6 2>/dev/null` \
			`ls -d /usr/local/lib/tk8.5 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk9.1 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk8.6 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk8.5 2>/dev/null` \
			; do
		    if test -f "$i/tkConfig.sh" ; then
			ac_cv_c_tkconfig="`(cd $i; pwd)`"
			break
		    fi




︙


453
454
455
456
457
458
459



460

461
462
463
464
465
466
467

449
450
451
452
453
454
455
456
457
458

459
460
461
462
463
464
465
466








+
+
+
-
+








	    AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
    ])
    CC=$hold_cc
    AC_MSG_RESULT($TEA_PLATFORM)

    # The BUILD_$pkg is to define the correct extern storage class
    # handling when making this package
    # To be able to sefely use the package name in a #define, it must not
    # contain anything other than alphanumeric characters and underscores
    SAFE_PKG_NAME=patsubst(AC_PACKAGE_NAME, [[^A-Za-z0-9_]], [_])
    AC_DEFINE_UNQUOTED(BUILD_${PACKAGE_NAME}, [],
    AC_DEFINE_UNQUOTED(BUILD_${SAFE_PKG_NAME}, [],
	    [Building extension source?])
    # Do this here as we have fully defined TEA_PLATFORM now
    if test "${TEA_PLATFORM}" = "windows" ; then
	EXEEXT=".exe"
	CLEANFILES="$CLEANFILES *.lib *.dll *.pdb *.exp"
    fi





︙


1190
1191
1192
1193
1194
1195
1196

1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207

1208
1209
1210
1211
1212
1213
1214

1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206

1207
1208
1209
1210
1211
1212
1213
1214








+










-
+








		    arm64|aarch64)
			MACHINE="ARM64"
			;;
		    ia64)
			MACHINE="IA64"
			;;
		esac
		do64bit_ok=yes
	    fi

	    if test "$GCC" != "yes" ; then
		if test "${SHARED_BUILD}" = "0" ; then
		    runtime=-MT
		else
		    runtime=-MD
		fi
		case "x`echo \${VisualStudioVersion}`" in
		    x1[[4-9]]*)
			lflags="${lflags} -nodefaultlib:libucrt.lib"
			lflags="${lflags} -nodefaultlib:ucrt.lib"
			TEA_ADD_LIBS([ucrt.lib])
		    ;;
		    *)
		    ;;
		esac

		if test "$do64bit" != "no" ; then




︙


1376
1377
1378
1379
1380
1381
1382
1383

1384
1385
1386



1387


1388
1389
1390
1391
1392
1393
1394

1376
1377
1378
1379
1380
1381
1382

1383
1384
1385
1386
1387
1388
1389

1390
1391
1392
1393
1394
1395
1396
1397
1398








-
+



+
+
+
-
+
+








	    SHLIB_CFLAGS="-export-dynamic -fPIC"
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".so"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*)
	CYGWIN_*|MINGW32_*|MINGW64_*|MSYS_*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    if test "${TEA_PLATFORM}" = "unix" -a  "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$(patsubst cyg%.dll,lib%.dll,\$[@]).a"
	    else
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a"
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a"
	    fi
	    EXEEXT=".exe"
	    do64bit_ok=yes
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"




︙


3200
3201
3202
3203
3204
3205
3206








3207
3208



3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227








3228
3229
3230
3231
3232
3233
3234

3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218


3219
3220
3221
3222
3223
3224
3225
3226


3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253








+
+
+
+
+
+
+
+
-
-
+
+
+





-
-












+
+
+
+
+
+
+
+









    #--------------------------------------------------------------------
    # Shared libraries and static libraries have different names.
    # Use the double eval to make sure any variables in the suffix is
    # substituted. (@@@ Might not be necessary anymore)
    #--------------------------------------------------------------------

    if test "$TEA_PLATFORM" = "unix"; then
	PACKAGE_LIB_PREFIX8="lib"
	if test "$EXEEXT" = ".exe" -a "$SHARED_BUILD" != "0"; then
	    PACKAGE_LIB_PREFIX9="cygtcl9"
	else
	    PACKAGE_LIB_PREFIX9="libtcl9"
	fi
    else
    PACKAGE_LIB_PREFIX8="${PACKAGE_LIB_PREFIX}"
    PACKAGE_LIB_PREFIX9="${PACKAGE_LIB_PREFIX}tcl9"
	PACKAGE_LIB_PREFIX8=""
	PACKAGE_LIB_PREFIX9="tcl9"
    fi
    if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then
	PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX9}"
    else
	PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX8}"
	AC_DEFINE(TCL_MAJOR_VERSION, 8, [Compile for Tcl8?])
    fi
    if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tk8}" != x; then
	AC_DEFINE(TK_MAJOR_VERSION, 8, [Compile for Tk8?])
    fi
    if test "${TEA_PLATFORM}" = "windows" ; then
	if test "${SHARED_BUILD}" = "1" ; then
	    # We force the unresolved linking of symbols that are really in
	    # the private libraries of Tcl and Tk.
	    if test x"${TK_BIN_DIR}" != x ; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TK_BIN_DIR}/${TK_STUB_LIB_FILE}`\""
	    fi
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\""
	    if test "$GCC" = "yes"; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -static-libgcc"
	    fi
	    AC_CACHE_CHECK([if the linker understands --disable-high-entropy-va],
		tcl_cv_ld_high_entropy, [
		hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Wl,--disable-high-entropy-va"
		AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_ld_high_entropy=yes],[tcl_cv_ld_high_entropy=no])
		CFLAGS=$hold_cflags])
	    if test $tcl_cv_ld_high_entropy = yes; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--disable-high-entropy-va"
	    fi
	    eval eval "PKG_LIB_FILE8=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	else
	    if test "$GCC" = "yes"; then
		PACKAGE_LIB_PREFIX=lib${PACKAGE_LIB_PREFIX}




︙


3252
3253
3254
3255
3256
3257
3258
3259
3260
3261



3262
3263
3264
3265
3266



3267
3268
3269
3270

3271
3272

3273
3274
3275
3276
3277
3278
3279

3271
3272
3273
3274
3275
3276
3277



3278
3279
3280
3281
3282



3283
3284
3285
3286
3287
3288

3289
3290

3291
3292
3293
3294
3295
3296
3297
3298








-
-
-
+
+
+


-
-
-
+
+
+



-
+

-
+








    else
	RANLIB_STUB="${RANLIB}"
	if test "${SHARED_BUILD}" = "1" ; then
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TCL_STUB_LIB_SPEC}"
	    if test x"${TK_BIN_DIR}" != x ; then
		SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TK_STUB_LIB_SPEC}"
	    fi
	    eval eval "PKG_LIB_FILE8=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=lib${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE8=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}"
	    RANLIB=:
	else
	    eval eval "PKG_LIB_FILE8=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=lib${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE8=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE9=${PACKAGE_LIB_PREFIX9}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}"
	fi
	# Some packages build their own stubs libraries
	if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then
	    eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a"
	    eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a"
	else
	    eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}"
	    eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}"
	fi
    fi

    # These are escaped so that only CFLAGS is picked up at configure time.
    # The other values will be substituted at make time.
    CFLAGS="${CFLAGS} \${CFLAGS_DEFAULT} \${CFLAGS_WARNING}"
    if test "${SHARED_BUILD}" = "1" ; then




︙







Changes to tests/all.tcl.



1
2
3
4
5
6
7
8
9

10
11
12
13

14
15

16
17

18
19








20

21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52







1
2
3
4
5
6



7

8


9
10

11
12

13
14
15
16
17
18
19
20
21
22
23

24
25
26
27
28







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47


48
49
50
51
52
53







-
-
-
+
-

-
-
+

-
+

-
+


+
+
+
+
+
+
+
+
-
+




-
-
-
-
-
-
-



















-
-
+
+
+
+
+
+

# 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.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
#


set path [file normalize [file dirname [file join [pwd] [info script]]]]
#set auto_path [linsert $auto_path 0 [file normalize [file join [file dirname [info script]] ..]]]
set auto_path [linsert $auto_path 0 [file dirname $path] [file normalize [pwd]]]
set auto_path [linsert $auto_path 0 [file dirname $path] $path]

if {[lsearch [namespace children] ::tcltest] == -1} {
if {"::tcltest" ni [namespace children]} {
    package require tcltest
    namespace import ::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
# Get common functions, if any
if {[file exists [file join $path common.tcl]]} {
    source -encoding utf-8 [file join $path common.tcl]
}

set ::tcltest::testSingleFile false
set ::tcltest::testsDirectory [file dir [info script]]

# We should ensure that the testsDirectory is absolute.
# This was introduced in Tcl 8.3+'s tcltest, so we need a catch.
catch {::tcltest::normalizePath ::tcltest::testsDirectory}

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

#  Exit code: 0=all passed, 1=one or more failed
exit $::exitCode
# 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
}








Changes to tests/badssl.csv.



1

2
3
4
5
6
7
8
9
10
11
12


13
14
15


16
17

18
19
20
21



22
23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39




40
41
42
43
44




45
46
47
48
49




50
51

52
53
54
55
56
57
58
59
60






61
62
63
64
65
66



67
68
69
70
71
72
73
74







75
76

77
78
79


1
2
3
4
5
6
7
8
9
10
11


12
13
14


15
16
17

18
19



20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36




37
38
39
40
41




42
43
44
45
46




47
48
49
50
51

52
53
54
55






56
57
58
59
60
61
62
63
64



65
66
67
68







69
70
71
72
73
74
75
76

77
78
79

80


+









-
-
+
+

-
-
+
+

-
+

-
-
-
+
+
+












-
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
+



-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+


-
+

# 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}}",,,,,,,,,
,,,,,,,,,,
command,# BadSSL.com Tests,,,,,,,,,
BadSSL,1000-sans,,,badssl 1000-sans.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,10000-sans,,,badssl 10000-sans.badssl.com,,,handshake failed: excessive message size,,,1
BadSSL,1000 sans,,,badssl 1000-sans.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,10000 sans,,,badssl 10000-sans.badssl.com,,,handshake failed: excessive message size,,,1
BadSSL,3des,,,badssl 3des.badssl.com,,glob,handshake failed: * alert handshake failure,,,1
BadSSL,captive-portal,old_api,,badssl captive-portal.badssl.com,,,"handshake failed: certificate verify failed due to ""Hostname mismatch""",,,1
BadSSL,captive-portal,new_api,,badssl captive-portal.badssl.com,,,"handshake failed: certificate verify failed due to ""hostname mismatch""",,,1
BadSSL,captive portal,old_api,,badssl captive-portal.badssl.com,,,"handshake failed: certificate verify failed due to ""Hostname mismatch""",,,1
BadSSL,captive portal,new_api,,badssl captive-portal.badssl.com,,,"handshake failed: certificate verify failed due to ""hostname mismatch""",,,1
BadSSL,cbc,,,badssl cbc.badssl.com,,,,,,
BadSSL,client-cert-missing,,,badssl client-cert-missing.badssl.com,,,,,,
BadSSL,client cert missing,,,badssl client-cert-missing.badssl.com,,,,,,
BadSSL,client,,,badssl client.badssl.com,,,,,,
BadSSL,dh-composite,old_api,,badssl dh-composite.badssl.com,,,,,,
BadSSL,dh-composite,new_api,,badssl dh-composite.badssl.com,,,handshake failed: dh key too small,,,1
BadSSL,dh-small-subgroup,,,badssl dh-small-subgroup.badssl.com,,,,,,
BadSSL,dh composite,old_api,,badssl dh-composite.badssl.com,,,,,,
BadSSL,dh composite,new_api,,badssl dh-composite.badssl.com,,,handshake failed: dh key too small,,,1
BadSSL,dh small subgroup,,,badssl dh-small-subgroup.badssl.com,,,,,,
BadSSL,dh480,old_api,,badssl dh480.badssl.com,,,handshake failed: dh key too small,,,1
BadSSL,dh480,new_api,,badssl dh480.badssl.com,,,handshake failed: modulus too small,,,1
BadSSL,dh512,old_api,,badssl dh512.badssl.com,,,handshake failed: dh key too small,,,1
BadSSL,dh512,mac,,badssl dh512.badssl.com,,,handshake failed: unknown security bits,,,1
BadSSL,dh1024,old_api,,badssl dh1024.badssl.com,,,,,,
BadSSL,dh1024,new_api,,badssl dh1024.badssl.com,,,handshake failed: dh key too small,,,1
BadSSL,dh2048,,,badssl dh2048.badssl.com,,,,,,
BadSSL,dsdtestprovider,,,badssl dsdtestprovider.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,ecc256,,,badssl ecc256.badssl.com,,,,,,
BadSSL,ecc384,,,badssl ecc384.badssl.com,,,,,,
BadSSL,edellroot,,,badssl edellroot.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,expired,,,badssl expired.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,extended-validation,,,badssl extended-validation.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,extended validation,,,badssl extended-validation.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,hsts,,,badssl hsts.badssl.com,,,,,,
BadSSL,https-everywhere,,,badssl https-everywhere.badssl.com,,,,,,
BadSSL,incomplete-chain,,,badssl incomplete-chain.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,invalid-expected-sct,,,badssl invalid-expected-sct.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,long-extended-subdomain-name-containing-many-letters-and-dashes,,,badssl long-extended-subdomain-name-containing-many-letters-and-dashes.badssl.com,,,,,,
BadSSL,https everywhere,,,badssl https-everywhere.badssl.com,,,,,,
BadSSL,incomplete chain,,,badssl incomplete-chain.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,invalid expected sct,,,badssl invalid-expected-sct.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,long extended subdomain name containing many letters and dashes,,,badssl long-extended-subdomain-name-containing-many-letters-and-dashes.badssl.com,,,,,,
BadSSL,longextendedsubdomainnamewithoutdashesinordertotestwordwrapping,,,badssl longextendedsubdomainnamewithoutdashesinordertotestwordwrapping.badssl.com,,,,,,
BadSSL,mitm-software,,,badssl mitm-software.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,no-common-name,,,badssl no-common-name.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,no-sct,,,badssl no-sct.badssl.com,,,,,,
BadSSL,no-subject,,,badssl no-subject.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,mitm software,,,badssl mitm-software.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,no common name,,,badssl no-common-name.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,no sct,,,badssl no-sct.badssl.com,,,,,,
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,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,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,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
BadSSL,sha1-2017,new_api,,badssl sha1-2017.badssl.com,,,"handshake failed: certificate verify failed due to ""CA signature digest algorithm too weak""",,,1
BadSSL,sha1-intermediate,,,badssl sha1-intermediate.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,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
BadSSL,sha1 2017,new_api,,badssl sha1-2017.badssl.com,,,"handshake failed: certificate verify failed due to ""CA signature digest algorithm too weak""",,,1
BadSSL,sha1 intermediate,,,badssl sha1-intermediate.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,sha256,,,badssl sha256.badssl.com,,,,,,
BadSSL,sha384,,,badssl sha384.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,sha512,,,badssl sha512.badssl.com,,,"handshake failed: certificate verify failed due to ""certificate has expired""",,,1
BadSSL,static-rsa,,,badssl static-rsa.badssl.com,,,,,,
BadSSL,subdomain.preloaded-hsts,old_api,,badssl subdomain.preloaded-hsts.badssl.com,,,"handshake failed: certificate verify failed due to ""Hostname mismatch""",,,1
BadSSL,subdomain.preloaded-hsts,new_api,,badssl subdomain.preloaded-hsts.badssl.com,,,"handshake failed: certificate verify failed due to ""hostname mismatch""",,,1
BadSSL,static rsa,,,badssl static-rsa.badssl.com,,,,,,
BadSSL,subdomain.preloaded hsts,old_api,,badssl subdomain.preloaded-hsts.badssl.com,,,"handshake failed: certificate verify failed due to ""Hostname mismatch""",,,1
BadSSL,subdomain.preloaded hsts,new_api,,badssl subdomain.preloaded-hsts.badssl.com,,,"handshake failed: certificate verify failed due to ""hostname mismatch""",,,1
BadSSL,superfish,,,badssl superfish.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,tls-v1-0:1010,tls1 old_api,,badssl tls-v1-0.badssl.com:1010,,,,,,
BadSSL,tls-v1-0:1010,tls1 new_api,,badssl tls-v1-0.badssl.com:1010,,,handshake failed: unsupported protocol,,,1
BadSSL,tls-v1-1:1011,tls1.1 old_api,,badssl tls-v1-1.badssl.com:1011,,,,,,
BadSSL,tls-v1-1:1011,tls1.1 new_api,,badssl tls-v1-1.badssl.com:1011,,,handshake failed: unsupported protocol,,,1
BadSSL,tls-v1-2:1012,tls1.2,,badssl tls-v1-2.badssl.com:1012,,,,,,
BadSSL,untrusted-root,old_api,,badssl untrusted-root.badssl.com,,,"handshake failed: certificate verify failed due to ""self signed certificate in certificate chain""",,,1
BadSSL,untrusted-root,new_api,,badssl untrusted-root.badssl.com,,,"handshake failed: certificate verify failed due to ""self-signed certificate in certificate chain""",,,1
BadSSL,tls v1 0:1010,tls1 old_api,,badssl tls-v1-0.badssl.com:1010,,,,,,
BadSSL,tls v1 0:1010,tls1 new_api,,badssl tls-v1-0.badssl.com:1010,,,handshake failed: unsupported protocol,,,1
BadSSL,tls v1 1:1011,tls1.1 old_api,,badssl tls-v1-1.badssl.com:1011,,,,,,
BadSSL,tls v1 1:1011,tls1.1 new_api,,badssl tls-v1-1.badssl.com:1011,,,handshake failed: unsupported protocol,,,1
BadSSL,tls v1 2:1012,tls1.2,,badssl tls-v1-2.badssl.com:1012,,,,,,
BadSSL,untrusted root,old_api,,badssl untrusted-root.badssl.com,,,"handshake failed: certificate verify failed due to ""self signed certificate in certificate chain""",,,1
BadSSL,untrusted root,new_api,,badssl untrusted-root.badssl.com,,,"handshake failed: certificate verify failed due to ""self-signed certificate in certificate chain""",,,1
BadSSL,upgrade,,,badssl upgrade.badssl.com,,,,,,
BadSSL,webpack-dev-server,,,badssl webpack-dev-server.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,webpack dev server,,,badssl webpack-dev-server.badssl.com,,,"handshake failed: certificate verify failed due to ""unable to get local issuer certificate""",,,1
BadSSL,wrong.host,old_api,,badssl wrong.host.badssl.com,,,"handshake failed: certificate verify failed due to ""Hostname mismatch""",,,1
BadSSL,wrong.host,new_api,,badssl wrong.host.badssl.com,,,"handshake failed: certificate verify failed due to ""hostname mismatch""",,,1
BadSSL,mozilla-modern,,,badssl mozilla-modern.badssl.com,,,,,,
BadSSL,mozilla modern,,,badssl mozilla-modern.badssl.com,,,,,,








Changes to tests/badssl.test.



1
2
3
4

5
6
7
8
9

10

11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26

27
28
29
30
31
32
33
34

35
36
37
38

39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54

55
56
57
58

59
60
61
62

63
64
65
66
67
68
69

1
2
3

4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26

27
28
29
30
31
32
33
34

35
36
37
38

39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54

55
56
57
58

59
60
61
62

63
64
65
66
67
68
69
70




-
+




-
+

+











-
+



-
+







-
+



-
+







-
+







-
+



-
+



-
+








# Auto generated test cases for badssl.csv

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

set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]
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}}

# BadSSL.com Tests


test BadSSL-1.1 {1000-sans} -body {
test BadSSL-1.1 {1000 sans} -body {
	badssl 1000-sans.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.2 {10000-sans} -body {
test BadSSL-1.2 {10000 sans} -body {
	badssl 10000-sans.badssl.com
    } -result {handshake failed: excessive message size} -returnCodes {1}

test BadSSL-1.3 {3des} -body {
	badssl 3des.badssl.com
    } -match {glob} -result {handshake failed: * alert handshake failure} -returnCodes {1}

test BadSSL-1.4 {captive-portal} -constraints {old_api} -body {
test BadSSL-1.4 {captive portal} -constraints {old_api} -body {
	badssl captive-portal.badssl.com
    } -result {handshake failed: certificate verify failed due to "Hostname mismatch"} -returnCodes {1}

test BadSSL-1.5 {captive-portal} -constraints {new_api} -body {
test BadSSL-1.5 {captive portal} -constraints {new_api} -body {
	badssl captive-portal.badssl.com
    } -result {handshake failed: certificate verify failed due to "hostname mismatch"} -returnCodes {1}

test BadSSL-1.6 {cbc} -body {
	badssl cbc.badssl.com
    }

test BadSSL-1.7 {client-cert-missing} -body {
test BadSSL-1.7 {client cert missing} -body {
	badssl client-cert-missing.badssl.com
    }

test BadSSL-1.8 {client} -body {
	badssl client.badssl.com
    }

test BadSSL-1.9 {dh-composite} -constraints {old_api} -body {
test BadSSL-1.9 {dh composite} -constraints {old_api} -body {
	badssl dh-composite.badssl.com
    }

test BadSSL-1.10 {dh-composite} -constraints {new_api} -body {
test BadSSL-1.10 {dh composite} -constraints {new_api} -body {
	badssl dh-composite.badssl.com
    } -result {handshake failed: dh key too small} -returnCodes {1}

test BadSSL-1.11 {dh-small-subgroup} -body {
test BadSSL-1.11 {dh small subgroup} -body {
	badssl dh-small-subgroup.badssl.com
    }

test BadSSL-1.12 {dh480} -constraints {old_api} -body {
	badssl dh480.badssl.com
    } -result {handshake failed: dh key too small} -returnCodes {1}





︙


107
108
109
110
111
112
113
114

115
116
117
118
119
120
121
122

123
124
125
126

127
128
129
130

131
132
133
134

135
136
137
138
139
140
141
142

143
144
145
146

147
148
149
150

151
152
153
154

155
156
157
158
159
160
161
162

163
164
165
166

167
168
169
170

171
172
173
174

175
176
177
178
179
180
181

108
109
110
111
112
113
114

115
116
117
118
119
120
121
122

123
124
125
126

127
128
129
130

131
132
133
134

135
136
137
138
139
140
141
142

143
144
145
146

147
148
149
150

151
152
153
154

155
156
157
158
159
160
161
162

163
164
165
166

167
168
169
170

171
172
173
174

175
176
177
178
179
180
181
182








-
+







-
+



-
+



-
+



-
+







-
+



-
+



-
+



-
+







-
+



-
+



-
+



-
+








	badssl edellroot.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.23 {expired} -body {
	badssl expired.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.24 {extended-validation} -body {
test BadSSL-1.24 {extended validation} -body {
	badssl extended-validation.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.25 {hsts} -body {
	badssl hsts.badssl.com
    }

test BadSSL-1.26 {https-everywhere} -body {
test BadSSL-1.26 {https everywhere} -body {
	badssl https-everywhere.badssl.com
    }

test BadSSL-1.27 {incomplete-chain} -body {
test BadSSL-1.27 {incomplete chain} -body {
	badssl incomplete-chain.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.28 {invalid-expected-sct} -body {
test BadSSL-1.28 {invalid expected sct} -body {
	badssl invalid-expected-sct.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.29 {long-extended-subdomain-name-containing-many-letters-and-dashes} -body {
test BadSSL-1.29 {long extended subdomain name containing many letters and dashes} -body {
	badssl long-extended-subdomain-name-containing-many-letters-and-dashes.badssl.com
    }

test BadSSL-1.30 {longextendedsubdomainnamewithoutdashesinordertotestwordwrapping} -body {
	badssl longextendedsubdomainnamewithoutdashesinordertotestwordwrapping.badssl.com
    }

test BadSSL-1.31 {mitm-software} -body {
test BadSSL-1.31 {mitm software} -body {
	badssl mitm-software.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.32 {no-common-name} -body {
test BadSSL-1.32 {no common name} -body {
	badssl no-common-name.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.33 {no-sct} -body {
test BadSSL-1.33 {no sct} -body {
	badssl no-sct.badssl.com
    }

test BadSSL-1.34 {no-subject} -body {
test BadSSL-1.34 {no subject} -body {
	badssl no-subject.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.35 {null} -body {
	badssl null.badssl.com
    } -match {glob} -result {handshake failed: * alert handshake failure} -returnCodes {1}

test BadSSL-1.36 {pinning-test} -body {
test BadSSL-1.36 {pinning test} -body {
	badssl pinning-test.badssl.com
    }

test BadSSL-1.37 {preact-cli} -body {
test BadSSL-1.37 {preact cli} -body {
	badssl preact-cli.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.38 {preloaded-hsts} -body {
test BadSSL-1.38 {preloaded hsts} -body {
	badssl preloaded-hsts.badssl.com
    }

test BadSSL-1.39 {rc4-md5} -body {
test BadSSL-1.39 {rc4 md5} -body {
	badssl rc4-md5.badssl.com
    } -match {glob} -result {handshake failed: * alert handshake failure} -returnCodes {1}

test BadSSL-1.40 {rc4} -body {
	badssl rc4.badssl.com
    } -match {glob} -result {handshake failed: * alert handshake failure} -returnCodes {1}





︙


191
192
193
194
195
196
197
198

199
200
201
202

203
204
205
206

207
208
209
210

211
212
213
214

215
216
217
218

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234

235
236
237
238

239
240
241
242

243
244
245
246
247
248
249
250

251
252
253
254

255
256
257
258

259
260
261
262

263
264
265
266

267
268
269
270

271
272
273
274

275
276
277
278
279
280
281
282

283
284
285
286
287
288
289
290
291
292
293
294

295
296
297
298
299
300

192
193
194
195
196
197
198

199
200
201
202

203
204
205
206

207
208
209
210

211
212
213
214

215
216
217
218

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234

235
236
237
238

239
240
241
242

243
244
245
246
247
248
249
250

251
252
253
254

255
256
257
258

259
260
261
262

263
264
265
266

267
268
269
270

271
272
273
274

275
276
277
278
279
280
281
282

283
284
285
286
287
288
289
290
291
292
293
294

295
296
297
298
299
300
301








-
+



-
+



-
+



-
+



-
+



-
+















-
+



-
+



-
+







-
+



-
+



-
+



-
+



-
+



-
+



-
+







-
+











-
+







	badssl rsa4096.badssl.com
    }

test BadSSL-1.44 {rsa8192} -body {
	badssl rsa8192.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.45 {self-signed} -constraints {old_api} -body {
test BadSSL-1.45 {self signed} -constraints {old_api} -body {
	badssl self-signed.badssl.com
    } -result {handshake failed: certificate verify failed due to "self signed certificate"} -returnCodes {1}

test BadSSL-1.46 {self-signed} -constraints {new_api} -body {
test BadSSL-1.46 {self signed} -constraints {new_api} -body {
	badssl self-signed.badssl.com
    } -result {handshake failed: certificate verify failed due to "self-signed certificate"} -returnCodes {1}

test BadSSL-1.47 {sha1-2016} -body {
test BadSSL-1.47 {sha1 2016} -body {
	badssl sha1-2016.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.48 {sha1-2017} -constraints {old_api} -body {
test BadSSL-1.48 {sha1 2017} -constraints {old_api} -body {
	badssl sha1-2017.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.49 {sha1-2017} -constraints {new_api} -body {
test BadSSL-1.49 {sha1 2017} -constraints {new_api} -body {
	badssl sha1-2017.badssl.com
    } -result {handshake failed: certificate verify failed due to "CA signature digest algorithm too weak"} -returnCodes {1}

test BadSSL-1.50 {sha1-intermediate} -body {
test BadSSL-1.50 {sha1 intermediate} -body {
	badssl sha1-intermediate.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.51 {sha256} -body {
	badssl sha256.badssl.com
    }

test BadSSL-1.52 {sha384} -body {
	badssl sha384.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.53 {sha512} -body {
	badssl sha512.badssl.com
    } -result {handshake failed: certificate verify failed due to "certificate has expired"} -returnCodes {1}

test BadSSL-1.54 {static-rsa} -body {
test BadSSL-1.54 {static rsa} -body {
	badssl static-rsa.badssl.com
    }

test BadSSL-1.55 {subdomain.preloaded-hsts} -constraints {old_api} -body {
test BadSSL-1.55 {subdomain.preloaded hsts} -constraints {old_api} -body {
	badssl subdomain.preloaded-hsts.badssl.com
    } -result {handshake failed: certificate verify failed due to "Hostname mismatch"} -returnCodes {1}

test BadSSL-1.56 {subdomain.preloaded-hsts} -constraints {new_api} -body {
test BadSSL-1.56 {subdomain.preloaded hsts} -constraints {new_api} -body {
	badssl subdomain.preloaded-hsts.badssl.com
    } -result {handshake failed: certificate verify failed due to "hostname mismatch"} -returnCodes {1}

test BadSSL-1.57 {superfish} -body {
	badssl superfish.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.58 {tls-v1-0:1010} -constraints {tls1 old_api} -body {
test BadSSL-1.58 {tls v1 0:1010} -constraints {tls1 old_api} -body {
	badssl tls-v1-0.badssl.com:1010
    }

test BadSSL-1.59 {tls-v1-0:1010} -constraints {tls1 new_api} -body {
test BadSSL-1.59 {tls v1 0:1010} -constraints {tls1 new_api} -body {
	badssl tls-v1-0.badssl.com:1010
    } -result {handshake failed: unsupported protocol} -returnCodes {1}

test BadSSL-1.60 {tls-v1-1:1011} -constraints {tls1.1 old_api} -body {
test BadSSL-1.60 {tls v1 1:1011} -constraints {tls1.1 old_api} -body {
	badssl tls-v1-1.badssl.com:1011
    }

test BadSSL-1.61 {tls-v1-1:1011} -constraints {tls1.1 new_api} -body {
test BadSSL-1.61 {tls v1 1:1011} -constraints {tls1.1 new_api} -body {
	badssl tls-v1-1.badssl.com:1011
    } -result {handshake failed: unsupported protocol} -returnCodes {1}

test BadSSL-1.62 {tls-v1-2:1012} -constraints {tls1.2} -body {
test BadSSL-1.62 {tls v1 2:1012} -constraints {tls1.2} -body {
	badssl tls-v1-2.badssl.com:1012
    }

test BadSSL-1.63 {untrusted-root} -constraints {old_api} -body {
test BadSSL-1.63 {untrusted root} -constraints {old_api} -body {
	badssl untrusted-root.badssl.com
    } -result {handshake failed: certificate verify failed due to "self signed certificate in certificate chain"} -returnCodes {1}

test BadSSL-1.64 {untrusted-root} -constraints {new_api} -body {
test BadSSL-1.64 {untrusted root} -constraints {new_api} -body {
	badssl untrusted-root.badssl.com
    } -result {handshake failed: certificate verify failed due to "self-signed certificate in certificate chain"} -returnCodes {1}

test BadSSL-1.65 {upgrade} -body {
	badssl upgrade.badssl.com
    }

test BadSSL-1.66 {webpack-dev-server} -body {
test BadSSL-1.66 {webpack dev server} -body {
	badssl webpack-dev-server.badssl.com
    } -result {handshake failed: certificate verify failed due to "unable to get local issuer certificate"} -returnCodes {1}

test BadSSL-1.67 {wrong.host} -constraints {old_api} -body {
	badssl wrong.host.badssl.com
    } -result {handshake failed: certificate verify failed due to "Hostname mismatch"} -returnCodes {1}

test BadSSL-1.68 {wrong.host} -constraints {new_api} -body {
	badssl wrong.host.badssl.com
    } -result {handshake failed: certificate verify failed due to "hostname mismatch"} -returnCodes {1}

test BadSSL-1.69 {mozilla-modern} -body {
test BadSSL-1.69 {mozilla modern} -body {
	badssl mozilla-modern.badssl.com
    }

# Cleanup
::tcltest::cleanupTests
return








Changes to tests/ciphers.csv.



1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
9


+








# 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],,,,,,,,,




︙


39
40
41
42
43
44
45
46
47
48
49




50
51
52
53
54
55
56
57




58
59
60
61

40
41
42
43
44
45
46




47
48
49
50
51
52
53
54




55
56
57
58
59
60
61
62








-
-
-
-
+
+
+
+




-
-
-
-
+
+
+
+





Ciphers By Protocol,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1] [::tls::ciphers tls1.1]",,,missing {} unexpected {},,,
Ciphers By Protocol,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2] [::tls::ciphers tls1.2]",,,missing {} unexpected {},,,
Ciphers By Protocol,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3] [::tls::ciphers tls1.3]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test cipher descriptions,,,,,,,,,
Ciphers With Descriptions,SSL2,ssl2,,"lcompare [exec_get ""\r\n"" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,SSL3,ssl3,,"lcompare [exec_get ""\r\n"" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.0,tls1,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.1,tls1.1,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.2,tls1.2,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.3,tls1.3,,"lcompare [exec_get ""\r\n"" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.0,tls1 old_api,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.1,tls1.1 old_api,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.2,tls1.2 old_api,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.3,tls1.3 old_api,,"lcompare [exec_get ""\r\n"" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test protocol specific ciphers,,,,,,,,,
Ciphers Protocol Specific,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.0,tls1,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.0,tls1 old_api,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.1,tls1.1 old_api,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.2,tls1.2 old_api,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.3,tls1.3 old_api,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test version,,,,,,,,,
Version,All,,,::tls::version,,glob,*,,,
Version,OpenSSL,OpenSSL,,::tls::version,,glob,OpenSSL*,,,








Changes to tests/ciphers.test.



1
2
3
4

5
6
7
8
9

10

11
12
13
14
15
16
17

1
2
3

4
5
6
7
8

9
10
11
12
13
14
15
16
17
18




-
+




-
+

+








# Auto generated test cases for ciphers.csv

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

set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]
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]




︙


79
80
81
82
83
84
85
86

87
88
89
90

91
92
93
94

95
96
97
98

99
100
101
102
103
104
105
106
107
108
109
110
111
112
113

114
115
116
117

118
119
120
121

122
123
124
125

126
127
128
129
130
131
132

80
81
82
83
84
85
86

87
88
89
90

91
92
93
94

95
96
97
98

99
100
101
102
103
104
105
106
107
108
109
110
111
112
113

114
115
116
117

118
119
120
121

122
123
124
125

126
127
128
129
130
131
132
133








-
+



-
+



-
+



-
+














-
+



-
+



-
+



-
+








	lcompare [exec_get "\r\n" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]
    } -result {missing {} unexpected {}}

test Ciphers_With_Descriptions-3.2 {SSL3} -constraints {ssl3} -body {
	lcompare [exec_get "\r\n" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]
    } -result {missing {} unexpected {}}

test Ciphers_With_Descriptions-3.3 {TLS1.0} -constraints {tls1} -body {
test Ciphers_With_Descriptions-3.3 {TLS1.0} -constraints {tls1 old_api} -body {
	lcompare [exec_get "\r\n" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]
    } -result {missing {} unexpected {}}

test Ciphers_With_Descriptions-3.4 {TLS1.1} -constraints {tls1.1} -body {
test Ciphers_With_Descriptions-3.4 {TLS1.1} -constraints {tls1.1 old_api} -body {
	lcompare [exec_get "\r\n" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]
    } -result {missing {} unexpected {}}

test Ciphers_With_Descriptions-3.5 {TLS1.2} -constraints {tls1.2} -body {
test Ciphers_With_Descriptions-3.5 {TLS1.2} -constraints {tls1.2 old_api} -body {
	lcompare [exec_get "\r\n" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]
    } -result {missing {} unexpected {}}

test Ciphers_With_Descriptions-3.6 {TLS1.3} -constraints {tls1.3} -body {
test Ciphers_With_Descriptions-3.6 {TLS1.3} -constraints {tls1.3 old_api} -body {
	lcompare [exec_get "\r\n" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]
    } -result {missing {} unexpected {}}

# Test protocol specific ciphers


test Ciphers_Protocol_Specific-4.1 {SSL2} -constraints {ssl2} -body {
	lcompare [exec_get ":" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]
    } -result {missing {} unexpected {}}

test Ciphers_Protocol_Specific-4.2 {SSL3} -constraints {ssl3} -body {
	lcompare [exec_get ":" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]
    } -result {missing {} unexpected {}}

test Ciphers_Protocol_Specific-4.3 {TLS1.0} -constraints {tls1} -body {
test Ciphers_Protocol_Specific-4.3 {TLS1.0} -constraints {tls1 old_api} -body {
	lcompare [exec_get ":" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]
    } -result {missing {} unexpected {}}

test Ciphers_Protocol_Specific-4.4 {TLS1.1} -constraints {tls1.1} -body {
test Ciphers_Protocol_Specific-4.4 {TLS1.1} -constraints {tls1.1 old_api} -body {
	lcompare [exec_get ":" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]
    } -result {missing {} unexpected {}}

test Ciphers_Protocol_Specific-4.5 {TLS1.2} -constraints {tls1.2} -body {
test Ciphers_Protocol_Specific-4.5 {TLS1.2} -constraints {tls1.2 old_api} -body {
	lcompare [exec_get ":" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]
    } -result {missing {} unexpected {}}

test Ciphers_Protocol_Specific-4.6 {TLS1.3} -constraints {tls1.3} -body {
test Ciphers_Protocol_Specific-4.6 {TLS1.3} -constraints {tls1.3 old_api} -body {
	lcompare [exec_get ":" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]
    } -result {missing {} unexpected {}}

# Test version


test Version-5.1 {All} -body {




︙







Changes to tests/common.tcl.



1
2
3

4
5
6
7
8
9
10

1
2
3
4
5
6
7
8
9
10
11




+








#!/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




︙







Changes to tests/keytest1.tcl.



1
2
3

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

24
25
26
27

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

24
25
26
27
28




+



















-
+





#!/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 -keyfile $keyfile -certfile $certfile -server myserv 12300
tls::socket -require 0 -keyfile $keyfile -certfile $certfile -server myserv 12300

puts "Now run keytest2.tcl"
vwait forever









Changes to tests/keytest2.tcl.



1
2
3

4
5
6

7
8
9
10

1
2
3
4
5
6

7
8
9
10
11




+


-
+





#!/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 127.0.0.1 12300]
set s [tls::socket -require 0 127.0.0.1 12300]
puts $s "A line"
flush $s
puts [join [tls::status $s] \n]
exit








Changes to tests/make_test_files.tcl.




1
2
3
4
5
6
7

1
2
3
4
5
6
7
8

+








#!/usr/bin/env tclsh
#
# Name:		Make Test Files From CSV Files
# Version:	0.3
# Date:		March 9, 2024
# Author:	Brian O'Hagan
# Email:	brian199@comcast.net
# Legal Notice:	(c) Copyright 2020 by Brian O'Hagan




︙


79
80
81
82
83
84
85
86
87


88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103

104




105
106
107
108
109
110
111

112
113
114
115
116
117

118
119
120
121
122
123
124

80
81
82
83
84
85
86


87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103
104
105

106
107
108
109
110
111
112
113
114
115

116
117
118
119
120
121
122
123
124
125
126
127
128
129
130








-
-
+
+






-
+









+
-
+
+
+
+






-
+






+









    # Add setup commands to test file
    puts $out [format "# Auto generated test cases for %s" [file tail $filename]]
    #puts $out [format "# Auto generated test cases for %s created on %s" [file tail $filename] [clock format [clock seconds]]]

    # Package requires
    puts $out "\n# Load Tcl Test package"
    puts $out [subst -nocommands {if {[lsearch [namespace children] ::tcltest] == -1} {\n\tpackage require tcltest\n\tnamespace import ::tcltest::*\n}\n}]
    puts $out {set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]}
    puts $out [subst -nocommands {if {[lsearch [namespace children] ::tcltest] < 0} {\n\tpackage require tcltest\n\tnamespace import ::tcltest::*\n}\n}]
    puts $out {set ::auto_path [concat [list [file dirname [file dirname [info script]]]] $::auto_path]}
    puts $out ""

    # Generate test cases and add to test file
    while {[gets $in data] > -1} {
	# Skip comments
	set data [string trim $data]
	if {[string match "#*" $data]} continue
	if {[string match "#*" $data] || [string match "\"#*" $data]} continue
	# Split comma separated fields with quotes
	set list [parse_csv $in $data]

	# Get command or test case
	foreach {group name constraints setup body cleanup match result output errorOutput returnCodes} $list {
	    if {$group eq "command"} {
		puts $out $name

	    } elseif {$group ne "" && $body ne ""} {
		# Remove illegal characters
		set group [string map [list " " "_"] $group]
		set group [string map [list " " "_" "-" "_"] $group]
		set name [string map [list "-" "_"] $name]

		# Define test number
		if {$group ne $prev} {
		    incr test
		    set prev $group
		    puts $out ""
		}

		# Test case
		# Create test case
		if {[string index $name 0] ne {$}} {
		    set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name]
		} else {
		    set buffer [format "\ntest %s-%d.%d %s" $group $test [incr cases($group)] $name]
		}

		# Add test case arguments
		foreach opt [list -constraints -setup -body -cleanup -match -result -output -errorOutput -returnCodes] {
		    set cmd [string trim [set [string trimleft $opt "-"]]]
		    if {$cmd ne ""} {
			if {$opt in [list -setup -body -cleanup]} {
			    append buffer " " $opt " \{\n"
			    foreach line [split $cmd ";"] {
				append buffer \t [string trim $line] \n




︙







Changes to tests/remote.tcl.




︙


9
10
11
12
13
14
15

16
17
18

19
20
21
22
23
24
25

9
10
11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
26








+


-
+








# 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 delimitor
# Initialize message delimiter

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

# Detect whether we should print out connection messages etc.




︙


41
42
43
44
45
46
47

48
49


50
51
52
53
54

55
56

57


58
59
60
61
62
63
64

42
43
44
45
46
47
48
49


50
51
52
53
54
55

56
57

58
59
60
61
62
63
64
65
66
67
68








+
-
-
+
+




-
+

-
+

+
+








	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} {
    if {[catch {uplevel "#0" $l} msg]} {
	if {0} {
	    set fd [open remoteServer.log a]
	    puts $fd "error: $msg"
	    close $fd
	}
	list error $msg
	set code error
    } else {
	list success $msg
	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--"} {




︙


94
95
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121


122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140


141
142
143
144
145
146
147

98
99
100
101
102
103
104

105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123


124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142


143
144
145
146
147
148
149
150
151








-

+

















-
-
+
+

















-
-
+
+








proc __accept__ {s a p} {
    global VERBOSE

    if {$VERBOSE} {
	puts "Server accepts new connection from $a:$p on $s"
    }
    tls::handshake $s
    fileevent $s readable [list __readAndExecute__ $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 < [expr $argc - 1]} {
		set serverPort [lindex $argv [expr $i + 1]]
	    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 < [expr $argc - 1]} {
		set serverAddress [lindex $argv [expr $i + 1]]
	    if {$i < $argc - 1} {
		set serverAddress [lindex $argv [expr {$i + 1}]]
	    }
	    break
	}
    }
}
if {![info exists serverAddress]} {
    set serverAddress 0.0.0.0




︙


173
174
175
176
177
178
179
180

181
182
183
184

185
186

177
178
179
180
181
182
183

184
185
186
187
188
189
190
191








-
+




+



}

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 -myaddr $serverAddress -server __accept__ \
	[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__
}








Changes to tests/simpleClient.tcl.



1
2

3
4
5
6
7
8
9
10

11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
26


27
28
29
30
31
32
33

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36



+







-
+




+











-
+
+








#!/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)		lorax
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-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




︙


102
103
104
105
106
107
108
109

110
111

105
106
107
108
109
110
111

112
113
114








-
+



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

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

go








Changes to tests/simpleServer.tcl.



1
2

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

22
23
24
25
26
27
28

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29



+


















-
+








#!/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 Certification ($OPTS(-require))\
		\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.




︙







Changes to tests/tlsIO.test.




︙


66
67
68
69
70
71
72

73
74
75
76
77
78
79

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80








+








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]




︙


99
100
101
102
103
104
105
106

107
108

109
110
111
112
113
114
115

100
101
102
103
104
105
106

107
108

109
110
111
112
113
114
115
116








-
+

-
+








	set remoteServerIP $env(remoteServerIP)
    }
}
if {![info exists remoteServerPort]} {
    if {[info exists env(remoteServerPort)]} {
	set remoteServerPort $env(remoteServerPort)
    } else {
        if {[info exists remoteServerIP]} {
	if {[info exists remoteServerIP]} {
	    set remoteServerPort $tlsServerPort
        }
	}
    }
}

proc do_handshake {s {type readable} {cmd {}} args} {
    if {[eof $s]} {
	close $s
	dputs "handshake: eof"




︙


151
152
153
154
155
156
157
158

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173


174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194

195
196
197
198
199
200
201

152
153
154
155
156
157
158

159
160
161
162
163
164
165
166
167
168
169
170
171
172


173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194

195
196
197
198
199
200
201
202








-
+













-
-
+
+




















-
+








# 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 \
    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 -cafile $caCert \
			-certfile $clientCert -keyfile $clientKey \
		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 {
		set noRemoteTestReason "$msg $::tcltest::tcltest"
		set doTestsWithRemoteServer 0
	    }
	}
    } else {
	fconfigure $commandSocket -translation crlf -buffering line
    }
}

# Some tests are run only if we are doing testing against a remote server.
set ::tcltest::testConstraints(doTestsWithRemoteServer) $doTestsWithRemoteServer
if {$doTestsWithRemoteServer == 0} {
    if {[string first s $::tcltest::verbose] != -1} {
    	puts "Skipping tests with remote server. See tests/socket.test for"
	puts "Skipping tests with remote server. See tests/socket.test for"
	puts "information on how to run remote server."
	puts "Reason for not doing remote tests: $noRemoteTestReason"
    }
}

#
# If we do the tests, define a command to send a command to the




︙


300
301
302
303
304
305
306

307
308

309
310

311
312
313
314
315

316
317
318
319
320
321
322
323
324
325
326
327
328

329
330
331


332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348

349
350

351
352

353
354
355
356
357
358




359
360
361
362
363
364
365
366
367
368
369

370
371
372

373
374
375

376
377
378


379
380
381
382
383
384
385
386
387
388

389
390

391
392

393
394
395
396
397
398




399
400
401
402
403
404
405
406
407
408

409
410
411

412
413

414
415
416


417
418
419
420
421
422
423
424
425
426

427
428

429
430

431
432
433
434
435
436




437
438
439
440
441
442
443
444
445
446

447
448

449
450

451
452
453


454
455
456
457
458
459
460
461
462
463

464
465

466
467

468
469
470
471
472
473




474
475
476
477
478
479
480
481
482
483

484
485

486
487

488
489
490


491
492
493
494

495
496
497

498
499
500
501
502
503
504
505
506
507
508
509
510

511
512

513
514

515
516
517

518
519

520
521
522
523
524
525
526
527
528







529
530
531
532
533
534
535
536
537
538
539

540
541
542
543
544
545
546
547
548
549
550
551
552
553
554

555

556
557

558

559
560
561
562



563
564
565
566
567
568
569
570
571
572
573










574
575
576
577

578
579
580
581

582
583
584

585
586


587
588


589
590
591
592

593
594
595
596
597

598
599
600
601
602

603
604
605
606

607
608

609
610
611
612
613
614
615
616
617
618
619
620
621
622


623
624
625
626
627
628
629
630
631
632
633
634
635
636

637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656

657
658
659

660
661
662
663
664
665
666

301
302
303
304
305
306
307
308
309

310
311

312
313
314
315
316

317
318
319
320
321
322
323
324
325
326
327
328
329

330
331


332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352

353
354

355
356
357




358
359
360
361
362
363
364
365
366
367
368
369
370
371

372
373
374

375
376
377

378
379


380
381
382
383
384
385
386
387
388
389
390
391
392
393

394
395

396
397
398




399
400
401
402
403
404
405
406
407
408
409
410
411

412
413
414

415
416

417
418


419
420
421
422
423
424
425
426
427
428
429
430
431
432

433
434

435
436
437




438
439
440
441
442
443
444
445
446
447
448
449
450

451
452

453
454

455
456


457
458
459
460
461
462
463
464
465
466
467
468
469
470

471
472

473
474
475




476
477
478
479
480
481
482
483
484
485
486
487
488

489
490

491
492

493
494


495
496
497
498
499
500
501
502
503

504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519

520
521

522
523
524

525
526

527
528
529







530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546

547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563

564
565

566
567
568
569



570
571
572
573










574
575
576
577
578
579
580
581
582
583
584
585
586

587
588
589
590

591
592
593
594
595


596
597
598

599
600
601
602
603

604
605
606
607
608

609
610
611
612
613

614
615
616
617
618
619
620

621
622
623
624
625
626
627
628
629
630
631
632
633


634
635
636
637
638
639
640
641
642
643
644
645
646
647
648

649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668

669
670
671

672
673
674
675
676
677
678
679








+

-
+

-
+




-
+












-
+

-
-
+
+

















+

-
+

-
+


-
-
-
-
+
+
+
+










-
+


-
+


-
+

-
-
+
+










+

-
+

-
+


-
-
-
-
+
+
+
+









-
+


-
+

-
+

-
-
+
+










+

-
+

-
+


-
-
-
-
+
+
+
+









-
+

-
+

-
+

-
-
+
+










+

-
+

-
+


-
-
-
-
+
+
+
+









-
+

-
+

-
+

-
-
+
+




+


-
+













+

-
+

-
+


-
+

-
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+










-
+















+
-
+

-
+

+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+



-
+



-
+



+
-
-
+
+

-
+
+



-
+




-
+




-
+




+

-
+












-
-
+
+













-
+



















-
+


-
+








} {1 {expected integer but got "badport"}}

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 prefer latest
	package require tls
	set timer [after 2000 "set x timed_out"]
	set timer [after 2000 [list set x timed_out]]
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
    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
	    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 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8828} msg]} {
        set x $msg
	set x $msg
    } else {
        lappend x [gets $f]
        close $msg
	lappend x [gets $f]
	close $msg
    }
    lappend x [gets $f]
    close $f
    set x
} {ready done {}}

if [info exists port] {
    incr port
} else {
    set port [expr {$tlsServerPort + [pid]%1024}]
}

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 prefer latest
	package require tls
	set timer [after 2000 "set x done"]
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8829 \]"
    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
	    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 \
    if {[catch {tls::socket -myport $port -require 0 \
	-certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8829} sock]} {
        set x $sock
	set x $sock
	catch {close [tls::socket 127.0.0.1 8829]}
    } else {
        puts $sock hello
	puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $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 prefer latest
	package require tls
	set timer [after 2000 "set x done"]
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8830 \]"
    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
	    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 \
    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
	set x $sock
    } else {
        puts $sock hello
	puts $sock hello
	catch {flush $sock}
        lappend x [gets $f]
        close $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 prefer latest
	package require tls
	set timer [after 2000 "set x done"]
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr localhost 8831 \]"
    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
	    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 -certfile $clientCert -cafile $caCert \
    if {[catch {tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey localhost 8831} sock]} {
        set x $sock
	set x $sock
    } else {
        puts $sock hello
	puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $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 prefer latest
	package require tls
	set timer [after 2000 "set x done"]
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8832 \]"
    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
	    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 -certfile $clientCert -cafile $caCert \
    if {[catch {tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8832} sock]} {
        set x $sock
	set x $sock
    } else {
        puts $sock hello
	puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $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 127.0.0.1 8833]}]} {
    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 prefer latest
	package require tls
	set timer [after 2000 "set x done"]
	set timer [after 2000 [list set x done]]
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8834 \]"
    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]
	    fileevent $s readable [list echo $s]
	    fconfigure $s -translation lf -buffering line
        }
	}
	proc echo {s} {
	     set l [gets $s]
             if {[eof $s]} {
                 global x
                 close $s
                 set x done
             } else {
                 puts $s $l
             }
	     if {[eof $s]} {
		 global x
		 close $s
		 set x done
	     } else {
		 puts $s $l
	     }
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
	puts done
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    gets $f
    set s [tls::socket -certfile $clientCert -cafile $caCert \
    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 prefer latest
    	package require tls
	package require tls
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8835 \]"
    puts $f "set f \[tls::socket -server accept -require 0 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8835 \]"
    puts $f {
	fconfigure $f -blocking 1 -buffering line
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	    fileevent $s readable [list echo $s]
	    fconfigure $s -blocking 0 -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
             }
	    global i
	    set l [gets $s]
	    if {[eof $s]} {
		global x
		close $s
		set x done
	    } elseif {[string length $l] > 0} {
		incr i
		puts $s $l
	    }
	}
	set i 0
	puts ready
	set timer [after 20000 "set x done"]
	set timer [after 20000 [list set x time-out]]
	vwait x
	after cancel $timer
	close $f
	puts "done $i"
	puts "$x $i"
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r]
    fconfigure $f -blocking 1 -buffering line
    gets $f
    set s [tls::socket -certfile $clientCert -cafile $caCert \
    gets $f var
    set s [tls::socket -require 0 -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey 127.0.0.1 8835]
    fconfigure $s -buffering line
    fconfigure $s -blocking 1 -buffering line
    tls::handshake $s
    catch {
	for {set x 0} {$x < 50} {incr x} {
	    puts $s "hello abcdefghijklmnop"
	    gets $s
	    gets $s var
	}
    }
    close $s
    catch {set x [gets $f]}
    close $f
    catch {close $f}
    set x
} {done 50}

test tlsIO-2.9 {socket conflict} {socket stdio} {
    set s [tls::socket -server accept 8828]
    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 prefer latest
	package require tls
	tls::socket -server accept 8828
	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 "set done timed_out"]
    set ss [tls::socket -server accept -certfile $serverCert -cafile $caCert \
    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 -certfile $clientCert -cafile $caCert \
    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 \
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8400]
    set sock ""
    set s2 [tls::socket -certfile $clientCert -cafile $caCert \
    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




︙


687
688
689
690
691
692
693

694
695
696


697
698
699
700

701
702
703
704
705
706
707
708
709
710
711
712


713
714
715


716
717
718
719
720
721
722
723
724
725
726

727
728
729

730
731
732
733
734
735
736
737
738
739


740
741
742
743
744
745
746
747
748
749
750
751

752
753
754
755



756
757
758

759
760
761
762
763
764
765
766
767
768
769
770
771
772







773
774
775
776
777
778
779
780
781
782
783
784
785
786
787

788
789
790
791

792
793
794
795

796
797
798
799
800
801
802

700
701
702
703
704
705
706
707
708


709
710
711
712
713

714
715
716
717
718
719
720
721
722
723
724


725
726
727


728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743

744
745
746
747
748
749
750
751
752


753
754

755
756
757
758
759
760
761
762
763
764
765
766
767



768
769
770
771
772

773
774
775
776
777
778
779
780







781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801

802
803
804
805

806
807
808
809

810
811
812
813
814
815
816
817








+

-
-
+
+



-
+










-
-
+
+

-
-
+
+











+


-
+








-
-
+
+
-











+

-
-
-
+
+
+


-
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+














-
+



-
+



-
+








	{socket stdio unixOnly} {
    # 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 prefer latest
	package require tls
	set timer [after 2000 "set x timed_out"]
	set f [tls::socket -server accept 8828]
	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
	    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 127.0.0.1 8828} msg]} {
        set x $msg
    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 $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 prefer latest
	package require tls
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
    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 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
    set x [list [catch {tls::socket -server accept -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey 8828} msg] \
    	-server accept 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 prefer latest
	package require tls
	set t1 [after 30000 "set x timed_out"]
	set t2 [after 31000 "set x timed_out"]
	set t3 [after 32000 "set x timed_out"]
	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 -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]"
    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
             set l [gets $s]
             if {[eof $s]} {
                 close $s
                 set x done
             } else {
                 puts $s $l
             }
	     set l [gets $s]
	     if {[eof $s]} {
		 close $s
		 set x done
	     } else {
		 puts $s $l
	     }
	}
	puts ready
	vwait x
	after cancel $t1
	vwait x
	after cancel $t2
	vwait 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 \
    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 \
    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 \
    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




︙


814
815
816
817
818
819
820

821
822
823
824

825
826
827
828
829
830
831

829
830
831
832
833
834
835
836
837
838
839

840
841
842
843
844
845
846
847








+



-
+









test tlsIO-4.1 {server with several clients} {socket stdio} {
    # have seen intermittent hangs on Windows
    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package prefer latest
	package require tls
	gets stdin
    }
    puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]"
    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




︙


841
842
843
844
845
846
847
848
849
850
851
852
853
854







855
856
857
858
859
860





861
862
863
864
865
866
867
868

857
858
859
860
861
862
863







864
865
866
867
868
869
870
871





872
873
874
875
876

877
878
879
880
881
882
883








-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-








    fconfigure $p3 -buffering line
    proc accept {s a p} {
	fconfigure $s -buffering line
	fileevent $s readable [list echo $s]
    }
    proc echo {s} {
	global x
        set l [gets $s]
        if {[eof $s]} {
            close $s
            set x done
        } else {
            puts $s $l
        }
	set l [gets $s]
	if {[eof $s]} {
	    close $s
	    set x done
	} else {
	    puts $s $l
	}
    }
    set t1 [after 30000 "set x timed_out"]
    set t2 [after 31000 "set x timed_out"]
    set t3 [after 32000 "set x timed_out"]
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    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]
	    -server accept 8828]
    puts $p1 open
    puts $p2 open
    puts $p3 open
    vwait x
    vwait x
    vwait x
    after cancel $t1




︙


880
881
882
883
884
885
886
887

888
889
890
891
892
893
894
895
896
897
898
899


900
901
902
903
904
905
906

907
908
909
910
911
912
913
914
915

916
917
918
919
920
921
922
923
924
925
926
927
928

929

930
931
932
933
934
935
936
937
938
939
940

941
942
943
944

945
946
947
948
949
950
951
952
953
954
955
956

957
958
959

960
961
962
963
964
965
966
967

968
969
970
971
972
973
974

895
896
897
898
899
900
901

902
903
904
905
906
907
908
909
910
911
912


913
914
915
916
917
918
919
920

921
922
923
924
925
926
927
928
929

930
931
932
933
934
935
936
937
938
939
940
941
942
943
944

945
946
947
948
949
950
951
952
953
954
955

956
957
958
959

960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975

976
977
978
979
980
981
982
983

984
985
986
987
988
989
990
991








-
+










-
-
+
+






-
+








-
+













+
-
+










-
+



-
+












+


-
+







-
+








    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 0x3000} msg]} {
    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 0x1} msg]} {
        set x {htons problem, should be disallowed, are you running as SU?}
    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 0x10000} msg]} {
    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 21} msg]} {
    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} {
    # 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 prefer latest
    	package require tls
	package require tls
	gets stdin
    }
    puts $f [list tls::socket -cafile $caCert 127.0.0.1 8848]
    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 \
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8848]
    puts $f hello
    close $f
    set timer [after 10000 "set x timed_out"]
    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 prefer latest
	package require tls
    }
    puts $f [list tls::socket -server accept \
    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 "set x timed_out"]
	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 \




︙


984
985
986
987
988
989
990

991
992
993

994
995
996
997
998
999
1000

1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021


1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035


1036
1037
1038
1039
1040
1041
1042
1043
1044
1045


1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058


1059
1060
1061
1062
1063
1064
1065
1066
1067
1068

1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081


1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113

1114

1115
1116
1117
1118
1119
1120
1121

1001
1002
1003
1004
1005
1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017

1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037


1038
1039

1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050


1051
1052

1053
1054
1055
1056
1057
1058
1059


1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072


1073
1074

1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094


1095
1096

1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108

1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128

1129
1130
1131
1132
1133
1134
1135
1136








+


-
+






-
+



















-
-
+
+
-











-
-
+
+
-







-
-
+
+











-
-
+
+
-








-
+











-
-
+
+
-












-
+


















+
-
+








} {0 0 3}

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 prefer latest
	package require tls
    }
    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8821"
    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 "set x timed_out"]
	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 \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -server accept -require 0 \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey 8822]
    	-server accept 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 \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -server accept -require 0 \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey 8823]
    	-server accept 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 "set x timed_out"]
	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 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8829]
	    -server accept 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 "set x timed_out"]
    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 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8830]
	    -server accept 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 \
    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 events} {socket} {
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} {




︙


1130
1131
1132
1133
1134
1135
1136
1137
1138


1139
1140

1141
1142
1143
1144
1145
1146
1147
1148
1149


1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160

1145
1146
1147
1148
1149
1150
1151


1152
1153


1154
1155
1156
1157
1158
1159
1160
1161


1162
1163
1164
1165


1166
1167
1168
1169
1170
1171
1172








-
-
+
+
-
-
+







-
-
+
+


-
-








	}
    }
    proc accept {s a p} {
	fconfigure $s -blocking 0
	fileevent $s readable [list do_handshake $s readable readlittle \
		-buffering none]
    }
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8831]
	    -server accept 8831]
    set c [tls::socket \
    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 timer2 [after 2000 [list close $c]]
    set timer [after 10000 "set done timed_out"]
    set timer [after 10000 [list set done timed_out]]
    after 1000 [list close $c]
    vwait done
    after cancel $timer
    after cancel $timer2
    catch {close $c}
    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]




︙


1180
1181
1182
1183
1184
1185
1186
1187
1188


1189
1190

1191
1192

1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207

1208
1209

1210
1211

1212

1213
1214
1215
1216
1217
1218
1219

1192
1193
1194
1195
1196
1197
1198


1199
1200


1201
1202

1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217

1218
1219

1220
1221
1222
1223

1224
1225
1226
1227
1228
1229
1230
1231








-
-
+
+
-
-
+

-
+














-
+

-
+


+
-
+








    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 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8839]
	    -server accept 8832]
    set c [tls::socket \
    set c [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    localhost 8832]
	    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 "readit $c"
    fileevent $c readable [list readit $c]
    set done 0
    set timer [after 10000 "set done timed_out"]
    set timer [after 10000 [list set done timed_out]]
    vwait done
    after cancel $timer
    catch {close $c}
    close $s
    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




︙


1241
1242
1243
1244
1245
1246
1247
1248
1249


1250
1251

1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267

1268
1269

1270
1271
1272
1273
1274
1275
1276
1277
1278
1279

1280
1281
1282
1283
1284
1285
1286
1287

1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304

1305
1306
1307
1308
1309
1310
1311
1312

1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328

1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343


1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359

1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373

1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389

1390
1391
1392
1393
1394
1395
1396

1253
1254
1255
1256
1257
1258
1259


1260
1261


1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277

1278
1279

1280
1281
1282
1283
1284
1285
1286
1287
1288
1289

1290
1291
1292
1293
1294
1295
1296
1297

1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314

1315
1316
1317
1318
1319
1320
1321
1322

1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338

1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352


1353
1354

1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368

1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382

1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398

1399
1400
1401
1402
1403
1404
1405
1406








-
-
+
+
-
-
+















-
+

-
+









-
+







-
+
















-
+







-
+















-
+













-
-
+
+
-














-
+













-
+















-
+








	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 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8833]
	    -server accept 8833]
    set c [tls::socket \
    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 -cafile $caCert -server accept 8898]
    set s [tls::socket -server accept -require 0 -cafile $caCert 8898]
    proc accept {s a p} {close $s; error}
    set c [tls::socket -cafile $caCert 127.0.0.1 8898]
    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 \
	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 \
    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 \
	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 \
    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 \
    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 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
	set socket10_6_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
		-server accept 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 \
    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 \
	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 \
    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




︙


1405
1406
1407
1408
1409
1410
1411
1412
1413


1414
1415
1416


1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431


1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446

1447
1448
1449
1450

1451
1452
1453
1454

1455
1456
1457
1458
1459
1460
1461

1415
1416
1417
1418
1419
1420
1421


1422
1423



1424
1425

1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437


1438
1439

1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452

1453
1454
1455
1456

1457
1458
1459
1460

1461
1462
1463
1464
1465
1466
1467
1468








-
-
+
+
-
-
-
+
+
-












-
-
+
+
-













-
+



-
+



-
+








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 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s1 [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
	    -server accept 8836]
    if {[catch {set s2 [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    if {[catch {set s2 [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]} msg]} {
	    -server accept 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 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
	set socket10_9_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
		-server accept 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 \
    set s1 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    fconfigure $s1 -buffering line
    set s2 [tls::socket \
    set s2 [tls::socket -require 0 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    $remoteServerIP 8836]
    fconfigure $s2 -buffering line
    set s3 [tls::socket \
    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




︙


1470
1471
1472
1473
1474
1475
1476
1477
1478
1479



1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502



1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519


1520
1521
1522
1523
1524
1525
1526
1527
1528
1529

1530
1531
1532
1533

1534
1535
1536
1537

1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549


1550
1551
1552
1553

1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569

1570
1571
1572
1573
1574
1575
1576

1477
1478
1479
1480
1481
1482
1483



1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506



1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524


1525
1526

1527
1528
1529
1530
1531
1532
1533
1534

1535
1536
1537
1538

1539
1540
1541
1542

1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553


1554
1555

1556
1557

1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573

1574
1575
1576
1577
1578
1579
1580
1581








-
-
-
+
+
+




















-
-
-
+
+
+















-
-
+
+
-








-
+



-
+



-
+










-
-
+
+
-


-
+















-
+








    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" 4003]
	set s2 [tls::socket -server "accept 4004" 4004]
	set s3 [tls::socket -server "accept 4005" 4005]
	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 $remoteServerIP 4003]
    set s2 [tls::socket $remoteServerIP 4004]
    set s3 [tls::socket $remoteServerIP 4005]
    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 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set s [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
	    -server accept 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 \
	    set s [tls::socket -require 0 \
		    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
		    [lindex $peername 0] 8836]
	    close $s
    	 }} msg]} {
	 }} msg]} {
	close $s
	error $msg
    }
    set timer [after 10000 "set x timed_out"]
    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 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
	set socket10_12_test_server [tls::socket -server accept -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
		-server accept 8836]
	proc accept {s a p} {close $s}
    }
    set s [tls::socket \
    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 \
	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} {




︙


1603
1604
1605
1606
1607
1608
1609
1610

1611
1612
1613
1614
1615
1616
1617
1618

1619
1620
1621
1622
1623
1624
1625

1608
1609
1610
1611
1612
1613
1614

1615
1616
1617
1618
1619
1620
1621
1622

1623
1624
1625
1626
1627
1628
1629
1630








-
+







-
+








		close $s
		set done 1
	    }
	} else {
	    incr len [string length $l]
	}
    }
    set c [tls::socket \
    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 "set done timed_out"]
    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} {




︙


1642
1643
1644
1645
1646
1647
1648
1649
1650


1651
1652
1653
1654
1655
1656
1657

1658
1659
1660
1661
1662
1663
1664

1647
1648
1649
1650
1651
1652
1653


1654
1655

1656
1657
1658
1659
1660

1661
1662
1663
1664
1665
1666
1667
1668








-
-
+
+
-





-
+








    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 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey \
	set socket10_14_test_server [tls::socket -server accept  -require 0 \
		-certfile $serverCert -cafile $caCert -keyfile $serverKey 8836]
		-server accept 8836]
	proc accept {s a p} {
	    tls::handshake $s
	    after 100 close $s
	}
    }
    set c [tls::socket \
    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




︙


1675
1676
1677
1678
1679
1680
1681
1682
1683


1684
1685
1686
1687
1688
1689
1690
1691

1679
1680
1681
1682
1683
1684
1685


1686
1687

1688
1689
1690
1691
1692
1693
1694








-
-
+
+
-








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




︙


1700
1701
1702
1703
1704
1705
1706
1707

1708
1709
1710
1711
1712
1713
1714

1715
1716
1717
1718
1719
1720
1721

1703
1704
1705
1706
1707
1708
1709

1710
1711
1712
1713
1714
1715
1716

1717
1718
1719
1720
1721
1722
1723
1724








-
+






-
+








	}
	proc writedata {s} {
	    global secondblock
	    puts -nonewline $s $secondblock
	    close $s
	}
    }
    set s [tls::socket \
    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 "set done timed_out"]
    set timer [after 10000 [list set done timed_out]]
    vwait done
    after cancel $timer
    sendCommand {close $l}
    set count
} 65566

proc getdata {type file} {




︙


1760
1761
1762
1763
1764
1765
1766

1767
1768
1769

1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790

1791
1792

1793
1794
1795
1796
1797
1798
1799

1763
1764
1765
1766
1767
1768
1769
1770
1771
1772

1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793

1794
1795

1796
1797
1798
1799
1800
1801
1802
1803








+


-
+




















-
+

-
+








    # waits a second, and exits.  The server socket will now
    # be closed unless script1 inherited it.

    set f [open script2 w]
    puts $f [list set tclsh $::tcltest::tcltest]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package prefer latest
	package require tls
    }
    puts $f "set f \[tls::socket -server accept \
    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 \
    if {[catch {tls::socket -require 0 \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
   	 127.0.0.1 8828} msg]} {
	 127.0.0.1 8828} msg]} {
	set x {server socket was not inherited}
    } else {
	close $msg
	set x {server socket was inherited}
    }

    set x




︙


1817
1818
1819
1820
1821
1822
1823

1824
1825
1826

1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840


1841
1842
1843
1844
1845
1846
1847
1848

1821
1822
1823
1824
1825
1826
1827
1828
1829
1830

1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843


1844
1845

1846
1847
1848
1849
1850
1851
1852








+


-
+












-
-
+
+
-








    # launches script1 and exits.  If the child process inherited the
    # client socket, the socket will still be open.

    set f [open script2 w]
    puts $f [list set tclsh $::tcltest::tcltest]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package prefer latest
	package require tls
    }
    puts $f "set f \[tls::socket -certfile $clientCert -cafile $caCert \
    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 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
    set server [tls::socket -server accept -require 0 \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8829]
	    -server accept 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]




︙


1878
1879
1880
1881
1882
1883
1884

1885
1886
1887

1888
1889
1890
1891
1892
1893
1894

1882
1883
1884
1885
1886
1887
1888
1889
1890
1891

1892
1893
1894
1895
1896
1897
1898
1899








+


-
+








    }
    close $f

    set f [open script2 w]
    puts $f [list set tclsh $::tcltest::tcltest]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package prefer latest
	package require tls
    }
    puts $f "set f \[tls::socket -server accept \
    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 &




︙


1902
1903
1904
1905
1906
1907
1908
1909

1910
1911
1912
1913
1914
1915
1916

1907
1908
1909
1910
1911
1912
1913

1914
1915
1916
1917
1918
1919
1920
1921








-
+








    # the socket stays open

    exec $::tcltest::tcltest script2 &

    after 2000 set ok_to_proceed 1
    vwait ok_to_proceed

    set f [tls::socket \
    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]




︙


1928
1929
1930
1931
1932
1933
1934

1935
1936


1937
1938
1939
1940



1941
1942
1943
1944
1945
1946
1947
1948






1949
1950
1951


1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966

1967
1968
1969
1970
1971
1972
1973

1933
1934
1935
1936
1937
1938
1939
1940


1941
1942
1943



1944
1945
1946
1947
1948






1949
1950
1951
1952
1953
1954
1955


1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971

1972
1973
1974
1975
1976
1977
1978
1979








+
-
-
+
+

-
-
-
+
+
+


-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+














-
+








test tlsIO-13.1 {Testing use of shared socket between two threads} \
	{socket testthread} {
    # HOBBS: never tested
    removeFile script
    threadReap

    makeFile {
	package prefer latest
    	package require tls
	set f [tls::socket -server accept 8828]
	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
        }
	    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 {
	     set l [gets $s]
	     if {[eof $s]} {
		 global x
		 close $s
		 set x done
	     } else {
	         incr i
                 puts $s $l
             }
		 puts $s $l
	     }
	}
	set i 0
	vwait x
	close $f

	# thread cleans itself up.
	testthread exit
    } script

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

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

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




︙


2013
2014
2015
2016
2017
2018
2019

2020

2021
2022
2023


2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035



2036
2037
2038
2039
2040



2041
2042
2043
2044
2045
2046
2047
2048



2049
2050
2051
2052

2053
2054
2055
2056
2057
2058
2059
2060
2061




2062
2063
2064
2065
2066
2067
2068

2019
2020
2021
2022
2023
2024
2025
2026

2027



2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038



2039
2040
2041
2042
2043



2044
2045
2046
2047
2048
2049
2050
2051



2052
2053
2054

2055
2056

2057
2058
2059
2060
2061
2062




2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073








+
-
+
-
-
-
+
+









-
-
-
+
+
+


-
-
-
+
+
+





-
-
-
+
+
+
-


-
+





-
-
-
-
+
+
+
+








	}
    }
    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 \
    set s [tls::socket -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey 8838]
	    -server accept 8831]
    set c [tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    localhost 8831]
    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 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
	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 \
        -certfile $serverCert -cafile $caCert -keyfile $serverKey -request 0 \
	-require 0 -ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 0 -tls1.3 1 \
    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]
        -server Accept 8831]
    # 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 8831]
	-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" {
            set ::done "handshake failed: wrong version number"
        }
	"handshake failed: wrong ssl version" -
	"handshake failed: unsupported protocol" {
	    set ::done "handshake failed: wrong version number"
	}
    }
    catch {close $c}
    catch {close $s}
    set ::done
} {handshake failed: wrong version number}

# cleanup




︙







Changes to win/rules.vc.




︙


20
21
22
23
24
25
26
27

28
29
30
31
32
33
34

20
21
22
23
24
25
26

27
28
29
30
31
32
33
34








-
+








!ifndef _RULES_VC
_RULES_VC = 1

# The following macros define the version of the rules.vc nmake build system
# For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
RULES_VERSION_MINOR = 13
RULES_VERSION_MINOR = 15

# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
!endif

!if "$(PRJ_PACKAGE_TCLNAME)" == ""




︙


693
694
695
696
697
698
699
700

701
702
703
704
705
706
707

693
694
695
696
697
698
699

700
701
702
703
704
705
706
707








-
+









!if [echo REM = This file is generated from rules.vc > versions.vc]
!endif
!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" "define TCL_MAJOR_VERSION" >> versions.vc]
!endif
!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
   && [nmakehlp -V "$(_TCL_H)" "define TCL_MINOR_VERSION" >> versions.vc]
!endif
!if [echo TCL_RELEASE_SERIAL = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_RELEASE_SERIAL >> versions.vc]
!endif
!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
!endif




︙


877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894

877
878
879
880
881
882
883




884
885
886
887
888
889
890








-
-
-
-








USE_THREAD_ALLOC= 0
!endif

!if [nmakehlp -f $(OPTS) "tcl8"]
!message *** Build for Tcl8
TCL_BUILD_FOR = 8
!endif
!if [nmakehlp -f $(OPTS) "tk8"]
!message *** Build for Tk8
TK_BUILD_FOR = 8
!endif

!if $(TCL_MAJOR_VERSION) == 8
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif
!endif




︙


1293
1294
1295
1296
1297
1298
1299

1300

1301
1302
1303
1304
1305
1306
1307

1289
1290
1291
1292
1293
1294
1295
1296

1297
1298
1299
1300
1301
1302
1303
1304








+
-
+








tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"

!endif # $(DOING_TK)
!endif # $(DOING_TK) || $(NEED_TK)

# Various output paths
PRJIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
# Even when building against Tcl 9, PRJLIBNAME8 must have "t"
PRJLIBNAME8	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
PRJLIBNAME8	= $(PROJECT)$(VERSION)t$(SUFX:t=).$(EXT)
# Even when building against Tcl 8, PRJLIBNAME9 must not have "t"
PRJLIBNAME9	= tcl9$(PROJECT)$(VERSION)$(SUFX:t=).$(EXT)
!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
PRJLIBNAME	= $(PRJLIBNAME8)
!else
PRJLIBNAME	= $(PRJLIBNAME9)
!endif




︙


1449
1450
1451
1452
1453
1454
1455
1456

1457
1458
1459
1460
1461
1462
1463
1464
1465
1466

1446
1447
1448
1449
1450
1451
1452

1453



1454
1455
1456
1457
1458
1459
1460








-
+
-
-
-









!if $(TCL_MAJOR_VERSION) == 8
!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES	= $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
!endif
!endif
!if "$(TCL_BUILD_FOR)" == "8"
OPTDEFINES	= $(OPTDEFINES) /DTCL_MAJOR_VERSION=8
OPTDEFINES	= $(OPTDEFINES) /DTCL_MAJOR_VERSION=8 /DTK_MAJOR_VERSION=8
!endif
!if "$(TK_BUILD_FOR)" == "8"
OPTDEFINES	= $(OPTDEFINES) /DTK_MAJOR_VERSION=8
!endif

# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
# so we pass both
!if !$(DOING_TCL) && !$(DOING_TK)
PKGNAMEFLAGS = /DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \




︙


1584
1585
1586
1587
1588
1589
1590
1591

1592
1593
1594
1595
1596
1597
1598

1578
1579
1580
1581
1582
1583
1584

1585
1586
1587
1588
1589
1590
1591
1592








-
+








ldebug= $(ldebug) -profile
!endif

### Declarations common to all linker versions
lflags	= -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)

!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
lflags	= $(lflags) -nodefaultlib:libucrt.lib
lflags	= $(lflags) -nodefaultlib:ucrt.lib
!endif

dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows

# Libraries that are required for every image.




︙


1643
1644
1645
1646
1647
1648
1649
1650

1651
1652
1653
1654
1655
1656
1657
1658
1659

1660
1661
1662
1663
1664
1665
1666

1637
1638
1639
1640
1641
1642
1643

1644
1645
1646
1647
1648
1649
1650
1651
1652

1653
1654
1655
1656
1657
1658
1659
1660








-
+








-
+








DEFAULT_BUILD_TARGET = $(PROJECT)
!endif

default-target: $(DEFAULT_BUILD_TARGET)

!if $(MULTIPLATFORM_INSTALL)
default-pkgindex:
	@echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
	@echo if {[package vsatisfies [package provide Tcl] 9.0]} { > $(OUT_DIR)\pkgIndex.tcl
	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
	@echo } else { >> $(OUT_DIR)\pkgIndex.tcl
	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
	@echo } >> $(OUT_DIR)\pkgIndex.tcl
!else
default-pkgindex:
	@echo if {[package vsatisfies [package provide Tcl] 9.0-]} { > $(OUT_DIR)\pkgIndex.tcl
	@echo if {[package vsatisfies [package provide Tcl] 9.0]} { > $(OUT_DIR)\pkgIndex.tcl
	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PRJLIBNAME9)]] >> $(OUT_DIR)\pkgIndex.tcl
	@echo } else { >> $(OUT_DIR)\pkgIndex.tcl
	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PRJLIBNAME8)]] >> $(OUT_DIR)\pkgIndex.tcl
	@echo } >> $(OUT_DIR)\pkgIndex.tcl
!endif




︙


1692
1693
1694
1695
1696
1697
1698

1699
1700
1701
1702
1703
1704
1705

1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700








+








	@$(CPY) $(PRJLIB) "$(LIB_INSTALL_DIR)" >NUL

# Alias for default-install-scripts
default-install-libraries: default-install-scripts

default-install-scripts: $(OUT_DIR)\pkgIndex.tcl
	@echo Installing libraries to '$(SCRIPT_INSTALL_DIR)'
	@if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
	@if exist $(LIBDIR) $(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)"
	@echo Installing package index in '$(SCRIPT_INSTALL_DIR)'
	@$(CPY) $(OUT_DIR)\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)

default-install-stubs:
	@echo Installing stubs library to '$(SCRIPT_INSTALL_DIR)'
	@if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"




︙







Changes to win/targets.vc.




︙


49
50
51
52
53
54
55

56
57
58
59
60
61
62

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63








+








# Unlike the other default targets, these cannot be in rules.vc because
# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC
# that the parent makefile will not define until after including rules-ext.vc
!if "$(PRJ_HEADERS_PUBLIC)" != ""
default-install: default-install-headers
default-install-headers:
	@echo Installing headers to '$(INCLUDE_INSTALL_DIR)'
	@if not exist "$(INCLUDE_INSTALL_DIR)" $(MKDIR) "$(INCLUDE_INSTALL_DIR)"
	@for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)"
!endif

!if "$(DISABLE_STANDARD_TARGETS)" == ""
DISABLE_STANDARD_TARGETS = 0
!endif





︙














Powered by Fossil · RSS