Check-in [9d265b298a]
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA
Overview
Comment:Merged in changes from master
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | crypto
Files: files | file ages | folders
SHA3-256: 9d265b298ae20e431a327c73af0f5b659967a07526400716251bfb187c02a8b6
User & Date: bohagan on 2024-05-29 01:30:58
Other Links: branch diff | manifest | tags
Context
2024-06-06
01:21
Merged in generate tls.tcl.h and debug mode option changes Leaf check-in: d00f5eca5d user: bohagan tags: crypto
2024-05-29
01:30
Merged in changes from master check-in: 9d265b298a user: bohagan tags: crypto
01:30
Added makefile option to enable SSL3. Disabled by default. Only use for legacy purposes. check-in: e7615b0d88 user: bohagan tags: tls-1.8
2024-05-26
18:15
Updates for MSYS2 check-in: 0046a7f25d user: bohagan tags: crypto
Changes

Modified ChangeLog from [03077231f7] to [dc44957559].

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

	* configure.in: Bump to version 1.6.3.
	* win/makefile.vc:
	* configure: regen with ac-2.59

	* tls.c (MiscObjCmd): Fixed non-static string array used in call
	  of Tcl_GetIndexFromObj(). Memory smash waiting to happen. Thanks
	  to Brian Griffin for alerting us all to the problem. 

2012-06-01  Andreas Kupries  <[email protected]>

	* tls.c: Applied Jeff's patch from
	  http://www.mail-archive.com/[email protected]/msg12356.html

	* configure.in: Bump to version 1.6.2.
	* win/makefile.vc:
	* configure: regen with ac-2.59
	
2010-08-11  Jeff Hobbs  <[email protected]>

	*** TLS 1.6.1 TAGGED ***

	* configure: regen with ac-2.59
	* win/makefile.vc, configure.in: bump version to 1.6.1
	* tclconfig/tcl.m4: updated to TEA 3.8







|









|







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

	* configure.in: Bump to version 1.6.3.
	* win/makefile.vc:
	* configure: regen with ac-2.59

	* tls.c (MiscObjCmd): Fixed non-static string array used in call
	  of Tcl_GetIndexFromObj(). Memory smash waiting to happen. Thanks
	  to Brian Griffin for alerting us all to the problem.

2012-06-01  Andreas Kupries  <[email protected]>

	* tls.c: Applied Jeff's patch from
	  http://www.mail-archive.com/[email protected]/msg12356.html

	* configure.in: Bump to version 1.6.2.
	* win/makefile.vc:
	* configure: regen with ac-2.59

2010-08-11  Jeff Hobbs  <[email protected]>

	*** TLS 1.6.1 TAGGED ***

	* configure: regen with ac-2.59
	* win/makefile.vc, configure.in: bump version to 1.6.1
	* tclconfig/tcl.m4: updated to TEA 3.8
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
	* tls.c:           Silence 64 bit integer conversion warnings
	* win/nmakehlp.c:  Update build system to support AMD64 target
	* win/makefile.vc: with MSVC8
	* win/rules.vc:

2007-06-22  Jeff Hobbs  <[email protected]>

	* tlsIO.c (TlsInputProc, TlsOutputProc, TlsWatchProc): 
	* tls.c (VerifyCallback): add an state flag in the verify callback
	that prevents possibly recursion (on 'update'). [Bug 1652380]

	* tests/ciphers.test: reworked to make test output cleaner to
	understand missing ciphers (if any)

	* Makefile.in, tclconfig/tcl.m4: update to TEA 3.6
	* configure, configure.in:       using autoconf-2.59

2007-02-28  Pat Thoyts  <[email protected]>

	* win/makefile.vc: Rebase the DLL sensibly. Additional libs for 
	static link of openssl.
	* tls.tcl: bug #1579837 - TIP 278 bug (possibly) - fixed.

2006-03-30  Pat Thoyts  <[email protected]>

	* tclconfig/*:  Updated to TEA 3.5 in response to bug 1460491
	* configure*:   Regenerated configure.







|











|







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
	* tls.c:           Silence 64 bit integer conversion warnings
	* win/nmakehlp.c:  Update build system to support AMD64 target
	* win/makefile.vc: with MSVC8
	* win/rules.vc:

2007-06-22  Jeff Hobbs  <[email protected]>

	* tlsIO.c (TlsInputProc, TlsOutputProc, TlsWatchProc):
	* tls.c (VerifyCallback): add an state flag in the verify callback
	that prevents possibly recursion (on 'update'). [Bug 1652380]

	* tests/ciphers.test: reworked to make test output cleaner to
	understand missing ciphers (if any)

	* Makefile.in, tclconfig/tcl.m4: update to TEA 3.6
	* configure, configure.in:       using autoconf-2.59

2007-02-28  Pat Thoyts  <[email protected]>

	* win/makefile.vc: Rebase the DLL sensibly. Additional libs for
	static link of openssl.
	* tls.tcl: bug #1579837 - TIP 278 bug (possibly) - fixed.

2006-03-30  Pat Thoyts  <[email protected]>

	* tclconfig/*:  Updated to TEA 3.5 in response to bug 1460491
	* configure*:   Regenerated configure.
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

	* Makefile.in:      Removed spurious copying of tls.tcl into the
	                    build directory.

2004-12-22  Pat Thoyts  <[email protected]>

	* configure.in:     Incremented minor version to 1.5.1
	* configure:        

2004-12-17  Pat Thoyts  <[email protected]>

	* win/makefile.vc:  Added the MSVC build system (from the Tcl
	* win/rules.vc:     sampleextension).
	* win/nmakehlp.c:
	* win/tls.rc        Added Windows resource file.
	
	* tls.tcl:          From patch #948155, added support for
	                    alternate socket commands.
	* tls.c:            Quieten some MSVC warnings. Prefer ckalloc
	                    over Tcl_Alloc. (David Graveraux).

2004-06-29  Pat Thoyts  <[email protected]>








|







|







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

	* Makefile.in:      Removed spurious copying of tls.tcl into the
	                    build directory.

2004-12-22  Pat Thoyts  <[email protected]>

	* configure.in:     Incremented minor version to 1.5.1
	* configure:

2004-12-17  Pat Thoyts  <[email protected]>

	* win/makefile.vc:  Added the MSVC build system (from the Tcl
	* win/rules.vc:     sampleextension).
	* win/nmakehlp.c:
	* win/tls.rc        Added Windows resource file.

	* tls.tcl:          From patch #948155, added support for
	                    alternate socket commands.
	* tls.c:            Quieten some MSVC warnings. Prefer ckalloc
	                    over Tcl_Alloc. (David Graveraux).

2004-06-29  Pat Thoyts  <[email protected]>

185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
	* pkgIndex.tcl.in, strncasecmp.c (removed):
	* Makefile.in, aclocal.m4, configure, configure.in:
	* tclconfig/README.txt, tclconfig/install-sh, tclconfig/tcl.m4:

2004-03-17  Dan Razzell <[email protected]>

	* tlsX509.c:	Add support for long serial numbers per RFC 3280.
			Format is now hexadecimal. 
			[Request #915313]
			Correctly convert certificate Distinguished Names
			to Tcl string representation.  Eliminates use of
			deprecated OpenSSL function.  Format is now compliant
			with RFC 2253.  [Request #915315]

2004-02-17  Dan Razzell <[email protected]>







|







185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
	* pkgIndex.tcl.in, strncasecmp.c (removed):
	* Makefile.in, aclocal.m4, configure, configure.in:
	* tclconfig/README.txt, tclconfig/install-sh, tclconfig/tcl.m4:

2004-03-17  Dan Razzell <[email protected]>

	* tlsX509.c:	Add support for long serial numbers per RFC 3280.
			Format is now hexadecimal.
			[Request #915313]
			Correctly convert certificate Distinguished Names
			to Tcl string representation.  Eliminates use of
			deprecated OpenSSL function.  Format is now compliant
			with RFC 2253.  [Request #915315]

2004-02-17  Dan Razzell <[email protected]>
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
2003-07-07  Jeff Hobbs  <[email protected]>

	* tls.c (Tls_Init):   added tls::misc command provided by
	* tlsX509.c:          Wojciech Kocjan (wojciech kocjan.org)
	* tests/keytest1.tcl: to expose more low-level SSL commands
	* tests/keytest2.tcl:

2003-05-15  Dan Razzell	<[email protected]> 

	* tls.tcl:
	* tlsInt.h:
	* tls.c: add support for binding a password callback to the socket.
	Now each socket can have its own command and password callbacks instead
	of being forced to have all password management pass through a common
	procedure.  The common password procedure is retained for compatibility







|







236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
2003-07-07  Jeff Hobbs  <[email protected]>

	* tls.c (Tls_Init):   added tls::misc command provided by
	* tlsX509.c:          Wojciech Kocjan (wojciech kocjan.org)
	* tests/keytest1.tcl: to expose more low-level SSL commands
	* tests/keytest2.tcl:

2003-05-15  Dan Razzell	<[email protected]>

	* tls.tcl:
	* tlsInt.h:
	* tls.c: add support for binding a password callback to the socket.
	Now each socket can have its own command and password callbacks instead
	of being forced to have all password management pass through a common
	procedure.  The common password procedure is retained for compatibility
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
	compiling with 8.2.  Now compiles with 8.2+ and tested to work
	with 8.2+ and dynamically adjust to the version of Tcl it was
	loaded into.  TLS will fail the test suite with Tcl 8.2-8.3.1.

	* tests/all.tcl: added catch around ::tcltest::normalizePath
	because it doesn't exist in pre-8.3 tcltest.

	* tests/simpleClient.tcl: 
	* tests/simpleServer.tcl: added simple client/server test scripts
	that use test certs and can do simple stress tests.

2000-08-14  Jeff Hobbs  <[email protected]>

	* tlsInt.h:
	* tlsIO.c:







|







375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
	compiling with 8.2.  Now compiles with 8.2+ and tested to work
	with 8.2+ and dynamically adjust to the version of Tcl it was
	loaded into.  TLS will fail the test suite with Tcl 8.2-8.3.1.

	* tests/all.tcl: added catch around ::tcltest::normalizePath
	because it doesn't exist in pre-8.3 tcltest.

	* tests/simpleClient.tcl:
	* tests/simpleServer.tcl: added simple client/server test scripts
	that use test certs and can do simple stress tests.

2000-08-14  Jeff Hobbs  <[email protected]>

	* tlsInt.h:
	* tlsIO.c:
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
	* tlsIO.c: added support for "corrected" stacked channels.  All
	the above channels are in TCL_CHANNEL_VERSION_2 #ifdefs.

2000-06-05  Scott Stanton  <[email protected]>

	* Makefile.in: Fixed broken test target.

	* tlsInt.h: 
	* tls.c: Cleaned up declarations of Tls_Clean to avoid errors on
	Windows (lint).

2000-06-05  Brent Welch <[email protected]>

	* tls.c, tlsIO.c:  Split Tls_Free into Tls_Clean, which does
	the SSL cleanup, and the Tcl_Free call.  It is important to shutdown







|







478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
	* tlsIO.c: added support for "corrected" stacked channels.  All
	the above channels are in TCL_CHANNEL_VERSION_2 #ifdefs.

2000-06-05  Scott Stanton  <[email protected]>

	* Makefile.in: Fixed broken test target.

	* tlsInt.h:
	* tls.c: Cleaned up declarations of Tls_Clean to avoid errors on
	Windows (lint).

2000-06-05  Brent Welch <[email protected]>

	* tls.c, tlsIO.c:  Split Tls_Free into Tls_Clean, which does
	the SSL cleanup, and the Tcl_Free call.  It is important to shutdown

Modified Makefile.in from [1e424cab1c] to [374d539e3c].

233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
	    $(INSTALL_DATA) $(srcdir)/$$i "$(DESTDIR)$(includedir)" ; \
	done

#========================================================================
# Install documentation.  Unix manpages should go in the $(mandir)
# directory.
#========================================================================
 
install-doc-html: doc
	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(pkglibdir)/html"
	@list='$(srcdir)/doc/*.html'; for i in $$list; do \
	    if test -f $$i ; then \
		echo "Installing $$i"; \
		$(INSTALL_DATA) $$i "$(DESTDIR)$(pkglibdir)/html"; \
	    fi; \







|







233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
	    $(INSTALL_DATA) $(srcdir)/$$i "$(DESTDIR)$(includedir)" ; \
	done

#========================================================================
# Install documentation.  Unix manpages should go in the $(mandir)
# directory.
#========================================================================

install-doc-html: doc
	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(pkglibdir)/html"
	@list='$(srcdir)/doc/*.html'; for i in $$list; do \
	    if test -f $$i ; then \
		echo "Installing $$i"; \
		$(INSTALL_DATA) $$i "$(DESTDIR)$(pkglibdir)/html"; \
	    fi; \

Modified README.txt from [767f622310] to [8780a2ec30].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Tool Command Language (TCL) Transport Layer Security (TLS) Extension

Intro
=====

This package provides an extension which implements Secure Socket Layer (SSL)
and Transport Layer Security (TLS) over Transmission Control Protocol (TCP)
network communication channels. It utilizes either the OpenSSL or LibreSSL
software library.
 
Version 1.9 also provides a cryptography library providing TCL scripts access
to the crypto capabilities of the OpenSSL library.


Description
===========










|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Tool Command Language (TCL) Transport Layer Security (TLS) Extension

Intro
=====

This package provides an extension which implements Secure Socket Layer (SSL)
and Transport Layer Security (TLS) over Transmission Control Protocol (TCP)
network communication channels. It utilizes either the OpenSSL or LibreSSL
software library.

Version 1.9 also provides a cryptography library providing TCL scripts access
to the crypto capabilities of the OpenSSL library.


Description
===========

Modified acinclude.m4 from [5e82556d1f] to [d72291abc4].

8
9
10
11
12
13
14









15
16
17
18
19
20
21
# Add here whatever m4 macros you want to define for your package
#

AC_DEFUN([TCLTLS_SSL_OPENSSL], [
	dnl Determine if pkg-config tool is available
	AC_CHECK_TOOL([PKG_CONFIG], [pkg-config])










	dnl Disable support for TLS 1.0 protocol
	AC_ARG_ENABLE([tls1], AS_HELP_STRING([--disable-tls1], [disable TLS1 protocol]), [
		if test "${enableval}" == "no"; then
			AC_DEFINE([NO_TLS1], [1], [Disable TLS1 protocol])
			AC_MSG_CHECKING([for disable TLS1 protocol])
			AC_MSG_RESULT([yes])
		fi







>
>
>
>
>
>
>
>
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# Add here whatever m4 macros you want to define for your package
#

AC_DEFUN([TCLTLS_SSL_OPENSSL], [
	dnl Determine if pkg-config tool is available
	AC_CHECK_TOOL([PKG_CONFIG], [pkg-config])

	dnl Enable support for SSL 3.0 protocol
	AC_ARG_ENABLE([ssl3], AS_HELP_STRING([--disable-ssl3], [disable SSL3 protocol]), [
		if test "${enableval}" == "no"; then
			AC_DEFINE([NO_SSL3], [1], [Disable SSL3 protocol])
			AC_MSG_CHECKING([for disable SSL3 protocol])
			AC_MSG_RESULT([yes])
		fi
	], AC_DEFINE([NO_SSL3], [1], [Disable SSL3 protocol]))

	dnl Disable support for TLS 1.0 protocol
	AC_ARG_ENABLE([tls1], AS_HELP_STRING([--disable-tls1], [disable TLS1 protocol]), [
		if test "${enableval}" == "no"; then
			AC_DEFINE([NO_TLS1], [1], [Disable TLS1 protocol])
			AC_MSG_CHECKING([for disable TLS1 protocol])
			AC_MSG_RESULT([yes])
		fi

Modified configure from [fc85e27c27] to [464341226c].

764
765
766
767
768
769
770

771
772
773
774
775
776
777
enable_threads
enable_shared
enable_stubs
enable_64bit
enable_64bit_vis
enable_rpath
enable_symbols

enable_tls1
enable_tls1_1
enable_tls1_2
enable_tls1_3
enable_ssl_fastpath
enable_hardening
enable_static_ssl







>







764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
enable_threads
enable_shared
enable_stubs
enable_64bit
enable_64bit_vis
enable_rpath
enable_symbols
enable_ssl3
enable_tls1
enable_tls1_1
enable_tls1_2
enable_tls1_3
enable_ssl_fastpath
enable_hardening
enable_static_ssl
1414
1415
1416
1417
1418
1419
1420

1421
1422
1423
1424
1425
1426
1427
  --enable-shared         build and link with shared libraries (default: on)
  --enable-stubs          build and link with stub libraries. Always true for
                          shared builds (default: on)
  --enable-64bit          enable 64bit support (default: off)
  --enable-64bit-vis      enable 64bit Sparc VIS support (default: off)
  --disable-rpath         disable rpath support (default: on)
  --enable-symbols        build with debugging symbols (default: off)

  --disable-tls1          disable TLS1 protocol
  --disable-tls1_1        disable TLS1.1 protocol
  --disable-tls1_2        disable TLS1.2 protocol
  --disable-tls1_3        disable TLS1.3 protocol
  --enable-ssl-fastpath   enable using the underlying file descriptor for
                          talking directly to the SSL library
  --enable-hardening      enable hardening attempts







>







1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
  --enable-shared         build and link with shared libraries (default: on)
  --enable-stubs          build and link with stub libraries. Always true for
                          shared builds (default: on)
  --enable-64bit          enable 64bit support (default: off)
  --enable-64bit-vis      enable 64bit Sparc VIS support (default: off)
  --disable-rpath         disable rpath support (default: on)
  --enable-symbols        build with debugging symbols (default: off)
  --disable-ssl3          disable SSL3 protocol
  --disable-tls1          disable TLS1 protocol
  --disable-tls1_1        disable TLS1.1 protocol
  --disable-tls1_2        disable TLS1.2 protocol
  --disable-tls1_3        disable TLS1.3 protocol
  --enable-ssl-fastpath   enable using the underlying file descriptor for
                          talking directly to the SSL library
  --enable-hardening      enable hardening attempts
9275
9276
9277
9278
9279
9280
9281






















9282
9283
9284
9285
9286
9287
9288
esac
    PKG_CONFIG=$ac_ct_PKG_CONFIG
  fi
else
  PKG_CONFIG="$ac_cv_prog_PKG_CONFIG"
fi
























		# Check whether --enable-tls1 was given.
if test ${enable_tls1+y}
then :
  enableval=$enable_tls1;
		if test "${enableval}" == "no"; then








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







9277
9278
9279
9280
9281
9282
9283
9284
9285
9286
9287
9288
9289
9290
9291
9292
9293
9294
9295
9296
9297
9298
9299
9300
9301
9302
9303
9304
9305
9306
9307
9308
9309
9310
9311
9312
esac
    PKG_CONFIG=$ac_ct_PKG_CONFIG
  fi
else
  PKG_CONFIG="$ac_cv_prog_PKG_CONFIG"
fi


		# Check whether --enable-ssl3 was given.
if test ${enable_ssl3+y}
then :
  enableval=$enable_ssl3;
		if test "${enableval}" == "no"; then

printf "%s\n" "#define NO_SSL3 1" >>confdefs.h

			{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for disable SSL3 protocol" >&5
printf %s "checking for disable SSL3 protocol... " >&6; }
			{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5
printf "%s\n" "yes" >&6; }
		fi

else case e in #(
  e)
printf "%s\n" "#define NO_SSL3 1" >>confdefs.h
 ;;
esac
fi


		# Check whether --enable-tls1 was given.
if test ${enable_tls1+y}
then :
  enableval=$enable_tls1;
		if test "${enableval}" == "no"; then

Modified generic/tls.c from [15ea667e37] to [5693b2c98c].

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

#define F2N(key, dsp) \
	(((key) == NULL) ? (char *) NULL : \
		Tcl_TranslateFileName(interp, (key), (dsp)))

static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key,
		char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
		int key_asn1_len, int cert_asn1_len, char *CApath, char *CAfile,
		char *ciphers, char *ciphersuites, int level, char *DHparams);

static int	TlsLibInit(int uninitialize);

#define TLS_PROTO_SSL2		0x01
#define TLS_PROTO_SSL3		0x02
#define TLS_PROTO_TLS1		0x04







|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

#define F2N(key, dsp) \
	(((key) == NULL) ? (char *) NULL : \
		Tcl_TranslateFileName(interp, (key), (dsp)))

static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key,
		char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
		Tcl_Size key_asn1_len, Tcl_Size cert_asn1_len, char *CApath, char *CAfile,
		char *ciphers, char *ciphersuites, int level, char *DHparams);

static int	TlsLibInit(int uninitialize);

#define TLS_PROTO_SSL2		0x01
#define TLS_PROTO_SSL3		0x02
#define TLS_PROTO_TLS1		0x04
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
 *-------------------------------------------------------------------
 */
static void
InfoCallback(const SSL *ssl, int where, int ret) {
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    char *major, *minor;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL)
	return;

    if (where & SSL_CB_HANDSHAKE_START) {







|







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
 *-------------------------------------------------------------------
 */
static void
InfoCallback(const SSL *ssl, int where, int ret) {
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    const char *major, *minor;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL)
	return;

    if (where & SSL_CB_HANDSHAKE_START) {
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
 * 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, char *msg) {
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr, *listPtr;
    unsigned long err;
    statePtr->err = msg;

    dprintf("Called");








|







424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
 * 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, const char *msg) {
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr, *listPtr;
    unsigned long err;
    statePtr->err = msg;

    dprintf("Called");

1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
		"\": not a TLS channel", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL);
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, (int) key_len,
	    (int) cert_len, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;








|
|







1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
		"\": not a TLS channel", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL);
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, key_len,
	    cert_len, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	    Tls_Free((tls_free_type *) statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;

1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
 * Side effects:
 *	constructs SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
static SSL_CTX *
CTX_Init(State *statePtr, int isServer, int proto, char *keyfile, char *certfile,
    unsigned char *key, unsigned char *cert, int key_len, int cert_len, char *CApath,
    char *CAfile, char *ciphers, char *ciphersuites, int level, char *DHparams) {
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
    int off = 0, abort = 0;
    int load_private_key;
    const SSL_METHOD *method;







|







1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
 * Side effects:
 *	constructs SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
static SSL_CTX *
CTX_Init(State *statePtr, int isServer, int proto, char *keyfile, char *certfile,
    unsigned char *key, unsigned char *cert, Tcl_Size key_len, Tcl_Size cert_len, char *CApath,
    char *CAfile, char *ciphers, char *ciphersuites, int level, char *DHparams) {
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
    int off = 0, abort = 0;
    int load_private_key;
    const SSL_METHOD *method;
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
	    SSL_CTX_free(ctx);
	    return NULL;
	}
	Tcl_DStringFree(&ds);

    } else if (cert != NULL) {
	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
	    Tcl_AppendResult(interp, "unable to set certificate: ",
		GET_ERR_REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}

    } else {







|







1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
	    SSL_CTX_free(ctx);
	    return NULL;
	}
	Tcl_DStringFree(&ds);

    } else if (cert != NULL) {
	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, (int) cert_len, cert) <= 0) {
	    Tcl_AppendResult(interp, "unable to set certificate: ",
		GET_ERR_REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}

    } else {
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
		    GET_ERR_REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    Tcl_DStringFree(&ds);

	} else if (key != NULL) {
	    if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) {
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp, "unable to set public key: ", GET_ERR_REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	}







|







1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
		    GET_ERR_REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    Tcl_DStringFree(&ds);

	} else if (key != NULL) {
	    if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key, (int) key_len) <= 0) {
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp, "unable to set public key: ", GET_ERR_REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	}
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
		X509_NAME_oneline(name, buffer, BUFSIZ);
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1));
	    }
	}
    }
    LAPPEND_OBJ(interp, objPtr, "caList", listPtr);
    LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list));


    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------







<







2323
2324
2325
2326
2327
2328
2329

2330
2331
2332
2333
2334
2335
2336
		X509_NAME_oneline(name, buffer, BUFSIZ);
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1));
	    }
	}
    }
    LAPPEND_OBJ(interp, objPtr, "caList", listPtr);
    LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list));


    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
2806
2807
2808
2809
2810
2811
2812

2813
2814
2815
2816
2817
2818
2819
 *		As of 'Tls_Init'
 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

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

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







>







2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
 *		As of 'Tls_Init'
 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

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

/*
 *------------------------------------------------------*
2828
2829
2830
2831
2832
2833
2834

2835
2836
2837
2838
2839
2840
2841
 *		initializes SSL library
 *
 *	Result:
 *		none
 *
 *------------------------------------------------------*
 */

static int TlsLibInit(int uninitialize) {
    static int initialized = 0;
    int status = TCL_OK;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    size_t num_locks;
#endif








>







2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
 *		initializes SSL library
 *
 *	Result:
 *		none
 *
 *------------------------------------------------------*
 */

static int TlsLibInit(int uninitialize) {
    static int initialized = 0;
    int status = TCL_OK;
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    size_t num_locks;
#endif

Modified generic/tls.h from [bcbadd0481] to [5524cb9711].

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 * 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)
 *
 */
 
#ifndef _TLS_H
#define _TLS_H

#include <tcl.h>

/*
 * Initialization routines -- our entire public C API.







|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 * 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)
 *
 */

#ifndef _TLS_H
#define _TLS_H

#include <tcl.h>

/*
 * Initialization routines -- our entire public C API.

Modified generic/tlsDigest.c from [46b363aa29] to [3071f42fa3].

1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398

    digestObj = Tcl_NewStringObj(digestName, -1);
    Tcl_IncrRefCount(digestObj);
    res = DigestDataHandler(interp, dataObj, digestObj, NULL, format, NULL, NULL, EVP_MAX_MD_SIZE);
    Tcl_DecrRefCount(digestObj);
    return res;
}
 
int MD4ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;
    return TemplateCmd(interp, objc, objv, "md4", HEX_FORMAT | TYPE_MD);
}

int MD5ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;







|







1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398

    digestObj = Tcl_NewStringObj(digestName, -1);
    Tcl_IncrRefCount(digestObj);
    res = DigestDataHandler(interp, dataObj, digestObj, NULL, format, NULL, NULL, EVP_MAX_MD_SIZE);
    Tcl_DecrRefCount(digestObj);
    return res;
}

int MD4ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;
    return TemplateCmd(interp, objc, objv, "md4", HEX_FORMAT | TYPE_MD);
}

int MD5ObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;

Modified generic/tlsEncrypt.c from [d46c2ffd0b] to [6b4ea24d02].

406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
int EncryptInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) {
    EncryptState *statePtr = (EncryptState *) clientData;
    Tcl_Channel parent;
    int out_len;
    Tcl_Size read;
    *errorCodePtr = 0;
    char *in_buf;
    
    dprintf("Called");

    /* Abort if nothing to process */
    if (toRead <= 0 || statePtr->self == (Tcl_Channel) NULL) {
	return 0;
    }








|







406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
int EncryptInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) {
    EncryptState *statePtr = (EncryptState *) clientData;
    Tcl_Channel parent;
    int out_len;
    Tcl_Size read;
    *errorCodePtr = 0;
    char *in_buf;

    dprintf("Called");

    /* Abort if nothing to process */
    if (toRead <= 0 || statePtr->self == (Tcl_Channel) NULL) {
	return 0;
    }

Modified generic/tlsIO.c from [d6aa421d6b] to [ee1c00be92].

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

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

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

	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    return -1;

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL_ERROR_SSL: Got permanent fatal SSL error, aborting immediately");
	    if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr, (char *) X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
	    }
	    if (backingError != 0) {
		Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError));
	    }
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return -1;

	case SSL_ERROR_WANT_READ:
	case SSL_ERROR_WANT_WRITE:







|







|









|


|







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

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

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

	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    return -1;

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL_ERROR_SSL: Got permanent fatal SSL error, aborting immediately");
	    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));
	    }
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return -1;

	case SSL_ERROR_WANT_READ:
	case SSL_ERROR_WANT_WRITE:
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
	    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, indicating that the connection has been aborted");
	    if (backingError != 0) {
		Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError));
	    } else if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr, (char *) 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) {
		dprintf("(Unexpected) EOF reached")
		*errorCodePtr = 0;
		bytesRead = 0;
		Tls_Error(statePtr, "EOF reached");
	    }    
#endif
	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */
	    if (backingError == 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)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		bytesRead = -1;
		Tls_Error(statePtr, (char *) Tcl_ErrnoMsg(*errorCodePtr));

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

	case SSL_ERROR_ZERO_RETURN:
	    dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
	    bytesRead = 0;
	    *errorCodePtr = 0;







|

|













|
















|





|







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
	    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, indicating that the connection has been aborted");
	    if (backingError != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    } 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) {
		dprintf("(Unexpected) EOF reached")
		*errorCodePtr = 0;
		bytesRead = 0;
		Tls_Error(statePtr, "EOF reached");
	    }
#endif
	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */
	    if (backingError == 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)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		bytesRead = -1;
		Tls_Error(statePtr, Tcl_ErrnoMsg(*errorCodePtr));

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

	case SSL_ERROR_ZERO_RETURN:
	    dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
	    bytesRead = 0;
	    *errorCodePtr = 0;
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
		written = 0;
		Tls_Error(statePtr, "EOF reached");

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

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

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL error, indicating that the connection has been aborted");
	    if (backingError != 0) {
		Tls_Error(statePtr, (char *) ERR_reason_error_string(backingError));
	    } else if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
		Tls_Error(statePtr, (char *) X509_verify_cert_error_string(SSL_get_verify_result(statePtr->ssl)));
	    } else {
		Tls_Error(statePtr, "Unknown SSL error");
	    }
	    *errorCodePtr = ECONNABORTED;
	    written = -1;
	    break;








|





|







|

|







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
		written = 0;
		Tls_Error(statePtr, "EOF reached");

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

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

	case SSL_ERROR_SSL:
	    /* A non-recoverable, fatal error in the SSL library occurred, usually a protocol error */
	    dprintf("SSL error, indicating that the connection has been aborted");
	    if (backingError != 0) {
		Tls_Error(statePtr, ERR_reason_error_string(backingError));
	    } 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;
	    written = -1;
	    break;

Modified generic/tlsInfo.c from [8c913d562b] to [b4637b95d3].

206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
	}
#else
	tag_len = EVP_CIPHER_CTX_get_tag_length(ctx);
#endif
	EVP_CIPHER_CTX_free(ctx);
	LAPPEND_INT(interp, resultObj, "tag_length", tag_len);
    }
    
    /* AEAD properties */
    {
	int aad_len = 0;
	if (flags & EVP_CIPH_FLAG_AEAD_CIPHER) {
	    aad_len = EVP_AEAD_TLS1_AAD_LEN;
	}
	LAPPEND_INT(interp, resultObj, "aad_length", aad_len);







|







206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
	}
#else
	tag_len = EVP_CIPHER_CTX_get_tag_length(ctx);
#endif
	EVP_CIPHER_CTX_free(ctx);
	LAPPEND_INT(interp, resultObj, "tag_length", tag_len);
    }

    /* AEAD properties */
    {
	int aad_len = 0;
	if (flags & EVP_CIPH_FLAG_AEAD_CIPHER) {
	    aad_len = EVP_AEAD_TLS1_AAD_LEN;
	}
	LAPPEND_INT(interp, resultObj, "aad_length", aad_len);
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

		/* cipher name or (NONE) */
		cp = SSL_CIPHER_get_name(c);
		if (cp == NULL) break;
		Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj((char *) cp, -1));
	    }

	} else {
	    char buf[BUFSIZ];
	    resultObj = Tcl_NewStringObj("", 0);
	    if (resultObj == NULL) {
		res = TCL_ERROR;







|







440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

		/* cipher name or (NONE) */
		cp = SSL_CIPHER_get_name(c);
		if (cp == NULL) break;
		Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(cp, -1));
	    }

	} else {
	    char buf[BUFSIZ];
	    resultObj = Tcl_NewStringObj("", 0);
	    if (resultObj == NULL) {
		res = TCL_ERROR;

Modified generic/tlsInt.h from [e79777dca6] to [6b6b71d2f2].

185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
	SSL_CTX *ctx;		/* SSL Context */
	BIO *bio;		/* Struct for SSL processing */
	BIO *p_bio;		/* Parent BIO (that is layered on Tcl_Channel) */

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

	char *err;
} State;

#ifdef USE_TCL_STUBS
#ifndef Tcl_StackChannel
#error "Unable to compile on this version of Tcl"
#endif /* Tcl_GetStackedChannel */
#endif /* USE_TCL_STUBS */







|







185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
	SSL_CTX *ctx;		/* SSL Context */
	BIO *bio;		/* Struct for SSL processing */
	BIO *p_bio;		/* Parent BIO (that is layered on Tcl_Channel) */

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

	const char *err;
} State;

#ifdef USE_TCL_STUBS
#ifndef Tcl_StackChannel
#error "Unable to compile on this version of Tcl"
#endif /* Tcl_GetStackedChannel */
#endif /* USE_TCL_STUBS */
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
 * Forward declarations
 */
const Tcl_ChannelType *Tls_ChannelType(void);
Tcl_Channel     Tls_GetParent(State *statePtr, int maskFlags);

Tcl_Obj         *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert);
Tcl_Obj		*Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer);
void            Tls_Error(State *statePtr, char *msg);
void            Tls_Free(tls_free_type *blockPtr);
void            Tls_Clean(State *statePtr);
int             Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);
int             Tls_DigestCommands(Tcl_Interp *interp);
int             Tls_EncryptCommands(Tcl_Interp *interp);
int             Tls_InfoCommands(Tcl_Interp *interp);
int             Tls_KDFCommands(Tcl_Interp *interp);







|







208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
 * Forward declarations
 */
const Tcl_ChannelType *Tls_ChannelType(void);
Tcl_Channel     Tls_GetParent(State *statePtr, int maskFlags);

Tcl_Obj         *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert);
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);
int             Tls_DigestCommands(Tcl_Interp *interp);
int             Tls_EncryptCommands(Tcl_Interp *interp);
int             Tls_InfoCommands(Tcl_Interp *interp);
int             Tls_KDFCommands(Tcl_Interp *interp);

Modified generic/tlsX509.c from [051a5b0d6c] to [70d85c26ad].

513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
    LAPPEND_INT(interp, certPtr, "extCount", X509_get_ext_count(cert));
    LAPPEND_OBJ(interp, certPtr, "extensions", Tls_x509Extensions(interp, cert));

    /* Authority Key Identifier (AKI) is the Subject Key Identifier (SKI) of
	its signer (the CA). RFC 5280 section 4.2.1.1, NID_authority_key_identifier */
    LAPPEND_OBJ(interp, certPtr, "authorityKeyIdentifier",
	Tls_x509Identifier(X509_get0_authority_key_id(cert)));
 
    /* Subject Key Identifier (SKI) is used to identify certificates that contain
	a particular public key. RFC 5280 section 4.2.1.2, NID_subject_key_identifier */
    LAPPEND_OBJ(interp, certPtr, "subjectKeyIdentifier",
	Tls_x509Identifier(X509_get0_subject_key_id(cert)));

    /* Key usage extension defines the purpose (e.g., encipherment, signature, certificate
	signing) of the key in the certificate. RFC 5280 section 4.2.1.3, NID_key_usage */







|







513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
    LAPPEND_INT(interp, certPtr, "extCount", X509_get_ext_count(cert));
    LAPPEND_OBJ(interp, certPtr, "extensions", Tls_x509Extensions(interp, cert));

    /* Authority Key Identifier (AKI) is the Subject Key Identifier (SKI) of
	its signer (the CA). RFC 5280 section 4.2.1.1, NID_authority_key_identifier */
    LAPPEND_OBJ(interp, certPtr, "authorityKeyIdentifier",
	Tls_x509Identifier(X509_get0_authority_key_id(cert)));

    /* Subject Key Identifier (SKI) is used to identify certificates that contain
	a particular public key. RFC 5280 section 4.2.1.2, NID_subject_key_identifier */
    LAPPEND_OBJ(interp, certPtr, "subjectKeyIdentifier",
	Tls_x509Identifier(X509_get0_subject_key_id(cert)));

    /* Key usage extension defines the purpose (e.g., encipherment, signature, certificate
	signing) of the key in the certificate. RFC 5280 section 4.2.1.3, NID_key_usage */

Modified license.terms from [767ca58173] to [10293d3448].

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.

GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal 
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license. 







|







|
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
MODIFICATIONS.

GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license.

Modified tests/oldTests/server.pem from [91b4eb6112] to [c1f4fc93d5].

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
cnlwdFNvZnQgRGV2IENBMB4XDTk3MDMyMjEzMzQwNFoXDTk4MDMyMjEzMzQwNFow
gYIxCzAJBgNVBAYTAkFVMRMwEQYDVQQIEwpRdWVlbnNsYW5kMREwDwYDVQQHEwhC
cmlzYmFuZTEaMBgGA1UEChMRQ3J5cHRTb2Z0IFB0eSBMdGQxFDASBgNVBAsTC2Rl
dmVsb3BtZW50MRkwFwYDVQQDExBDcnlwdFNvZnQgRGV2IENBMFwwDQYJKoZIhvcN
AQEBBQADSwAwSAJBAOAOAqogG5QwAmLhzyO4CoRnx/wVy4NZP4dxJy83O1EnL0rw
OdsamJKvPOLHgSXo3gDu9uVyvCf/QJmZAmC5ml8CAwEAATANBgkqhkiG9w0BAQQF
AANBADRRS/GVdd7rAqRW6SdmgLJduOU2yq3avBu99kRqbp9A/dLu6r6jU+eP4oOA
TfdbFZtAAD2Hx9jUtY3tfdrJOb8= 
-----END CERTIFICATE-----

-----BEGIN CERTIFICATE-----
MIICVjCCAgACAQAwDQYJKoZIhvcNAQEEBQAwgbUxCzAJBgNVBAYTAkFVMRMwEQYD
VQQIEwpRdWVlbnNsYW5kMREwDwYDVQQHEwhCcmlzYmFuZTEaMBgGA1UEChMRQ3J5
cHRTb2Z0IFB0eSBMdGQxLDAqBgNVBAsTI1dPUlRITEVTUyBDRVJUSUZJQ0FUSU9O
IEFVVEhPUklUSUVTMTQwMgYDVQQDEytaRVJPIFZBTFVFIENBIC0gREVNT05TVFJB







|







267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
cnlwdFNvZnQgRGV2IENBMB4XDTk3MDMyMjEzMzQwNFoXDTk4MDMyMjEzMzQwNFow
gYIxCzAJBgNVBAYTAkFVMRMwEQYDVQQIEwpRdWVlbnNsYW5kMREwDwYDVQQHEwhC
cmlzYmFuZTEaMBgGA1UEChMRQ3J5cHRTb2Z0IFB0eSBMdGQxFDASBgNVBAsTC2Rl
dmVsb3BtZW50MRkwFwYDVQQDExBDcnlwdFNvZnQgRGV2IENBMFwwDQYJKoZIhvcN
AQEBBQADSwAwSAJBAOAOAqogG5QwAmLhzyO4CoRnx/wVy4NZP4dxJy83O1EnL0rw
OdsamJKvPOLHgSXo3gDu9uVyvCf/QJmZAmC5ml8CAwEAATANBgkqhkiG9w0BAQQF
AANBADRRS/GVdd7rAqRW6SdmgLJduOU2yq3avBu99kRqbp9A/dLu6r6jU+eP4oOA
TfdbFZtAAD2Hx9jUtY3tfdrJOb8=
-----END CERTIFICATE-----

-----BEGIN CERTIFICATE-----
MIICVjCCAgACAQAwDQYJKoZIhvcNAQEEBQAwgbUxCzAJBgNVBAYTAkFVMRMwEQYD
VQQIEwpRdWVlbnNsYW5kMREwDwYDVQQHEwhCcmlzYmFuZTEaMBgGA1UEChMRQ3J5
cHRTb2Z0IFB0eSBMdGQxLDAqBgNVBAsTI1dPUlRITEVTUyBDRVJUSUZJQ0FUSU9O
IEFVVEhPUklUSUVTMTQwMgYDVQQDEytaRVJPIFZBTFVFIENBIC0gREVNT05TVFJB

Modified tests/oldTests/tlsHttp.tcl from [a53b6ea2fa] to [9ac8651bfa].

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
source tls.tcl
package require http

#
# Initialize context
#
#tls::init -certfile client.pem -cafile server.pem -ssl2 1 -ssl3 1 -tls1 0 ;#-cipher RC4-MD5
tls::init -cafile server.pem 
#
# Register with http module
#
http::register https 443 [list ::tls::socket -require 1]

set user novadigm\\matt
set pass sensus







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
source tls.tcl
package require http

#
# Initialize context
#
#tls::init -certfile client.pem -cafile server.pem -ssl2 1 -ssl3 1 -tls1 0 ;#-cipher RC4-MD5
tls::init -cafile server.pem
#
# Register with http module
#
http::register https 443 [list ::tls::socket -require 1]

set user novadigm\\matt
set pass sensus

Modified tests/oldTests/tlsSrv.tcl from [03126ed641] to [cb7a0f8fc4].

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
proc reflectCB {chan {verbose 0}} {
    set x hello
    if {[catch {read $chan 1024} data]} {
	puts stderr "EOF ($data)"
	catch {close $chan}
	return
    }
	
    if {$verbose && $data != ""} {
	puts -nonewline stderr $data
    }
    if {[eof $chan]} {    ;# client gone or finished
	puts stderr "EOF"
	close $chan        ;# release the servers client channel
	return







|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
proc reflectCB {chan {verbose 0}} {
    set x hello
    if {[catch {read $chan 1024} data]} {
	puts stderr "EOF ($data)"
	catch {close $chan}
	return
    }

    if {$verbose && $data != ""} {
	puts -nonewline stderr $data
    }
    if {[eof $chan]} {    ;# client gone or finished
	puts stderr "EOF"
	close $chan        ;# release the servers client channel
	return
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
	return
    }
    puts [tls::status $chan]

    fconfigure $chan -buffering none -blocking 0
    fileevent $chan readable [list reflectCB $chan 1]
}
#tls::init -cafile server.pem -certfile server.pem 
tls::init -cafile server.pem
#tls::init 

set chan [tls::socket -server acceptCB \
		-request 1 -require 0 1234]
#		-require 1 -command tls::callback 1234]

puts "Server waiting connection on $chan (1234)"
puts [fconfigure $chan]

# Go into the eventloop
vwait /Exit







|

|










40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
	return
    }
    puts [tls::status $chan]

    fconfigure $chan -buffering none -blocking 0
    fileevent $chan readable [list reflectCB $chan 1]
}
#tls::init -cafile server.pem -certfile server.pem
tls::init -cafile server.pem
#tls::init

set chan [tls::socket -server acceptCB \
		-request 1 -require 0 1234]
#		-require 1 -command tls::callback 1234]

puts "Server waiting connection on $chan (1234)"
puts [fconfigure $chan]

# Go into the eventloop
vwait /Exit

Modified tests/oldTests/tlsSrv2.tcl from [26eb405e56] to [94b6f94d30].

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#
proc reflectCB {chan {verbose 0}} {
    if {[catch {read $chan 1024} data]} {
	puts stderr "EOF ($data)"
	catch {close $chan}
	return
    }
	
    if {$verbose && $data != ""} {
	puts -nonewline stderr $data
    }
    if {[eof $chan]} {    ;# client gone or finished
	puts stderr "EOF"
	close $chan        ;# release the servers client channel
	return







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#
proc reflectCB {chan {verbose 0}} {
    if {[catch {read $chan 1024} data]} {
	puts stderr "EOF ($data)"
	catch {close $chan}
	return
    }

    if {$verbose && $data != ""} {
	puts -nonewline stderr $data
    }
    if {[eof $chan]} {    ;# client gone or finished
	puts stderr "EOF"
	close $chan        ;# release the servers client channel
	return

Modified tests/tlsIO.test from [4478956f16] to [15d6345268].

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
# Commands tested in this file: socket.                          -*- tcl -*-
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions. 
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tlsIO.test,v 1.24 2015/06/06 09:07:08 apnadkarni Exp $

# Running socket tests with a remote server:
# ------------------------------------------
# 
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
# can start the remote server on any machine reachable from the machine on
# which you want to run the socket tests, by issuing:
# 
#     tcltest remote.tcl -port 8048	# Or choose another port number.
# 
# If the machine you are running the remote server on has several IP
# interfaces, you can choose which interface the server listens on for
# connections by specifying the -address command line flag, so:
# 
#     tcltest remote.tcl -address your.machine.com
# 
# These options can also be set by environment variables. On Unix, you can
# type these commands to the shell from which the remote server is started:
# 
#     shell% setenv serverPort 8048
#     shell% setenv serverAddress your.machine.com
# 
# and subsequently you can start the remote server with:
# 
#     tcltest remote.tcl
# 
# to have it listen on port 8048 on the interface your.machine.com.
#     
# When the server starts, it prints out a detailed message containing its
# configuration information, and it will block until killed with a Ctrl-C.
# Once the remote server exists, you can run the tests in socket.test with
# the server by setting two Tcl variables:
# 
#     % set remoteServerIP <name or address of machine on which server runs>
#     % set remoteServerPort 8048
# 
# These variables are also settable from the environment. On Unix, you can:
# 
#     shell% setenv remoteServerIP machine.where.server.runs
#     shell% setenv remoteServerPort 8048
# 
# The preamble of the socket.test file checks to see if the variables are set
# either in Tcl or in the environment; if they are, it attempts to connect to
# the server. If the connection is successful, the tests using the remote
# server will be performed; otherwise, it will attempt to start the remote
# server (via exec) on platforms that support this, on the local host,
# listening at port 8048. If all fails, a message is printed and the tests
# using the remote server are not performed.







|








|





|

|



|

|


|


|

|

|

|




|


|

|


|







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
# Commands tested in this file: socket.                          -*- tcl -*-
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tlsIO.test,v 1.24 2015/06/06 09:07:08 apnadkarni Exp $

# Running socket tests with a remote server:
# ------------------------------------------
#
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
# can start the remote server on any machine reachable from the machine on
# which you want to run the socket tests, by issuing:
#
#     tcltest remote.tcl -port 8048	# Or choose another port number.
#
# If the machine you are running the remote server on has several IP
# interfaces, you can choose which interface the server listens on for
# connections by specifying the -address command line flag, so:
#
#     tcltest remote.tcl -address your.machine.com
#
# These options can also be set by environment variables. On Unix, you can
# type these commands to the shell from which the remote server is started:
#
#     shell% setenv serverPort 8048
#     shell% setenv serverAddress your.machine.com
#
# and subsequently you can start the remote server with:
#
#     tcltest remote.tcl
#
# to have it listen on port 8048 on the interface your.machine.com.
#
# When the server starts, it prints out a detailed message containing its
# configuration information, and it will block until killed with a Ctrl-C.
# Once the remote server exists, you can run the tests in socket.test with
# the server by setting two Tcl variables:
#
#     % set remoteServerIP <name or address of machine on which server runs>
#     % set remoteServerPort 8048
#
# These variables are also settable from the environment. On Unix, you can:
#
#     shell% setenv remoteServerIP machine.where.server.runs
#     shell% setenv remoteServerPort 8048
#
# The preamble of the socket.test file checks to see if the variables are set
# either in Tcl or in the environment; if they are, it attempts to connect to
# the server. If the connection is successful, the tests using the remote
# server will be performed; otherwise, it will attempt to start the remote
# server (via exec) on platforms that support this, on the local host,
# listening at port 8048. If all fails, a message is printed and the tests
# using the remote server are not performed.
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	proc echo {s} {
	     global i
             set l [gets $s]
             if {[eof $s]} {
                 global x
                 close $s
                 set x done
             } else { 
	         incr i
                 puts $s $l
             }
	}
	set i 0
	puts ready
	set timer [after 20000 "set x done"]







|







564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
	proc echo {s} {
	     global i
             set l [gets $s]
             if {[eof $s]} {
                 global x
                 close $s
                 set x done
             } else {
	         incr i
                 puts $s $l
             }
	}
	set i 0
	puts ready
	set timer [after 20000 "set x done"]
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
	}
    }
    proc timerproc {} {
	global done count c
	set done true
	set count {timer went off, eof is not sticky}
	close $c
    }	
    set count 0
    set done false
    proc write_then_close {s} {
	puts $s bye
	close $s
    }
    proc accept {s a p} {







|







1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
	}
    }
    proc timerproc {} {
	global done count c
	set done true
	set count {timer went off, eof is not sticky}
	close $c
    }
    set count 0
    set done false
    proc write_then_close {s} {
	puts $s bye
	close $s
    }
    proc accept {s a p} {
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
	gets $s3
    }
    close $s1
    close $s2
    close $s3
    sendCommand {close $socket10_9_test_server}
    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]







|







1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
	gets $s3
    }
    close $s1
    close $s2
    close $s3
    sendCommand {close $socket10_9_test_server}
    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]
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
1980
1981
1982
1983
	proc echo {s} {
	     global i
             set l [gets $s]
             if {[eof $s]} {
                 global x
                 close $s
                 set x done
             } else { 
	         incr i
                 puts $s $l
             }
	}
	set i 0
	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]
    fconfigure $s -buffering line

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

    after 2000
    lappend result [threadReap]
    
    set result

} {hello 1}

test tlsIO-14.1 {test tls::unimport} {socket} {
    list [catch {tls::unimport} msg] $msg
} {1 {wrong # args: should be "tls::unimport channel"}}







|











|



|













|







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
1980
1981
1982
1983
	proc echo {s} {
	     global i
             set l [gets $s]
             if {[eof $s]} {
                 global x
                 close $s
                 set x done
             } else {
	         incr i
                 puts $s $l
             }
	}
	set i 0
	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]
    fconfigure $s -buffering line

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

    after 2000
    lappend result [threadReap]

    set result

} {hello 1}

test tlsIO-14.1 {test tls::unimport} {socket} {
    list [catch {tls::unimport} msg] $msg
} {1 {wrong # args: should be "tls::unimport channel"}}
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046

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

    # Server - Only accept TLS 1.2
    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 1 -tls1.3 0 \







|




|







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

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

    # Server - Only accept TLS 1.2
    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 1 -tls1.3 0 \