Changes On Branch f69776b9466adf17

Changes In Branch nijtmans Through [f69776b946] Excluding Merge-Ins

This is equivalent to a diff from b5c41cdeb6 to f69776b946

2024-05-27
21:50
re-generate configure check-in: ebf674a714 user: jan.nijtmans tags: nijtmans
2024-03-12
14:30
Merge trunk check-in: c005e3d09b user: jan.nijtmans tags: bohagan
14:21
More simple code formatting ... no change in functionality check-in: f69776b946 user: jan.nijtmans tags: nijtmans
2024-03-05
13:57
Update to latest acinclude.m4 check-in: cbbb604ed3 user: jan.nijtmans tags: nijtmans
2024-01-25
22:22
Somewhat better TEA support, not complete yet. Make this the continuation of the tls-1.7 branch. main/trunk will continue with 1.8.0 check-in: b7b0bd5a8f user: jan.nijtmans tags: tls-1.7
2024-01-24
14:35
First changes needed for Tcl 9.0 check-in: 3057d6e2e0 user: jan.nijtmans tags: nijtmans
2023-03-04
15:44
Merge add-support-alpn into main check-in: 4b4daeada4 user: bohagan tags: trunk
2022-05-30
16:12
Create new branch named "feature-dump-keys" check-in: f6b9f887ef user: rkeene tags: feature-dump-keys
16:08
Bug [e1f9a21c67]: Start of ALPN support check-in: 07bafe02de user: schelte tags: add-support-alpn
16:07
Create new branch named "add-support-alpn" check-in: 283dc6f133 user: rkeene tags: add-support-alpn
2021-01-14
12:56
Ticket [604bb68b5c] : rudimentary nmake build system check-in: b5c41cdeb6 user: oehhar tags: trunk
2020-10-15
10:54
Corrected instructions. Removed already applied patch Closed-Leaf check-in: b6aa13660a user: oehhar tags: bug-604bb68b5c-nmake
2020-10-12
20:32
add "version" element with SSL/TLS protocol version to tls::status check-in: 9c32a526ed user: resuna tags: trunk

Modified .fossil-settings/ignore-glob from [053031e94a] to [b290d0ded2].

15
16
17
18
19
20
21
22
15
16
17
18
19
20
21








-
tlsBIO.o
tlsIO.o
tlsX509.o
tls.tcl.h
tls.tcl.h.new.1
tls.tcl.h.new.2
build/work
dh_params.h

Added .fossil-settings/manifest version [1e2c3d8462].


1
+
u

Modified ChangeLog from [7400a29b58] to [dc44957559].








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







TclTLS 1.7.22
==========

Release Date: Mon Oct 12 15:40:16 CDT 2020

https://tcltls.rkeene.org/

2015-05-01  Andreas Kupries  <[email protected]>

	* configure.in: Bump to version 1.6.5.
	* win/makefile.vc:
	* configure: regen with ac-2.59
	* tls.c: Accepted SF TLS [bug/patch #57](https://sourceforge.net/p/tls/bugs/57/).
	* tlsIO.c: Accepted core Tcl patch in [ticket](http://core.tcl.tk/tcl/tktview/0f94f855cafed92d0e174b7d835453a02831b4dd).
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
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. 
	  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
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
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): 
	* 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 
	* 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.
133
134
135
136
137
138
139
140

141
142
143
144
145
146
147
148

149
150
151
152
153
154
155
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:        
	* 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]>

178
179
180
181
182
183
184
185

186
187
188
189
190
191
192
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. 
			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]>
229
230
231
232
233
234
235
236

237
238
239
240
241
242
243
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]> 
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
368
369
370
371
372
373
374
375

376
377
378
379
380
381
382
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/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:
471
472
473
474
475
476
477
478

479
480
481
482
483
484
485
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: 
	* 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

Deleted HEADER version [b4ecd86142].

1
2
3
4
5
6
7







-
-
-
-
-
-
-
TclTLS @@VERS@@
==========

Release Date: @@DATE@@

https://tcltls.rkeene.org/

Modified Makefile.in from [500d902713] to [20111b5bb5].














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




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

+
-
+
+
+
+
+

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

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

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

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

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

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

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




-
-
+
+


-
+

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

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

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

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

+
+
+
+
-
+

-
+
-
-
-
+
+

-
-

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

+
+
-
+
+
+
+
# Makefile.in --
#
#	This file is the Makefile for the TclTLS Extension. The file
#	"Makefile.in" is the template for a Makefile. To generate the
#	actual Makefile, run "./configure", which is a configuration script
#	generated by the "autoconf" program (constructs like "@foo@" will
#	get replaced in the actual Makefile.
#
# Copyright (c) 1999 Scriptics Corporation.
# Copyright (c) 2002-2005 ActiveState Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
CC = @CC@
AR = @AR@
RANLIB = @RANLIB@
CFLAGS = @CFLAGS@ @SHOBJFLAGS@
CPPFLAGS = @CPPFLAGS@ -I@srcdir@ -I. @DEFS@ @TCL_DEFS@
LDFLAGS = @LDFLAGS@ @SHOBJLDFLAGS@
LIBS = @LIBS@
PACKAGE_VERSION = @PACKAGE_VERSION@
prefix = @prefix@
exec_prefix = @exec_prefix@
libdir = @libdir@
TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@
PACKAGE_INSTALL_DIR = $(TCL_PACKAGE_PATH)/tcltls$(PACKAGE_VERSION)
INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
VPATH = @srcdir@

#========================================================================
# Add additional lines to handle any additional AC_SUBST cases that
# have been added in a customized configure script.
#========================================================================

#SAMPLE_NEW_VAR	= @SAMPLE_NEW_VAR@

#========================================================================
# Nothing of the variables below this line should need to be changed.
# Please check the TARGETS section below to make sure the make targets
# are correct.
#========================================================================

#========================================================================
# The names of the source files is defined in the configure script.
# The object files are used for linking into the final library.
# This will be used when a dist target is added to the Makefile.
# It is not important to specify the directory, as long as it is the
# $(srcdir) or in the generic, win or unix subdirectory.
#========================================================================

PKG_SOURCES	= @PKG_SOURCES@
PKG_OBJECTS	= @PKG_OBJECTS@

PKG_STUB_SOURCES = @PKG_STUB_SOURCES@
PKG_STUB_OBJECTS = @PKG_STUB_OBJECTS@

#========================================================================
# PKG_TCL_SOURCES identifies Tcl runtime files that are associated with
# this package that need to be installed, if any.
#========================================================================

PKG_TCL_SOURCES = @PKG_TCL_SOURCES@

#========================================================================
# This is a list of public header files to be installed, if any.
#========================================================================

PKG_HEADERS	= @PKG_HEADERS@

#========================================================================
# "PKG_LIB_FILE" refers to the library (dynamic or static as per
# configuration options) composed of the named objects.
#========================================================================

PKG_LIB_FILE	= @PKG_LIB_FILE@
PKG_LIB_FILE8	= @PKG_LIB_FILE8@
PKG_LIB_FILE9	= @PKG_LIB_FILE9@
PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@

lib_BINARIES	= $(PKG_LIB_FILE)
BINARIES	= tls.tcl.h $(lib_BINARIES) pkgIndex.tcl

SHELL		= @SHELL@

srcdir		= @srcdir@
prefix		= @prefix@
exec_prefix	= @exec_prefix@

bindir		= @bindir@
libdir		= @libdir@
includedir	= @includedir@
datarootdir	= @datarootdir@
runstatedir	= @runstatedir@
datadir		= @datadir@
mandir		= @mandir@

DESTDIR		=
all: @EXTENSION_TARGET@

PKG_DIR		= $(PACKAGE_NAME)$(PACKAGE_VERSION)
pkgdatadir	= $(datadir)/$(PKG_DIR)
pkglibdir	= $(libdir)/$(PKG_DIR)
pkgincludedir	= $(includedir)/$(PKG_DIR)

top_builddir	= @abs_top_builddir@
@EXTENSION_TARGET@: @TCLEXT_BUILD@-@EXTENSION_TARGET@
	mv @TCLEXT_BUILD@-@EXTENSION_TARGET@ @EXTENSION_TARGET@

INSTALL_OPTIONS	=
INSTALL		= @INSTALL@ $(INSTALL_OPTIONS)
INSTALL_DATA_DIR = @INSTALL_DATA_DIR@
INSTALL_DATA	= @INSTALL_DATA@
INSTALL_PROGRAM	= @INSTALL_PROGRAM@
INSTALL_SCRIPT	= @INSTALL_SCRIPT@
INSTALL_LIBRARY	= @INSTALL_LIBRARY@

PACKAGE_NAME	= @PACKAGE_NAME@
PACKAGE_VERSION	= @PACKAGE_VERSION@
CC		= @CC@
CCLD		= @CCLD@
CFLAGS_DEFAULT	= @CFLAGS_DEFAULT@
CFLAGS_WARNING	= @CFLAGS_WARNING@
EXEEXT		= @EXEEXT@
LDFLAGS_DEFAULT	= @LDFLAGS_DEFAULT@
MAKE_LIB	= @MAKE_LIB@
MAKE_STUB_LIB	= @MAKE_STUB_LIB@
OBJEXT		= @OBJEXT@
RANLIB		= @RANLIB@
RANLIB_STUB	= @RANLIB_STUB@
SHLIB_CFLAGS	= @SHLIB_CFLAGS@
SHLIB_LD	= @SHLIB_LD@
SHLIB_LD_LIBS	= @SHLIB_LD_LIBS@
STLIB_LD	= @STLIB_LD@
#TCL_DEFS	= @TCL_DEFS@
TCL_BIN_DIR	= @TCL_BIN_DIR@
TCL_SRC_DIR	= @TCL_SRC_DIR@
#TK_BIN_DIR	= @TK_BIN_DIR@
#TK_SRC_DIR	= @TK_SRC_DIR@

# Not used, but retained for reference of what libs Tcl required
#TCL_LIBS	= @TCL_LIBS@

#========================================================================
# TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our
# package without installing.  The other environment variables allow us
# to test against an uninstalled Tcl.  Add special env vars that you
# require for testing here (like TCLX_LIBRARY).
#========================================================================

EXTRA_PATH	= $(top_builddir):$(TCL_BIN_DIR)
#EXTRA_PATH	= $(top_builddir):$(TCL_BIN_DIR):$(TK_BIN_DIR)
TCLLIBPATH	= $(top_builddir)
TCLSH_ENV	= TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library`
PKG_ENV		= @LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \
		  PATH="$(EXTRA_PATH):$(PATH)" \
		  TCLLIBPATH="$(TCLLIBPATH)"

TCLSH_PROG	= @TCLSH_PROG@
TCLSH		= $(TCLSH_ENV) $(PKG_ENV) $(TCLSH_PROG)

#WISH_ENV	= TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library`
#WISH_PROG	= @WISH_PROG@
#WISH		= $(TCLSH_ENV) $(WISH_ENV) $(PKG_ENV) $(WISH_PROG)

SHARED_BUILD	= @SHARED_BUILD@

INCLUDES	= @PKG_INCLUDES@ @TCL_INCLUDES@ $(SSL_INCLUDES) -I.
#INCLUDES	= @PKG_INCLUDES@ @TCL_INCLUDES@ @TK_INCLUDES@ @TK_XINCLUDES@

PKG_CFLAGS	= @PKG_CFLAGS@

# TCL_DEFS is not strictly need here, but if you remove it, then you
# must make sure that configure.ac checks for the necessary components
# that your library may use.  TCL_DEFS can actually be a problem if
# you do not compile with a similar machine setup as the Tcl core was
# compiled with.
#DEFS		= $(TCL_DEFS) @DEFS@ $(PKG_CFLAGS)
DEFS		= @DEFS@ $(PKG_CFLAGS)

# Move pkgIndex.tcl to 'BINARIES' var if it is generated in the Makefile
CONFIG_CLEAN_FILES = Makefile pkgIndex.tcl generic/tls.tcl.h
CLEANFILES	= @CLEANFILES@
# The shared object target
shared-@EXTENSION_TARGET@: tls.o tlsBIO.o tlsIO.o tlsX509.o Makefile
	$(CC) $(CPPFLAGS) $(CFLAGS) $(LDFLAGS) -o shared-@EXTENSION_TARGET@ tls.o tlsBIO.o tlsIO.o tlsX509.o $(LIBS)
	-@WEAKENSYMS@ shared-@EXTENSION_TARGET@
	-@REMOVESYMS@ shared-@EXTENSION_TARGET@

CPPFLAGS	= @CPPFLAGS@
LIBS		= @PKG_LIBS@ @LIBS@
AR		= @AR@
CFLAGS		= @CFLAGS@
LDFLAGS		= @LDFLAGS@
LDFLAGS_DEFAULT	= @LDFLAGS_DEFAULT@
COMPILE		= $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) \
			  $(CFLAGS_DEFAULT) $(CFLAGS_WARNING) $(SHLIB_CFLAGS) $(CFLAGS)

GDB		= gdb
VALGRIND	= valgrind
VALGRINDARGS	= --tool=memcheck --num-callers=8 --leak-resolution=high \
		  --leak-check=yes --show-reachable=yes -v

.SUFFIXES: .c .$(OBJEXT)

#========================================================================
# Start of user-definable TARGETS section
#========================================================================

#========================================================================
# TEA TARGETS.  Please note that the "libraries:" target refers to platform
# independent files, and the "binaries:" target includes executable programs and
# platform-dependent libraries.  Modify these targets so that they install
# the various pieces of your package.  The make and install rules
# for the BINARIES that you specified above have already been done.
#========================================================================

all: binaries libraries doc
# The static target
static-@EXTENSION_TARGET@: tls.o tlsBIO.o tlsIO.o tlsX509.o Makefile
	$(AR) rcu static-@EXTENSION_TARGET@ tls.o tlsBIO.o tlsIO.o tlsX509.o
	-$(RANLIB) static-@EXTENSION_TARGET@

#========================================================================
# The binaries target builds executable programs, Windows .dll's, unix
# shared/static libraries, and any other platform-dependent files.
# The list of targets to build for "binaries:" is specified at the top
# of the Makefile, in the "BINARIES" variable.
#========================================================================

binaries: $(BINARIES)

libraries:

#========================================================================
# Your doc target should differentiate from doc builds (by the developer)
# and doc installs (see install-doc), which just install the docs on the
# end user machine when building from source.
#========================================================================

doc:
	@echo "If you have documentation to create, place the commands to"
	@echo "build the docs in the 'doc:' target.  For example:"
	@echo "        xml2nroff sample.xml > sample.n"
	@echo "        xml2html sample.xml > sample.html"

install: all install-binaries install-libraries

install-binaries: binaries install-lib-binaries install-bin-binaries

#========================================================================
# This rule installs platform-independent files, such as header files.
# The list=...; for p in $$list handles the empty list case x-platform.
#========================================================================

install-libraries: libraries
	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(includedir)"
	@echo "Installing header files in $(DESTDIR)$(includedir)"
	@list='$(PKG_HEADERS)'; for i in $$list; do \
	    echo "Installing $(srcdir)/$$i" ; \
	    $(INSTALL_DATA) $(srcdir)/$$i "$(DESTDIR)$(includedir)" ; \
	done;

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

install-doc: doc
	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(mandir)/mann"
	@echo "Installing documentation in $(DESTDIR)$(mandir)"
	@list='$(srcdir)/doc/*.n'; for i in $$list; do \
	    echo "Installing $$i"; \
	    $(INSTALL_DATA) $$i "$(DESTDIR)$(mandir)/mann" ; \
	done
# Dependencies for all our targets
tls.o: @srcdir@/tls.c @srcdir@/tlsInt.h @srcdir@/tclOpts.h tls.tcl.h dh_params.h Makefile
	$(CC) $(CPPFLAGS) $(CFLAGS) -o tls.o -c @srcdir@/tls.c

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)]]"

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)]]"
tlsBIO.o: @srcdir@/tlsBIO.c @srcdir@/tlsInt.h Makefile
	$(CC) $(CPPFLAGS) $(CFLAGS) -o tlsBIO.o -c @srcdir@/tlsBIO.c

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)

depend:
tlsIO.o: @srcdir@/tlsIO.c @srcdir@/tlsInt.h Makefile
	$(CC) $(CPPFLAGS) $(CFLAGS) -o tlsIO.o -c @srcdir@/tlsIO.c

#========================================================================
# $(PKG_LIB_FILE) should be listed as part of the BINARIES variable
# mentioned above.  That will ensure that this target is built when you
# run "make binaries".
#
# The $(PKG_OBJECTS) objects are created and linked into the final
# library.  In most cases these object files will correspond to the
# source files above.
#========================================================================

$(PKG_LIB_FILE): $(PKG_OBJECTS)
	-rm -f $(PKG_LIB_FILE)
	${MAKE_LIB}
	$(RANLIB) $(PKG_LIB_FILE)

$(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS)
	-rm -f $(PKG_STUB_LIB_FILE)
	${MAKE_STUB_LIB}
	$(RANLIB_STUB) $(PKG_STUB_LIB_FILE)
tlsX509.o: @srcdir@/tlsX509.c @srcdir@/tlsInt.h Makefile
	$(CC) $(CPPFLAGS) $(CFLAGS) -o tlsX509.o -c @srcdir@/tlsX509.c

#========================================================================
# 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 $@
#
# 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

.c.@OBJEXT@:
	$(COMPILE) -c `@CYGPATH@ $<` -o $@

# Create a C-source-ified version of the script resources
# for TclTLS so that we only need a single file to enable
# this extension
tls.tcl.h: @srcdir@/tls.tcl Makefile
	od -A n -v -t xC < '@srcdir@/tls.tcl' > tls.tcl.h.new.1
tls.tcl.h: @srcdir@/library/tls.tcl Makefile
	od -A n -v -t xC < '@srcdir@/library/tls.tcl' > tls.tcl.h.new.1
	sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > tls.tcl.h.new.2
	rm -f tls.tcl.h.new.1
	mv tls.tcl.h.new.2 tls.tcl.h
	mv tls.tcl.h.new.2 @srcdir@/generic/tls.tcl.h

tls.o:	tlsUuid.h
# Create default DH parameters
dh_params.h: @srcdir@/gen_dh_params Makefile
	sh @srcdir@/gen_dh_params @GEN_DH_PARAMS_ARGS@ > dh_params.h.new
	mv dh_params.h.new dh_params.h

$(srcdir)/manifest.uuid:
	printf "git-" >$(srcdir)/manifest.uuid
	(cd $(srcdir); git rev-parse HEAD >>$(srcdir)/manifest.uuid || \
	    (printf "svn-r" >$(srcdir)/manifest.uuid ; \
	    svn info --show-item last-changed-revision >>$(srcdir)/manifest.uuid) || \
	    printf "unknown" >$(srcdir)/manifest.uuid)

tlsUuid.h:	$(srcdir)/manifest.uuid
	echo "#define TLS_VERSION_UUID \\" >$@
	cat $(srcdir)/manifest.uuid >>$@
	echo "" >>$@

#========================================================================
# Create the pkgIndex.tcl file.
# It is usually easiest to let Tcl do this for you with pkg_mkIndex, but
# you may find that you need to customize the package.  If so, either
# modify the -hand version, or create a pkgIndex.tcl.in file and have
# the configure script output the pkgIndex.tcl by editing configure.in.
#========================================================================

pkgIndex.tcl: $(srcdir)/pkgIndex.tcl.in
	cd $(top_builddir) \
	  && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status

#========================================================================
# Distribution creation
# You may need to tweak this target to make it work correctly.
#========================================================================
# Install the extension
install: @EXTENSION_TARGET@ pkgIndex.tcl
	$(INSTALL) -d '$(DESTDIR)$(PACKAGE_INSTALL_DIR)'
	$(INSTALL_PROGRAM) @EXTENSION_TARGET@ '$(DESTDIR)$(PACKAGE_INSTALL_DIR)'
	$(INSTALL_DATA)    pkgIndex.tcl '$(DESTDIR)$(PACKAGE_INSTALL_DIR)'

#COMPRESS	= tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar
COMPRESS	= tar zcvf $(PKG_DIR).tar.gz $(PKG_DIR)
DIST_ROOT	= /tmp/dist
DIST_DIR	= $(DIST_ROOT)/$(PKG_DIR)

DIST_INSTALL_DATA	= CPPROG='cp -p' $(INSTALL) -m 644
DIST_INSTALL_DATA_RECUR	= CPPROG='cp -p -R' $(INSTALL)
DIST_INSTALL_SCRIPT	= CPPROG='cp -p' $(INSTALL) -m 755

dist-clean:
	rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.*

dist: dist-clean
	# TEA files
	$(INSTALL_DATA_DIR) $(DIST_DIR)
	$(DIST_INSTALL_DATA) $(srcdir)/Makefile.in \
		$(srcdir)/acinclude.m4 $(srcdir)/aclocal.m4 \
		$(srcdir)/configure.ac $(DIST_DIR)/
	$(DIST_INSTALL_SCRIPT) $(srcdir)/configure $(DIST_DIR)/

	# Extension files
	$(DIST_INSTALL_DATA) $(srcdir)/ChangeLog \
		$(srcdir)/license.terms $(srcdir)/README.txt \
		$(srcdir)/pkgIndex.tcl.in $(DIST_DIR)/
# A convienent helper to undo the installation just done
uninstall:
	rm -f '$(DESTDIR)$(PACKAGE_INSTALL_DIR)/@EXTENSION_TARGET@'
	rm -f '$(DESTDIR)$(PACKAGE_INSTALL_DIR)/pkgIndex.tcl'
	-rmdir '$(DESTDIR)$(PACKAGE_INSTALL_DIR)'

	# TEA files
	$(INSTALL_DATA_DIR) $(DIST_DIR)/tclconfig
	$(DIST_INSTALL_DATA) $(srcdir)/tclconfig/README.txt \
		$(srcdir)/tclconfig/tcl.m4 $(srcdir)/tclconfig/install-sh \
		$(srcdir)/license.terms $(DIST_DIR)/tclconfig/

	$(INSTALL_DATA_DIR) $(DIST_DIR)/win
	$(DIST_INSTALL_DATA) \
		$(srcdir)/win/README.txt $(srcdir)/win/*.vc \
		$(srcdir)/win/nmakehlp.c $(DIST_DIR)/win/

	list='build demos doc generic library macosx tests unix'; \
	for p in $$list; do \
# Test target, run the automated test suite
test: @EXTENSION_TARGET@
	@TCLSH_PROG@ @srcdir@/tests/all.tcl $(TESTFLAGS) -load "lappend auto_path $(shell pwd)"
	    if test -d $(srcdir)/$$p ; then \
		$(INSTALL_DATA_DIR) $(DIST_DIR)/$$p; \
		$(DIST_INSTALL_DATA_RECUR) $(srcdir)/$$p/* $(DIST_DIR)/$$p/; \
	    fi; \
	done

	(cd $(DIST_ROOT); $(COMPRESS);)
	cd $(top_builddir)
	mv $(DIST_ROOT)/$(PKG_DIR).tar.gz $(top_builddir)

#========================================================================
# End of user-definable section
#========================================================================

#========================================================================
# Don't modify the file to clean here.  Instead, set the "CLEANFILES"
# variable in configure.ac
#========================================================================
# Clean the local build directory for rebuild against the same configuration

clean:
	rm -f tls.o tlsBIO.o tlsIO.o tlsX509.o
	-test -z "$(BINARIES)" || rm -f $(BINARIES)
	rm -f @EXTENSION_TARGET@ shared-@EXTENSION_TARGET@ static-@EXTENSION_TARGET@
	rm -f shared-@EXT[email protected] shared-@EXTENSION_TARGET@.lib
	rm -f tls.tcl.h tls.tcl.h.new.1 tls.tcl.h.new.2
	-rm -f *.$(OBJEXT) core *.core
	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)

# Clean the local build directory back to what it was after unpacking the
# distribution tarball
distclean: clean
	-rm -f *.tab.c
	-rm -f $(CONFIG_CLEAN_FILES)
	rm -f config.log config.status
	rm -f dh_params.h.new dh_params.h
	rm -f Makefile pkgIndex.tcl
	rm -f tcltls.a.linkadd
	rm -f tcltls.syms

# Clean the local build directory back to only thing things that exist in
# version control system
mrproper: distclean
	rm -f @srcdir@/configure @srcdir@/config.sub @srcdir@/config.guess @srcdir@/install-sh
	rm -f @srcdir@/aclocal.m4
	rm -rf @srcdir@/autom4te.cache
	-rm -f config.cache config.log config.status
	-rm -R autom4te.cache

#========================================================================
# Install binary object libraries.  On Windows this includes both .dll and
# .lib files.  Because the .lib files are not explicitly listed anywhere,
# we need to deduce their existence from the .dll file of the same name.
# Library files go into the lib directory.
# In addition, this will generate the pkgIndex.tcl
# file in the install location (assuming it can find a usable tclsh shell)
#
# You should not have to modify this target.
#========================================================================

install-lib-binaries: binaries
	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(pkglibdir)"
	@list='$(lib_BINARIES)'; for p in $$list; do \
	  if test -f $$p; then \
	    echo " $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p"; \
	    $(INSTALL_LIBRARY) $$p "$(DESTDIR)$(pkglibdir)/$$p"; \
	    ext=`echo $$p|sed -e "s/.*\.//"`; \
	    if test "x$$ext" = "xdll"; then \
		lib=`basename $$p|sed -e 's/.[^.]*$$//'`.lib; \
		if test -f $$lib; then \
		    echo " $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib"; \
	            $(INSTALL_DATA) $$lib "$(DESTDIR)$(pkglibdir)/$$lib"; \
		fi; \
	    fi; \
	  fi; \
	done
	@list='$(PKG_TCL_SOURCES)'; for p in $$list; do \
	  if test -f $(srcdir)/$$p; then \
	    destp=`basename $$p`; \
	    echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \
	    $(INSTALL_DATA) $(srcdir)/$$p "$(DESTDIR)$(pkglibdir)/$$destp"; \
	  fi; \
	done
	@if test "x$(SHARED_BUILD)" = "x1"; then \
	    echo " Install pkgIndex.tcl $(DESTDIR)$(pkglibdir)"; \
	    $(INSTALL_DATA) pkgIndex.tcl "$(DESTDIR)$(pkglibdir)"; \
	fi

#========================================================================
# Install binary executables (e.g. .exe files and dependent .dll files)
# This is for files that must go in the bin directory (located next to
# wish and tclsh), like dependent .dll files on Windows.
#
# You should not have to modify this target, except to define bin_BINARIES
# above if necessary.
#========================================================================

install-bin-binaries: binaries
	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(bindir)"
	@list='$(bin_BINARIES)'; for p in $$list; do \
	  if test -f $$p; then \
	    echo " $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p"; \
	    $(INSTALL_PROGRAM) $$p "$(DESTDIR)$(bindir)/$$p"; \
	  fi; \
	done

Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
	cd $(top_builddir) \
	  && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status

uninstall-binaries:
	list='$(lib_BINARIES)'; for p in $$list; do \
	  rm -f "$(DESTDIR)$(pkglibdir)/$$p"; \
	done
	list='$(PKG_TCL_SOURCES)'; for p in $$list; do \
	  p=`basename $$p`; \
	  rm -f "$(DESTDIR)$(pkglibdir)/$$p"; \
	done
	list='$(bin_BINARIES)'; for p in $$list; do \
	  rm -f "$(DESTDIR)$(bindir)/$$p"; \
	done

.PHONY: all binaries clean depend distclean doc install libraries test
.PHONY: gdb gdb-test valgrind valgrindshell
.PHONY: all install uninstall clean distclean mrproper test

# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:

Modified README.txt from [4d858d5c33] to [3dc72eec51].








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







TclTLS 1.7.22
==========

Release Date: Mon Oct 12 15:40:16 CDT 2020

https://tcltls.rkeene.org/

Original TLS Copyright (C) 1997-2000 Matt Newman <[email protected]>
TLS 1.4.1    Copyright (C) 2000 Ajuba Solutions
TLS 1.6      Copyright (C) 2008 ActiveState Software Inc.
TLS 1.7      Copyright (C) 2016 Matt Newman, Ajuba Solutions, ActiveState
                                Software Inc, Roy Keene <[email protected]>

TLS (aka SSL) Channel - can be layered on any bi-directional Tcl_Channel.

Added acinclude.m4 version [087476b928].
















































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#
# Include the TEA standard macro set
#

builtin(include,tclconfig/tcl.m4)

#
# Add here whatever m4 macros you want to define for your package
#

AC_DEFUN([TCLTLS_SSL_OPENSSL], [
	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
	])

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

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

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


	dnl Determine if we have been asked to use a fast path if possible
	AC_ARG_ENABLE([ssl-fastpath], AS_HELP_STRING([--enable-ssl-fastpath],
		[enable using the underlying file descriptor for talking directly to the SSL library]), [
		tcltls_ssl_fastpath="$enableval"
	], [
		tcltls_ssl_fastpath='no'
	])
	if test "$tcltls_ssl_fastpath" = 'yes'; then
		AC_DEFINE(TCLTLS_SSL_USE_FASTPATH, [1], [Enable SSL library direct use of the underlying file descriptor])
	fi
	AC_MSG_CHECKING([for fast path])
	AC_MSG_RESULT([$tcltls_ssl_fastpath])


	dnl Enable hardening
	AC_ARG_ENABLE([hardening], AS_HELP_STRING([--enable-hardening], [enable hardening attempts]), [
		tcltls_enable_hardening="$enableval"
	], [
		tcltls_enable_hardening='yes'
	])
	if test "$tcltls_enable_hardening" = 'yes'; then
		if test "$GCC" = 'yes' -o "$CC" = 'clang'; then
			TEA_ADD_CFLAGS([-fstack-protector-all])
			TEA_ADD_CFLAGS([-fno-strict-overflow])
			AC_DEFINE([_FORTIFY_SOURCE], [2], [Enable fortification])
		fi
	fi
	AC_MSG_CHECKING([for enable hardening])
	AC_MSG_RESULT([$tcltls_enable_hardening])


	dnl Determine if we have been asked to statically link to the SSL library
	AC_ARG_ENABLE([static-ssl], AS_HELP_STRING([--enable-static-ssl], [enable static linking to the SSL library]), [
		TCLEXT_TLS_STATIC_SSL="$enableval"
	], [
		TCLEXT_TLS_STATIC_SSL='no'
	])
	AC_MSG_CHECKING([for static linking of openSSL libraries])
	AC_MSG_RESULT([$TCLEXT_TLS_STATIC_SSL])


	dnl Set SSL files root path
	AC_ARG_WITH([openssl-dir],
		AS_HELP_STRING([--with-openssl-dir=<dir>],
			[path to root directory of OpenSSL or LibreSSL installation]
		), [
			openssldir="$withval"
		], [
			openssldir=''
		]
	)
	AC_MSG_CHECKING([for OpenSSL directory])
	AC_MSG_RESULT($openssldir)

	dnl Set SSL include files path
	AC_ARG_WITH([openssl-includedir],
		AS_HELP_STRING([--with-openssl-includedir=<dir>],
			[path to include directory of OpenSSL or LibreSSL installation]
		), [
			opensslincludedir="$withval"
		], [
			if test ! -z "$openssldir"; then
				opensslincludedir="${openssldir}/include"
			else
				opensslincludedir=''
			fi
		]
	)
	AC_MSG_CHECKING([for OpenSSL include directory])
	AC_MSG_RESULT($opensslincludedir)

	dnl Set SSL include vars
	if test ! -z "$opensslincludedir"; then
		if test -f "$opensslincludedir/openssl/ssl.h"; then
			TCLTLS_SSL_CFLAGS="-I$opensslincludedir"
			TCLTLS_SSL_INCLUDES="-I$opensslincludedir"
			AC_MSG_CHECKING([for ssl.h])
			AC_MSG_RESULT([yes])
		else
			AC_MSG_CHECKING([for ssl.h])
			AC_MSG_RESULT([no])
			AC_MSG_ERROR([Unable to locate ssl.h])
		fi
	fi

	dnl Set SSL lib files path
	AC_ARG_WITH([openssl-libdir],
		AS_HELP_STRING([--with-openssl-libdir=<dir>],
			[path to lib directory of OpenSSL or LibreSSL installation]
		), [
			openssllibdir="$withval"
		], [
			if test ! -z "$openssldir"; then
				if test "$do64bit" == 'yes'; then
					openssllibdir="$openssldir/lib64"
				else
					openssllibdir="$openssldir/lib"
				fi
			else
				openssllibdir=''
			fi
		]
	)
	AC_MSG_CHECKING([for OpenSSL lib directory])
	AC_MSG_RESULT($openssllibdir)

	dnl Set SSL lib vars
	if test ! -z "$openssllibdir"; then
		if test -f "$openssllibdir/libssl${SHLIB_SUFFIX}"; then
			if test "${TCLEXT_TLS_STATIC_SSL}" == 'no'; then
				TCLTLS_SSL_LIBS="-L$openssllibdir -lcrypto -lssl"
			#else
				# Linux and Solaris
				#TCLTLS_SSL_LIBS="-Wl,-Bstatic `$PKG_CONFIG --static --libs crypto ssl` -Wl,-Bdynamic"
				# HPUX
				# -Wl,-a,archive ... -Wl,-a,shared_archive
			fi
		else
			AC_MSG_ERROR([Unable to locate libssl${SHLIB_SUFFIX}])
		fi
	fi

	dnl Set location of pkgconfig files
	AC_ARG_WITH([openssl-pkgconfig],
		AS_HELP_STRING([--with-openssl-pkgconfig=<dir>],
			[path to pkgconfigdir directory for OpenSSL or LibreSSL]
		), [
			opensslpkgconfigdir="$withval"
		], [
			if test -d ${libdir}/../pkgconfig; then
				opensslpkgconfigdir="$libdir/../pkgconfig"
			else
				opensslpkgconfigdir=''
			fi
		]
	)
	AC_MSG_CHECKING([for OpenSSL pkgconfig])
	AC_MSG_RESULT($opensslpkgconfigdir)


	# Use Package Config tool to get config
	pkgConfigExtraArgs=''
	if test "${SHARED_BUILD}" == 0 -o "$TCLEXT_TLS_STATIC_SSL" = 'yes'; then
		pkgConfigExtraArgs='--static'
	fi

	dnl Use pkg-config to find the libraries
	if test -n "${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
		if test -z "$TCLTLS_SSL_LIBS"; then
			TCLTLS_SSL_LIBS="`"${PKG_CONFIG}" openssl --libs $pkgConfigExtraArgs`" || AC_MSG_ERROR([Unable to get OpenSSL Configuration])
		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
		PKG_CONFIG_PATH="${PKG_CONFIG_PATH_SAVE}"
	fi


	dnl Fallback settings for OpenSSL includes and libs
	if test -z "$TCLTLS_SSL_LIBS"; then
		TCLTLS_SSL_LIBS="-lcrypto -lssl"
	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

	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 or LibreSSL])
	AC_ARG_VAR([TCLTLS_SSL_INCLUDES], [C compiler include paths for OpenSSL or LibreSSL])
	AC_ARG_VAR([TCLTLS_SSL_LIBS], [libraries to pass to the linker for OpenSSL or LibreSSL])
])

Added aclocal.m4 version [aa2bfd12c3].






































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# generated automatically by aclocal 1.16.5 -*- Autoconf -*-

# Copyright (C) 1996-2021 Free Software Foundation, Inc.

# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.

m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])])
# ===========================================================================
#  https://www.gnu.org/software/autoconf-archive/ax_check_compile_flag.html
# ===========================================================================
#
# SYNOPSIS
#
#   AX_CHECK_COMPILE_FLAG(FLAG, [ACTION-SUCCESS], [ACTION-FAILURE], [EXTRA-FLAGS], [INPUT])
#
# DESCRIPTION
#
#   Check whether the given FLAG works with the current language's compiler
#   or gives an error.  (Warnings, however, are ignored)
#
#   ACTION-SUCCESS/ACTION-FAILURE are shell commands to execute on
#   success/failure.
#
#   If EXTRA-FLAGS is defined, it is added to the current language's default
#   flags (e.g. CFLAGS) when the check is done.  The check is thus made with
#   the flags: "CFLAGS EXTRA-FLAGS FLAG".  This can for example be used to
#   force the compiler to issue an error when a bad flag is given.
#
#   INPUT gives an alternative input source to AC_COMPILE_IFELSE.
#
#   NOTE: Implementation based on AX_CFLAGS_GCC_OPTION. Please keep this
#   macro in sync with AX_CHECK_{PREPROC,LINK}_FLAG.
#
# LICENSE
#
#   Copyright (c) 2008 Guido U. Draheim <[email protected]>
#   Copyright (c) 2011 Maarten Bosmans <[email protected]>
#
#   Copying and distribution of this file, with or without modification, are
#   permitted in any medium without royalty provided the copyright notice
#   and this notice are preserved.  This file is offered as-is, without any
#   warranty.

#serial 6

AC_DEFUN([AX_CHECK_COMPILE_FLAG],
[AC_PREREQ(2.64)dnl for _AC_LANG_PREFIX and AS_VAR_IF
AS_VAR_PUSHDEF([CACHEVAR],[ax_cv_check_[]_AC_LANG_ABBREV[]flags_$4_$1])dnl
AC_CACHE_CHECK([whether _AC_LANG compiler accepts $1], CACHEVAR, [
  ax_check_save_flags=$[]_AC_LANG_PREFIX[]FLAGS
  _AC_LANG_PREFIX[]FLAGS="$[]_AC_LANG_PREFIX[]FLAGS $4 $1"
  AC_COMPILE_IFELSE([m4_default([$5],[AC_LANG_PROGRAM()])],
    [AS_VAR_SET(CACHEVAR,[yes])],
    [AS_VAR_SET(CACHEVAR,[no])])
  _AC_LANG_PREFIX[]FLAGS=$ax_check_save_flags])
AS_VAR_IF(CACHEVAR,yes,
  [m4_default([$2], :)],
  [m4_default([$3], :)])
AS_VAR_POPDEF([CACHEVAR])dnl
])dnl AX_CHECK_COMPILE_FLAGS

m4_include([acinclude.m4])

Deleted aclocal/ax_check_compile_flag.m4 version [0974cae407].

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





















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# ===========================================================================
#  https://www.gnu.org/software/autoconf-archive/ax_check_compile_flag.html
# ===========================================================================
#
# SYNOPSIS
#
#   AX_CHECK_COMPILE_FLAG(FLAG, [ACTION-SUCCESS], [ACTION-FAILURE], [EXTRA-FLAGS], [INPUT])
#
# DESCRIPTION
#
#   Check whether the given FLAG works with the current language's compiler
#   or gives an error.  (Warnings, however, are ignored)
#
#   ACTION-SUCCESS/ACTION-FAILURE are shell commands to execute on
#   success/failure.
#
#   If EXTRA-FLAGS is defined, it is added to the current language's default
#   flags (e.g. CFLAGS) when the check is done.  The check is thus made with
#   the flags: "CFLAGS EXTRA-FLAGS FLAG".  This can for example be used to
#   force the compiler to issue an error when a bad flag is given.
#
#   INPUT gives an alternative input source to AC_LINK_IFELSE.
#
#   NOTE: Implementation based on AX_CFLAGS_GCC_OPTION. Please keep this
#   macro in sync with AX_CHECK_{PREPROC,LINK}_FLAG.
#
# LICENSE
#
#   Copyright (c) 2008 Guido U. Draheim <[email protected]>
#   Copyright (c) 2011 Maarten Bosmans <[email protected]>
#
#   Copying and distribution of this file, with or without modification, are
#   permitted in any medium without royalty provided the copyright notice
#   and this notice are preserved.  This file is offered as-is, without any
#   warranty.

#serial 6

AC_DEFUN([AX_CHECK_COMPILE_FLAG],
[AC_PREREQ(2.64)dnl for _AC_LANG_PREFIX and AS_VAR_IF
AS_VAR_PUSHDEF([CACHEVAR],[ax_cv_check_[]_AC_LANG_ABBREV[]flags_$4_$1])dnl
AC_CACHE_CHECK([whether _AC_LANG compiler accepts $1], CACHEVAR, [
  ax_check_save_flags=$[]_AC_LANG_PREFIX[]FLAGS
  _AC_LANG_PREFIX[]FLAGS="$[]_AC_LANG_PREFIX[]FLAGS $4 $1"
  AC_LINK_IFELSE([m4_default([$5],[AC_LANG_PROGRAM()])],
    [AS_VAR_SET(CACHEVAR,[yes])],
    [AS_VAR_SET(CACHEVAR,[no])])
  _AC_LANG_PREFIX[]FLAGS=$ax_check_save_flags])
AS_VAR_IF(CACHEVAR,yes,
  [m4_default([$2], :)],
  [m4_default([$3], :)])
AS_VAR_POPDEF([CACHEVAR])dnl
])dnl AX_CHECK_COMPILE_FLAGS

Deleted aclocal/shobj.m4 version [2123b62392].

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









































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
dnl Usage:
dnl    DC_TEST_SHOBJFLAGS(shobjflags, shobjldflags, action-if-not-found)
dnl
AC_DEFUN([DC_TEST_SHOBJFLAGS], [
  AC_SUBST(SHOBJFLAGS)
  AC_SUBST(SHOBJCPPFLAGS)
  AC_SUBST(SHOBJLDFLAGS)

  OLD_LDFLAGS="$LDFLAGS"
  OLD_CFLAGS="$CFLAGS"
  OLD_CPPFLAGS="$CPPFLAGS"

  SHOBJFLAGS=""
  SHOBJCPPFLAGS=""
  SHOBJLDFLAGS=""

  CFLAGS="$OLD_CFLAGS $1"
  CPPFLAGS="$OLD_CPPFLAGS $2"
  LDFLAGS="$OLD_LDFLAGS $3"

  AC_TRY_LINK([#include <stdio.h>
int unrestst(void);], [ printf("okay\n"); unrestst(); return(0); ], [ SHOBJFLAGS="$1"; SHOBJCPPFLAGS="$2"; SHOBJLDFLAGS="$3" ], [
    LDFLAGS="$OLD_LDFLAGS"
    CFLAGS="$OLD_CFLAGS"
    CPPFLAGS="$OLD_CPPFLAGS"
    $4
  ])

  LDFLAGS="$OLD_LDFLAGS"
  CFLAGS="$OLD_CFLAGS"
  CPPFLAGS="$OLD_CPPFLAGS"
])

AC_DEFUN([DC_GET_SHOBJFLAGS], [
  AC_SUBST(SHOBJFLAGS)
  AC_SUBST(SHOBJCPPFLAGS)
  AC_SUBST(SHOBJLDFLAGS)

  DC_CHK_OS_INFO

  AC_MSG_CHECKING(how to create shared objects)

  if test -z "$SHOBJFLAGS" -a -z "$SHOBJLDFLAGS" -a -z "$SHOBJCPPFLAGS"; then
    DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-shared], [
      DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-shared -mimpure-text], [
        DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-shared -rdynamic -Wl,-G,-z,textoff], [
          DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-shared -Wl,-G], [
            DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-shared -dynamiclib -flat_namespace -undefined suppress -bind_at_load], [
              DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-dynamiclib -flat_namespace -undefined suppress -bind_at_load], [
                DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-Wl,-dynamiclib -Wl,-flat_namespace -Wl,-undefined,suppress -Wl,-bind_at_load], [
                  DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-dynamiclib -flat_namespace -undefined suppress], [
                    DC_TEST_SHOBJFLAGS([-fPIC], [-DPIC], [-dynamiclib], [
                      AC_MSG_RESULT(cant)
                      AC_MSG_ERROR([We are unable to make shared objects.])
                    ])
                  ])
                ])
              ])
            ])
          ])
        ])
      ])
    ])
  fi

  AC_MSG_RESULT($SHOBJCPPFLAGS $SHOBJFLAGS $SHOBJLDFLAGS)

  DC_SYNC_SHLIBOBJS
])

AC_DEFUN([DC_SYNC_SHLIBOBJS], [
  AC_SUBST(SHLIBOBJS)
  SHLIBOBJS=""
  for obj in $LIB@&t@OBJS; do
    SHLIBOBJS="$SHLIBOBJS `echo $obj | sed 's/\.o$/_shr.o/g'`"
  done
])

AC_DEFUN([DC_SYNC_RPATH], [
	AC_ARG_ENABLE([rpath], AS_HELP_STRING([--disable-rpath], [disable setting of rpath]), [
		if test "$enableval" = 'no'; then
			set_rpath='no'
		else
			set_rpath='yes'
		fi
	], [
		if test "$cross_compiling" = 'yes'; then
			set_rpath='no'
		else
			ifelse($1, [], [
				set_rpath='yes'
			], [
				set_rpath='$1'
			])
		fi
	])

	if test "$set_rpath" = 'yes'; then
		OLD_LDFLAGS="$LDFLAGS"

		AC_CACHE_CHECK([how to set rpath], [rsk_cv_link_set_rpath], [
			AC_LANG_PUSH(C)
			for tryrpath in "-Wl,-rpath" "-Wl,--rpath" "-Wl,-R"; do
				LDFLAGS="$OLD_LDFLAGS $tryrpath -Wl,/tmp"
				AC_LINK_IFELSE([AC_LANG_PROGRAM([], [ return(0); ])], [
					rsk_cv_link_set_rpath="$tryrpath"
					break
				])
			done
			AC_LANG_POP(C)
			unset tryrpath
		])

		LDFLAGS="$OLD_LDFLAGS"
		unset OLD_LDFLAGS

		if test -n "$rsk_cv_link_set_rpath"; then
			ADDLDFLAGS=""
			for opt in $LDFLAGS $LIBS; do
				if echo "$opt" | grep '^-L' >/dev/null; then
					rpathdir="`echo "$opt" | sed 's@^-L *@@'`"
					ADDLDFLAGS="$ADDLDFLAGS $rsk_cv_link_set_rpath -Wl,$rpathdir"
				fi
			done
			unset opt

			LDFLAGS="$LDFLAGS $ADDLDFLAGS"

			unset ADDLDFLAGS
		fi
	fi
])

AC_DEFUN([DC_CHK_OS_INFO], [
	AC_CANONICAL_HOST
	AC_SUBST(SHOBJEXT)
	AC_SUBST(SHOBJFLAGS)
	AC_SUBST(SHOBJCPPFLAGS)
	AC_SUBST(SHOBJLDFLAGS)
	AC_SUBST(CFLAGS)
	AC_SUBST(CPPFLAGS)
	AC_SUBST(AREXT)

	if test "$dc_cv_dc_chk_os_info_called" != '1'; then
		dc_cv_dc_chk_os_info_called='1'

		AC_MSG_CHECKING(host operating system)
		AC_MSG_RESULT($host_os)

		SHOBJEXT="so"
		AREXT="a"

		case $host_os in
			darwin*)
				SHOBJEXT="dylib"
				;;
			hpux*)
				case "$host_cpu" in
					ia64)
						SHOBJEXT="so"
						;;
					*)
						SHOBJEXT="sl"
						;;
				esac
				;;
			mingw32|mingw32msvc*)
				SHOBJEXT="dll"
				CFLAGS="$CFLAGS -mms-bitfields"
				CPPFLAGS="$CPPFLAGS -mms-bitfields"
				SHOBJCPPFLAGS="-DPIC"
				SHOBJLDFLAGS='-shared -Wl,--dll -Wl,--enable-auto-image-base -Wl,--output-def,$[@].def,--out-implib,$[@].a'
				;;
			msvc)
				SHOBJEXT="dll"
				AREXT='lib'
				CFLAGS="$CFLAGS -nologo"
				SHOBJCPPFLAGS='-DPIC'
				SHOBJLDFLAGS='/LD /LINK /NODEFAULTLIB:MSVCRT'
				;;
			cygwin*)
				SHOBJEXT="dll"
				SHOBJFLAGS="-fPIC"
				SHOBJCPPFLAGS="-DPIC"
				CFLAGS="$CFLAGS -mms-bitfields"
				CPPFLAGS="$CPPFLAGS -mms-bitfields"
				SHOBJLDFLAGS='-shared -Wl,--enable-auto-image-base -Wl,--output-def,$[@].def,--out-implib,$[@].a'
				;;
		esac
	fi
])

AC_DEFUN([SHOBJ_SET_SONAME], [
	SAVE_LDFLAGS="$LDFLAGS"

	AC_MSG_CHECKING([how to specify soname])

	for try in "-Wl,--soname,$1" "Wl,-install_name,$1" '__fail__'; do
		LDFLAGS="$SAVE_LDFLAGS"

		if test "${try}" = '__fail__'; then
			AC_MSG_RESULT([can't])

			break
		fi

		LDFLAGS="${LDFLAGS} ${try}"
		AC_TRY_LINK([void TestTest(void) { return; }], [], [
			LDFLAGS="${SAVE_LDFLAGS}"
			SHOBJLDFLAGS="${SHOBJLDFLAGS} ${try}"

			AC_MSG_RESULT([$try])

			break
		])
	done

	AC_SUBST(SHOBJLDFLAGS)
])

dnl $1 = Description to show user
dnl $2 = Libraries to link to
dnl $3 = Variable to update (optional; default LIBS)
dnl $4 = Action to run if found
dnl $5 = Action to run if not found
AC_DEFUN([SHOBJ_DO_STATIC_LINK_LIB], [
        ifelse($3, [], [
                define([VAR_TO_UPDATE], [LIBS])
        ], [
                define([VAR_TO_UPDATE], [$3])
        ])  


	AC_MSG_CHECKING([for how to statically link to $1])

	trylink_ADD_LDFLAGS=''
	for arg in $VAR_TO_UPDATE; do
		case "${arg}" in
			-L*)
				trylink_ADD_LDFLAGS="${arg}"
				;;
		esac
	done

	SAVELIBS="$LIBS"
	staticlib=""
	found="0"
	dnl HP/UX uses -Wl,-a,archive ... -Wl,-a,shared_archive
	dnl Linux and Solaris us -Wl,-Bstatic ... -Wl,-Bdynamic
	AC_LANG_PUSH([C])
	for trylink in "-Wl,-a,archive $2 -Wl,-a,shared_archive" "-Wl,-Bstatic $2 -Wl,-Bdynamic" "$2"; do
		if echo " ${LDFLAGS} " | grep ' -static ' >/dev/null; then
			if test "${trylink}" != "$2"; then
				continue
			fi
		fi

		LIBS="${SAVELIBS} ${trylink_ADD_LDFLAGS} ${trylink}"

		AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], [
			staticlib="${trylink}"
			found="1"

			break
		])
	done
	AC_LANG_POP([C])
	LIBS="${SAVELIBS}"

	if test "${found}" = "1"; then
		new_RESULT=''
		SAVERESULT="$VAR_TO_UPDATE"
		for lib in ${SAVERESULT}; do
			addlib='1'
			for removelib in $2; do
				if test "${lib}" = "${removelib}"; then
					addlib='0'
					break
				fi
			done

			if test "$addlib" = '1'; then
				new_RESULT="${new_RESULT} ${lib}"
			fi
		done
		VAR_TO_UPDATE="${new_RESULT} ${staticlib}"

		AC_MSG_RESULT([${staticlib}])

		$4
	else
		AC_MSG_RESULT([cant])

		$5
	fi
])

Deleted aclocal/tcl.m4 version [0d8f54c2f7].

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














































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
dnl Tcl M4 Routines

dnl Find a runnable Tcl
AC_DEFUN([TCLEXT_FIND_TCLSH_PROG], [
	AC_CACHE_CHECK([for runnable tclsh], [tcl_cv_tclsh_native_path], [
		dnl Try to find a runnable tclsh
		if test -z "$TCLCONFIGPATH"; then
			TCLCONFIGPATH=/dev/null/null
		fi

		for try_tclsh in "$TCLSH_NATIVE" "$TCLCONFIGPATH/../bin/tclsh" \
		                 "$TCLCONFIGPATH/../bin/tclsh8.6" \
		                 "$TCLCONFIGPATH/../bin/tclsh8.5" \
		                 "$TCLCONFIGPATH/../bin/tclsh8.4" \
		                 `which tclsh 2>/dev/null` \
		                 `which tclsh8.6 2>/dev/null` \
		                 `which tclsh8.5 2>/dev/null` \
		                 `which tclsh8.4 2>/dev/null` \
		                 tclsh; do
			if test -z "$try_tclsh"; then
				continue
			fi
			if test -x "$try_tclsh"; then
				if echo 'exit 0' | "$try_tclsh" 2>/dev/null >/dev/null; then
					tcl_cv_tclsh_native_path="$try_tclsh"

					break
				fi
			fi
		done

		if test "$TCLCONFIGPATH" = '/dev/null/null'; then
			unset TCLCONFIGPATH
		fi
	])

	TCLSH_PROG="${tcl_cv_tclsh_native_path}"
	AC_SUBST(TCLSH_PROG)
])


dnl Must call AC_CANONICAL_HOST  before calling us
AC_DEFUN([TCLEXT_FIND_TCLCONFIG], [

	TCLCONFIGPATH=""
	AC_ARG_WITH([tcl], AS_HELP_STRING([--with-tcl], [directory containing tcl configuration (tclConfig.sh)]), [
		if test "x$withval" = "xno"; then
			AC_MSG_ERROR([cant build without tcl])
		fi

		TCLCONFIGPATH="$withval"
	], [
		if test "$cross_compiling" = 'no'; then
			TCLEXT_FIND_TCLSH_PROG
			tclConfigCheckDir0="`echo 'puts [[tcl::pkgconfig get libdir,runtime]]' | "$TCLSH_PROG" 2>/dev/null`"
			tclConfigCheckDir1="`echo 'puts [[tcl::pkgconfig get scriptdir,runtime]]' | "$TCLSH_PROG" 2>/dev/null`"
		else
			tclConfigCheckDir0=/dev/null/null
			tclConfigCheckDir1=/dev/null/null
		fi

		if test "$cross_compiling" = 'no'; then
			dirs="/usr/$host_alias/lib /usr/lib /usr/lib64 /usr/local/lib /usr/local/lib64"
		else
			dirs=''
		fi

		for dir in "$tclConfigCheckDir0" "$tclConfigCheckDir1" $dirs; do
			if test -f "$dir/tclConfig.sh"; then
				TCLCONFIGPATH="$dir"

				break
			fi
		done
	])

	AC_MSG_CHECKING([for path to tclConfig.sh])

	if test -z "$TCLCONFIGPATH"; then
		AC_MSG_ERROR([unable to locate tclConfig.sh.  Try --with-tcl.])
	fi

	AC_SUBST(TCLCONFIGPATH)

	AC_MSG_RESULT([$TCLCONFIGPATH])

	dnl Find Tcl if we haven't already
	if test -z "$TCLSH_PROG"; then
		TCLEXT_FIND_TCLSH_PROG
	fi
])

dnl Must define TCLCONFIGPATH before calling us (i.e., by TCLEXT_FIND_TCLCONFIG)
AC_DEFUN([TCLEXT_LOAD_TCLCONFIG], [
	AC_MSG_CHECKING([for working tclConfig.sh])

	if test -f "$TCLCONFIGPATH/tclConfig.sh"; then
		. "$TCLCONFIGPATH/tclConfig.sh"
	else
		AC_MSG_ERROR([unable to load tclConfig.sh])
	fi


	AC_MSG_RESULT([found])
])

AC_DEFUN([TCLEXT_INIT], [
	AC_CANONICAL_HOST

	TCLEXT_FIND_TCLCONFIG
	TCLEXT_LOAD_TCLCONFIG

	AC_DEFINE_UNQUOTED([MODULE_SCOPE], [static], [Define how to declare a function should only be visible to the current module])

	TCLEXT_BUILD='shared'
	AC_ARG_ENABLE([shared], AS_HELP_STRING([--disable-shared], [disable the shared build (same as --enable-static)]), [
		if test "$enableval" = "no"; then
			TCLEXT_BUILD='static'
			TCL_SUPPORTS_STUBS=0
		fi
	])

	AC_ARG_ENABLE([static], AS_HELP_STRING([--enable-static], [enable a static build]), [
		if test "$enableval" = "yes"; then
			TCLEXT_BUILD='static'
			TCL_SUPPORTS_STUBS=0
		fi
	])

	AC_ARG_ENABLE([stubs], AS_HELP_STRING([--disable-stubs], [disable use of Tcl stubs]), [
		if test "$enableval" = "no"; then
			TCL_SUPPORTS_STUBS=0
		else
			TCL_SUPPORTS_STUBS=1
		fi
	])

	if test "$TCL_SUPPORTS_STUBS" = "1"; then
		AC_DEFINE([USE_TCL_STUBS], [1], [Define if you are using the Tcl Stubs Mechanism])

		TCL_STUB_LIB_SPEC="`eval echo "${TCL_STUB_LIB_SPEC}"`"
		LIBS="${LIBS} ${TCL_STUB_LIB_SPEC}"
	else
		TCL_LIB_SPEC="`eval echo "${TCL_LIB_SPEC}"`"
		LIBS="${LIBS} ${TCL_LIB_SPEC}"
	fi

	TCL_INCLUDE_SPEC="`eval echo "${TCL_INCLUDE_SPEC}"`"

	CFLAGS="${CFLAGS} ${TCL_INCLUDE_SPEC}"
	CPPFLAGS="${CPPFLAGS} ${TCL_INCLUDE_SPEC}"
	TCL_DEFS_TCL_ONLY=`(
		eval "set -- ${TCL_DEFS}"
		for flag in "[$]@"; do
			case "${flag}" in
				-DTCL_*)
					echo "${flag}" | sed "s/'/'\\''/g" | sed "s@^@'@;s@"'[$]'"@'@" | tr $'\n' ' '
					;;
			esac
		done
	)`
	TCL_DEFS="${TCL_DEFS_TCL_ONLY}"
	AC_SUBST(TCL_DEFS)

	dnl Needed for package installation
	if test "$prefix" = 'NONE' -a "$exec_prefix" = 'NONE' -a "${libdir}" = '${exec_prefix}/lib'; then
		TCL_PACKAGE_PATH="`echo "${TCL_PACKAGE_PATH}" | sed 's@  *$''@@' | awk '{ print [$]1 }'`"
	else
		TCL_PACKAGE_PATH='${libdir}'
	fi
	AC_SUBST(TCL_PACKAGE_PATH)

	AC_SUBST(LIBS)
])

Deleted aclocal/tcltls_openssl.m4 version [3644ca7551].

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





























































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
dnl $1 = Name of variable
dnl $2 = Name of function to check for
dnl $3 = Name of protocol
dnl $4 = Name of CPP macro to define
dnl $5 = Name of CPP macro to check for instead of a function
AC_DEFUN([TCLTLS_SSL_OPENSSL_CHECK_PROTO_VER], [
	dnl Determine if particular SSL version is enabled
	if test "[$]$1" = "true" -o "[$]$1" = "force"; then
		proto_check='true'
		ifelse($5,, [
			AC_CHECK_FUNC($2,, [
				proto_check='false'
			])
		], [
			AC_LANG_PUSH(C)
			AC_MSG_CHECKING([for $3 protocol support])
			AC_COMPILE_IFELSE([AC_LANG_PROGRAM([
#include <openssl/ssl.h>
#include <openssl/opensslv.h>
#if (SSLEAY_VERSION_NUMBER >= 0x0907000L)
# include <openssl/conf.h>
#endif
			], [
int x = $5;
			])], [
				AC_MSG_RESULT([yes])
			], [
				AC_MSG_RESULT([no])

				proto_check='false'
			])
			AC_LANG_POP([C])
		])

		if test "$proto_check" = 'false'; then
			if test "[$]$1" = "force"; then
				AC_MSG_ERROR([Unable to enable $3])
			fi

			$1='false'
		fi
	fi

	if test "[$]$1" = "false"; then
		AC_DEFINE($4, [1], [Define this to disable $3 in OpenSSL support])
	fi

])

AC_DEFUN([TCLTLS_SSL_OPENSSL], [
	openssldir=''
	opensslpkgconfigdir=''
	AC_ARG_WITH([ssl-dir],
		AS_HELP_STRING(
			[--with-ssl-dir=<dir>],
			[deprecated, use --with-openssl-dir -- currently has the same meaning]
		), [
			openssldir="$withval"
		]
	)
	AC_ARG_WITH([openssl-dir],
		AS_HELP_STRING(
			[--with-openssl-dir=<dir>],
			[path to root directory of OpenSSL or LibreSSL installation]
		), [
			openssldir="$withval"
		]
	)
	AC_ARG_WITH([openssl-pkgconfig],
		AS_HELP_STRING(
			[--with-openssl-pkgconfig=<dir>],
			[path to root directory of OpenSSL or LibreSSL pkgconfigdir]
		), [
			opensslpkgconfigdir="$withval"
		]
	)

	if test -n "$openssldir"; then
		if test -e "$openssldir/libssl.$SHOBJEXT"; then
			TCLTLS_SSL_LIBS="-L$openssldir -lssl -lcrypto"
			openssldir="`AS_DIRNAME(["$openssldir"])`"
		else
			TCLTLS_SSL_LIBS="-L$openssldir/lib -lssl -lcrypto"
		fi
		TCLTLS_SSL_CFLAGS="-I$openssldir/include"
		TCLTLS_SSL_CPPFLAGS="-I$openssldir/include"
	fi

	pkgConfigExtraArgs=''
	if test "$TCLEXT_BUILD" = "static" -o "$TCLEXT_TLS_STATIC_SSL" = 'yes'; then
		pkgConfigExtraArgs='--static'
	fi

	dnl Use pkg-config to find the libraries
	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}${PATH_SEPARATOR}${PKG_CONFIG_PATH}"
		export PKG_CONFIG_PATH
	fi

	AC_ARG_VAR([TCLTLS_SSL_LIBS], [libraries to pass to the linker for OpenSSL or LibreSSL])
	AC_ARG_VAR([TCLTLS_SSL_CFLAGS], [C compiler flags for OpenSSL or LibreSSL])
	AC_ARG_VAR([TCLTLS_SSL_CPPFLAGS], [C preprocessor flags for OpenSSL or LibreSSL])
	if test -z "$TCLTLS_SSL_LIBS"; then
		TCLTLS_SSL_LIBS="`"${PKGCONFIG}" openssl --libs $pkgConfigExtraArgs`" || AC_MSG_ERROR([Unable to get OpenSSL Configuration])
	fi
	if test -z "$TCLTLS_SSL_CFLAGS"; then
		TCLTLS_SSL_CFLAGS="`"${PKGCONFIG}" openssl --cflags-only-other $pkgConfigExtraArgs`" || AC_MSG_ERROR([Unable to get OpenSSL Configuration])
	fi
	if test -z "$TCLTLS_SSL_CPPFLAGS"; then
		TCLTLS_SSL_CPPFLAGS="`"${PKGCONFIG}" openssl --cflags-only-I $pkgConfigExtraArgs`" || AC_MSG_ERROR([Unable to get OpenSSL Configuration])
	fi
	PKG_CONFIG_PATH="${PKG_CONFIG_PATH_SAVE}"

	if test "$TCLEXT_BUILD" = "static"; then
		dnl If we are doing a static build, save the linker flags for other programs to consume
		rm -f tcltls.${AREXT}.linkadd
		AS_ECHO(["$TCLTLS_SSL_LIBS"]) > tcltls.${AREXT}.linkadd
	fi

	dnl If we have been asked to statically link to the SSL library, specifically tell the linker to do so
	if test "$TCLEXT_TLS_STATIC_SSL" = 'yes'; then
		dnl Don't bother doing this if we aren't actually doing the runtime linking
		if test "$TCLEXT_BUILD" != "static"; then
			dnl Split the libraries into SSL and non-SSL libraries
			new_TCLTLS_SSL_LIBS_normal=''
			new_TCLTLS_SSL_LIBS_static=''
			for arg in $TCLTLS_SSL_LIBS; do
				case "${arg}" in
					-L*)
						new_TCLTLS_SSL_LIBS_normal="${new_TCLTLS_SSL_LIBS_normal} ${arg}"
						new_TCLTLS_SSL_LIBS_static="${new_TCLTLS_SSL_LIBS_static} ${arg}"
						;;
					-ldl|-lrt|-lc|-lpthread|-lm|-lcrypt|-lidn|-lresolv|-lgcc|-lgcc_s)
						new_TCLTLS_SSL_LIBS_normal="${new_TCLTLS_SSL_LIBS_normal} ${arg}"
						;;
					-l*)
						new_TCLTLS_SSL_LIBS_static="${new_TCLTLS_SSL_LIBS_static} ${arg}"
						;;
					*)
						new_TCLTLS_SSL_LIBS_normal="${new_TCLTLS_SSL_LIBS_normal} ${arg}"
						;;
				esac
			done
			SHOBJ_DO_STATIC_LINK_LIB([OpenSSL], [$new_TCLTLS_SSL_LIBS_static], [new_TCLTLS_SSL_LIBS_static])
			TCLTLS_SSL_LIBS="${new_TCLTLS_SSL_LIBS_normal} ${new_TCLTLS_SSL_LIBS_static}"
		fi
	fi

	dnl Save compile-altering variables we are changing
	SAVE_LIBS="${LIBS}"
	SAVE_CFLAGS="${CFLAGS}"
	SAVE_CPPFLAGS="${CPPFLAGS}"

	dnl Update compile-altering variables to include the OpenSSL libraries
	LIBS="${TCLTLS_SSL_LIBS} ${SAVE_LIBS} ${TCLTLS_SSL_LIBS}"
	CFLAGS="${TCLTLS_SSL_CFLAGS} ${SAVE_CFLAGS} ${TCLTLS_SSL_CFLAGS}"
	CPPFLAGS="${TCLTLS_SSL_CPPFLAGS} ${SAVE_CPPFLAGS} ${TCLTLS_SSL_CPPFLAGS}"

	dnl Verify that basic functionality is there
	AC_LANG_PUSH(C)
	AC_MSG_CHECKING([if a basic OpenSSL program works])
	AC_LINK_IFELSE([AC_LANG_PROGRAM([
#include <openssl/ssl.h>
#include <openssl/opensslv.h>
#if (SSLEAY_VERSION_NUMBER >= 0x0907000L)
# include <openssl/conf.h>
#endif
		], [
  SSL_library_init();
  SSL_load_error_strings();
		])], [
		AC_MSG_RESULT([yes])
	], [
		AC_MSG_RESULT([no])
		AC_MSG_ERROR([Unable to compile a basic program using OpenSSL])
	])
	AC_LANG_POP([C])

	AC_CHECK_FUNCS([TLS_method])
	TCLTLS_SSL_OPENSSL_CHECK_PROTO_VER([tcltls_ssl_ssl2], [SSLv2_method], [sslv2], [NO_SSL2])
	TCLTLS_SSL_OPENSSL_CHECK_PROTO_VER([tcltls_ssl_ssl3], [SSLv3_method], [sslv3], [NO_SSL3])
	TCLTLS_SSL_OPENSSL_CHECK_PROTO_VER([tcltls_ssl_tls1_0], [TLSv1_method], [tlsv1.0], [NO_TLS1])
	TCLTLS_SSL_OPENSSL_CHECK_PROTO_VER([tcltls_ssl_tls1_1], [TLSv1_1_method], [tlsv1.1], [NO_TLS1_1])
	TCLTLS_SSL_OPENSSL_CHECK_PROTO_VER([tcltls_ssl_tls1_2], [TLSv1_2_method], [tlsv1.2], [NO_TLS1_2])
	TCLTLS_SSL_OPENSSL_CHECK_PROTO_VER([tcltls_ssl_tls1_3], [], [tlsv1.3], [NO_TLS1_3], [SSL_OP_NO_TLSv1_3])

	AC_CACHE_VAL([tcltls_cv_func_tlsext_hostname], [
		AC_LANG_PUSH(C)
		AC_MSG_CHECKING([for SSL_set_tlsext_host_name])
		AC_LINK_IFELSE([AC_LANG_PROGRAM([
#include <openssl/ssl.h>
#if (SSLEAY_VERSION_NUMBER >= 0x0907000L)
# include <openssl/conf.h>
#endif
			], [
  (void)SSL_set_tlsext_host_name((void *) 0, (void *) 0);
			])], [
			AC_MSG_RESULT([yes])
			tcltls_cv_func_tlsext_hostname='yes'
		], [
			AC_MSG_RESULT([no])
			tcltls_cv_func_tlsext_hostname='no'
		])
		AC_LANG_POP([C])
	])

	if test "$tcltls_cv_func_tlsext_hostname" = 'no'; then
		AC_DEFINE([OPENSSL_NO_TLSEXT], [1], [Define this if your OpenSSL does not support the TLS Extension for SNI])
	fi

	dnl Restore compile-altering variables
	LIBS="${SAVE_LIBS}"
	CFLAGS="${SAVE_CFLAGS}"
	CPPFLAGS="${SAVE_CPPFLAGS}"
])

Deleted aclocal/versionscript.m4 version [b9d44e1a68].

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





















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
AC_DEFUN([DC_SETUP_STABLE_API], [
	VERSIONSCRIPT="$1"
	SYMFILE="$2"

	DC_FIND_STRIP_AND_REMOVESYMS([$SYMFILE])
	DC_SETVERSIONSCRIPT([$VERSIONSCRIPT], [$SYMFILE])
])


AC_DEFUN([DC_SETVERSIONSCRIPT], [
	VERSIONSCRIPT="$1"
	SYMFILE="$2"
	TMPSYMFILE="${SYMFILE}.tmp"
	TMPVERSIONSCRIPT="${VERSIONSCRIPT}.tmp"

	echo "${SYMPREFIX}Test_Symbol" > "${TMPSYMFILE}"

	echo '{' > "${TMPVERSIONSCRIPT}"
	echo '	local:' >> "${TMPVERSIONSCRIPT}"
	echo "		${SYMPREFIX}Test_Symbol;" >> "${TMPVERSIONSCRIPT}"
	echo '};' >> "${TMPVERSIONSCRIPT}"

	SAVE_LDFLAGS="${LDFLAGS}"

	AC_MSG_CHECKING([for how to set version script])

	for tryaddldflags in "-Wl,--version-script,${TMPVERSIONSCRIPT}" "-Wl,-exported_symbols_list,${TMPSYMFILE}"; do
		LDFLAGS="${SAVE_LDFLAGS} ${tryaddldflags}"
		AC_TRY_LINK([void Test_Symbol(void) { return; }], [], [
			addldflags="`echo "${tryaddldflags}" | sed 's/\.tmp$//'`"

			break
		])
	done

	rm -f "${TMPSYMFILE}"
	rm -f "${TMPVERSIONSCRIPT}"

	LDFLAGS="${SAVE_LDFLAGS}"

	if test -n "${addldflags}"; then
		SHOBJLDFLAGS="${SHOBJLDFLAGS} ${addldflags}"

		AC_MSG_RESULT($addldflags)
	else
		AC_MSG_RESULT([don't know])
	fi

	AC_SUBST(SHOBJLDFLAGS)
])

AC_DEFUN([DC_FIND_STRIP_AND_REMOVESYMS], [
	SYMFILE="$1"

	dnl Determine how to strip executables
	AC_CHECK_TOOLS(OBJCOPY, objcopy gobjcopy, [false])
	AC_CHECK_TOOLS(STRIP, strip gstrip, [false])

	if test "x${STRIP}" = "xfalse"; then
		STRIP="${OBJCOPY}"
	fi

	WEAKENSYMS='true'
	REMOVESYMS='true'
	SYMPREFIX=''

	case $host_os in
		darwin*)
			SYMPREFIX="_"
			REMOVESYMS="${STRIP} -u -x"
			;;
		*)
			if test "x${OBJCOPY}" != "xfalse"; then
				WEAKENSYMS="${OBJCOPY} --keep-global-symbols=${SYMFILE}"
				REMOVESYMS="${OBJCOPY} --discard-all"
			elif test "x${STRIP}" != "xfalse"; then
				REMOVESYMS="${STRIP} -x"
			fi
			;;
	esac

	AC_SUBST(WEAKENSYMS)
	AC_SUBST(REMOVESYMS)
	AC_SUBST(SYMPREFIX)
])

Deleted autogen.sh version [825e8c0a23].

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




















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#! /usr/bin/env bash

update='0'
if [ "$1" = '-update' ]; then
	update='1'
fi

commands=(
	curl diff cat mkdir rm mv automake autoconf
)

urls=(
	http://chiselapp.com/user/rkeene/repository/autoconf/doc/trunk/tcl.m4
	http://chiselapp.com/user/rkeene/repository/autoconf/doc/trunk/shobj.m4
	http://chiselapp.com/user/rkeene/repository/autoconf/doc/trunk/versionscript.m4
	'http://git.savannah.gnu.org/gitweb/?p=autoconf-archive.git;a=blob_plain;f=m4/ax_check_compile_flag.m4'
)

localFiles=(
	aclocal/tcltls_openssl.m4
)

failed='0'
for command in "${commands[@]}"; do
	if [ ! -f "$(which "${command}" 2>/dev/null)" ]; then
		echo "error: Unable to locate ${command}" >&2
		failed='1'
	fi
done
if [ "${failed}" = '1' ]; then
	exit 1
fi

cd "$(dirname "$(which "$0")")" || exit 1

mkdir aclocal >/dev/null 2>/dev/null

files=()

for url in "${urls[@]}"; do
	file="aclocal/$(echo "${url}" | sed 's@^.*/@@')"

	if [ -f "${file}" ]; then
		if [ "${update}" = '0' ]; then
			files=("${files[@]}" "${file}")

			continue
		fi
	fi

	curl -lsS "${url}" > "${file}.new" || exit 1
	if diff "${file}.new" "${file}" >/dev/null 2>/dev/null; then
		rm -f "${file}.new"
	else
		mv "${file}.new" "${file}"
	fi

	files=("${files[@]}" "${file}")
done

for file in "${files[@]}" "${localFiles[@]}"; do
	cat "${file}"
done > aclocal.m4.new

if diff aclocal.m4.new aclocal.m4 >/dev/null 2>/dev/null; then
	rm -f aclocal.m4.new
else
	mv aclocal.m4.new aclocal.m4
fi

automake --add-missing --copy --force-missing >/dev/null 2>/dev/null
if ! [ -f install-sh -o -f install.sh -o -f shtool ]; then
	echo "automake failed" >&2
	exit 1
fi

autoconf

if grep AC_COMPILE_IFELSE aclocal/ax_check_compile_flag.m4 >/dev/null; then
	sed 's@AC_COMPILE_IFELSE@AC_LINK_IFELSE@g' aclocal/ax_check_compile_flag.m4 > aclocal/ax_check_compile_flag.m4.new
	mv aclocal/ax_check_compile_flag.m4.new aclocal/ax_check_compile_flag.m4
fi

rm -rf autom4te.cache

Deleted build/makearch.info version [f2c0aaf165].

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














































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# This is the name of the utility, it will be prefixed to the tarball name
UTIL="tcltls"

# This is the name of output files that should exist after configure 
# procedures.
BINS="tcltls.so"

# This lists the name of files that are required to exist
REQS=""

# Version of utility, if empty it will be guessed.
# If set to "auto" it will be maintained in a file called .version
# in the source directory and the revision will be incremented
# each time a "makearch" is done.
#
# If @@SVNLCR@@ is used anywhere in this version number, it will be
# replaced with the highest last-changed-rev from the output of
#   svn info -R    (or 0)
VERS=""

# Space sperated list of documents, if they exist, they will be
# prefixed with the contents of the DOC_HDR file and substitution
# will occur:
#     @@UTIL@@ becomes the utility name ${UTIL}
#     @@VERS@@ becomes the utility version
#     @@DATE@@ becomes the current date
DOCS="README.txt ChangeLog"
DOC_HDR="HEADER"

# These files follow the same convention as DOCS, but don't have the header
# tacked onto them.
UPDATE_VARS="tls.htm"

# This script is executed immediately after copying the files
# to a temp directory to attempt to compile
BEFORE="build/pre.sh"

# This script is executed after updating variables
UPDATED=""

# This script is executed immediately prior to creation of the
# tarball
AFTER="build/post.sh"

# Files matching these (space-seperated) patterns are deleted
TMPS="*.out HEADER"

Deleted build/post.sh version [cb645c3205].

1
2
3
4
5
6
7
8








-
-
-
-
-
-
-
-
#! /usr/bin/env bash

set -e

rm -rf build
rm -f autogen.sh

exit 0

Deleted build/pre.sh version [a8f310fb41].

1
2
3
4
5
6






-
-
-
-
-
-
#! /usr/bin/env bash

./autogen.sh || exit 1
rm -rf aclocal

exit 0

Added configure version [d42fd61c71].

more than 10,000 changes

Modified configure.ac from [6234df6904] to [7ae4b1d7b6].

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





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

-
-
-
+
-
-
+
+
+
+

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

-
-
+
-
-
-
-
-
-

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

-
-
-
+
+
+

-
-
+
+
+
-
-
+
+
+

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

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

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

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

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

+
+
+

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

+
+
+
-
-
+
+

-
-
-
-
-
-
-
+
-
-

-
-
-
+
+
+

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

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

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

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

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

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

-
-
+
dnl Define ourselves
AC_INIT(tcltls, 1.8.0)

dnl Checks for programs.
#!/bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.
AC_PROG_CC
AC_PROG_MAKE_SET
AC_PROG_INSTALL
AC_GNU_SOURCE

dnl Determine system information
DC_CHK_OS_INFO

#
dnl Look for appropriate headers
AC_CHECK_HEADERS(unistd.h stdlib.h string.h strings.h)
#-----------------------------------------------------------------------
# This is the configure.ac for the TclTLS extension.  The only places you
# should need to modify this file are marked by the string __CHANGE__.
#-----------------------------------------------------------------------

#-----------------------------------------------------------------------
dnl Perform Tcl Extension required stuff
# Set your package name and version numbers here.
TCLEXT_INIT

if test "$TCLEXT_BUILD" != 'static'; then
#
# 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.
	dnl Determine how to make shared objects
	DC_GET_SHOBJFLAGS
#-----------------------------------------------------------------------

	EXTENSION_TARGET="tcltls.${SHOBJEXT}"
else
AC_INIT([tls],[1.8.0])
	AC_CHECK_TOOL([AR], [ar], [false])
	AC_CHECK_TOOL([RANLIB], [ranlib], [:])
	EXTENSION_TARGET="tcltls.${AREXT}"
fi
AC_SUBST(EXTENSION_TARGET)
AC_SUBST(TCLEXT_BUILD)

dnl Determine what SSL library to link with
AC_ARG_WITH([ssl], AS_HELP_STRING([--with-ssl=<name>], [name of ssl library to build against (openssl, libressl, nss, auto)]), [
	if test "$withval" = "no"; then
#--------------------------------------------------------------------
# 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.
#--------------------------------------------------------------------

TEA_INIT

		AC_MSG_ERROR([You may not specify --without-ssl])
	fi
AC_CONFIG_AUX_DIR(tclconfig)

	if test "$withval" = "yes"; then
		AC_MSG_ERROR([If you specify --with-ssl then you must provide a value])
	fi
#--------------------------------------------------------------------
# Load the tclConfig.sh file
#--------------------------------------------------------------------

	tcltls_ssl_lib="$withval"
], [
TEA_PATH_TCLCONFIG
TEA_LOAD_TCLCONFIG

	tcltls_ssl_lib='auto'
])
#--------------------------------------------------------------------
# Load the tkConfig.sh file if necessary (Tk extension)
#--------------------------------------------------------------------

dnl Enable support for building the same library every time
tcltls_deterministic='false'
AC_ARG_ENABLE([deterministic], AS_HELP_STRING([--enable-deterministic], [enable deterministic parameters]), [
	if test "$enableval" = "yes"; then
		tcltls_deterministic='true'
	fi
])
if test "$tcltls_deterministic" = 'true'; then
	GEN_DH_PARAMS_ARGS='fallback'
else
	GEN_DH_PARAMS_ARGS=''
#TEA_PATH_TKCONFIG
fi
#TEA_LOAD_TKCONFIG

dnl Enable support for specifying pre-computed DH params size
AC_ARG_WITH([builtin-dh-params-size], AS_HELP_STRING([--with-builtin-dh-params-size=<bits>], [specify the size of the built-in, precomputed, DH params]), [
	AS_CASE([$withval],
		[2048|4096|8192],,
		[
#-----------------------------------------------------------------------
# Handle the --prefix=... option by defaulting to what Tcl gave.
# Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER.
#-----------------------------------------------------------------------

TEA_PREFIX
			AC_MSG_ERROR([Unsupported DH params size: $withval])
		]
	)

#-----------------------------------------------------------------------
# Standard compiler checks.
# This sets up CC by using the CC env var, or looks for gcc otherwise.
# This also calls AC_PROG_CC and a few others to create the basic setup
# necessary to compile executables.
#-----------------------------------------------------------------------

	GEN_DH_PARAMS_ARGS="${GEN_DH_PARAMS_ARGS} bits=$withval"
])
AC_SUBST(GEN_DH_PARAMS_ARGS)
TEA_SETUP_COMPILER

dnl Allow the user to manually disable protocols
dnl ## SSLv2: Enabled by default
tcltls_ssl_ssl2='true'
AC_ARG_ENABLE([sslv2], AS_HELP_STRING([--disable-sslv2], [disable SSLv2 protocol]), [
	if test "$enableval" = "yes"; then
		tcltls_ssl_ssl2='force'
	else
		tcltls_ssl_ssl2='false'
	fi
])
#-----------------------------------------------------------------------
# __CHANGE__
# Specify the C source files to compile in TEA_ADD_SOURCES,
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

dnl ## SSLv3: Enabled by default
tcltls_ssl_ssl3='true'
TEA_ADD_SOURCES([tls.c tlsBIO.c tlsIO.c tlsX509.c])
TEA_ADD_HEADERS([generic/tls.h])
AC_ARG_ENABLE([sslv3], AS_HELP_STRING([--disable-sslv3], [disable SSLv3 protocol]), [
	if test "$enableval" = "yes"; then
		tcltls_ssl_ssl3='force'
TEA_ADD_INCLUDES([])
	else
		tcltls_ssl_ssl3='false'
	fi
])

TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
dnl ## TLSv1.0: Enabled by default
tcltls_ssl_tls1_0='true'
TEA_ADD_STUB_SOURCES([])
TEA_ADD_TCL_SOURCES([library/tls.tcl])
AC_ARG_ENABLE([tlsv1.0], AS_HELP_STRING([--disable-tlsv1.0], [disable TLSv1.0 protocol]), [
	if test "$enableval" = "yes"; then
		tcltls_ssl_tls1_0='force'

	else
		tcltls_ssl_tls1_0='false'
	fi
])

#--------------------------------------------------------------------
#
dnl ## TLSv1.1: Enabled by default
tcltls_ssl_tls1_1='true'
AC_ARG_ENABLE([tlsv1.1], AS_HELP_STRING([--disable-tlsv1.1], [disable TLSv1.1 protocol]), [
	if test "$enableval" = "yes"; then
		tcltls_ssl_tls1_1='force'
	else
		tcltls_ssl_tls1_1='false'
	fi
# You can add more files to clean if your extension creates any extra
# files by extending CLEANFILES.
])

dnl ## TLSv1.2: Enabled by default
# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
#
# A few miscellaneous platform-specific items:
# TEA_ADD_* any platform specific compiler/build info here.
#--------------------------------------------------------------------

tcltls_ssl_tls1_2='true'
AC_ARG_ENABLE([tlsv1.2], AS_HELP_STRING([--disable-tlsv1.2], [disable TLSv1.2 protocol]), [
	if test "$enableval" = "yes"; then
		tcltls_ssl_tls1_2='force'
	else
		tcltls_ssl_tls1_2='false'
	fi
CONFIG_CLEAN_FILES="$CONFIG_CLEAN_FILES tls.tcl.h.* config.log config.status Makefile pkgIndex.tcl tcltls.a.linkadd tcltls.syms"
if test "${TEA_PLATFORM}" = "windows" ; then
    AC_DEFINE(BUILD_tls)
    AC_DEFINE(WINDOWS)
    CLEANFILES="pkgIndex.tcl *.lib *.dll *.exp *.ilk *.pdb vc*.pch"
else
    CLEANFILES="pkgIndex.tcl *.so"
fi
])
AC_SUBST(CLEANFILES)

#--------------------------------------------------------------------
# Choose which headers you need.  Extension authors should try very
# hard to only rely on the Tcl public header files.  Internal headers
# contain private data structures and are subject to change without
dnl ## TLSv1.3: Enabled by default
tcltls_ssl_tls1_3='true'
AC_ARG_ENABLE([tlsv1.3], AS_HELP_STRING([--disable-tlsv1.3], [disable TLSv1.3 protocol]), [
	if test "$enableval" = "yes"; then
		tcltls_ssl_tls1_3='force'
# notice.
# This MUST be called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG
#--------------------------------------------------------------------

TEA_PUBLIC_TCL_HEADERS
	else
#TEA_PRIVATE_TCL_HEADERS
		tcltls_ssl_tls1_3='false'
	fi
])

#TEA_PUBLIC_TK_HEADERS
#TEA_PRIVATE_TK_HEADERS
#TEA_PATH_X

dnl Enable support for a debugging build
tcltls_debug='false'
AC_ARG_ENABLE([debug], AS_HELP_STRING([--enable-debug], [enable debugging parameters]), [
	if test "$enableval" = "yes"; then
		tcltls_debug='true'
	fi
#--------------------------------------------------------------------
# Check whether --enable-threads or --disable-threads was given.
# This auto-enables if Tcl was compiled threaded.
#--------------------------------------------------------------------

TEA_ENABLE_THREADS

])
if test "$tcltls_debug" = 'true'; then
	AC_DEFINE(TCLEXT_TCLTLS_DEBUG, [1], [Enable debugging build])
	AX_CHECK_COMPILE_FLAG([-fcheck-pointer-bounds], [CFLAGS="$CFLAGS -fcheck-pointer-bounds"])
#--------------------------------------------------------------------
# The statement below defines a collection of symbols related to
# building as a shared library instead of a static library.
#--------------------------------------------------------------------

else
	dnl If we are not doing debugging disable some of the more annoying warnings
	AX_CHECK_COMPILE_FLAG([-Wno-unused-value], [CFLAGS="$CFLAGS -Wno-unused-value"])
TEA_ENABLE_SHARED
	AX_CHECK_COMPILE_FLAG([-Wno-unused-parameter], [CFLAGS="$CFLAGS -Wno-unused-parameter"])
	AX_CHECK_COMPILE_FLAG([-Wno-deprecated-declarations], [CFLAGS="$CFLAGS -Wno-deprecated-declarations"])
fi

#--------------------------------------------------------------------
# This macro figures out what flags to use with the compiler/linker
# when building shared/static debug/optimized objects.  This information
dnl Find "pkg-config" since we need to use it
AC_CHECK_TOOL([PKGCONFIG], [pkg-config], [false])
# can be taken from the tclConfig.sh file, but this figures it all out.
#--------------------------------------------------------------------

dnl Determine if we have been asked to use a fast path if possible
tcltls_ssl_fastpath='no'
AC_ARG_ENABLE([ssl-fastpath], AS_HELP_STRING([--enable-ssl-fastpath], [enable using the underlying file descriptor for talking directly to the SSL library]), [
	if test "$enableval" = 'yes'; then
		tcltls_ssl_fastpath='yes'
	else
		tcltls_ssl_fastpath='no'
TEA_CONFIG_CFLAGS
	fi
])

if test "$tcltls_ssl_fastpath" = 'yes'; then
	AC_DEFINE(TCLTLS_SSL_USE_FASTPATH, [1], [Define this to enable using the underlying file descriptor for talking directly to the SSL library])
fi
#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols option.
#--------------------------------------------------------------------

dnl Determine if we have been asked to statically link to the SSL library
TCLEXT_TLS_STATIC_SSL='no'
AC_ARG_ENABLE([static-ssl], AS_HELP_STRING([--enable-static-ssl], [enable statically linking to the specified SSL library]), [
	if test "$enableval" = 'yes'; then
		TCLEXT_TLS_STATIC_SSL='yes'
TEA_ENABLE_SYMBOLS

#--------------------------------------------------------------------
# Everyone should be linking against the Tcl stub library.  If you
# can't for some reason, remove this definition.  If you aren't using
# stubs, you also need to modify the SHLIB_LD_LIBS setting below to
# link against the non-stubbed Tcl library.  Add Tk too if necessary.
	fi
])
#--------------------------------------------------------------------

AC_DEFINE(USE_TCL_STUBS)
dnl Enable compiler warnings
AX_CHECK_COMPILE_FLAG([-Wall], [CFLAGS="$CFLAGS -Wall"])
AX_CHECK_COMPILE_FLAG([-W], [
	CFLAGS="$CFLAGS -W"
	AX_CHECK_COMPILE_FLAG([-Wno-self-assign], [CFLAGS="$CFLAGS -Wno-self-assign"])
#AC_DEFINE(USE_TK_STUBS)

#--------------------------------------------------------------------
# This macro generates a line to use when building a library.  It
# depends on values set by the TEA_ENABLE_SHARED, TEA_ENABLE_SYMBOLS,
])
# and TEA_LOAD_TCLCONFIG macros above.
#--------------------------------------------------------------------

dnl Enable hardening
tcltls_enable_hardening='auto'
AC_ARG_ENABLE([hardening], AS_HELP_STRING([--disable-hardening], [disable hardening attempts]), [
TEA_MAKE_LIB

	tcltls_enable_hardening="$enableval"
])
if test "$tcltls_enable_hardening" = 'auto'; then
	tcltls_enable_hardening='true'
	if test "$TCLEXT_BUILD" = 'static'; then
		tcltls_enable_hardening='false'
	fi
#--------------------------------------------------------------------
# This marco includes the TCL TLS specific functions to set the
# OpenSSL or LibreSSL config.
#--------------------------------------------------------------------
elif test "$tcltls_enable_hardening" = 'yes'; then
	tcltls_enable_hardening='true'
else
	tcltls_enable_hardening='false'
fi
if test "$tcltls_enable_hardening" = 'true'; then
	AX_CHECK_COMPILE_FLAG([-fstack-protector-all], [CFLAGS="$CFLAGS -fstack-protector-all"])
	AX_CHECK_COMPILE_FLAG([-fno-strict-overflow], [CFLAGS="$CFLAGS -fno-strict-overflow"])
	AC_DEFINE([_FORTIFY_SOURCE], [2], [Enable fortification])
fi

dnl XXX:TODO: Automatically determine the SSL library to use
dnl           defaulting to OpenSSL for compatibility reasons
if test "$tcltls_ssl_lib" = 'auto'; then
	tcltls_ssl_lib='openssl'
fi

AC_MSG_CHECKING([which TLS library to use])
AC_MSG_RESULT([$tcltls_ssl_lib])

dnl Manually rewrite libressl to OpenSSL since we use the
dnl compatibility interface
if test "$tcltls_ssl_lib" = "libressl"; then
	tcltls_ssl_lib='openssl'
fi

AS_CASE([$tcltls_ssl_lib],
	[openssl], [
		TCLTLS_SSL_OPENSSL
	],
	[nss], [
	 	TCLTLS_SSL_LIBS=""
		TCLTLS_SSL_CFLAGS=""
TCLTLS_SSL_OPENSSL
		TCLTLS_SSL_CPPFLAGS=""
	],
	[
		AC_MSG_ERROR([Unsupported SSL library: $tcltls_ssl_lib])
	]

#--------------------------------------------------------------------
# Shared libraries and static libraries have different names.
# Also, windows libraries and unix libraries have different names.
# For the OpenSSL version, I chose to use the same library names that
# OpenSSL uses as its default names.
#--------------------------------------------------------------------

)
dnl Determine how to use this SSL library
AC_MSG_CHECKING([how to use $tcltls_ssl_lib])
LIBS="${TCLTLS_SSL_LIBS} ${LIBS} ${TCLTLS_SSL_LIBS}"
CFLAGS="${TCLTLS_SSL_CFLAGS} ${CFLAGS} ${TCLTLS_SSL_CFLAGS}"
CPPFLAGS="${TCLTLS_SSL_CPPFLAGS} ${CPPFLAGS} ${TCLTLS_SSL_CPPFLAGS}"
AC_MSG_RESULT([$TCLTLS_SSL_CPPFLAGS $TCLTLS_SSL_CFLAGS $TCLTLS_SSL_LIBS])
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}])
    fi
else
	TEA_ADD_CFLAGS([${TCLTLS_SSL_CFLAGS} -Wno-deprecated-declarations])
	TEA_ADD_INCLUDES([${TCLTLS_SSL_INCLUDES}])
	TEA_ADD_LIBS([${TCLTLS_SSL_LIBS}])
fi

#--------------------------------------------------------------------
# Determine the name of the tclsh and/or wish executables in the
# Tcl and Tk build directories or the location they were installed
# into. These paths are used to support running test cases only,
# the Makefile should not be making use of these paths to generate
# a pkgIndex.tcl file or anything else at extension build time.
#--------------------------------------------------------------------

dnl Sync the RPATH if requested
if test "$TCLEXT_BUILD" != 'static'; then
	if test "$TCLEXT_TLS_STATIC_SSL" = 'yes'; then
		DC_SYNC_RPATH([no])
	else
		DC_SYNC_RPATH([yes])
TEA_PROG_TCLSH
#TEA_PROG_WISH

#--------------------------------------------------------------------
# Setup a *Config.sh.in configuration file.
#--------------------------------------------------------------------

#TEA_EXPORT_CONFIG([tls])
#AC_SUBST(SAMPLE_VAR)
	fi
fi

#--------------------------------------------------------------------
# Specify files to substitute AC variables in. You may alternatively
dnl Enable a stable ABI
DC_SETUP_STABLE_API([${srcdir}/tcltls.vers], tcltls.syms)
if test "$tcltls_debug" = 'true'; then
# have a special pkgIndex.tcl.in or other files which require
# substituting the AC variables in. Include these here.
#--------------------------------------------------------------------

AC_CONFIG_FILES([Makefile pkgIndex.tcl])
#AC_CONFIG_FILES([tlsConfig.sh])

	WEAKENSYMS=':'
	REMOVESYMS=':'
fi
#--------------------------------------------------------------------
# Finally, substitute all of the various values into the files
# specified with AC_CONFIG_FILES.
#--------------------------------------------------------------------

dnl Produce output
AC_OUTPUT(Makefile pkgIndex.tcl tcltls.syms)
AC_OUTPUT

Added doc/docs.css version [0ab4787813].


1
+
body,div,p,th,td,li,dd,ul,ol,dl,dt,blockquote{font-family:Verdana,sans-serif}pre,code{font-family:courier new,Courier,monospace}pre{background-color:#f6fcec;border-top:1px solid #6a6a6a;border-bottom:1px solid #6a6a6a;padding:1em;overflow:auto}body{background-color:#fff;font-size:12px;line-height:1.25;letter-spacing:.2px;padding-left:.5em}h1,h2,h3,h4{font-family:Georgia,serif;padding-left:1em;margin-top:1em}h1{font-size:18px;color:#11577b;border-bottom:1px dotted #11577b;margin-top:0}h2{font-size:14px;color:#11577b;background-color:#c5dce8;padding-left:1em;border:1px solid #6a6a6a}h3,h4{color:#1674a4;background-color:#e8f2f6;border-bottom:1px dotted #11577b;border-top:1px dotted #11577b}h3{font-size:12px}h4{font-size:11px}.keylist dt,.arguments dt{width:20em;float:left;padding:2px;border-top:1px solid #999}.keylist dt{font-weight:700}.keylist dd,.arguments dd{margin-left:20em;padding:2px;border-top:1px solid #999}.copy{background-color:#f6fcfc;white-space:pre;font-size:80%;border-top:1px solid #6a6a6a;margin-top:2em}.tablecell{font-size:12px;padding-left:.5em;padding-right:.5em}

Added doc/tls.html version [106eeb2a8c].



































































































































































































































































































































































































































































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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
<!DOCTYPE html>
<html lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="Copyright" content="1999 Matt Newman / 2004 Starfish Systems">
<title>TLS (SSL) Tcl Commands</title>
<link rel="stylesheet" href="docs.css" type="text/css" media="all">
</head>

<body bgcolor="#FFFFFF">

<dl>
    <dd><a href="#NAME">NAME</a>
    <dl>
    <dd><b>tls</b> - binding to <b>OpenSSL</b> toolkit.</dd>
    </dl>
    </dd>
    <dd><a href="#SYNOPSIS">SYNOPSIS</a> </dd>
    <dd><dl>
	    <dd><b>package require Tcl</b> <em>?<b>8.5</b>?</em></dd>
	    <dd><b>package require tls</b> <em>?@@VERS@@?</em></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::init</b> <em>?options?</em> </dd>
	    <dd><b>tls::socket</b> <em>?options? host port</em></dd>
	    <dd><b>tls::socket</b> <em>?-server command? ?options? port</em></dd>
	    <dd><b>tls::handshake</b> <em>channel</em></dd>
	    <dd><b>tls::status</b> <em>?-local? channel</em></dd>
	    <dd><b>tls::import</b> <em>channel ?options?</em></dd>
	    <dd><b>tls::unimport</b> <em>channel</em></dd>
	    <dd><b>tls::ciphers</b> <em>protocol ?verbose?</em></dd>
	    <dd><b>tls::version</b></dd>
	</dl>
    </dd>
    <dd><a href="#COMMANDS">COMMANDS</a></dd>
    <dd><a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a></dd>
    <dd><a href="#HTTPS EXAMPLE">HTTPS EXAMPLE</a></dd>
    <dd><a href="#SEE ALSO">SPECIAL CONSIDERATIONS</a></dd>
    <dd><a href="#SEE ALSO">SEE ALSO</a></dd>
</dl>

<hr>

<h3><a name="NAME">NAME</a></h3>

<p><strong>tls</strong> - binding to <strong>OpenSSL</strong>
toolkit.</p>

<h3><a name="SYNOPSIS">SYNOPSIS</a></h3>

<p><b>package require Tcl 8.5</b><br>
<b>package require tls @@VERS@@</b><br>
<br>
<a href="#tls::init"><b>tls::init</b> <i>?options?</i><br>
</a><a href="#tls::socket"><b>tls::socket</b> <em>?options? host
port</em><br>
<b>tls::socket</b><em> ?-server command? ?options? port</em><br>
</a><a href="#tls::status"><b>tls::status</b> <em>?-local? channel</em><br>
</a><a href="#tls::handshake"><b>tls::handshake</b><em> channel</em></a><br>
<br>
<a href="#tls::import"><b>tls::import</b> <i>channel ?options?</i></a><br>
<a href="#tls::unimport"><b>tls::unimport</b> <i>channel</i></a><br>
<a href="#tls::ciphers protocol ?verbose?"><strong>tls::ciphers</strong>
<em>protocol ?verbose?</em></a><br>
<a href="#tls::version"><b>tls::version</b></a>
</p>

<h3><a name="DESCRIPTION">DESCRIPTION</a></h3>

<p>This extension provides a generic binding to <a
href="http://www.openssl.org/">OpenSSL</a>, utilizing the
<strong>Tcl_StackChannel</strong>
API for Tcl 8.2 and higher. The sockets behave exactly the same
as channels created using Tcl's built-in <strong>socket</strong>
command with additional options for controlling the SSL session.
To use TLS with an earlier version of Tcl than 8.4, please obtain
TLS 1.3.
</p>

<h3><a name="COMMANDS">COMMANDS</a></h3>

<p>Typically one would use the <strong>tls::socket </strong>command
which provides compatibility with the native Tcl <strong>socket</strong>
command. In such cases <strong>tls::import</strong> should not be
used directly.</p>

<dl>
    <dt><a name="tls::init"><b>tls::init</b> <i>?options?</i></a></dt>
    <dd>This routine sets the default options used by <strong>tls::socket</strong>
	and is <em>optional</em>. If you call <strong>tls::import</strong>
	directly this routine has no effect. Any of the options
	that <strong>tls::socket</strong> accepts can be set
	using this command, though you should limit your options
	to only TLS related ones.</dd>
    <dt>&nbsp;</dt>
    <dt><a name="tls::socket"><b>tls::socket</b> <em>?options?
	host port</em></a></dt>
    <dt><b>tls::socket</b><em> ?-server command? ?options? port</em></dt>
    <dd>This is a helper function that utilizes the underlying
	commands (<strong>tls::import</strong>). It behaves
	exactly the same as the native Tcl <strong>socket</strong>
	command except that the options can include any of the
	applicable <a href="#tls::import"><strong>tls:import</strong></a>
	options with one additional option:
<blockquote>
    <dl>
	<dt><strong>-autoservername</strong> <em>bool</em></dt>
	<dd>Automatically send the -servername as the <em>host</em> argument
	    (default is  <em>false</em>)</dd>
    </dl>
</blockquote>
    <dt>&nbsp;</dt>
    <dt><a name="tls::handshake"><strong>tls::handshake</strong> <em>channel</em></a></dt>
    <dd>Forces handshake to take place, and returns 0 if
	handshake is still in progress (non-blocking), or 1 if
	the handshake was successful. If the handshake failed
	this routine will throw an error.</dd>
    <dt>&nbsp;</dt>
    <dt><a name="tls::status"><strong>tls::status</strong>
    <em>?-local? channel</em></a></dt>
    <dd>Returns the current security status of an SSL channel. The
	result is a list of key-value pairs describing the
	connected peer. If the result is an empty list then the
	SSL handshake has not yet completed.
	If <em>-local</em> is given, then the certificate information
	is the one used locally.</dd>
</dl>

<blockquote>
    <dl>
	<dt><strong>issuer</strong> <em>dn</em></dt>
	<dd>The distinguished name (DN) of the certificate
	    issuer.</dd>
	<dt><strong>subject</strong> <em>dn</em></dt>
	<dd>The distinguished name (DN) of the certificate
	    subject.</dd>
	<dt><strong>notBefore</strong> <em>date</em></dt>
	<dd>The begin date for the validity of the certificate.</dd>
	<dt><strong>notAfter</strong> <em>date</em></dt>
	<dd>The expiry date for the certificate.</dd>
	<dt><strong>serial</strong> <em>n</em></dt>
	<dd>The serial number of the certificate.</dd>
	<dt><strong>cipher</strong> <em>cipher</em></dt>
	<dd>The current cipher in use between the client and
	    server channels.</dd>
	<dt><strong>sbits</strong> <em>n</em></dt>
	<dd>The number of bits used for the session key.</dd>
	<dt><strong>certificate</strong> <em>n</em></dt>
	<dd>The PEM encoded certificate.</dd>
	<dt><strong>version</strong> <em>value</em></dt>
	<dd>The protocol version used for the connection:
	  SSLv2, SSLv3, TLSv1, TLSv1.1, TLSv1.2, unknown</dd>
    </dl>
</blockquote>

<dl>
    <dt><a name="tls::import"><b>tls::import</b> <i>channel
	?options?</i></a></dt>
    <dd>SSL-enable a regular Tcl channel - it need not be a
	socket, but must provide bi-directional flow. Also
	setting session parameters for SSL handshake.</dd>
</dl>

<blockquote>
    <dl>
	<dt><strong>-cadir</strong> <em>dir</em></dt>
	<dd>Provide the directory containing the CA certificates.</dd>
	<dt><strong>-cafile </strong><em>filename</em></dt>
	<dd>Provide the CA file.</dd>
	<dt><strong>-certfile</strong> <em>filename</em></dt>
	<dd>Provide the name of a file containing certificate to use.</dd>
	<dt><strong>-cert</strong> <em>filename</em></dt>
	<dd>Provide the contents of a certificate to use, as a DER encoded binary value (X.509 DER).</dd>
	<dt><strong>-cipher </strong><em>string</em></dt>
	<dd>Provide the cipher suites to use. Syntax is as per
	    OpenSSL.</dd>
	<dt><strong>-command</strong> <em>callback</em></dt>
	<dd>If specified, this callback will be invoked at several points
	    during the OpenSSL handshake.  It can pass errors and tracing
	    information, and it can allow Tcl scripts to perform
	    their own validation of the certificate in place of the
	    default validation provided by OpenSSL.
	    <br>
	    See <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a> for
	    further discussion.</dd>
	<dt><strong>-dhparams </strong><em>filename</em></dt>
	<dd>Provide a Diffie-Hellman parameters file.</dd>
	<dt><strong>-keyfile</strong> <em>filename</em></dt>
	<dd>Provide the private key file. (default is
	    value of -certfile)</dd>
	<dt><strong>-key</strong> <em>filename</em></dt>
	<dd>Provide the private key to use as a DER encoded value (PKCS#1 DER)</dd>
	<dt><strong>-model</strong> <em>channel</em></dt>
	<dd>This will force this channel to share the same <em><strong>SSL_CTX</strong></em>
	    structure as the specified <em>channel</em>, and
	    therefore share callbacks etc.</dd>
	<dt><strong>-password</strong> <em>callback</em></dt>
	<dd>If supplied, this callback will be invoked when OpenSSL needs
	    to obtain a password, typically to unlock the private key of
	    a certificate.
	    The callback should return a string which represents the
	    password to be used.
	    <br>
	    See <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a> for
	    further discussion.</dd>
	<dt><strong>-request </strong><em>bool</em></dt>
	<dd>Request a certificate from peer during SSL handshake.
	    (default is  <em>true</em>)</dd>
	<dt><strong>-require</strong> <em>bool</em></dt>
	<dd>Require a valid certificate from peer during SSL
	    handshake. If this is set to true then <strong>-request</strong>
	    must also be set to true. (default is  <em>false</em>)</dd>
	<dt><strong>-server</strong> <em>bool</em></dt>
	<dd>Handshake as server if true, else handshake as
	    client.(default is  <em>false</em>)</dd>
	<dt><strong>-servername</strong> <em>host</em></dt>
	<dd>Only available if the OpenSSL library the package is linked
	    against supports the TLS hostname extension for 'Server Name
	    Indication' (SNI). Use to name the logical host we are talking
	    to and expecting a certificate for</dd>
	<dt><strong>-ssl2</strong> <em>bool</em></dt>
	<dd>Enable use of SSL v2. (default is <em>false</em>)</dd>
	<dt><strong>-ssl3 </strong><em>bool</em></dt>
	<dd>Enable use of SSL v3. (default is <em>false</em>)</dd>
	<dt>-<strong>tls1</strong> <em>bool</em></dt>
	<dd>Enable use of TLS v1. (default is <em>true</em>)</dd>
	<dt>-<strong>tls1.1</strong> <em>bool</em></dt>
	<dd>Enable use of TLS v1.1 (default is <em>true</em>)</dd>
	<dt>-<strong>tls1.2</strong> <em>bool</em></dt>
	<dd>Enable use of TLS v1.2 (default is <em>true</em>)</dd>
	<dt>-<strong>tls1.3</strong> <em>bool</em></dt>
	<dd>Enable use of TLS v1.3 (default is <em>true</em>)</dd>
    </dl>
</blockquote>

<dl>
    <dt><a name="tls::unimport"><b>tls::unimport</b> <i>channel</i></a></dt>
    <dd>Provided for symmetry to <strong>tls::import</strong>, this
      unstacks the SSL-enabling of a regular Tcl channel.  An error
      is thrown if TLS is not the top stacked channel type.</dd>
</dl>

<dl>
    <dt><a name="tls::ciphers protocol ?verbose?"><strong>tls::ciphers</strong>
	<em>protocol ?verbose?</em></a></dt>
    <dd>Returns list of supported ciphers based on the <em>protocol</em>
	you supply, which must be one of <em>ssl2, ssl3, or tls1</em>.
	If <em>verbose</em> is specified as true then a verbose,
	semi-human readable list is returned providing additional
	information on the nature of the cipher support. In each
	case the result is a Tcl list.</dd>
</dl>

<dl>
    <dt><a name="tls::version"><strong>tls::version</strong></a></dt>
    <dd>Returns the version string defined by OpenSSL.</dd>
</dl>

<h3><a name="CALLBACK OPTIONS">CALLBACK OPTIONS</a></h3>

<p>
As indicated above, individual channels can be given their own callbacks
to handle intermediate processing by the OpenSSL library, using the
<em>-command</em> and <em>-password</em> options passed to either of
<strong>tls::socket</strong> or <strong>tls::import</strong>.
</p>

<blockquote>
<dl>

    <dt><strong>-command</strong> <em>callback</em></dt>
    <dd>
	Invokes the specified <em>callback</em> script at
	several points during the OpenSSL handshake.
	Except as indicated below, values returned from the
	callback are ignored.
	Arguments appended to the script upon callback take one of the
	following forms:

	<br>
	<br>

	<dl>

<!--	This form of callback is disabled.

	<dt>
	  <strong>error</strong> <em>channel message</em>
	</dt>
	<dd>
	  The <em>message</em> argument contains an error message generated
	  by the OpenSSL function
	  <code>ERR_reason_error_string()</code>.
	</dd>

	<br>
-->

	<dt>
	  <strong>info</strong> <em>channel major minor message</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_CTX_set_info_callback()</code>.
	  <br>
	  The <em>major</em> and <em>minor</em> arguments are used to
	  represent the state information bitmask.
	  <dl>
	  <dt>Possible values for <em>major</em> are:</dt>
	  <dd><code>handshake, alert, connect, accept</code>.</dd>
	  <dt>Possible values for <em>minor</em> are:</dt>
	  <dd><code>start, done, read, write, loop, exit</code>.</dd>
	  </dl>
	  The <em>message</em> argument is a descriptive string which may
	  be generated either by
	  <code>SSL_state_string_long()</code> or by
	  <code>SSL_alert_desc_string_long()</code>,
	  depending on context.
	</dd>

	<br>

	<dt>
	  <strong>verify</strong> <em>channel depth cert status error</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_set_verify()</code>.
	  <br>
	  The <em>depth</em> argument is an integer representing the
	  current depth on the certificate chain, with
	  <code>0</code> as the subject certificate and higher values
	  denoting progressively more indirect issuer certificates.
	  <br>
	  The <em>cert</em> argument is a list of key-value pairs similar
	  to those returned by
	  <a href="#tls::status"><strong>tls::status</strong></a>.
	  <br>
	  The <em>status</em> argument is an integer representing the
	  current validity of the certificate.
	  A value of <code>0</code> means the certificate is deemed invalid.
	  A value of <code>1</code> means the certificate is deemed valid.
	  <br>
	  The <em>error</em> argument supplies the message, if any, generated
	  by
	  <code>X509_STORE_CTX_get_error()</code>.
	  <br>
	  <br>
	  The callback may override normal validation processing by explicitly
	  returning one of the above <em>status</em> values.
	</dd>

	</dl>
    </dd>

    <br>

    <dt><strong>-password</strong> <em>callback</em></dt>
    <dd>
	Invokes the specified <em>callback</em> script when OpenSSL needs to
	obtain a password.  The callback should return a string which
	represents the password to be used.
	No arguments are appended to the script upon callback.
    </dd>
</dl>
</blockquote>

<p>
Reference implementations of these callbacks are provided in the
distribution as <strong>tls::callback</strong> and
<strong>tls::password</strong> respectively.  Note that these are
<em>sample</em> implementations only.  In a more realistic deployment
you would specify your own callback scripts on each TLS channel
using the <em>-command</em> and <em>-password</em> options.
</p>

<p>
The default behavior when the <em>-command</em> option is not specified is for
TLS to process the associated library callbacks internally.
The default behavior when the <em>-password</em> option is not specified is for
TLS to process the associated library callbacks by attempting to call
<strong>tls::password</strong>.
The difference between these two behaviors is a consequence of maintaining
compatibility with earlier implementations.
</p>

<p>
The <strong>tls::debug</strong> variable provides some additional
control over these reference callbacks.  Its value is zero by default.
Higher values produce more diagnostic output, and will also force the
verify method in <strong>tls::callback</strong> to accept the
certificate, even when it is invalid.
</p>

<p>
<em>
The use of the reference callbacks <strong>tls::callback</strong> and
<strong>tls::password</strong> is not recommended.  They may be removed
from future releases.
</em>
</p>

<p>
<em>
The use of the variable <strong>tls::debug</strong> is not recommended.
It may be removed from future releases.
</em>
</p>

<h3><a name="HTTPS EXAMPLE">HTTPS EXAMPLE</a></h3>

<p>This example uses a sample server.pem provided with the TLS release,
courtesy of the <strong>OpenSSL</strong> project.</p>

<pre><code>
package require http
package require tls

http::register https 443 [list ::tls::socket -autoservername true -require true -cadir /etc/ssl/certs]

set tok [http::geturl https://core.tcl-lang.org/]
</code></pre>

<h3><a name="SPECIAL CONSIDERATIONS">SPECIAL CONSIDERATIONS</a></h3>

<p>The capabilities of this package can vary enormously based
upon how your OpenSSL library was configured and built. At the
most macro-level OpenSSL supports a &quot;no patents&quot; build,
which disables RSA, IDEA, RC(2,4,5) and SSL2 - if your OpenSSL is
configured this way then you will need to build TLS with the
-DNO_PATENTS option - and the resultant module will function
correctly and also support ADH certificate-less encryption,
however you will be unable to utilize this to speak to normal Web
Servers, which typically require RSA support. Please see <a
href="http://www.openssl.org/">http://www.openssl.org/</a> for
more information on the whole issue of patents and US export
restrictions. </p>

<h3><a name="SEE ALSO">SEE ALSO</a></h3>

<p><strong>socket</strong>, <strong>fileevent</strong>, <a
href="http://www.openssl.org/"><strong>OpenSSL</strong></a></p>

<hr>

<pre>
Copyright &copy; 1999 Matt Newman.
Copyright &copy; 2004 Starfish Systems.
</pre>
</body>
</html>

Deleted gen_dh_params version [c005dd2aeb].

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
























































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#! /usr/bin/env sh

bits='2048'
option_fallback='0'
for arg in "$@"; do
	case "${arg}" in
		fallback)
			option_fallback='1'
			;;
		bits=*)
			bits="`echo "${arg}" | cut -f 2 -d =`"
			;;
	esac
done

openssl_dhparam() {
	if [ -x "`which openssl 2>/dev/null`" ]; then
		o_output="`openssl dhparam -C "$@" 2>/dev/null`" || return 1
		o_output="`echo "${o_output}" | sed 's/get_dh[0-9][0-9]*/get_dhParams/'`" || return 1
		o_output="`echo "${o_output}" | sed '/^-----BEGIN DH PARAMETERS-----$/,/^-----END DH PARAMETERS-----$/ d;/^#/ d'`" || return 1

		echo "${o_output}"

		return 0
	fi

	return 1
}

gen_dh_params_openssl() {
	openssl_dhparam "${bits}" < /dev/null || return 1
	return 0
}

gen_dh_params_remote() {
	url="https://2ton.com.au/dhparam/${bits}"

	r_input="`curl -sS "${url}"`" || \
		r_input="`wget -O - -o /dev/null "${url}"`" || return 1

	if r_output="`echo "${r_input}" | openssl_dhparam`"; then
		echo "${r_output}"

		return 0
	fi

	return 1
}

gen_dh_params_fallback() {
	cat << \_EOF_
DH *get_dhParams(void) {
	static unsigned char dhp[] = {
_EOF_
	case "${bits}" in
		2048)
			cat << \_EOF_
		0xC1,0x51,0x58,0x69,0xFB,0xE8,0x6C,0x47,0x2B,0x86,0x61,0x4F,
		0x20,0x2E,0xD3,0xFC,0x19,0xEE,0xB8,0xF3,0x35,0x7D,0xBA,0x86,
		0x2A,0xC3,0xC8,0x6E,0xF4,0x99,0x75,0x65,0xD3,0x7A,0x9E,0xDF,
		0xD4,0x1F,0x88,0xE3,0x17,0xFC,0xA1,0xED,0xA2,0xB6,0x77,0x84,
		0xAA,0x08,0xF2,0x97,0x59,0x7A,0xA0,0x03,0x0D,0x3E,0x7E,0x6D,
		0x65,0x6A,0xA4,0xEA,0x54,0xA9,0x52,0x5F,0x63,0xB4,0xBC,0x98,
		0x4E,0xF6,0xE1,0xA4,0xEE,0x16,0x0A,0xB0,0x01,0xBD,0x9F,0xA1,
		0xE8,0x23,0x29,0x56,0x40,0x95,0x13,0xEB,0xCB,0xD5,0xFC,0x76,
		0x1A,0x41,0x26,0xCE,0x20,0xEB,0x30,0x10,0x17,0x07,0xE1,0x8C,
		0xAC,0x57,0x37,0x8B,0xE8,0x01,0xDE,0xA9,0xEF,0xA4,0xC2,0xA4,
		0x6E,0x48,0x25,0x11,0x33,0x11,0xD4,0x52,0x79,0x87,0x9F,0x75,
		0x61,0xF7,0x9C,0x7D,0x36,0x41,0xCB,0xEC,0x8F,0xEA,0x4A,0x47,
		0x6A,0x36,0x37,0x75,0xB9,0x8E,0xF5,0x5F,0x67,0xCF,0x1F,0xD8,
		0xCA,0x70,0x42,0xC7,0xA2,0xED,0x0F,0x7D,0xBE,0x43,0x08,0x28,
		0x66,0x3D,0xDD,0x87,0x0D,0x61,0x6E,0xD0,0xE7,0x49,0xD1,0x70,
		0xA9,0x4D,0xD5,0xFD,0xED,0xF2,0x6D,0x32,0x17,0x97,0x5B,0x06,
		0x60,0x9C,0x5F,0xA3,0x5D,0x34,0x14,0x7E,0x63,0x54,0xE4,0x7E,
		0x09,0x8F,0xBB,0x8E,0xA0,0xD0,0x96,0xAC,0x30,0x20,0x39,0x3B,
		0x8C,0x92,0x65,0x37,0x0A,0x8F,0xEC,0x72,0x8B,0x61,0x7D,0x62,
		0x24,0x54,0xE9,0x1D,0x01,0x68,0x89,0xC4,0x7B,0x3C,0x48,0x62,
		0x9B,0x83,0x11,0x3A,0x0B,0x0D,0xEF,0x5A,0xE4,0x7A,0xA0,0x69,
		0xF4,0x54,0xB5,0x5B
_EOF_
			;;
		4096)
			cat << \_EOF_
		0xE3,0xA6,0x64,0x2D,0xE8,0x01,0xD0,0x81,0x67,0xCF,0x12,0x38,
		0x5C,0x99,0x48,0x37,0xD7,0x0F,0x8D,0x10,0xEA,0x88,0x31,0x6D,
		0xD4,0x69,0x10,0x57,0x94,0x8E,0xE8,0xF9,0x22,0xFE,0x0D,0x55,
		0xC6,0x9D,0x29,0x7E,0x45,0x89,0xAA,0xD5,0x98,0xD2,0x98,0xFE,
		0x03,0x54,0x5E,0x91,0x4C,0x4A,0xA7,0xFF,0x1F,0x2F,0x41,0x34,
		0x03,0x9B,0x64,0x0A,0xFA,0x53,0xC7,0x45,0xD7,0x41,0x3F,0x16,
		0xCD,0x40,0x9E,0xF2,0xC3,0xBD,0x49,0x2C,0x0C,0x35,0x9B,0x2F,
		0x7D,0xA5,0x07,0x58,0xD1,0xFD,0xE9,0x6B,0x7A,0x54,0xA9,0xC2,
		0xAC,0x09,0x7F,0x58,0xD5,0x52,0xB2,0x8A,0x5D,0xEC,0x41,0x23,
		0x93,0xF4,0x05,0x8B,0x46,0x0E,0x46,0x46,0xC5,0xB4,0x75,0xCB,
		0x1D,0x1D,0x6E,0x81,0xC5,0x55,0x24,0x1D,0x09,0x23,0xE2,0x3F,
		0xF4,0x48,0x60,0xD7,0x95,0xC0,0x8B,0x71,0x11,0xA6,0x0B,0x04,
		0x29,0xB6,0xAD,0xBF,0x05,0x6F,0x3B,0xB3,0x70,0x34,0xA5,0xF9,
		0x14,0x81,0xD5,0xEA,0x3C,0x3C,0x38,0x44,0xCF,0x3D,0x32,0x29,
		0x92,0xD5,0x1A,0x3C,0x25,0xB7,0x3D,0x42,0x17,0x96,0x8B,0xEE,
		0xC3,0xE7,0x61,0x3A,0x51,0xC5,0x2A,0x51,0xBA,0x8F,0xD0,0x4C,
		0x51,0x19,0xBE,0x35,0x1A,0x2E,0x9B,0x55,0x02,0xA7,0x5A,0xBF,
		0xA2,0x00,0xF9,0xFF,0x4B,0xCA,0x76,0x25,0x3D,0x3B,0xB1,0x04,
		0x9A,0x6D,0x7E,0x12,0xBB,0xBE,0x6A,0x5A,0xB2,0x87,0x8B,0xBC,
		0xB9,0x7C,0x6A,0xE7,0x5E,0xC3,0x41,0x91,0x24,0xAD,0x5C,0xC7,
		0x3F,0x24,0x77,0x17,0x53,0x9D,0x6A,0x5A,0x8E,0x39,0x00,0x1B,
		0x49,0x93,0x07,0x6C,0x67,0xF3,0x1C,0x24,0x57,0x76,0x5E,0x78,
		0xF1,0x8D,0x81,0xFF,0x81,0xD0,0x1B,0x7A,0x04,0xAC,0x7D,0x5B,
		0x35,0x5F,0x45,0x25,0xAE,0x30,0x11,0x5B,0x34,0x17,0xE7,0x2D,
		0x9D,0xE7,0x56,0x90,0x75,0x24,0x0C,0x01,0x84,0x38,0x1A,0x62,
		0x55,0x43,0x66,0x21,0x29,0x44,0xE5,0x4B,0x90,0x9E,0x48,0x92,
		0x0B,0x96,0x2A,0xD0,0xCD,0x3A,0xA4,0xBE,0xE7,0xDC,0xA3,0xFB,
		0x0F,0xA3,0x9B,0xF7,0xA9,0x26,0x5A,0xCC,0x7F,0x4B,0x1A,0x5F,
		0xD6,0x32,0xA9,0x71,0xA1,0x10,0xE5,0x7C,0x4F,0x59,0xFE,0x3D,
		0x60,0x41,0x0A,0xA7,0x68,0x60,0x1E,0xDE,0x6E,0xF7,0x71,0x4D,
		0xBE,0xC8,0x49,0xF8,0x57,0x7C,0x99,0x6E,0x59,0x32,0xF8,0x26,
		0xF1,0x25,0x94,0xC5,0xDA,0x78,0xBB,0x48,0x97,0xE8,0xDF,0x70,
		0x05,0x86,0xE2,0xE7,0x35,0xD7,0x3F,0x23,0x18,0xAA,0x86,0x53,
		0x6B,0x0D,0xEC,0x93,0x89,0xA4,0xD0,0xDA,0xE3,0xDD,0x11,0x06,
		0xCE,0xDD,0x4D,0xD3,0xBF,0x9A,0x71,0x5E,0xA7,0x39,0x9A,0x31,
		0x4B,0x56,0xB3,0x22,0x1B,0x81,0xDC,0xBE,0x0E,0x7B,0x8A,0xAA,
		0x37,0x61,0xED,0x4D,0xEE,0x1A,0xC3,0x54,0xBC,0x4F,0x0E,0x61,
		0x38,0x00,0xAA,0x45,0x18,0xC2,0xDF,0xA5,0x3D,0x75,0x98,0x16,
		0xBB,0x0A,0x39,0x9A,0xFE,0x1F,0x53,0xAD,0xC3,0xEA,0xDF,0xC6,
		0x3D,0xD5,0xBA,0xC8,0xF3,0x03,0x3A,0x3B,0x8D,0x03,0x84,0xCD,
		0x86,0xED,0x42,0xDB,0xD8,0xE0,0xC1,0xAF,0xB1,0xDD,0xB5,0x35,
		0x28,0xB1,0x02,0xE2,0x9B,0x12,0x2E,0x12,0x02,0x1C,0x7D,0x3B,
		0x3B,0x8D,0xAF,0x9D,0x3F,0xD6,0xE0,0x53
_EOF_
			;;
		8192)
			cat << \_EOF_
		0x9C,0xC3,0x9C,0x6C,0x61,0xC5,0xFA,0x32,0xB8,0x86,0x5A,0x38,
		0xED,0x46,0x5C,0x81,0x08,0xD9,0x69,0x11,0x44,0x50,0x97,0x4D,
		0xCB,0x09,0xFC,0xD1,0x68,0x9F,0x4E,0x96,0x10,0xFF,0xDA,0xD7,
		0xA3,0xC9,0x74,0xE9,0xBA,0xDB,0x6B,0x04,0xB8,0xBF,0xF4,0x72,
		0x6D,0x18,0xB1,0xF4,0x9A,0x77,0xA9,0x94,0xE8,0x13,0xF7,0x1D,
		0x92,0x12,0x7B,0xB9,0x92,0x71,0x54,0x83,0x73,0x71,0xF6,0xA7,
		0x12,0xEC,0x62,0xB8,0xDC,0xA1,0x2E,0x00,0x88,0x53,0xF3,0x01,
		0xAF,0x52,0xF7,0xBB,0xE1,0x7B,0xF1,0x2A,0xD9,0xEF,0x21,0xD4,
		0x88,0x18,0xEC,0x98,0x72,0x05,0x60,0xEC,0x5A,0x1C,0x2D,0x0D,
		0x43,0x5D,0x19,0xD6,0x1D,0xD2,0x3C,0x8E,0xD3,0x43,0x62,0x6C,
		0x32,0x14,0x40,0xD6,0xBE,0xE7,0x84,0x6E,0x76,0xA5,0x90,0x14,
		0xC8,0x40,0xA3,0x2E,0x6A,0x3D,0x3B,0x43,0x5D,0xB1,0x3F,0x5F,
		0x6E,0xD5,0x1B,0xE0,0x20,0x82,0x8A,0xEE,0xC5,0x65,0x05,0x62,
		0xB5,0x96,0xEE,0x27,0xF1,0xF3,0x32,0xE4,0x00,0x7D,0x6A,0x6C,
		0x45,0x05,0x00,0x4A,0x9C,0x9D,0xB9,0x19,0x77,0xC5,0x31,0xEE,
		0x6E,0x30,0x54,0x0D,0x08,0xFF,0x19,0xC4,0x34,0xD7,0x9F,0xC9,
		0x5B,0x89,0x22,0x4E,0xC0,0xBF,0x16,0x3E,0x10,0xBB,0x58,0xBA,
		0x31,0x5C,0xDC,0xD3,0xD9,0xFF,0x73,0xD9,0x29,0x66,0x4A,0xE6,
		0xB0,0xBA,0x4B,0x1A,0x3C,0x5E,0xA7,0x19,0x19,0xD8,0x84,0xD2,
		0x54,0x47,0x86,0xE3,0xCA,0xF7,0x8A,0xC9,0xDB,0x3A,0x5A,0xB7,
		0xB7,0xA4,0x27,0x57,0x53,0x34,0x9D,0xF2,0xF2,0x26,0x0D,0xAC,
		0xC5,0xFA,0xE9,0x9A,0xC5,0xDA,0x9D,0xA3,0x2E,0x40,0x85,0x92,
		0xF4,0x2F,0xEA,0xF7,0xA4,0x6F,0x36,0x36,0x41,0xFA,0x41,0x5B,
		0x02,0x4E,0xFC,0xDF,0xBB,0x5F,0x74,0x7B,0xFF,0x81,0xEB,0x60,
		0x08,0x55,0x91,0xBF,0x0C,0x1E,0x80,0xB3,0xC3,0x39,0x5A,0x5D,
		0x08,0x3E,0x3C,0xB8,0x76,0xE1,0x92,0x37,0xF1,0xCC,0x0C,0x3F,
		0x46,0xED,0x51,0x2D,0x6F,0x57,0x05,0x47,0x78,0xB5,0xF1,0x6B,
		0x7C,0xEA,0x51,0xA6,0x88,0xD8,0x63,0x18,0x8E,0x42,0x0E,0x50,
		0xF1,0xAC,0xD0,0x75,0x0A,0xB5,0x9B,0xD5,0x07,0x3A,0xF0,0x75,
		0x04,0x27,0xC5,0xBD,0xA6,0xAE,0x18,0xEE,0x30,0x22,0x70,0x56,
		0x09,0xA7,0xC2,0x26,0x61,0x3B,0x56,0x27,0x82,0x97,0xF6,0xFE,
		0x7A,0x3D,0x17,0x3C,0xC2,0x27,0x39,0xD3,0xBB,0x80,0xB6,0x42,
		0x4D,0x20,0xB1,0xC1,0x89,0x00,0x77,0x8C,0x6F,0xDD,0x6F,0x1D,
		0x44,0xAD,0x1B,0x92,0x6F,0xD6,0x56,0x11,0x6E,0x12,0x5C,0x7F,
		0x69,0x33,0x17,0x7A,0x20,0xE8,0x5D,0x81,0xC0,0xDD,0x1E,0xBE,
		0xEF,0x62,0x81,0xF2,0xEA,0xEA,0xDE,0x7B,0xA1,0x8C,0x7D,0x91,
		0x8B,0x62,0xBD,0x13,0x53,0x41,0xB9,0x45,0x65,0x11,0xB0,0x00,
		0x7C,0xA6,0x12,0x19,0xDC,0x77,0x26,0xD6,0x13,0xC8,0xDF,0x47,
		0x7A,0xCE,0xEB,0xD8,0xC3,0xDF,0x7F,0x21,0x27,0x5C,0x4A,0x6B,
		0xE9,0x27,0xC7,0x60,0x56,0x6E,0xA2,0x5F,0xF2,0xAD,0xB0,0xC3,
		0x97,0xF6,0xE9,0xDF,0xFB,0x1F,0xE9,0x17,0x06,0x36,0xC5,0x10,
		0xC0,0x49,0xD5,0x59,0xEA,0x97,0x27,0xE7,0x43,0x64,0xDE,0x31,
		0xD7,0x14,0x9D,0xDC,0x78,0xC5,0x0E,0xEF,0x6A,0x76,0x57,0x33,
		0xAF,0x54,0xB1,0x30,0xD0,0x91,0x24,0x09,0x24,0x40,0xD5,0x00,
		0x9B,0x84,0xF7,0xFC,0xAD,0x7F,0x41,0xBB,0x00,0x84,0x49,0x49,
		0xA1,0x43,0x44,0xA0,0xA3,0xD1,0xBA,0x49,0xD8,0xCE,0x60,0x90,
		0x07,0x20,0xCD,0xC8,0xEB,0xD4,0x02,0x71,0xB8,0x60,0xDF,0xA9,
		0x6B,0xEC,0x25,0x8D,0x71,0x28,0x6A,0x2E,0xF6,0x52,0xF0,0x24,
		0xF3,0xF5,0x1E,0x00,0x7B,0x7C,0xCA,0x6A,0x6B,0xD7,0x4F,0x3E,
		0x5E,0x4B,0x85,0xCF,0xF1,0x67,0x9F,0x89,0x5A,0xF4,0x3A,0x29,
		0x73,0xFF,0xDC,0x68,0x25,0xA5,0x60,0x10,0xFC,0x9A,0x73,0x78,
		0xEA,0x28,0xC1,0x11,0x3B,0x07,0x46,0xEB,0xDE,0xF1,0xF3,0x2E,
		0xC7,0xC1,0x24,0xFB,0xC2,0x6C,0x4A,0x38,0x6C,0x9A,0x7F,0x87,
		0x76,0x30,0xF4,0xCC,0x21,0x49,0xC1,0x66,0x3D,0x95,0xE4,0xAA,
		0xE2,0x75,0x08,0xAB,0xEF,0xA2,0x51,0x30,0xFE,0x86,0xD0,0xE1,
		0x4C,0x05,0x0C,0xDE,0x63,0x93,0xB3,0x37,0x11,0x81,0xB5,0x8F,
		0x84,0xE2,0x48,0xC1,0xF6,0xF6,0xD6,0x50,0x91,0xDE,0x61,0x14,
		0x7B,0x6E,0x88,0x95,0x30,0x52,0xEF,0xA5,0x03,0x99,0xBE,0x50,
		0x97,0xE3,0x25,0x8F,0x50,0x01,0x9C,0x54,0x99,0x2E,0x4C,0x6A,
		0x61,0xD7,0x0D,0xB9,0xFE,0xE9,0xFC,0x37,0xC1,0x6A,0xDF,0x84,
		0xF4,0x5A,0x7E,0xBA,0x95,0x23,0x5C,0x41,0x35,0xDB,0xF9,0x1E,
		0x93,0xC6,0x29,0x8E,0x57,0x28,0x3D,0x3A,0xDE,0x31,0x86,0x69,
		0x3D,0xC3,0x8F,0x27,0x62,0x84,0x77,0x58,0x02,0x7F,0x90,0x76,
		0x2D,0xDF,0x45,0x70,0x3F,0x04,0x44,0x5C,0xD1,0x8C,0x73,0x5E,
		0xB5,0xC8,0x9A,0x72,0x3E,0xA9,0x4D,0xFC,0xDC,0xAC,0x7B,0xFF,
		0x54,0xC2,0x7B,0x3B,0x11,0x6B,0x14,0xA3,0x50,0xDB,0x14,0xB0,
		0x89,0x5A,0xE7,0xDD,0xBF,0x1E,0x27,0xBC,0xC6,0x30,0xC4,0xD6,
		0x74,0x13,0x26,0xBA,0x67,0x15,0x56,0x42,0xED,0xDA,0xFF,0x9F,
		0x4B,0xBE,0x3E,0xBC,0xD0,0xA8,0xCA,0xB1,0x8E,0xB7,0xD0,0xFF,
		0xE0,0x87,0x67,0xE4,0x51,0xA4,0xB9,0xF3,0x47,0xFA,0x13,0xFA,
		0xB1,0xDA,0xB6,0xF8,0xEC,0x6D,0x0B,0x2E,0x99,0x37,0xB8,0x66,
		0x80,0x83,0x3A,0xCA,0x46,0x6D,0xDC,0x24,0x9F,0x83,0x54,0xA9,
		0x70,0x62,0x21,0x6D,0x28,0x0E,0x63,0x8B,0x91,0x7F,0xFF,0xCD,
		0x80,0xF5,0xAC,0xE6,0x90,0x97,0x3C,0xB5,0xE8,0x00,0x90,0x96,
		0xB7,0x26,0x2C,0xB2,0x9C,0xEF,0xBF,0xCC,0xD6,0xA8,0x01,0xA0,
		0xFC,0x20,0x61,0xBD,0xA9,0xEE,0x5F,0x8B,0x32,0x1C,0x62,0xF0,
		0x94,0x81,0x86,0x30,0x1B,0xB1,0x12,0xF5,0x58,0x52,0x8D,0xE4,
		0x99,0x43,0x60,0x9B,0x24,0xF8,0x8B,0x14,0x63,0x0C,0x93,0xF4,
		0x7A,0x70,0x0A,0xE1,0x45,0x16,0x92,0x9D,0x12,0x50,0x05,0x3C,
		0x05,0xEE,0x40,0x32,0x4D,0x99,0xFF,0xF6,0x14,0x25,0xF6,0xDF,
		0xD8,0xDA,0xE0,0x85,0x1B,0x3F,0x2C,0x50,0xD9,0x01,0x4B,0x01,
		0x65,0x2C,0x75,0x32,0xBA,0x6F,0x00,0x56,0xD3,0x83,0xC8,0x44,
		0x9B,0x62,0x3F,0x88,0xA7,0x18,0xAC,0x69,0xBB,0xF3,0x14,0xD3,
		0xA4,0x09,0x6C,0x4A,0x14,0x0C,0x55,0x95,0x7A,0x33,0x21,0x99,
		0x0F,0x01,0x00,0x5D,0x2D,0xAB,0xEB,0x7A,0x76,0x03,0xE7,0x2A,
		0x1D,0xC2,0x86,0x4B
_EOF_
			;;
		*)
			return 1
			;;
	esac

	cat << \_EOF_
	};
	static unsigned char dhg[] = {
		0x02,
	};

	DH *dh = DH_new();;
	BIGNUM *dhp_bn, *dhg_bn;

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

	dhp_bn = BN_bin2bn(dhp, sizeof (dhp), NULL);
	dhg_bn = BN_bin2bn(dhg, sizeof (dhg), NULL);

#ifdef TCLTLS_OPENSSL_PRE_1_1_API
	dh->p = dhp_bn;
	dh->g = dhg_bn;

	if (dhp_bn == NULL || dhg_bn == NULL) {
#else
	if (dhp_bn == NULL || dhg_bn == NULL || !DH_set0_pqg(dh, dhp_bn, NULL, dhg_bn)) {
#endif
		DH_free(dh);
		BN_free(dhp_bn);
		BN_free(dhg_bn);
		return(NULL);
	}

	return(dh);
}
_EOF_

	return 0
}

# Enable support for giving the same DH params each time
if [ "${option_fallback}" = '1' ]; then
	gen_dh_params_fallback && exit 0

	echo "Unable to generate fallback parameters for DH of ${bits} bits" >&2

	exit 1
fi

echo "*****************************" >&2
echo "** Generating DH Primes.   **" >&2
echo "** This will take a while. **" >&2
echo "*****************************" >&2
gen_dh_params_openssl && exit 0
gen_dh_params_remote && exit 0
gen_dh_params_fallback && exit 0

echo "Unable to generate parameters for DH of ${bits} bits" >&2

exit 1

Added generic/tclOpts.h version [2aa98ce596].




























































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 *  Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Stylized option processing - requires consistent
 * external vars: opt, idx, objc, objv
 */

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPT_PROLOG(option)			\
    if (strcmp(opt, (option)) == 0) {		\
	if (++idx >= objc) {			\
	    Tcl_AppendResult(interp,		\
		"no argument given for ",	\
		(option), " option",		\
		(char *) NULL);			\
	    return TCL_ERROR;			\
	}
#define OPT_POSTLOG()				\
	continue;				\
    }
#define OPTOBJ(option, var)			\
    OPT_PROLOG(option)				\
    var = objv[idx];				\
    OPT_POSTLOG()

#define OPTSTR(option, var)			\
    OPT_PROLOG(option)				\
    var = Tcl_GetString(objv[idx]);\
    OPT_POSTLOG()

#define OPTINT(option, var)			\
    OPT_PROLOG(option)				\
    if (Tcl_GetIntFromObj(interp, objv[idx],	\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

#define OPTBOOL(option, var)			\
    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

#define OPTBYTE(option, var, lvar)		\
    OPT_PROLOG(option)				\
    var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
    OPT_POSTLOG()

#define OPTBAD(type, list)			\
    Tcl_AppendResult(interp, "bad ", (type),	\
		" \"", opt, "\": must be ",	\
		(list), (char *) NULL)

#endif /* _TCL_OPTS_H */

Added generic/tls.c version [02ab8298f1].



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
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
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
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
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
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
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
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
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
1233
1234
1235
1236
1237
1238
1239
1240
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
1397
1398
1399
1400
1401
1402
1403
1404
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
1462
1463
1464
1465
1466
1467
1468
1469
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
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
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
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
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
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
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
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
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright (C) 1997-1999 Matt Newman <[email protected]>
 * some modifications:
 *	Copyright (C) 2000 Ajuba Solutions
 *	Copyright (C) 2002 ActiveState Corporation
 *	Copyright (C) 2004 Starfish Systems
 *	Copyright (C) 2023 Brian O'Hagan
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built (almost) from scratch based upon observation of
 * OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), 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)
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <stdio.h>
#include <stdlib.h>
#include "tlsUuid.h"

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


/*
 * Forward declarations
 */

#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
#define TLS_PROTO_TLS1_1	0x08
#define TLS_PROTO_TLS1_2	0x10
#define TLS_PROTO_TLS1_3	0x20
#define ENABLED(flag, mask)	(((flag) & (mask)) == (mask))

/*
 * We lose the tcl password callback when we use the RSA BSAFE SSL-C 1.1.2
 * libraries instead of the current OpenSSL libraries.
 */

#ifdef BSAFE
#define PRE_OPENSSL_0_9_4 1
#endif

/*
 * Pre OpenSSL 0.9.4 Compat
 */

#ifndef STACK_OF
#define STACK_OF(x)			STACK
#define sk_SSL_CIPHER_num(sk)		sk_num((sk))
#define sk_SSL_CIPHER_value( sk, index)	(SSL_CIPHER*)sk_value((sk), (index))
#endif

/*
 * Thread-Safe TLS Code
 */

#ifdef TCL_THREADS
#define OPENSSL_THREAD_DEFINES
#include <openssl/opensslconf.h>

#ifdef OPENSSL_THREADS
#include <openssl/crypto.h>

/*
 * Threaded operation requires locking callbacks
 * Based from /crypto/cryptlib.c of OpenSSL and NSOpenSSL.
 */

static Tcl_Mutex *locks = NULL;
static int locksCount = 0;
static Tcl_Mutex init_mx;

void CryptoThreadLockCallback(
    int mode,
    int n,
    TCL_UNUSED(const char *),
    TCL_UNUSED(int))
{
	if (mode & CRYPTO_LOCK) {
		/* This debugging is turned off by default -- it's too noisy. */
		/* dprintf("Called to lock (n=%i of %i)", n, locksCount); */
		Tcl_MutexLock(&locks[n]);
	} else {
		/* dprintf("Called to unlock (n=%i of %i)", n, locksCount); */
		Tcl_MutexUnlock(&locks[n]);
	}

	/* dprintf("Returning"); */

	return;
}

unsigned long CryptoThreadIdCallback(void) {
	unsigned long ret;

	dprintf("Called");

	ret = (unsigned long) Tcl_GetCurrentThread();

	dprintf("Returning %lu", ret);

	return ret;
}
#endif /* OPENSSL_THREADS */
#endif /* TCL_THREADS */


/*
 *-------------------------------------------------------------------
 *
 * InfoCallback --
 *
 *	Monitors SSL connection process
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *
 *-------------------------------------------------------------------
 */
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;

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

#if 0
    if (where & SSL_CB_ALERT) {
	sev = SSL_alert_type_string_long(ret);
	if (strcmp( sev, "fatal")==0) {	/* Map to error */
	    Tls_Error(statePtr, SSL_ERROR(ssl, 0));
	    return;
	}
    }
#endif
    if (where & SSL_CB_HANDSHAKE_START) {
	major = "handshake";
	minor = "start";
    } else if (where & SSL_CB_HANDSHAKE_DONE) {
	major = "handshake";
	minor = "done";
    } else {
	if (where & SSL_CB_ALERT)		major = "alert";
	else if (where & SSL_ST_CONNECT)	major = "connect";
	else if (where & SSL_ST_ACCEPT)		major = "accept";
	else					major = "unknown";

	if (where & SSL_CB_READ)		minor = "read";
	else if (where & SSL_CB_WRITE)		minor = "write";
	else if (where & SSL_CB_LOOP)		minor = "loop";
	else if (where & SSL_CB_EXIT)		minor = "exit";
	else					minor = "unknown";
    }

    Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( "info", -1));

    Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );

    Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( major, -1) );

    Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( minor, -1) );

    if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
	Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
    } else if (where & SSL_CB_ALERT) {
	const char *cp = (char *)SSL_alert_desc_string_long(ret);

	Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( cp, -1) );
    } else {
	Tcl_ListObjAppendElement( interp, cmdPtr,
	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
    }
    Tcl_Preserve((void *) interp);
    Tcl_Preserve((void *) statePtr);

    Tcl_IncrRefCount( cmdPtr);
    (void) Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount( cmdPtr);

    Tcl_Release((void *) statePtr);
    Tcl_Release((void *) interp);

}

/*
 *-------------------------------------------------------------------
 *
 * VerifyCallback --
 *
 *	Monitors SSL certificate validation process.
 *	This is called whenever a certificate is inspected
 *	or decided invalid.
 *
 * Results:
 *	A callback bound to the socket may return one of:
 *	    0			- the certificate is deemed invalid
 *	    1			- the certificate is deemed valid
 *	    empty string	- no change to certificate validation
 *
 * 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, X509_STORE_CTX *ctx)
{
    Tcl_Obj *cmdPtr, *result;
    char *errStr, *string;
    Tcl_Size length;
    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
    X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
    State *statePtr	= (State*)SSL_get_app_data(ssl);
    int depth		= X509_STORE_CTX_get_error_depth(ctx);
    int err		= X509_STORE_CTX_get_error(ctx);

    dprintf("Verify: %d", ok);

    if (!ok) {
	errStr = (char *)X509_verify_cert_error_string(err);
    } else {
	errStr = (char *)0;
    }

    if (statePtr->callback == NULL) {
	if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) {
	    return ok;
	} else {
	    return 1;
	}
    }
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( "verify", -1));

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewIntObj( depth) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tls_NewX509Obj( statePtr->interp, cert) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewIntObj( ok) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( errStr ? errStr : "", -1) );

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

    statePtr->flags |= TLS_TCL_CALLBACK;

    Tcl_IncrRefCount( cmdPtr);
    if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
	/* It got an error - reject the certificate.		*/
	Tcl_BackgroundError( statePtr->interp);
	ok = 0;
    } else {
	result = Tcl_GetObjResult(statePtr->interp);
	string = Tcl_GetStringFromObj(result, &length);
	/* An empty result leaves verification unchanged.	*/
	if (string != NULL && length > 0) {
	    if (Tcl_GetIntFromObj(statePtr->interp, result, &ok) != TCL_OK) {
		Tcl_BackgroundError(statePtr->interp);
		ok = 0;
	    }
	}
    }
    Tcl_DecrRefCount( cmdPtr);

    statePtr->flags &= ~(TLS_TCL_CALLBACK);

    Tcl_Release((void *) statePtr);
    Tcl_Release((void *) statePtr->interp);

    return ok;	/* By default, leave verification unchanged.	*/
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Error --
 *
 *	Calls callback with $fd and $msg - so the callback can decide
 *	what to do with errors.
 *
 * 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_Obj *cmdPtr;

    dprintf("Called");

    if (msg && *msg) {
	Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL);
    } else {
	msg = Tcl_GetString(Tcl_GetObjResult(statePtr->interp));
    }
    statePtr->err = msg;

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	char buf[BUFSIZ];
	sprintf(buf, "SSL channel \"%s\": error: %s",
	    Tcl_GetChannelName(statePtr->self), msg);
	Tcl_SetResult( statePtr->interp, buf, TCL_VOLATILE);
	Tcl_BackgroundError( statePtr->interp);
	return;
    }
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj("error", -1));

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(msg, -1));

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

    Tcl_IncrRefCount(cmdPtr);
    if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
	Tcl_BackgroundError(statePtr->interp);
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((void *) statePtr);
    Tcl_Release((void *) statePtr->interp);
}

/*
 *-------------------------------------------------------------------
 *
 * PasswordCallback --
 *
 *	Called when a password is needed to unpack RSA and PEM keys.
 *	Evals any bound password script and returns the result as
 *	the password string.
 *-------------------------------------------------------------------
 */
#ifdef PRE_OPENSSL_0_9_4
/*
 * No way to handle user-data therefore no way without a global
 * variable to access the Tcl interpreter.
*/
static int
PasswordCallback(
    TCL_UNUSED(char *) /* buf */,
    TCL_UNUSED(int) /* size */,
    TCL_UNUSED(int) /* verify */)
{
    return -1;
}
#else
static int
PasswordCallback(
    char *buf,
    int size,
    TCL_UNUSED(int), /* verify */
    void *udata)
{
    State *statePtr	= (State *) udata;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int result;

    dprintf("Called");

    if (statePtr->password == NULL) {
	if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL)
		== TCL_OK) {
	    const char *ret = Tcl_GetStringResult(interp);
	    strncpy(buf, ret, (size_t) size);
	    return (int)strlen(ret);
	} else {
	    return -1;
	}
    }

    cmdPtr = Tcl_DuplicateObj(statePtr->password);

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

    Tcl_IncrRefCount(cmdPtr);
    result = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (result != TCL_OK) {
	Tcl_BackgroundError(statePtr->interp);
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((void *) statePtr);
    Tcl_Release((void *) statePtr->interp);

    if (result == TCL_OK) {
	const char *ret = Tcl_GetStringResult(interp);
	strncpy(buf, ret, (size_t) size);
	return (int)strlen(ret);
    } else {
	return -1;
    }
}
#endif

/********************/
/* Commands         */
/********************/

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd -- list available ciphers
 *
 *	This procedure is invoked to process the "tls::ciphers" command
 *	to list available ciphers, based upon protocol selected.
 *
 * Results:
 *	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(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj	*const objv[])
{
    Tcl_Obj *objPtr = NULL;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    const char *cp;
    char buf[BUFSIZ];
    int index, verbose = 0;

    dprintf("Called");

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum protocol)index) {
    case TLS_SSL2:
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
    case TLS_SSL3:
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
    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
	ctx = SSL_CTX_new(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
	ctx = SSL_CTX_new(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
	ctx = SSL_CTX_new(TLSv1_2_method()); break;
#endif
    case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3_METHOD)
	Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
	return TCL_ERROR;
#else
	ctx = SSL_CTX_new(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:
	break;
    }
    if (ctx == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
	return TCL_ERROR;
    }

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

    if (!verbose) {
	for (index = 0; ; index++) {
	    cp = (char*)SSL_get_cipher_list( ssl, index);
	    if (cp == NULL) break;
	    Tcl_ListObjAppendElement( interp, objPtr,
		Tcl_NewStringObj( cp, -1) );
	}
    } else {
	sk = SSL_get_ciphers(ssl);

	for (index = 0; index < sk_SSL_CIPHER_num(sk); index++) {
	    size_t i;
	    SSL_CIPHER_description( sk_SSL_CIPHER_value( sk, index),
				    buf, sizeof(buf));
	    for (i = strlen(buf) - 1; i ; i--) {
		if (buf[i] == ' ' || buf[i] == '\n' ||
		    buf[i] == '\r' || buf[i] == '\t') {
		    buf[i] = '\0';
		} else {
		    break;
		}
	    }
	    Tcl_ListObjAppendElement( interp, objPtr,
		Tcl_NewStringObj( buf, -1) );
	}
    }
    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * HandshakeObjCmd --
 *
 *	This command is used to verify whether the handshake is complete
 *	or not.
 *
 * Results:
 *	A standard Tcl result. 1 means handshake complete, 0 means pending.
 *
 * Side effects:
 *	May force SSL negotiation to take place.
 *
 *-------------------------------------------------------------------
 */

static int HandshakeObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Channel chan;        /* The channel to set a mode on. */
    State *statePtr;        /* client state for ssl socket */
    const char *errStr = NULL;
    int ret = 1;
    int err = 0;

    dprintf("Called");

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }
    statePtr = (State *)Tcl_GetChannelInstanceData(chan);

    dprintf("Calling Tls_WaitForConnect");
    ret = Tls_WaitForConnect(statePtr, &err, 1);
    dprintf("Tls_WaitForConnect returned: %i", ret);

    if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) {
	dprintf("Async set and err = EAGAIN");
	ret = 0;
    } else if (ret < 0) {
	long result;
	errStr = statePtr->err;
	Tcl_ResetResult(interp);
	Tcl_SetErrno(err);

	if (!errStr || (*errStr == 0)) {
	    errStr = Tcl_PosixError(interp);
	}

	Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *)NULL);
	if ((result = SSL_get_verify_result(statePtr->ssl)) != X509_V_OK) {
	    Tcl_AppendResult(interp, " due to \"", X509_verify_cert_error_string(result), "\"", (char *)NULL);
	}
	Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "FAILED", (char *)NULL);
	dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
	return TCL_ERROR;
    } else {
	if (err != 0) {
	    dprintf("Got an error with a completed handshake: err = %i", err);
	}
	ret = 1;
    }

    dprintf("Returning TCL_OK with data \"%i\"", ret);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *
 *	This procedure is invoked to process the "ssl" command
 *
 *	The ssl command pushes SSL over a (newly connected) tcp socket
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */

static int
ImportObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Channel chan;		/* The channel to set a mode on. */
    State *statePtr;		/* client state for ssl socket */
    SSL_CTX *ctx		= NULL;
    Tcl_Obj *script		= NULL;
    Tcl_Obj *password		= NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx;
    Tcl_Size len;
    int flags			= TLS_TCL_INIT;
    int server			= 0;	/* is connection incoming or outgoing? */
    char *keyfile		= NULL;
    char *certfile		= NULL;
    unsigned char *key		= NULL;
    Tcl_Size key_len		= 0;
    unsigned char *cert		= NULL;
    Tcl_Size cert_len		= 0;
    char *ciphers		= NULL;
    char *CAfile		= NULL;
    char *CApath			= NULL;
    char *DHparams		= NULL;
    char *model			= NULL;
    char *servername		= NULL;	/* hostname for Server Name Indication */
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0;
    int verify = 0, require = 0, request = 1;

    dprintf("Called");

#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
    tls1 = 0;
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
    tls1_1 = 0;
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
    tls1_2 = 0;
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
    tls1_3 = 0;
#endif

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

    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);

    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetString(objv[idx]);

	if (opt[0] != '-')
	    break;

	OPTSTR("-cadir", CApath);
	OPTSTR("-cafile", CAfile);
	OPTBYTE("-cert", cert, cert_len);
	OPTSTR("-certfile", certfile);
	OPTSTR("-cipher", ciphers);
	OPTSTR("-ciphers", ciphers);
	OPTOBJ("-command", script);
	OPTSTR("-dhparams", DHparams);
	OPTBYTE("-key", key, key_len);
	OPTSTR("-keyfile", keyfile);
	OPTSTR("-model", model);
	OPTOBJ("-password", password);
	OPTBOOL("-request", request);
	OPTBOOL("-require", require);
	OPTBOOL("-server", server);
	OPTSTR("-servername", servername);
	OPTBOOL("-ssl2", ssl2);
	OPTBOOL("-ssl3", ssl3);
	OPTBOOL("-tls1", tls1);
	OPTBOOL("-tls1.1", tls1_1);
	OPTBOOL("-tls1.2", tls1_2);
	OPTBOOL("-tls1.3", tls1_3);

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

	return TCL_ERROR;
    }
    if (request)	    verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (verify == 0)	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);

    /* reset to NULL if blank string provided */
    if (cert && !*cert)		        cert	        = NULL;
    if (key && !*key)		        key	        = NULL;
    if (certfile && !*certfile)         certfile	= NULL;
    if (keyfile && !*keyfile)		keyfile	        = NULL;
    if (ciphers && !*ciphers)	        ciphers	        = NULL;
    if (CAfile && !*CAfile)	        CAfile	        = NULL;
    if (CApath && !*CApath)	        CApath	        = NULL;
    if (DHparams && !*DHparams)	        DHparams        = NULL;

    /* new SSL state */
    statePtr		= (State *) ckalloc((unsigned) sizeof(State));
    memset(statePtr, 0, sizeof(State));

    statePtr->flags	= flags;
    statePtr->interp	= interp;
    statePtr->vflags	= verify;
    statePtr->err	= "";

    /* allocate script */
    if (script) {
	(void) Tcl_GetStringFromObj(script, &len);
	if (len) {
	    statePtr->callback = script;
	    Tcl_IncrRefCount(statePtr->callback);
	}
    }

    /* allocate password */
    if (password) {
	(void) Tcl_GetStringFromObj(password, &len);
	if (len) {
	    statePtr->password = password;
	    Tcl_IncrRefCount(statePtr->password);
	}
    }

    if (model != NULL) {
	int mode;
	/* Get the "model" context */
	chan = Tcl_GetChannel(interp, model, &mode);
	if (chan == (Tcl_Channel) NULL) {
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}

	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	    Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		    "\": not a TLS channel", (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *)NULL);
	    Tls_Free((void *)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, NULL, 0, DHparams)) == NULL) {
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;

    /*
     * We need to make sure that the channel works in binary (for the
     * encryption not to get goofed up).
     * We only want to adjust the buffering in pre-v2 channels, where
     * each channel in the stack maintained its own buffers.
     */
    Tcl_DStringInit(&upperChannelTranslation);
    Tcl_DStringInit(&upperChannelBlocking);
    Tcl_DStringInit(&upperChannelEOFChar);
    Tcl_DStringInit(&upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-eofchar", &upperChannelEOFChar);
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    Tcl_SetChannelOption(interp, chan, "-blocking", "true");
    dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*
	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
	 */
	Tls_Free((void *)statePtr);
	return TCL_ERROR;
    }

    Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation));
    Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding));
    Tcl_SetChannelOption(interp, statePtr->self, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar));
    Tcl_SetChannelOption(interp, statePtr->self, "-blocking", Tcl_DStringValue(&upperChannelBlocking));

    /*
     * SSL Initialization
     */
    statePtr->ssl = SSL_new(statePtr->ctx);
    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *)NULL);
	Tls_Free((void *)statePtr);
	return TCL_ERROR;
    }

    /* Set host server name */
    if (servername) {
	/* Sets the server name indication (SNI) in ClientHello extension */
	/* Per RFC 6066, hostname is a ASCII encoded string, though RFC 4366 says UTF-8. */
	if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
	    Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *)NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *)NULL);
	    Tls_Free((void *)statePtr);
	    return TCL_ERROR;
	}
    }

    /*
     * SSL Callbacks
     */
    SSL_set_app_data(statePtr->ssl, (void *)statePtr);	/* point back to us */
    SSL_set_verify(statePtr->ssl, verify, VerifyCallback);
    SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback);

    /* Create Tcl_Channel BIO Handler */
    statePtr->p_bio	= BIO_new_tcl(statePtr, BIO_NOCLOSE);
    statePtr->bio	= BIO_new(BIO_f_ssl());

    if (server) {
	statePtr->flags |= TLS_TCL_SERVER;
	SSL_set_accept_state(statePtr->ssl);
    } else {
	SSL_set_connect_state(statePtr->ssl);
    }
    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE);

    /*
     * End of SSL Init
     */
    dprintf("Returning %s", Tcl_GetChannelName(statePtr->self));
    Tcl_SetResult(interp, (char *)Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * UnimportObjCmd --
 *
 *	This procedure is invoked to remove the topmost channel filter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */

static int
UnimportObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Channel chan;		/* The channel to set a mode on. */

    dprintf("Called");

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);

    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", (char *)NULL);
	Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *)NULL);
	return TCL_ERROR;
    }

    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
 *
 * Results:
 *	A valid SSL_CTX instance or NULL.
 *
 * Side effects:
 *	constructs SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */

static SSL_CTX *
CTX_Init(
    State *statePtr,
    TCL_UNUSED(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,
    TCL_UNUSED(char *), /* ciphersuites */
    TCL_UNUSED(int), /* level */
    char *DHparams)
{
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
    Tcl_DString ds1;
    int off = 0;
    int load_private_key;
    const SSL_METHOD *method;

    dprintf("Called");

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

    /* create SSL context */
    if (ENABLED(proto, TLS_PROTO_SSL2)) {
	Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *)NULL);
	return NULL;
    }
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
	Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *)NULL);
	return NULL;
    }
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
    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) || defined(OPENSSL_NO_TLS1_1_METHOD)
    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) || defined(OPENSSL_NO_TLS1_2_METHOD)
    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

    switch (proto) {
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
    case TLS_PROTO_TLS1:
	method = TLSv1_method();
	break;
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
    case TLS_PROTO_TLS1_1:
	method = TLSv1_1_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 = TLSv1_2_method();
	break;
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    case TLS_PROTO_TLS1_3:
	/* Use the generic method and constraint range after context is created */
	method = TLS_method();
	break;
#endif
    default:
	/* Negotiate highest available SSL/TLS version */
	method = TLS_method();
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1)   ? 0 : SSL_OP_NO_TLSv1);
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1);
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3);
#endif
	break;
    }

    ctx = SSL_CTX_new(method);
    if (!ctx) {
	return NULL;
    }

#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

    SSL_CTX_set_app_data(ctx, interp);	/* remember the interpreter */
    SSL_CTX_set_options(ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options(ctx, off);		/* disable protocol versions */
    SSL_CTX_sess_set_cache_size(ctx, 128);

    /* Set user defined ciphers, cipher suites, and security level */
    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;
    }

    /* set some callbacks */
    SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback);

#ifndef BSAFE
    SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr);
#endif

    /* read a Diffie-Hellman parameters file, or use the built-in one */
#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;
	    Tcl_DStringInit(&ds);
	    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;
	    }

	    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);
		SSL_CTX_free(ctx);
		return NULL;
	    }
	    SSL_CTX_set_tmp_dh(ctx, dh);
	    DH_free(dh);
	} 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 */
    load_private_key = 0;
    if (certfile != NULL) {
	load_private_key = 1;

	Tcl_DStringInit(&ds);

	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, ": ",
		    GET_ERR_REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    } else if (cert != NULL) {
	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp, "unable to set certificate: ",
		    GET_ERR_REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    } else {
	certfile = (char*)X509_get_default_cert_file();

	if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) {
#if 0
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ",
		    GET_ERR_REASON(), (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
#endif
	}
    }

    /* 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 */
	    if (keyfile == NULL) {
		keyfile = certfile;
	    }

	    if (SSL_CTX_use_PrivateKey_file(ctx, F2N(keyfile, &ds), SSL_FILETYPE_PEM) <= 0) {
		Tcl_DStringFree(&ds);
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp, "unable to set public key file ", keyfile, " ",
			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) {
		Tcl_DStringFree(&ds);
		/* 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;
	    }
	}
	/* Now we know that a key and cert have been set against
	 * the SSL context */
	if (!SSL_CTX_check_private_key(ctx)) {
	    Tcl_AppendResult(interp, "private key does not match the certificate public key",
			     (char *)NULL);
	    SSL_CTX_free(ctx);
	    return NULL;
	}
    }

    /* Set verification CAs */
    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&ds1);
    if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CApath, &ds1)) ||
	!SSL_CTX_set_default_verify_paths(ctx)) {
#if 0
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&ds1);
	/* Don't currently care if this fails */
	Tcl_AppendResult(interp, "SSL default verify paths: ",
		GET_ERR_REASON(), (char *)NULL);
	SSL_CTX_free(ctx);
	return NULL;
#endif
    }

    /* https://sourceforge.net/p/tls/bugs/57/ */
    /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */
    if (CAfile != NULL) {
        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);
    Tcl_DStringFree(&ds1);
    return ctx;
}

/*
 *-------------------------------------------------------------------
 *
 * StatusObjCmd -- return certificate for connected peer.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
StatusObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj	*const objv[])
{
    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;

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

    /* Get channel Id */
    channelName = Tcl_GetString(objv[(objc == 2 ? 1 : 2)]);
    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", (char *)NULL);
	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) {
	peer = SSL_get_peer_certificate(statePtr->ssl);
    } else {
	peer = SSL_get_certificate(statePtr->ssl);
    }
    /* Get X509 certificate info */
    if (peer) {
	objPtr = Tls_NewX509Obj(interp, peer);
	if (objc == 2) {
	    X509_free(peer);
	    peer = NULL;
	}
    } else {
	objPtr = Tcl_NewListObj(0, NULL);
    }

    LAPPEND_INT(interp, objPtr, "sbits", SSL_get_cipher_bits(statePtr->ssl, NULL));

    ciphers = (char*)SSL_get_cipher(statePtr->ssl);
    if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) {
	LAPPEND_STR(interp, objPtr, "cipher", ciphers, -1);
    }

    LAPPEND_STR(interp, objPtr, "version", SSL_get_version(statePtr->ssl), -1);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * VersionObjCmd -- return version string from OpenSSL.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
VersionObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    TCL_UNUSED(int) /* objc */,
    TCL_UNUSED(Tcl_Obj *const *) /* objv */)
{
    Tcl_Obj *objPtr;

    dprintf("Called");

    objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * MiscObjCmd -- misc commands
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
MiscObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj	*const objv[])
{
    static const char *commands [] = { "req", NULL };
    enum command { C_REQ, C_DUMMY };
    int cmd;

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0, &cmd) != TCL_OK) {
	return TCL_ERROR;
    }

    ERR_clear_error();

    switch ((enum command) cmd) {
	case C_REQ: {
	    EVP_PKEY *pkey=NULL;
	    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="";
	    char *keyout,*pemout,*str;
	    int keysize,serial=0,days=365;

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

	    if ((objc<5) || (objc>6)) {
		Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?");
		return TCL_ERROR;
	    }

	    if (Tcl_GetIntFromObj(interp, objv[2], &keysize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    keyout=Tcl_GetString(objv[3]);
	    pemout=Tcl_GetString(objv[4]);

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

#if OPENSSL_VERSION_NUMBER < 0x30000000L
	    bne = BN_new();
	    rsa = RSA_new();
	    pkey = EVP_PKEY_new();
	    if (bne == NULL || rsa == NULL || pkey == NULL || !BN_set_word(bne,RSA_F4) ||
		!RSA_generate_key_ex(rsa, keysize, bne, NULL) || !EVP_PKEY_assign_RSA(pkey, rsa)) {
		EVP_PKEY_free(pkey);
		/* RSA_free(rsa); freed by EVP_PKEY_free */
		BN_free(bne);
#else
	    pkey = EVP_RSA_gen((unsigned int)keysize);
	    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;
	    } else {
		out=BIO_new(BIO_s_file());
		BIO_write_filename(out,keyout);
		PEM_write_bio_PrivateKey(out,pkey,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;
		}

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

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

		out=BIO_new(BIO_s_file());
		BIO_write_filename(out,pemout);
		PEM_write_bio_X509(out,cert);
		BIO_free_all(out);

		X509_free(cert);
		EVP_PKEY_free(pkey);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
		BN_free(bne);
#endif
	    }
	}
	break;
    default:
	break;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * 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
#if TCL_MAJOR_VERSION > 8
Tls_Free( void *blockPtr )
#else
Tls_Free( char *blockPtr )
#endif
{
    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) {
    dprintf("Called");

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

    if (statePtr->bio) {
	/* This will call SSL_shutdown. Bug 1414045 */
	dprintf("BIO_free_all(%p)", statePtr->bio);
	BIO_free_all(statePtr->bio);
	statePtr->bio = NULL;
    }
    if (statePtr->ssl) {
	dprintf("SSL_free(%p)", statePtr->ssl);
	SSL_free(statePtr->ssl);
	statePtr->ssl = NULL;
    }
    if (statePtr->ctx) {
	SSL_CTX_free(statePtr->ctx);
	statePtr->ctx = NULL;
    }
    if (statePtr->callback) {
	Tcl_DecrRefCount(statePtr->callback);
	statePtr->callback = NULL;
    }
    if (statePtr->password) {
	Tcl_DecrRefCount(statePtr->password);
	statePtr->password = NULL;
    }

    dprintf("Returning");
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Init --
 *
 *	This is a package initialization procedure, which is called
 *	by Tcl when this package is to be added to an interpreter.
 *
 * Results:  Ssl configured and loaded
 *
 * Side effects:
 *	 create the ssl command, initialize ssl context
 *
 *-------------------------------------------------------------------
 */

#ifndef STRINGIFY
#  define STRINGIFY(x) STRINGIFY1(x)
#  define STRINGIFY1(x) #x
#endif

static const char tlsTclInitScript[] = {
#include "tls.tcl.h"
    0x00
};

DLLEXPORT int Tls_Init(
    Tcl_Interp *interp)
{
    Tcl_CmdInfo info;

    dprintf("Called");

	/*
	 * We only support Tcl 8.6 or newer
	 */
    if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
	return TCL_ERROR;
    }

    if (TlsLibInit(0) != TCL_OK) {
	Tcl_AppendResult(interp, "could not initialize SSL library", (char *)NULL);
	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, NULL, 0);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, NULL, 0);

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

    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
	Tcl_CreateObjCommand(interp, "::tls::build-info",
		info.objProc, (void *)(
		    PACKAGE_VERSION "+" STRINGIFY(TLS_VERSION_UUID)
#if defined(__clang__) && defined(__clang_major__)
			    ".clang-" STRINGIFY(__clang_major__)
#if __clang_minor__ < 10
			    "0"
#endif
			    STRINGIFY(__clang_minor__)
#endif
#if defined(__cplusplus) && !defined(__OBJC__)
			    ".cplusplus"
#endif
#ifndef NDEBUG
			    ".debug"
#endif
#if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__)
			    ".gcc-" STRINGIFY(__GNUC__)
#if __GNUC_MINOR__ < 10
			    "0"
#endif
			    STRINGIFY(__GNUC_MINOR__)
#endif
#ifdef __INTEL_COMPILER
			    ".icc-" STRINGIFY(__INTEL_COMPILER)
#endif
#ifdef TCL_MEM_DEBUG
			    ".memdebug"
#endif
#if defined(_MSC_VER)
			    ".msvc-" STRINGIFY(_MSC_VER)
#endif
#ifdef USE_NMAKE
			    ".nmake"
#endif
#ifndef TCL_CFG_OPTIMIZED
			    ".no-optimize"
#endif
#ifdef __OBJC__
			    ".objective-c"
#if defined(__cplusplus)
			    "plusplus"
#endif
#endif
#ifdef TCL_CFG_PROFILED
			    ".profile"
#endif
#ifdef PURIFY
			    ".purify"
#endif
#ifdef STATIC_BUILD
			    ".static"
#endif
		), NULL);
    }

    return Tcl_PkgProvideEx(interp, PACKAGE_NAME, PACKAGE_VERSION, NULL);
}

/*
 *------------------------------------------------------*
 *
 *	Tls_SafeInit --
 *
 *	------------------------------------------------*
 *	Standard procedure required by 'load'.
 *	Initializes this extension for a safe interpreter.
 *	------------------------------------------------*
 *
 *	Side effects:
 *		As of 'Tls_Init'
 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

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

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *
 *	------------------------------------------------*
 *	Initializes SSL library once per application
 *	------------------------------------------------*
 *
 *	Side effects:
 *		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

    if (uninitialize) {
	if (!initialized) {
	    dprintf("Asked to uninitialize, but we are not initialized");

	    return TCL_OK;
	}

	dprintf("Asked to uninitialize");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexLock(&init_mx);

	if (locks) {
	    free(locks);
	    locks = NULL;
	    locksCount = 0;
	}
#endif
	initialized = 0;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexUnlock(&init_mx);
#endif

	return TCL_OK;
    }

    if (initialized) {
	dprintf("Called, but using cached value");
	return status;
    }

    dprintf("Called");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    Tcl_MutexLock(&init_mx);
#endif
    initialized = 1;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    num_locks = CRYPTO_num_locks();
    locksCount = num_locks;
    locks = malloc(sizeof(*locks) * num_locks);
    memset(locks, 0, sizeof(*locks) * num_locks);

    CRYPTO_set_locking_callback(CryptoThreadLockCallback);
    CRYPTO_set_id_callback(CryptoThreadIdCallback);
#endif

    if (SSL_library_init() != 1) {
	status = TCL_ERROR;
	goto done;
    }

    SSL_load_error_strings();
    ERR_load_crypto_strings();

    BIO_new_tcl(NULL, 0);

done:
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
    Tcl_MutexUnlock(&init_mx);
#endif

    return status;
}

Added generic/tls.h version [5524cb9711].































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), 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)
 *
 */

#ifndef _TLS_H
#define _TLS_H

#include <tcl.h>

/*
 * Initialization routines -- our entire public C API.
 */
DLLEXPORT int Tls_Init(Tcl_Interp *interp);
DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp);

#endif /* _TLS_H */

Added generic/tlsBIO.c version [26205b6a4d].






























































































































































































































































































































































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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Provides BIO layer to interface OpenSSL to Tcl.
 */

#include "tlsInt.h"

#ifdef TCLTLS_OPENSSL_PRE_1_1_API
#define BIO_get_data(bio)                ((bio)->ptr)
#define BIO_get_init(bio)                ((bio)->init)
#define BIO_get_shutdown(bio)            ((bio)->shutdown)
#define BIO_set_data(bio, val)           (bio)->ptr = (val)
#define BIO_set_init(bio, val)           (bio)->init = (val)
#define BIO_set_shutdown(bio, val)       (bio)->shutdown = (val)

/* XXX: This assumes the variable being assigned to is BioMethods */
#define BIO_meth_new(type_, name_)       (BIO_METHOD *)Tcl_Alloc(sizeof(BIO_METHOD)); \
                                         memset(BioMethods, 0, sizeof(BIO_METHOD)); \
                                         BioMethods->type = type_; \
                                         BioMethods->name = name_;
#define BIO_meth_set_write(bio, val)     (bio)->bwrite = val;
#define BIO_meth_set_read(bio, val)      (bio)->bread = val;
#define BIO_meth_set_puts(bio, val)      (bio)->bputs = val;
#define BIO_meth_set_ctrl(bio, val)      (bio)->ctrl = val;
#define BIO_meth_set_create(bio, val)    (bio)->create = val;
#define BIO_meth_set_destroy(bio, val)   (bio)->destroy = val;
#endif

static int BioWrite(BIO *bio, const char *buf, int bufLen) {
    Tcl_Channel chan;
    Tcl_Size ret;
    int tclEofChan, tclErrno;

    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

    dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);

    ret = Tcl_WriteRaw(chan, buf, (Tcl_Size)bufLen);

    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

    dprintf("[chan=%p] BioWrite(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
	    chan, bufLen, ret, tclEofChan, tclErrno);

    BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;
    } else if (ret == 0) {
	dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);
    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}
    } else {
	dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret);
    }

    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_read(bio)) {
	    dprintf("Setting should retry read flag");

	    BIO_set_retry_read(bio);
	}
    }
    return (int)ret;
}

/* Called by SSL_read()*/
static int BioRead(BIO *bio, char *buf, int bufLen) {
    Tcl_Channel chan;
    Tcl_Size ret = 0;
    int tclEofChan, tclErrno;

    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

    dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);

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

    ret = Tcl_ReadRaw(chan, buf, (Tcl_Size)bufLen);

    tclEofChan = Tcl_Eof(chan);
    tclErrno = Tcl_GetErrno();

    dprintf("[chan=%p] BioRead(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
	    chan, bufLen, ret, tclEofChan, tclErrno);

    BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;
    } else if (ret == 0) {
	dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0");
	dprintf("Setting retry read flag");
	BIO_set_retry_read(bio);
    } else if (ret < 0) {
	dprintf("We got some kind of I/O error");

	if (tclErrno == EAGAIN) {
	    dprintf("It's EAGAIN");
	} else {
	    dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
	}
    } else {
	dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret);
    }

    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_write(bio)) {
	    dprintf("Setting should retry write flag");

	    BIO_set_retry_write(bio);
	}
    }

    dprintf("BioRead(%p, <buf>, %d) [%p] returning %" TCL_SIZE_MODIFIER "d",
	    bio, bufLen, (void *) chan, ret);

    return (int)ret;
}

static int BioPuts(BIO *bio, const char *str) {
    dprintf("BioPuts(%p, <string:%p>) called", bio, str);

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

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
    Tcl_Channel chan;
    long ret = 1;

    chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

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

    switch (cmd) {
	case BIO_CTRL_RESET:
		dprintf("Got BIO_CTRL_RESET");
		ret = 0;
		break;
	case BIO_C_FILE_SEEK:
		dprintf("Got BIO_C_FILE_SEEK");
		ret = 0;
		break;
	case BIO_C_FILE_TELL:
		dprintf("Got BIO_C_FILE_TELL");
		ret = 0;
		break;
	case BIO_CTRL_INFO:
		dprintf("Got BIO_CTRL_INFO");
		ret = 1;
		break;
	case BIO_C_SET_FD:
		dprintf("Unsupported call: BIO_C_SET_FD");
		ret = -1;
		break;
	case BIO_C_GET_FD:
		dprintf("Unsupported call: BIO_C_GET_FD");
		ret = -1;
		break;
	case BIO_CTRL_GET_CLOSE:
		dprintf("Got BIO_CTRL_CLOSE");
		ret = BIO_get_shutdown(bio);
		break;
	case BIO_CTRL_SET_CLOSE:
		dprintf("Got BIO_SET_CLOSE");
		BIO_set_shutdown(bio, num);
		break;
	case BIO_CTRL_EOF:
		dprintf("Got BIO_CTRL_EOF");
		ret = ((chan) ? Tcl_Eof(chan) : 1);
		break;
	case BIO_CTRL_PENDING:
		dprintf("Got BIO_CTRL_PENDING");
		ret = ((chan) ? ((Tcl_InputBuffered(chan) ? 1 : 0)) : 0);
		dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
		break;
	case BIO_CTRL_WPENDING:
		dprintf("Got BIO_CTRL_WPENDING");
		ret = 0;
		break;
	case BIO_CTRL_DUP:
		dprintf("Got BIO_CTRL_DUP");
		break;
	case BIO_CTRL_FLUSH:
		dprintf("Got BIO_CTRL_FLUSH");
		ret = ((chan) && (Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
		dprintf("BIO_CTRL_FLUSH returning value %li", ret);
		break;
#ifdef BIO_CTRL_PUSH
	case BIO_CTRL_PUSH:
		dprintf("Got BIO_CTRL_PUSH");
		ret = 0;
		break;
#endif
#ifdef BIO_CTRL_POP
	case BIO_CTRL_POP:
		dprintf("Got BIO_CTRL_POP");
		ret = 0;
		break;
#endif
#ifdef BIO_CTRL_SET
	case BIO_CTRL_SET:
		dprintf("Got BIO_CTRL_SET");
		ret = 0;
		break;
#endif
#ifdef BIO_CTRL_GET
	case BIO_CTRL_GET :
		dprintf("Got BIO_CTRL_GET ");
		ret = 0;
		break;
#endif
#ifdef BIO_CTRL_GET_KTLS_SEND
	case BIO_CTRL_GET_KTLS_SEND:
		dprintf("Got BIO_CTRL_GET_KTLS_SEND");
		ret = 0;
		break;
#endif
#ifdef BIO_CTRL_GET_KTLS_RECV
	case BIO_CTRL_GET_KTLS_RECV:
		dprintf("Got BIO_CTRL_GET_KTLS_RECV");
		ret = 0;
		break;
#endif
	default:
		dprintf("Got unknown control command (%i)", cmd);
		ret = -2;
		break;
    }
    return ret;
}

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

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

static int BioFree(BIO *bio) {
    if (bio == NULL) {
	return(0);
    }

    dprintf("BioFree(%p) called", bio);

    if (BIO_get_shutdown(bio)) {
	if (BIO_get_init(bio)) {
	    /*shutdown(bio->num, 2) */
	    /*closesocket(bio->num) */
	}

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

BIO *BIO_new_tcl(
    State *statePtr,
    int flags)
{
    BIO *bio;
    static BIO_METHOD *BioMethods = NULL;
#ifdef TCLTLS_SSL_USE_FASTPATH
    Tcl_Channel parentChannel;
    const Tcl_ChannelType *parentChannelType;
    void *parentChannelFdIn_p, *parentChannelFdOut_p;
    int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
    int validParentChannelFd;
    int tclGetChannelHandleRet;
#endif

    dprintf("BIO_new_tcl() called");

    if (BioMethods == NULL) {
	BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl");
	BIO_meth_set_write(BioMethods, BioWrite);
	BIO_meth_set_read(BioMethods, BioRead);
	BIO_meth_set_puts(BioMethods, BioPuts);
	BIO_meth_set_ctrl(BioMethods, BioCtrl);
	BIO_meth_set_create(BioMethods, BioNew);
	BIO_meth_set_destroy(BioMethods, BioFree);
    }

    if (statePtr == NULL) {
	dprintf("Asked to setup a NULL state, just creating the initial configuration");

	return(NULL);
    }

#ifdef TCLTLS_SSL_USE_FASTPATH
    /*
     * If the channel can be mapped back to a file descriptor, just use the file descriptor
     * with the SSL library since it will likely be optimized for this.
     */
    parentChannel = Tls_GetParent(statePtr, 0);
    parentChannelType = Tcl_GetChannelType(parentChannel);

    validParentChannelFd = 0;
    if (strcmp(parentChannelType->typeName, "tcp") == 0) {
	tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, &parentChannelFdIn_p);
	if (tclGetChannelHandleRet == TCL_OK) {
	    tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, &parentChannelFdOut_p);
	    if (tclGetChannelHandleRet == TCL_OK) {
		parentChannelFdIn = PTR2INT(parentChannelFdIn_p);
		parentChannelFdOut = PTR2INT(parentChannelFdOut_p);
		if (parentChannelFdIn == parentChannelFdOut) {
		    parentChannelFd = parentChannelFdIn;
		    validParentChannelFd = 1;
		}
	    }
	}
    }

    if (validParentChannelFd) {
	dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn);
	bio = BIO_new_socket(parentChannelFd, flags);
	statePtr->flags |= TLS_TCL_FASTPATH;
	return(bio);
    }

    dprintf("Falling back to Tcl I/O for this channel");
#endif

    bio = BIO_new(BioMethods);
    BIO_set_data(bio, statePtr);
    BIO_set_shutdown(bio, flags);
    BIO_set_init(bio, 1);
    return(bio);
}

Added generic/tlsIO.c version [dc77fddc45].





































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
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
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
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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 * Copyright (C) 2000 Ajuba Solutions
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), 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)
 *
 */

#include "tlsInt.h"

/*
 * Forward declarations
 */
static void TlsChannelHandlerTimer(void *clientData);

/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes
 *
 * Results:
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *    Sets the device into blocking or nonblocking mode.
 *
 *-------------------------------------------------------------------
 */
static int TlsBlockModeProc(void *instanceData, int mode) {
    State *statePtr = (State *)instanceData;

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

/*
 *-------------------------------------------------------------------
 *
 * TlsClose2Proc --
 *
 *    This procedure is invoked by the generic IO level to perform
 *    channel-type-specific cleanup when a SSL socket based channel
 *    is closed.
 *
 *    Note: we leave the underlying socket alone, is this right?
 *
 * Results:
 *    0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *    Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
#if TCL_MAJOR_VERSION > 8
#   define TlsCloseProc NULL /* No longer neccessary in Tcl 9 */
#else
static int TlsCloseProc(
    void *instanceData,
    TCL_UNUSED(Tcl_Interp *))
{
    State *statePtr = (State *)instanceData;

    dprintf("TlsCloseProc(%p)", statePtr);

    Tls_Clean(statePtr);
    Tcl_EventuallyFree(statePtr, Tls_Free);
    return TCL_OK;
}
#endif

static int TlsClose2Proc(
    void *instanceData,    /* The socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    int flags)			/* Flags to close read and/or write side of channel */
{
    State *statePtr = (State *)instanceData;

    dprintf("TlsClose2Proc(%p)", statePtr);

    if ((flags&(TCL_CLOSE_READ|TCL_CLOSE_WRITE))) {
	return EINVAL;
    }
    Tls_Clean(statePtr);
    Tcl_EventuallyFree(statePtr, Tls_Free);
    return TCL_OK;
}

/*
 *------------------------------------------------------*
 *
 * Tls_WaitForConnect --
 *
 * Result:
 *    0 if successful, -1 if failed.
 *
 * Side effects:
 *    Issues SSL_accept or SSL_connect
 *
 *------------------------------------------------------*
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
    unsigned long backingError;
    int err, rc;
    int bioShouldRetry;

    dprintf("WaitForConnect(%p)", statePtr);
    dprintFlags(statePtr);

    if (!(statePtr->flags & TLS_TCL_INIT)) {
	dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
	*errorCodePtr = 0;
	return 0;
    }

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
	/*
	 * 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 (;;) {
	/* Not initialized yet! */
	if (statePtr->flags & TLS_TCL_SERVER) {
	    dprintf("Calling SSL_accept()");
	    err = SSL_accept(statePtr->ssl);
	} else {
	    dprintf("Calling SSL_connect()");
	    err = SSL_connect(statePtr->ssl);
	}

	if (err > 0) {
	    dprintf("That seems to have gone okay");

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

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

	dprintf("Got error: %i (rc = %i)", err, rc);

	bioShouldRetry = 0;
	if (err <= 0) {
	    if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
		bioShouldRetry = 1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		bioShouldRetry = 1;
	    } else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
		bioShouldRetry = 1;
	    }
	} else {
	    if (!SSL_is_init_finished(statePtr->ssl)) {
		bioShouldRetry = 1;
	    }
	}

	if (bioShouldRetry) {
	    dprintf("The I/O did not complete -- but we should try it again");

	    if (statePtr->flags & TLS_TCL_ASYNC) {
		dprintf("Returning EAGAIN so that it can be retried later");
		*errorCodePtr = EAGAIN;
		return -1;
	    } else {
		dprintf("Doing so now");
		continue;
	    }
	}

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


    *errorCodePtr = EINVAL;

    switch (rc) {
	case SSL_ERROR_NONE:
	    /* The connection is up, we are done here */
	    dprintf("The connection is up");
	    break;
	case SSL_ERROR_ZERO_RETURN:
	    dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...")
	    return -1;
	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

	    if (backingError == 0 && err == 0) {
		dprintf("EOF reached")
		*errorCodePtr = ECONNRESET;
	    } 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;
		}
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		if (*errorCodePtr == ECONNRESET) {
		    *errorCodePtr = ECONNABORTED;
		}
		}

		statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		return -1;
	case SSL_ERROR_SSL:
	    dprintf("Got permanent fatal SSL error, aborting immediately");
		Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return -1;
	default:
	    dprintf("We got a confusing reply: %i", rc);
	    *errorCodePtr = Tcl_GetErrno();
	    dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
	    return -1;
    }

#if 0
    if (statePtr->flags & TLS_TCL_SERVER) {
	dprintf("This is an TLS server, checking the certificate for the peer");

	err = SSL_get_verify_result(statePtr->ssl);
	if (err != X509_V_OK) {
		dprintf("Invalid certificate, returning in failure");

		Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
		statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
		*errorCodePtr = ECONNABORTED;
		return -1;
	}
    }
#endif

    dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
    statePtr->flags &= ~TLS_TCL_INIT;

    dprintf("Returning in success");
    *errorCodePtr = 0;
    return 0;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to read input from a SSL socket based channel.
 *
 * 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.
 *
 * Side effects:
 *    Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsInputProc(
    void *instanceData,
    char *buf,
    int bufSize,
    int *errorCodePtr)
{
    unsigned long backingError;
    State *statePtr = (State *)instanceData;
    int bytesRead;
    int tlsConnect;
    int err;

    *errorCodePtr = 0;

    dprintf("BIO_read(%d)", bufSize);

    if (statePtr->flags & TLS_TCL_CALLBACK) {
	/* don't process any bytes while verify callback is running */
	dprintf("Callback is running, reading 0 bytes");
	return 0;
    }

    dprintf("Calling Tls_WaitForConnect");
    tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
    if (tlsConnect < 0) {
	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;
	}
	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
     * correctly.  Similar fix in TlsOutputProc. - hobbs
     */
    ERR_clear_error();
    bytesRead = BIO_read(statePtr->bio, buf, bufSize);
    dprintf("BIO_read -> %d", bytesRead);

    err = SSL_get_error(statePtr->ssl, bytesRead);

#if 0
    if (bytesRead <= 0) {
	if (BIO_should_retry(statePtr->bio)) {
	    dprintf("I/O failed, will retry based on EAGAIN");
	    *errorCodePtr = EAGAIN;
	}
    }
#endif

    switch (err) {
	case SSL_ERROR_NONE:
	    dprintBuffer(buf, bytesRead);
	    break;
	case SSL_ERROR_SSL:
	    dprintf("SSL negotiation error, indicating that the connection has been aborted");

	    Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
	    *errorCodePtr = ECONNABORTED;
	    bytesRead = -1;

	    break;
	case SSL_ERROR_SYSCALL:
		backingError = ERR_get_error();

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

		break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
			bytesRead = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
			bytesRead = -1;
			*errorCodePtr = EAGAIN;
			break;
		default:
			dprintf("Unknown error (err = %i), mapping to EOF", err);
		*errorCodePtr = 0;
		bytesRead = 0;
		break;
    }

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

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *    This procedure is invoked by the generic IO level
 *       to write output to a SSL socket based channel.
 *
 * 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.
 *
 * Side effects:
 *    Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsOutputProc(
    void *instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    unsigned long backingError;
    State *statePtr = (State *)instanceData;
    int written, err;
    int tlsConnect;

    *errorCodePtr = 0;

    dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
    dprintBuffer(buf, toWrite);

    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Don't process output while callbacks are running");
	written = -1;
	*errorCodePtr = EAGAIN;
	return -1;
    }

    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;
	}
	return written;
    }

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

	if (err <= 0) {
	    dprintf("Flushing failed");

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

	written = 0;
	*errorCodePtr = 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
     * work correctly.  Similar fix in TlsInputProc. - hobbs
     */
    ERR_clear_error();
    written = BIO_write(statePtr->bio, buf, toWrite);
    dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);

    err = SSL_get_error(statePtr->ssl, written);
    switch (err) {
	case SSL_ERROR_NONE:
	    if (written < 0) {
		written = 0;
	    }
	    break;
	case SSL_ERROR_WANT_WRITE:
	    dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
	    *errorCodePtr = EAGAIN;
	    written = -1;
	    break;
	case SSL_ERROR_WANT_READ:
	    dprintf(" write R BLOCK");
	    break;
	case SSL_ERROR_WANT_X509_LOOKUP:
	    dprintf(" write X BLOCK");
	    break;
	case SSL_ERROR_ZERO_RETURN:
	    dprintf(" closed");
	    written = 0;
	    *errorCodePtr = 0;
	    break;
	case SSL_ERROR_SYSCALL:
	    backingError = ERR_get_error();

	    if (backingError == 0 && written == 0) {
		dprintf("EOF reached")
		*errorCodePtr = 0;
		written = 0;
	    } else if (backingError == 0 && written == -1) {
		dprintf("I/O error occurred (errno = %lu)", (unsigned long) Tcl_GetErrno());
		*errorCodePtr = Tcl_GetErrno();
		written = -1;
	    } else {
		dprintf("I/O error occurred (backingError = %lu)", backingError);
		*errorCodePtr = backingError;
		written = -1;
	    }
	    break;
	case SSL_ERROR_SSL:
	    Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
	    *errorCodePtr = ECONNABORTED;
	    written = -1;
	    break;
	default:
	    dprintf("unknown error: %d", err);
	    break;
    }

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

/*
 *-------------------------------------------------------------------
 *
 * TlsSetOptionProc --
 *
 *    Sets an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * Results:
 *    TCL_OK if successful or TCL_ERROR if failed.
 *
 * Side effects:
 *    Updates channel option to new value.
 *
 *-------------------------------------------------------------------
 */
static int
TlsSetOptionProc(void *instanceData,    /* Socket state. */
    Tcl_Interp *interp,		/* For errors - can be NULL. */
    const char *optionName,	/* Name of the option to set the value for, or
				 * NULL to get all options and their values. */
    const char *optionValue)	/* Value for option. */
{
    State *statePtr = (State *)instanceData;

    Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverSetOptionProc *setOptionProc;

    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
    if (setOptionProc != NULL) {
	return (*setOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, optionValue);
    } else if (optionName == (char*) NULL) {
	/*
	 * Request is query for all options, this is ok.
	 */
	return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return Tcl_BadChannelOption(interp, optionName, "");
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *    Gets an option value for a SSL socket based channel, or a
 *    list of all options and their values.
 *
 * 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.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(
    void *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 downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
    Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
	return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, optionValue);
    } else if (optionName == (char*) NULL) {
	/*
	 * Request is query for all options, this is ok.
	 */
	return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return Tcl_BadChannelOption(interp, optionName, "");
}

/*
 *-------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
 *    Initialize the notifier to watch Tcl_Files from this channel.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Sets up the notifier so that a future event on the channel
 *    will be seen by Tcl.
 *
 *-------------------------------------------------------------------
 */

static void
TlsWatchProc(
    void *instanceData,    /* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
{
    Tcl_Channel     downChan;
    State *statePtr = (State *)instanceData;

    dprintf("TlsWatchProc(0x%x)", mask);

    /* Pretend to be dead as long as the verify callback is running.
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Callback is on-going, doing nothing");
	return;
    }

    dprintFlags(statePtr);

    downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);

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

	Tcl_GetChannelType(downChan)->watchProc(Tcl_GetChannelInstanceData(downChan), 0);
	statePtr->watchMask = 0;
	return;
    }

    statePtr->watchMask = mask;

    /* No channel handlers any more. We will be notified automatically
     * about events on the channel below via a call to our
     * 'TransformNotifyProc'. But we have to pass the interest down now.
     * We are allowed to add additional 'interest' to the mask if we want
     * to. But this transformation has no such interest. It just passes
     * the request down, unchanged.
     */
    dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
    Tcl_GetChannelType(downChan)->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

    /*
     * Management of the internal timer.
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	dprintf("A timer was found, deleting it");
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    if ((mask & TCL_READABLE) &&
	((Tcl_InputBuffered(statePtr->self) > 0) || (BIO_ctrl_pending(statePtr->bio) > 0))) {
	/*
	 * There is interest in readable events and we actually have
	 * data waiting, so generate a timer to flush that.
	 */
	dprintf("Creating a new timer since data appears to be waiting");
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, statePtr);
    }
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
 *    Called from Tcl_GetChannelFile to retrieve o/s file handler
 *    from the SSL socket based channel.
 *
 * Results:
 *    The appropriate Tcl_File handle or NULL if none.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------
 */
static int TlsGetHandleProc(
    void *instanceData,    /* Socket state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    void **handlePtr)	/* Handle associated with the channel */
{
    State *statePtr = (State *)instanceData;

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

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *    Handler called by Tcl to inform us of activity
 *    on the underlying channel.
 *
 * Results:
 *    Type of event or 0 if failed
 *
 * Side effects:
 *    May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */

static int TlsNotifyProc(
    void *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;

    /*
     * An event occurred in the underlying channel.  This
     * transformation doesn't process such events thus returns the
     * incoming mask unchanged.
     */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	/*
	 * 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 WatchProc).
	 */
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    if (statePtr->flags & TLS_TCL_CALLBACK) {
	dprintf("Returning 0 due to callback");
	return 0;
    }

    dprintf("Calling Tls_WaitForConnect");
    errorCode = 0;
    if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
	if (errorCode == EAGAIN) {
	    dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");

	    return 0;
	}

	dprintf("Tls_WaitForConnect returned an error");
    }

    dprintf("Returning %i", mask);

    return mask;
}

/*
 *------------------------------------------------------*
 *
 *    TlsChannelHandlerTimer --
 *
 *    ------------------------------------------------*
 *    Called by the notifier (-> timer) to flush out
 *    information waiting in channel buffers.
 *    ------------------------------------------------*
 *
 *    Side effects:
 *        As of 'TlsChannelHandler'.
 *
 *    Result:
 *        None.
 *
 *------------------------------------------------------*
 */
static void TlsChannelHandlerTimer(void *clientData) {
    State *statePtr = (State *)clientData;
    int mask = 0;

    dprintf("Called");

    statePtr->timer = (Tcl_TimerToken) NULL;

    if (BIO_wpending(statePtr->bio)) {
	dprintf("[chan=%p] BIO writable", statePtr->self);

	mask |= TCL_WRITABLE;
    }

    if (BIO_pending(statePtr->bio)) {
	dprintf("[chan=%p] BIO readable", statePtr->self);

	mask |= TCL_READABLE;
    }

    dprintf("Notifying ourselves");
    Tcl_NotifyChannel(statePtr->self, mask);

    dprintf("Returning");

    return;
}

Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) {
    dprintf("Requested to get parent of channel %p", statePtr->self);

    if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) {
	dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL");
	return NULL;
    }
    return Tcl_GetStackedChannel(statePtr->self);
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *    Return the correct TLS channel driver info
 *
 * Results:
 *    The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *    None.
 *
 *-------------------------------------------------------------------
 */
static const Tcl_ChannelType tlsChannelType = {
    "tls",			/* Type name */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TlsCloseProc,		/* Close proc */
    TlsInputProc,		/* Input proc */
    TlsOutputProc,		/* Output proc */
    0,			/* Seek proc */
    TlsSetOptionProc,		/* Set option proc */
    TlsGetOptionProc,		/* Get option proc */
    TlsWatchProc,		/* Initialize notifier */
    TlsGetHandleProc,		/* Get OS handles out of channel */
    TlsClose2Proc,		/* close2proc */
    TlsBlockModeProc,		/* Set blocking/nonblocking mode*/
    0,			/* Flush proc */
    TlsNotifyProc,		/* Handling of events bubbling up */
    0,			/* Wide seek proc */
    NULL,			/* Thread action */
    NULL			/* Truncate */
};

const Tcl_ChannelType *Tls_ChannelType(void) {
    return &tlsChannelType;
}

Added generic/tlsInt.h version [0ebd67e10b].


























































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), 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)
 *
 */
#ifndef _TLSINT_H
#define _TLSINT_H

#include "tls.h"
#include <errno.h>
#include <string.h>
#include <stdint.h>

#ifdef _WIN32
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <wincrypt.h> /* OpenSSL needs this on Windows */
#endif

#ifdef NO_PATENTS
#  define NO_IDEA
#  define NO_RC2
#  define NO_RC4
#  define NO_RC5
#  define NO_RSA
#endif

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

/*
 * Determine if we should use the pre-OpenSSL 1.1.0 API
 */
#undef TCLTLS_OPENSSL_PRE_1_1
#if defined(LIBRESSL_VERSION_NUMBER)
#  define TCLTLS_OPENSSL_PRE_1_1_API 1
#endif

#ifndef ECONNABORTED
#define ECONNABORTED	130	/* Software caused connection abort */
#endif
#ifndef ECONNRESET
#define ECONNRESET	131	/* Connection reset by peer */
#endif

#ifdef TCLEXT_TCLTLS_DEBUG
#include <ctype.h>
#define dprintf(...) { \
	char dprintfBuffer[8192], *dprintfBuffer_p; \
	dprintfBuffer_p = &dprintfBuffer[0]; \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \
	dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \
	fprintf(stderr, "%s\n", dprintfBuffer); \
}
#define dprintBuffer(bufferName, bufferLength) { \
	int dprintBufferIdx; \
	unsigned char dprintBufferChar; \
	fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \
	for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \
		dprintBufferChar = bufferName[dprintBufferIdx]; \
		if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \
			fprintf(stderr, "'%c' ", dprintBufferChar); \
		} else { \
			fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \
		}; \
	}; \
	fprintf(stderr, "}\n"); \
}
#define dprintFlags(statePtr) { \
	char dprintfBuffer[8192], *dprintfBuffer_p; \
	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_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) /**/
#endif

#define TCLTLS_SSL_ERROR(ssl,err) ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err))))
#define GET_ERR_REASON()	ERR_reason_error_string(ERR_get_error())

/* Common list append macros */
#define LAPPEND_BARRAY(interp, obj, text, value, size) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewByteArrayObj(value, size)); \
}
#define LAPPEND_STR(interp, obj, text, value, size) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(value, size)); \
}
#define LAPPEND_INT(interp, obj, text, value) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewWideIntObj(value)); \
}
#define LAPPEND_BOOL(interp, obj, text, value) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewBooleanObj(value)); \
}
#define LAPPEND_OBJ(interp, obj, text, listObj) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, listObj); \
}

/*
 * OpenSSL BIO Routines
 */
#define BIO_TYPE_TCL	(19|0x0400)

/*
 * 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
                                         * further I/O will result in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH 	(1<<6)	/* The parent channel is being used directly by the SSL library */
#define TLS_TCL_DELAY (5)

/*
 * This structure describes the per-instance state of an SSL channel.
 *
 * The SSL processing context is maintained here, in the ClientData
 */
typedef struct State {
	Tcl_Channel self;	/* this socket channel */
	Tcl_TimerToken timer;

	int flags;		/* see State.flags above  */
	int watchMask;		/* current WatchProc mask */
	int mode;		/* current mode of parent channel */

	Tcl_Interp *interp;	/* interpreter in which this resides */
	Tcl_Obj *callback;	/* script called for tracing, info, and errors */
	Tcl_Obj *password;	/* script called for certificate password */

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

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

#ifndef JOIN
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
#endif

#ifndef TCL_UNUSED
# if defined(__cplusplus)
#   define TCL_UNUSED(T) T
# elif defined(__GNUC__) && (__GNUC__ > 2)
#   define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
# else
#   define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
# endif
#endif

#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) && !defined(TCL_SIZE_MODIFIER)
#   define TCL_SIZE_MODIFIER ""
#endif

/*
 * 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);
void            Tls_Error(State *statePtr, char *msg);
#if TCL_MAJOR_VERSION > 8
void            Tls_Free(void *blockPtr);
#else
void            Tls_Free(char *blockPtr);
#endif
void            Tls_Clean(State *statePtr);
int             Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);

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

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

#endif /* _TLSINT_H */

Added generic/tlsX509.c version [54cb39143a].

































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Copyright (C) 1997-2000 Sensus Consulting Ltd.
 * Matt Newman <[email protected]>
 * Copyright (C) 2023 Brian O'Hagan
 */
#include "tlsInt.h"

/* Define maximum certificate size. Max PEM size 100kB and DER size is 24kB. */
#define CERT_STR_SIZE 32768

/*
 *  Ensure these are not macros - known to be defined on Win32
 */
#ifdef min
#undef min
#endif

#ifdef max
#undef max
#endif

static int min(int a, int b)
{
    return (a < b) ? a : b;
}

static int max(int a, int b)
{
    return (a > b) ? a : b;
}

/*
 * ASN1_UTCTIME_tostr --
 */
static char *
ASN1_UTCTIME_tostr(ASN1_UTCTIME *tm)
{
    static char bp[128];
    char *v;
    int gmt=0;
    static char *mon[12]={
	"Jan","Feb","Mar","Apr","May","Jun",
	"Jul","Aug","Sep","Oct","Nov","Dec"};
    int i;
    int y=0,M=0,d=0,h=0,m=0,s=0;

    i=tm->length;
    v=(char *)tm->data;

    if (i < 10) goto err;
    if (v[i-1] == 'Z') gmt=1;
    for (i=0; i<10; i++)
	if ((v[i] > '9') || (v[i] < '0')) goto err;
    y= (v[0]-'0')*10+(v[1]-'0');
    if (y < 70) y+=100;
    M= (v[2]-'0')*10+(v[3]-'0');
    if ((M > 12) || (M < 1)) goto err;
    d= (v[4]-'0')*10+(v[5]-'0');
    h= (v[6]-'0')*10+(v[7]-'0');
    m=  (v[8]-'0')*10+(v[9]-'0');
    if (	(v[10] >= '0') && (v[10] <= '9') &&
		(v[11] >= '0') && (v[11] <= '9'))
	s=  (v[10]-'0')*10+(v[11]-'0');

    sprintf(bp,"%s %2d %02d:%02d:%02d %d%s",
		   mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":"");
    return bp;
 err:
    return "Bad time value";
}

/*
 *------------------------------------------------------*
 *
 *	Tls_NewX509Obj --
 *
 *	------------------------------------------------*
 *	Converts a X509 certificate into a Tcl_Obj
 *	------------------------------------------------*
 *
 *	Side effects:
 *		None
 *
 *	Result:
 *		A Tcl List Object representing the provided
 *		X509 certificate.
 *
 *------------------------------------------------------*
 */

Tcl_Obj*
Tls_NewX509Obj(
    Tcl_Interp *interp,
    X509 *cert)
{
    Tcl_Obj *certPtr = Tcl_NewListObj(0, NULL);
    BIO *bio;
    int n;
    unsigned long flags;
    char subject[BUFSIZ];
    char issuer[BUFSIZ];
    char serial[BUFSIZ];
    char notBefore[BUFSIZ];
    char notAfter[BUFSIZ];
    char certStr[CERT_STR_SIZE], *certStr_p;
    int certStr_len, toRead;
#ifndef NO_SSL_SHA
    int shai;
    char sha_hash_ascii[SHA_DIGEST_LENGTH * 2 + 1];
    unsigned char sha_hash_binary[SHA_DIGEST_LENGTH];
    const char *shachars="0123456789ABCDEF";

    sha_hash_ascii[SHA_DIGEST_LENGTH * 2] = '\0';
#endif

    certStr[0] = 0;
    if ((bio = BIO_new(BIO_s_mem())) == NULL) {
	subject[0] = 0;
	issuer[0]  = 0;
	serial[0]  = 0;
    } else {
	flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
	flags &= ~ASN1_STRFLGS_ESC_MSB;

	X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags);
	n = BIO_read(bio, subject, min(BIO_pending(bio), BUFSIZ - 1));
	n = max(n, 0);
	subject[n] = 0;
	(void)BIO_flush(bio);

	X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags);
	n = BIO_read(bio, issuer, min(BIO_pending(bio), BUFSIZ - 1));
	n = max(n, 0);
	issuer[n] = 0;
	(void)BIO_flush(bio);

	i2a_ASN1_INTEGER(bio, X509_get_serialNumber(cert));
	n = BIO_read(bio, serial, min(BIO_pending(bio), BUFSIZ - 1));
	n = max(n, 0);
	serial[n] = 0;
	(void)BIO_flush(bio);

	if (PEM_write_bio_X509(bio, cert)) {
	    certStr_p = certStr;
	    certStr_len = 0;
	    while (1) {
		toRead = min(BIO_pending(bio), CERT_STR_SIZE - certStr_len - 1);
		toRead = min(toRead, BUFSIZ);
		if (toRead == 0) {
		    break;
		}
		dprintf("Reading %i bytes from the certificate...", toRead);
		n = BIO_read(bio, certStr_p, toRead);
		if (n <= 0) {
		    break;
		}
		certStr_len += n;
		certStr_p   += n;
	    }
	    *certStr_p = '\0';
	    (void)BIO_flush(bio);
	}

	BIO_free(bio);
    }

    strcpy( notBefore, ASN1_UTCTIME_tostr( X509_get_notBefore(cert) ));
    strcpy( notAfter, ASN1_UTCTIME_tostr( X509_get_notAfter(cert) ));

#ifndef NO_SSL_SHA
    X509_digest(cert, EVP_sha1(), sha_hash_binary, NULL);
    for (shai = 0; shai < SHA_DIGEST_LENGTH; shai++) {
	sha_hash_ascii[shai * 2]     = shachars[(sha_hash_binary[shai] & 0xF0) >> 4];
	sha_hash_ascii[shai * 2 + 1] = shachars[(sha_hash_binary[shai] & 0x0F)];
    }
    LAPPEND_STR(interp, certPtr, "sha1_hash", sha_hash_ascii, SHA_DIGEST_LENGTH * 2);

#endif
    LAPPEND_STR(interp, certPtr, "subject", subject, -1);

    LAPPEND_STR(interp, certPtr, "issuer", issuer, -1);

    LAPPEND_STR(interp, certPtr, "notBefore", notBefore, -1);

    LAPPEND_STR(interp, certPtr, "notAfter", notAfter, -1);

    LAPPEND_STR(interp, certPtr, "serial", serial, -1);

    LAPPEND_STR(interp, certPtr, "certificate", certStr, -1);

    return certPtr;
}

Added library/tls.tcl version [ebe93438e0].















































































































































































































































































































































































































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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#
# Copyright (C) 1997-2000 Matt Newman <[email protected]>
#
namespace eval tls {
    variable logcmd tclLog
    variable debug 0

    # Default flags passed to tls::import
    variable defaults {}

    # Maps UID to Server Socket
    variable srvmap
    variable srvuid 0

    # Over-ride this if you are using a different socket command
    variable socketCmd
    if {![info exists socketCmd]} {
        set socketCmd [info command ::socket]
    }

    # This is the possible arguments to tls::socket and tls::init
    # The format of this is a list of lists
    ## Each inner list contains the following elements
    ### Server (matched against "string match" for 0/1)
    ### Option name
    ### Variable to add the option to:
    #### sopts: [socket] option
    #### iopts: [tls::import] option
    ### How many arguments the following the option to consume
    variable socketOptionRules {
        {0 -async sopts 0}
        {* -myaddr sopts 1}
        {0 -myport sopts 1}
        {* -type sopts 1}
        {* -cadir iopts 1}
        {* -cafile iopts 1}
        {* -cert iopts 1}
        {* -certfile iopts 1}
        {* -cipher iopts 1}
        {* -command iopts 1}
        {* -dhparams iopts 1}
        {* -key iopts 1}
        {* -keyfile iopts 1}
        {* -password iopts 1}
        {* -request iopts 1}
        {* -require iopts 1}
        {* -autoservername discardOpts 1}
        {* -servername iopts 1}
        {* -ssl2 iopts 1}
        {* -ssl3 iopts 1}
        {* -tls1 iopts 1}
        {* -tls1.1 iopts 1}
        {* -tls1.2 iopts 1}
        {* -tls1.3 iopts 1}
    }

    # tls::socket and tls::init options as a humane readable string
    variable socketOptionsNoServer
    variable socketOptionsServer

    # Internal [switch] body to validate options
    variable socketOptionsSwitchBody
}

proc tls::_initsocketoptions {} {
    variable socketOptionRules
    variable socketOptionsNoServer
    variable socketOptionsServer
    variable socketOptionsSwitchBody

    # Do not re-run if we have already been initialized
    if {[info exists socketOptionsSwitchBody]} {
        return
    }

    # Create several structures from our list of options
    ## 1. options: a text representation of the valid options for the current
    ##             server type
    ## 2. argSwitchBody: Switch body for processing arguments
    set options(0) [list]
    set options(1) [list]
    set argSwitchBody [list]
    foreach optionRule $socketOptionRules {
        set ruleServer [lindex $optionRule 0]
        set ruleOption [lindex $optionRule 1]
        set ruleVarToUpdate [lindex $optionRule 2]
        set ruleVarArgsToConsume [lindex $optionRule 3]

        foreach server [list 0 1] {
            if {![string match $ruleServer $server]} {
                continue
            }

            lappend options($server) $ruleOption
        }

        switch -- $ruleVarArgsToConsume {
            0 {
                set argToExecute {
                    lappend @VAR@ $arg
                    set argsArray($arg) true
                }
            }
            1 {
                set argToExecute {
                    incr idx
                    if {$idx >= [llength $args]} {
                        return -code error "\"$arg\" option must be followed by value"
                    }
                    set argValue [lindex $args $idx]
                    lappend @VAR@ $arg $argValue
                    set argsArray($arg) $argValue
                }
            }
            default {
                return -code error "Internal argument construction error"
            }
        }

        lappend argSwitchBody $ruleServer,$ruleOption [string map [list @VAR@ $ruleVarToUpdate] $argToExecute]
    }

    # Add in the final options
    lappend argSwitchBody {*,-*} {return -code error "bad option \"$arg\": must be one of $options"}
    lappend argSwitchBody default break

    # Set the final variables
    set socketOptionsNoServer   [join $options(0) {, }]
    set socketOptionsServer     [join $options(1) {, }]
    set socketOptionsSwitchBody $argSwitchBody
}

proc tls::initlib {dir dll} {
    # Package index cd's into the package directory for loading.
    # Irrelevant to unixoids, but for Windows this enables the OS to find
    # the dependent DLL's in the CWD, where they may be.
    set cwd [pwd]
    catch {cd $dir}
    if {[string equal $::tcl_platform(platform) "windows"] &&
	![string equal [lindex [file system $dir] 0] "native"]} {
	# If it is a wrapped executable running on windows, the openssl
	# dlls must be copied out of the virtual filesystem to the disk
	# where Windows will find them when resolving the dependency in
	# the tls dll. We choose to make them siblings of the executable.
	package require starkit
	set dst [file nativename [file dirname $starkit::topdir]]
	foreach sdll [glob -nocomplain -directory $dir -tails *eay32.dll] {
	    catch {file delete -force            $dst/$sdll}
	    catch {file copy   -force $dir/$sdll $dst/$sdll}
	}
    }
    set res [catch {uplevel #0 [list load [file join [pwd] $dll]]} err]
    catch {cd $cwd}
    if {$res} {
	namespace eval [namespace parent] {namespace delete tls}
	return -code $res $err
    }
    rename tls::initlib {}
}


#
# Backwards compatibility, also used to set the default
# context options
#
proc tls::init {args} {
    variable defaults
    variable socketOptionsNoServer
    variable socketOptionsServer
    variable socketOptionsSwitchBody

    tls::_initsocketoptions

    # Technically a third option should be used here: Options that are valid
    # only a both servers and non-servers
    set server -1
    set options $socketOptionsServer

    # Validate arguments passed
    set initialArgs $args
    set argc [llength $args]

    array set argsArray [list]
    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg $socketOptionsSwitchBody
    }

    set defaults $initialArgs
}
#
# Helper function - behaves exactly as the native socket command.
#
proc tls::socket {args} {
    variable socketCmd
    variable defaults
    variable socketOptionsNoServer
    variable socketOptionsServer
    variable socketOptionsSwitchBody

    tls::_initsocketoptions

    set idx [lsearch $args -server]
    if {$idx != -1} {
	set server 1
	set callback [lindex $args [expr {$idx+1}]]
	set args [lreplace $args $idx [expr {$idx+1}]]

	set usage "wrong # args: should be \"tls::socket -server command ?options? port\""
        set options $socketOptionsServer
    } else {
	set server 0

	set usage "wrong # args: should be \"tls::socket ?options? host port\""
        set options $socketOptionsNoServer
    }

    # Combine defaults with current options
    set args [concat $defaults $args]

    set argc [llength $args]
    set sopts {}
    set iopts [list -server $server]

    array set argsArray [list]
    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg $socketOptionsSwitchBody
    }

    if {$server} {
	if {($idx + 1) != $argc} {
	    return -code error $usage
	}
	set uid [incr ::tls::srvuid]

	set port [lindex $args [expr {$argc-1}]]
	lappend sopts $port
	#set sopts [linsert $sopts 0 -server $callback]
	set sopts [linsert $sopts 0 -server [list tls::_accept $iopts $callback]]
	#set sopts [linsert $sopts 0 -server [list tls::_accept $uid $callback]]
    } else {
	if {($idx + 2) != $argc} {
	    return -code error $usage
	}

	set host [lindex $args [expr {$argc-2}]]
	set port [lindex $args [expr {$argc-1}]]

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

	lappend sopts $host $port
    }
    #
    # Create TCP/IP socket
    #
    set chan [eval $socketCmd $sopts]
    if {!$server && [catch {
	#
	# Push SSL layer onto socket
	#
	eval [list tls::import] $chan $iopts
    } err]} {
	set info ${::errorInfo}
	catch {close $chan}
	return -code error -errorinfo $info $err
    }
    return $chan
}

# tls::_accept --
#
#   This is the actual accept that TLS sockets use, which then calls
#   the callback registered by tls::socket.
#
# Arguments:
#   iopts	tls::import opts
#   callback	server callback to invoke
#   chan	socket channel to accept/deny
#   ipaddr	calling IP address
#   port	calling port
#
# Results:
#   Returns an error if the callback throws one.
#
proc tls::_accept { iopts callback chan ipaddr port } {
    log 2 [list tls::_accept $iopts $callback $chan $ipaddr $port]

    set chan [eval [list tls::import $chan] $iopts]

    lappend callback $chan $ipaddr $port
    if {[catch {
	uplevel #0 $callback
    } err]} {
	log 1 "tls::_accept error: ${::errorInfo}"
	close $chan
	error $err $::errorInfo $::errorCode
    } else {
	log 2 "tls::_accept - called \"$callback\" succeeded"
    }
}
#
# Sample callback for hooking: -
#
# error
# verify
# info
#
proc tls::callback {option args} {
    variable debug

    #log 2 [concat $option $args]

    switch -- $option {
	"error"	{
	    foreach {chan msg} $args break

	    log 0 "TLS/$chan: error: $msg"
	}
	"verify"	{
	    # poor man's lassign
	    foreach {chan depth cert rc err} $args break

	    array set c $cert

	    if {$rc != "1"} {
		log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)"
	    } else {
		log 2 "TLS/$chan: verify/$depth: $c(subject)"
	    }
	    if {$debug > 0} {
		return 1;	# FORCE OK
	    } else {
		return $rc
	    }
	}
	"info"	{
	    # poor man's lassign
	    foreach {chan major minor state msg} $args break

	    if {$msg != ""} {
		append state ": $msg"
	    }
	    # For tracing
	    upvar #0 tls::$chan cb
	    set cb($major) $minor

	    log 2 "TLS/$chan: $major/$minor: $state"
	}
	default	{
	    return -code error "bad option \"$option\":\
		    must be one of error, info, or verify"
	}
    }
}

proc tls::xhandshake {chan} {
    upvar #0 tls::$chan cb

    if {[info exists cb(handshake)] && \
	$cb(handshake) == "done"} {
	return 1
    }
    while {1} {
	vwait tls::${chan}(handshake)
	if {![info exists cb(handshake)]} {
	    return 0
	}
	if {$cb(handshake) == "done"} {
	    return 1
	}
    }
}

proc tls::password {} {
    log 0 "TLS/Password: did you forget to set your passwd!"
    # Return the worlds best kept secret password.
    return "secret"
}

proc tls::log {level msg} {
    variable debug
    variable logcmd

    if {$level > $debug || $logcmd == ""} {
	return
    }
    set cmd $logcmd
    lappend cmd $msg
    uplevel #0 $cmd
}

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

23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38

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 
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. 
terms specified in this license.

Modified pkgIndex.tcl.in from [6c4c62dd82] to [4281cedefb].




1
2


3
4
5
6
7
8
9
10
11
12
13




















14
15
16
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
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-

# -*- tcl -*-
# Tcl package index file, version 1.1
#
if {[package vsatisfies [package present Tcl] 8.5]} {
	package ifneeded tls @PACKAGE_VERSION@ [list apply {{dir} {
if {[package vsatisfies [package provide Tcl] 9.0-]} {
    package ifneeded @PACKAGE_NAME@ @PACKAGE_VERSION@ \
		if {{@TCLEXT_BUILD@} eq "static"} {
			load {} Tls
		} else {
			load [file join $dir @EXTENSION_TARGET@] Tls
		}

		set tlsTclInitScript [file join $dir tls.tcl]
		if {[file exists $tlsTclInitScript]} {
			source $tlsTclInitScript
		}
	}} $dir]
	    [list load [file join $dir @PKG_LIB_FILE9@] [string totitle @PACKAGE_NAME@]]
    set initScript [file join $dir @[email protected]]
    if {[file exists $initScript]} {
	source -encoding utf-8 $initScript
    }
} else {
    if {![package vsatisfies [package provide Tcl] 8.5]} {return}
    package ifneeded @PACKAGE_NAME@ @PACKAGE_VERSION@ [list apply {{dir} {
	if {[string tolower [file extension @PKG_LIB_FILE8@]] in [list .dll .dylib .so]} {
	    # Load dynamic library
	    load [file join $dir @PKG_LIB_FILE8@] [string totitle @PACKAGE_NAME@]
	} else {
	    # Static library
	    load {} [string totitle @PACKAGE_NAME@]
	}
	set initScript [file join $dir @PACKAGE_NAME@.tcl]
	if {[file exists $initScript]} {
	    source -encoding utf-8 $initScript
	}
    }} $dir]
} elseif {[package vsatisfies [package present Tcl] 8.4]} {
	package ifneeded tls @PACKAGE_VERSION@ [list load [file join $dir @EXTENSION_TARGET@] Tls]
}

Deleted tclOpts.h version [1a6cf1121d].

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


























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 *  Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Stylized option processing - requires consitent
 * external vars: opt, idx, objc, objv
 */
#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPT_PROLOG(option)			\
    if (strcmp(opt, (option)) == 0) {		\
	if (++idx >= objc) {			\
	    Tcl_AppendResult(interp,		\
		"no argument given for ",	\
		(option), " option",		\
		(char *) NULL);			\
	    return TCL_ERROR;			\
	}
#define OPT_POSTLOG()				\
	continue;				\
    }
#define OPTOBJ(option, var)			\
    OPT_PROLOG(option)				\
    var = objv[idx];				\
    OPT_POSTLOG()

#define OPTSTR(option, var)			\
    OPT_PROLOG(option)				\
    var = Tcl_GetStringFromObj(objv[idx], NULL);\
    OPT_POSTLOG()

#define OPTINT(option, var)			\
    OPT_PROLOG(option)				\
    if (Tcl_GetIntFromObj(interp, objv[idx],	\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

#define OPTBOOL(option, var)			\
    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

#define OPTBYTE(option, var, lvar)			\
    OPT_PROLOG(option)				\
    var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
    OPT_POSTLOG()

#define OPTBAD(type, list)			\
    Tcl_AppendResult(interp, "bad ", (type),	\
		" \"", opt, "\": must be ",	\
		(list), (char *) NULL)

#endif /* _TCL_OPTS_H */

Deleted tcltls.syms.in version [f4a8c433c1].

1

-
@SYMPREFIX@Tls_Init

Deleted tcltls.vers version [f9f493f912].

1
2
3
4
5
6






-
-
-
-
-
-
{
	global:
		Tls_Init;
	local:
		*;
};

Modified tests/all.tcl from [d55b3d9c74] to [b44ef18ced].

1
2
3
4
5
6
7
8
9

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

9
10
11
12
13
14
15
16








-
+







# 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.
# 
#
# RCS: @(#) $Id: all.tcl,v 1.5 2000/08/15 18:45:01 hobbs Exp $

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

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

Modified tests/certs/ca.pem from [deed2c9802] to [484e3a5644].

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
20
21
22

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

-----BEGIN CERTIFICATE-----
MIIDkTCCAnmgAwIBAgIUPg6RCIdGBkdlV10XlcfJxHJINeowDQYJKoZIhvcNAQEL
BQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNVBAgMEEJyaXRpc2ggQ29sdW1iaWExEjAQ
BgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UECgwRU2FtcGxlIENlcnRzIEludGwwHhcN
MIIC2jCCAkOgAwIBAgIBADANBgkqhkiG9w0BAQQFADBYMQswCQYDVQQGEwJDQTEZ
MBcGA1UECBMQQnJpdGlzaCBDb2x1bWJpYTESMBAGA1UEBxMJVmFuY291dmVyMRow
GAYDVQQKExFTYW1wbGUgQ2VydHMgSW50bDAeFw0wMTA2MjEyMDI2MDRaFw0wMTA3
MTkwNzE4MTEyNjM0WhcNMTkwODE3MTEyNjM0WjBYMQswCQYDVQQGEwJDQTEZMBcG
A1UECAwQQnJpdGlzaCBDb2x1bWJpYTESMBAGA1UEBwwJVmFuY291dmVyMRowGAYD
VQQKDBFTYW1wbGUgQ2VydHMgSW50bDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCC
MjEyMDI2MDRaMFgxCzAJBgNVBAYTAkNBMRkwFwYDVQQIExBCcml0aXNoIENvbHVt
YmlhMRIwEAYDVQQHEwlWYW5jb3V2ZXIxGjAYBgNVBAoTEVNhbXBsZSBDZXJ0cyBJ
bnRsMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDJeHe1yfuw7YCx6nZ4hcyl
qe1JgOXSMqAzHwfHf/EdGtQUhsfsmgx9cZCKgtuZaoRKidl60MFeW2zq12ORuPUB
w90mQh46KDPRNWm1jViI/xmKUY+so6F5P/c6aA0QYqcpDhM7GgMvaAbEuY70gQ0l
uhxMv75mKMWC4RuzFyVVjwIDAQABo4GzMIGwMB0GA1UdDgQWBBTwwtcIvZ/wpImV
VC/e3C/I9qXWVTCBgAYDVR0jBHkwd4AU8MLXCL2f8KSJlVQv3twvyPal1lWhXKRa
MFgxCzAJBgNVBAYTAkNBMRkwFwYDVQQIExBCcml0aXNoIENvbHVtYmlhMRIwEAYD
VQQHEwlWYW5jb3V2ZXIxGjAYBgNVBAoTEVNhbXBsZSBDZXJ0cyBJbnRsggEAMAwG
A1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEEBQADgYEANprDWDEI9/UUkIL4kxvK8Woy
AQoCggEBALbsv1fBwo9o/xGkbZgnYTycPMcvttk0w4LPamni++zl6XkV+mGnGUEl
5Zpn0Ynchsi/dhwhIEY+il9FWeWJ5Dgl4i/fHUTz3L+NZYafGTwCuSFmPCbGd/ho
54tyZoax5CLQuBAnHGaYlIy9uJRL7eELqZICzxd3mD897DuQMX3fLLOAf0S94VDv
KytPilY6I9hvwBoy8WH4tQfj3xTIpE/+VB6A6hnG2jTRzwKGlCMpXV8Fj4ZMrGTp
XTufon4wO/G1YJ8WGDpnJth6y9N0B4yni4xv7MJO+6R69CvpK8udCTfd8exjceAt
iqjY9bbErVh4FPTUYK2dmMhtuMQFYFECAwEAAaNTMFEwHQYDVR0OBBYEFB88aJVh
lJEffxFp17pVhAJk/FFRMB8GA1UdIwQYMBaAFB88aJVhlJEffxFp17pVhAJk/FFR
MA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZIhvcNAQELBQADggEBAHbA2u+peV8gYB3c
akWYabFR3s2RnxwCMDi0d7eKh+8k+NHLjD1FnWt9VNmub3sd8+PdTMk41PlLfroG
lCAd31HnYqoi498ivgpczwFj3BQSssmhld+aCFyE83KVIeMuP55fcp44vxQuEmcn
EWnH66cMUxI1D3jcQWE=
IDSN1+p3q1rJuW0sLeo1AEzOuu/HfrEDtIUBYI1OAY0FfJHnfDHPSy/FGWWydDzZ
POQP8k/0HHT5CvzrDGUWjPQwkFyAvm/7VrJNfUg5RALWUhZIC3b5/gbVUEh/exzY
eSElOjy3M32t1HQuOrGSHBsoal5D4xyeTdf55hMkxZJZfbhUt3/5ZmcPw1QryX/4
cqp6QJTDZhVOLHPhVNGIckCy7+DTBo7BDqDt2cEUE7NQ6w2BQTSY5WHCFHcHgJJ6
5jKQzsrIXe3K0cl23KxW+JC0vYBkckIalhQQ8hQLIQU6gF0wwFjE+H7yNixtH3bt
BXkdO6c=
-----END CERTIFICATE-----

Modified tests/certs/client.key from [73e1cabe1e] to [fb4dcc3cad].

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

























15
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

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

-----BEGIN RSA PRIVATE KEY-----
MIICXgIBAAKBgQDByy+QiN7Gde+Pf6Wvjk4OZlXfbV68mzmLh/xrXIdGQL5KqRhi
ydUZSUU87TZ/poZAFGA8kds0pmD1TWy4lGiJjoU5pxeIvl8d08Sqbh6Srxv1CKJm
J7RIp4RvEpviOSaDUC0wkLMvAAaAu2ZpNEncsotV4eSaE/WhvCHamBjpSwIDAQAB
AoGAP0q48h+Bgpep8dfiqP91BsbtbNcvhbG8jZGQIxBJLeyfOYsYZ8s7SdLgRhHD
JtWgKvV8qMuKKBvetr7erznpGdHcDDw1wutL2PagET756BjAtxcZ0lEx129eXThH
10+09QEbSlO9XRd1OvAdLCb80H97+jZXMVJ6eb/uMuVzUMECQQDzikOjJLK678fa
haesVYBqmsFAihGIUK+7Ki1F8wS6/oKLHWKDdFYoI/3Zve0qdFGFdvZicFqLAjKl
QOXxBGrpAkEAy7Vf1nmp8FAj2p1/0383EuIhjmMjQw2SHYMbTaCwbnYGJrPoeMwE
dwaaWwfgmXFeoc6lzBRUeDVz2EE6EyzqEwJBAO9XR4eSrlAHDFsWlSVJVg3ujtO1
nOthmIKRPbML1O9M5tB/DWzxLSb/0B9ohyb8740Bz7wIfQM2Ir3DXPeThtkCQQDH
zSYrHznnUzNXgZOWxfgmtVVkayhy5CSkfauSAEIMlgaCf4NMuA7JD9jl4FwTJHdF
DYLhIC+ZmBP/0Do+BJexAkEAjrF928xMKcsrVmr7zlEhl+4B75kDkXm8TDV42PQI
WzmYuHZHwWZApU42VVlWEToIog2s0RVBOyHdiQsNwrL6Rw==
MIIEpAIBAAKCAQEAxzY90F1CGLDXKlOiJsvZ9kZks/TBVTx9WDJBrZDG328/V03O
4R7+kBRwF5rayitOHf0EWB6wMknpWMpz3JStJ9+Dl/K9ix9VUHmySySIh8eVxEO2
/wjsou2QyBnzgeLFn2Y+m1Sb3NYeEbjayMbqTnZ1ySV6xVLFQLKGTUhH1pE78L8b
bt0HAQ8ZS3mb9vBQ0seJrx0dOM+SP6DXDtgNolpCLKbnJkk/hknb0+5a2ctTf/JN
gyl4MyuV7ZHv56ofTwPx6uldQxfSxxyS0SAkC1gKa498b8kbB6fB7SXL9JJ5Jz27
vWnsROFxaquiVuVb0m014G5rGC23YozY8ELIMwIDAQABAoIBAEQ7WNq4Rn5Me7X8
pUpiggovPCjDCUEXkdsWg5ZeQy+eW/ScKuLCifBxf58mJBAg2wW8drNz92eSF0GZ
PivsJI7GqLzvoGo5VjBVLnM8VSMkgjCR/OjHdr2rXu6arOPs90FMdN8hEK2IDQ6G
4TDpqLEtM9SsaKuTWQp62zM3MZvU0eUFP9oiZ6cp/D7CpSq76cQFpCQekR8a4f9Q
eGkVzK/cwCauiB055CUB8Jzc5ZmmQal7mjVJ955d6kWWH4J1HP6ktNSiPLxaKA4W
IvPwtTKOpy0XblZ7hVTTiVhuTZnmF+xqDMj0RsDPO5IAH7/2HZ03ku2yOEIMmg4i
5eK5yFECgYEA7mbEpQHRJxQiFkx0hQKISMvy0afYN41s7qmtoY4nzFMSOI54YgcU
w91ZsR+Ac4yLNCCJYxIyuRm4j15YvH3NK4etINJ+9pWPzbTRuKNOHgIySA4QyYhG
azkO+6pwiy6IOhyPNBek//EaGgnfEFSGcSeEUUcQy/QwXW1QsUB3SnkCgYEA1erh
yM8IOkcp2c41klZTYhzZQYxdWJBGw9AhlVo082K4qIOLSaZCO5nn5xya2veUl9qz
0Ee+14wSP/zOX1lXkd9iLoqHmqo2u/nw+MnFdyqwtH0aBnG/bhP+2v6dar2JH/sp
DDQh9y753vcat8H1eWSWKXrkDHZg3fsnjtiR/QsCgYEA09mjGXa5494yRFqAmMod
TYNfLgvXSdZ1XMiPsSbgGuQfJv8D3yinvT3wPEPgI85azWG0dMNxK6e9qDmQ5T9t
mSciJC6qAHn7pjLuwwLroiMVh45oQI7G9PVpaR6WkDgzemByqTnxuDcKmOT4wkw6
hEc3f/qE5JkEeaFwuXKuDxECgYA9O+c13E22oPhR6L1dDmkABNIL+WofF+2pz8JN
Rm0x3miNlFoi0vzSotPHTGDnnUdj0K74SBFREj+HIY7RrHlswE0SlYULuP3CAWIB
VYC5A/dhMw5oGdd6Yy7o8UmObIL8LKErZSDz6PaN5J45S8RA45I4fX0aNCi2YlaI
hWYE0QKBgQC69xGEbQUXLnR5XQ6i5RVHwIJUts9mk7IJjhEdktm73Ke2aUdovwQ+
MZqZyJOjiuh+pllgLjitnKYCLaF6cDmlTXBg19rXYA65D7TZVj3+zu3+WaBCc4zq
J7++4DvtVqyzGRAiCez+lMRm6tB7QvdYHCDAUxVUKdS7EqV1grkjxw==
-----END RSA PRIVATE KEY-----

Modified tests/certs/client.pem from [c9c6acad76] to [2050e8c953].

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
15
16
17
18
19

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

-----BEGIN CERTIFICATE-----
MIICHzCCAYgCAQEwDQYJKoZIhvcNAQEEBQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNV
BAgTEEJyaXRpc2ggQ29sdW1iaWExEjAQBgNVBAcTCVZhbmNvdXZlcjEaMBgGA1UE
ChMRU2FtcGxlIENlcnRzIEludGwwHhcNMDEwNjIxMjAyOTU4WhcNMDEwNzIxMjAy
OTU4WjBYMQswCQYDVQQGEwJDQTEZMBcGA1UECBMQQnJpdGlzaCBDb2x1bWJpYTES
MBAGA1UEBxMJVmFuY291dmVyMRowGAYDVQQKExFTYW1wbGUgQ2VydHMgSW50bDCB
nzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAwcsvkIjexnXvj3+lr45ODmZV321e
vJs5i4f8a1yHRkC+SqkYYsnVGUlFPO02f6aGQBRgPJHbNKZg9U1suJRoiY6FOacX
iL5fHdPEqm4ekq8b9QiiZie0SKeEbxKb4jkmg1AtMJCzLwAGgLtmaTRJ3LKLVeHk
mhP1obwh2pgY6UsCAwEAATANBgkqhkiG9w0BAQQFAAOBgQC9llXASadBxwkaEIZ7
MIIDJDCCAgwCAQQwDQYJKoZIhvcNAQELBQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNV
BAgMEEJyaXRpc2ggQ29sdW1iaWExEjAQBgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UE
CgwRU2FtcGxlIENlcnRzIEludGwwHhcNMTkwNzE4MTEzMzQwWhcNMTkwODE3MTEz
MzQwWjBYMQswCQYDVQQGEwJDQTEZMBcGA1UECAwQQnJpdGlzaCBDb2x1bWJpYTES
MBAGA1UEBwwJVmFuY291dmVyMRowGAYDVQQKDBFTYW1wbGUgQ2VydHMgSW50bDCC
ASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMc2PdBdQhiw1ypToibL2fZG
ZLP0wVU8fVgyQa2Qxt9vP1dNzuEe/pAUcBea2sorTh39BFgesDJJ6VjKc9yUrSff
g5fyvYsfVVB5skskiIfHlcRDtv8I7KLtkMgZ84HixZ9mPptUm9zWHhG42sjG6k52
dcklesVSxUCyhk1IR9aRO/C/G27dBwEPGUt5m/bwUNLHia8dHTjPkj+g1w7YDaJa
Qiym5yZJP4ZJ29PuWtnLU3/yTYMpeDMrle2R7+eqH08D8erpXUMX0sccktEgJAtY
CmuPfG/JGwenwe0ly/SSeSc9u71p7EThcWqrolblW9JtNeBuaxgtt2KM2PBCyDMC
AwEAATANBgkqhkiG9w0BAQsFAAOCAQEAgEps7DSYpNrN7VXdCw+AsOLikSyWZbOg
bmCYMWIB6+jjxa0YCY2jYgqCslny/bkLgIuxIcxf83ouFfXU52r/mq04jfuRfyRt
zCT8C+Z9nhKHdHA0cVYJ+tNuZfssQ+cFHUfjDOsCEFTJ1OoooafnIHpPXub1FcYr
SCLdcK0BwPbCcJUZrIHwu3Nu7g==
kgeiYJWzemghHZJ62dj60aOmlxiYvPHONkds/d39wOuJkURcSBZL56VTqXIOuTXO
pdBTIxJK9qroZphTt+5up4Z2YaBKb5mBdE/sldwJuxkw5pylLWbBtSaw0i9K40Q7
7xY/+IDMZB6Duc+lDIWvaVk84U5wHxdzUJcgdBRcUCXlmDP672j3KsILSjx5737g
yKil2uagRp/QaZgSv3vkwcwX/RiqPHoIBBiLscaSxPIwiOCJJO1CP3rlPfu/1rlH
765wwtoimMIV503aUe0cMOO7z71zUjsDQkNgjTJtqQFC78ZZsayLFg==
-----END CERTIFICATE-----

Modified tests/certs/client.req from [85521da890] to [5ffe930c8b].

1
2
3
4
5
6
7









8
9
10






11
1






2
3
4
5
6
7
8
9
10



11
12
13
14
15
16
17

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

-----BEGIN CERTIFICATE REQUEST-----
MIIBmDCCAQECAQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNVBAgTEEJyaXRpc2ggQ29s
dW1iaWExEjAQBgNVBAcTCVZhbmNvdXZlcjEaMBgGA1UEChMRU2FtcGxlIENlcnRz
IEludGwwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBAMHLL5CI3sZ1749/pa+O
Tg5mVd9tXrybOYuH/Gtch0ZAvkqpGGLJ1RlJRTztNn+mhkAUYDyR2zSmYPVNbLiU
aImOhTmnF4i+Xx3TxKpuHpKvG/UIomYntEinhG8Sm+I5JoNQLTCQsy8ABoC7Zmk0
Sdyyi1Xh5JoT9aG8IdqYGOlLAgMBAAGgADANBgkqhkiG9w0BAQQFAAOBgQB8xq+d
MIICnTCCAYUCAQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNVBAgMEEJyaXRpc2ggQ29s
dW1iaWExEjAQBgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UECgwRU2FtcGxlIENlcnRz
IEludGwwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDHNj3QXUIYsNcq
U6Imy9n2RmSz9MFVPH1YMkGtkMbfbz9XTc7hHv6QFHAXmtrKK04d/QRYHrAySelY
ynPclK0n34OX8r2LH1VQebJLJIiHx5XEQ7b/COyi7ZDIGfOB4sWfZj6bVJvc1h4R
uNrIxupOdnXJJXrFUsVAsoZNSEfWkTvwvxtu3QcBDxlLeZv28FDSx4mvHR04z5I/
oNcO2A2iWkIspucmST+GSdvT7lrZy1N/8k2DKXgzK5Xtke/nqh9PA/Hq6V1DF9LH
HJLRICQLWAprj3xvyRsHp8HtJcv0knknPbu9aexE4XFqq6JW5VvSbTXgbmsYLbdi
jNjwQsgzAgMBAAGgADANBgkqhkiG9w0BAQsFAAOCAQEAXColfK+WzYiOxHzNnObF
On5JqJBZcc9rW70jmSU7AlSZ48UQlmNmlUSj4YznWUCbDawEfHWv0Xpfho+bio+L
hFuzt0WsotTW1sboFpG3csHyCpGmIxw5Lacv2x5+dDx0jRbyI426+CUn+ZPv5pv8
iiVrlyiX2P3jifQjhv39Kgbs5cOr/Ic8KKz5rg==
7dQwvSd8d97Q0vZLjV0H5ZTQVSwswb9WKWrXnX2VPTMlcxc3K9UJaHtiJZQX1Xhr
N13z6D41ZcSGOk16NUkRy/zNtWn4RNiEMyLs1wiQrsPbgAn0KomwE+3FeOMhWKfi
KFWhV8E8RNIhUM+Wejyrrw2f6Cv13RH6xiQ6ZEvcI8tq3RlM5GfaC0nn3pp/H+Ag
QmCpmr+OUGpz1XtGBJ0GiEIntl4XnRSkzmB5dwAkUF5XdiRnA285i04WSbxoheQo
PPav26T16pNlyjlkm+Rub1K79SV5Rk0EJLcopFDc3csjnlQQokpVm+oBw8oCCY4W
xQ==
-----END CERTIFICATE REQUEST-----

Modified tests/certs/file.srl from [0908cbeb2f] to [662a919451].

1


1
-
+
02
04

Modified tests/certs/privkey.pem from [8b0cd2f057] to [68364dca5f].

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
20
21
22
23
24
25
26
27
28
29
30
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-----BEGIN RSA PRIVATE KEY-----
Proc-Type: 4,ENCRYPTED
DEK-Info: DES-EDE3-CBC,E5670F088D470CF8

j53yMhP9QC8ZElMlyTENZ9rI6mq9hjQepTGBhku8W0JuGIDSQTbDieGNJ7myTLEo
AckDGFndIPMJFxz3GU2OYZ40sZE7CL6lkc5JsgSvt2QEp5qK30l9Ij6NnXN/BfpQ
ETliDPzDNWD0ILM43C2J/sNwgwu2SgAMj7BIn2adNuT5AN1nNXdxUg+tbGrEeH39
eiHKTBRS+40t6KMxW1ftl85zl6WRSRM+3/URdNKUbVq0DQmpFpXT1XcKGxv4GVao
X4jyj6pE5L610cIiT3vy0qK3B3UKsQNOE8Z7aTV9eKvGk7F4LVSQpFz+DDgv/nLb
f2CLIR75MAv7FhcD/Ko+RzxfExPJB0BBsYZGarZcyd1R3rVl/rQAmd+xnZZfM5kV
iRtl7ux8NldaFkZ7XU71ZkLIiivHPDEY6gKWXe3ANsXzVxSO3Zh9okT1P7jyMaNt
Ucz7xD0T7+hnmIV4EU10h849o99F37eN3Ygjjy2xZmMsCfs/Qaem1mlJF0d87472
7pZcOd+PgBpV2W2O9NTerd6+TPhyqGhgtucrQLID7B+eheLXaexAjgBYwHv9LbOo
uCYPS9s4DBJgvoPhz+IZ/PEZVpY/w5QJ9DsBe0xOv+KWWt9KdcA0SWRYtJUznNSS
YX3eVKZD0C3d5hgr0vSDUe/p6nsgvubHH/v/9EbruXql6PCVu0akO34n+91374pi
85G3EWEuzUwxmKDCr228W5NB2bqFet9CgtHycnQ8cjM61AYpLZx4iTCxH8s6m+lY
WRr1sFm38il8oTODZTQ6o/w91RELhyMd9MTJUZNEqqsgN4y0/r7Dww==
-----END RSA PRIVATE KEY-----
-----BEGIN ENCRYPTED PRIVATE KEY-----
MIIFHDBOBgkqhkiG9w0BBQ0wQTApBgkqhkiG9w0BBQwwHAQIBWemhNjEyFQCAggA
MAwGCCqGSIb3DQIJBQAwFAYIKoZIhvcNAwcECPdy2pJ53hrdBIIEyDerixPd/2vy
eVgr1L6PQSzoyTUx7zrddw7w3Wg8N/TIjFqKGw98edDDPcNlKXbaalpnjL+aMTPa
fqirXYffJKrMkUhbldKiJca4q25Y+if+K7+TExdltGxEF+OvadcQzjKEFFUZsMkq
d89EOGecjICvuQblVX7YlSjZbaIHcK/l0lTQ2vWwi8ZQjLQhjoeO5bXl8b1m2s7H
uWDi+M0jHPf5FN4Exmi0296L5bdUjESyGNIDgJEPDtb+U+k2fbryE0uusGCHXpWZ
Y9UnKE9zDm0aUbD1L2RiztORW5GCRD+2QGQSNHJnWfIVMvOQLC6xSDFS80UfZ29i
eoiPwmObliBM6TsG98qBeye4Bn9+vEJeOJwCEJJgRZy57oK3M3NwD681FgRLiIqx
PDOkwg6yUxKjpn8JfAG3fVkaQ6mt2rAIzR9ClbK3Tk0i6b0B7iWW6VF6ihe5Eqlc
+nX37hXtw6RH6iCqnySoo64PoTtxvG5y9s3bxp1sVmRCJv85bUIp7xLbh/VoyqXf
aHUYHy48M7lHdarl6tgDAMizJor7m9ZeZqAdOnkUMePehkJ9svIUaudRiO9FzVGP
3aIGTXw4KfaLwFsT5O0DqsjFnhmrt0c8NOQyCbcEZZS2D7o2g548oEd/k7PH8u2M
pPnQOI/S2Vb/K4EeUMDHsT6sV/6MFASwKaT4rXBXeyg7ryvqbBTzqAA50kAsUeG7
/euNHuenZVTIfSYEaZzcBJ9M38ouhbvtdzVIqyJR3DzPXc/olPMudlg2l1ES7CUr
muGTs1TrFT/Ucu07rPlYYFPUuk6nUC5llhTN3n9GfmHcnkeiE8PPfbX3y3I7z3Xh
Fj4atR2VB26kxu77oKy8MM4ANd8uKvHAWEornuIZ/H3BbLOZsTnIR0+HhrXq9oT+
FxxiUFzrKIZKt9dZHfLo27YjvnlP1uQKfaljvTt4OTTbAfV5Q8mWj8OBAyQc0WRv
EHgHxcItGiwnGhoParqQFO6Cbtw+1G71t1b5Jd5tbEpbHMlugGP5jPWlM/KfJi8e
mDi+30jTft5+1TEOmQK4hlpINfGOM1h07FPI8bjm3k44FW7FFJPZ8XlCT/JTJ87Y
Fo92Z7uLW1O6oasj5ooiFYN0F9VyTYRhEcjGzt0aQso/9shNHHFn6T9ECzTsgEJq
lAYpGESd6nlOkhDAwO2DWbrPYuJTnlj5j2tR6mV1u8mSEbMfB/p3AG4vmdrz0u4c
hm7+H/pC0bVR+vwZslijZe77jMrWE5VQgDgcdCUS5V8hyRt0nt6AXr48jX4Rnpjh
90Tb/wJH7AhIzG+Lr7jHoPNe4JWEN8zaBLT5N1l2YDO0+6lSVLMN1lk3q9M3ff4Q
ExAxsEb7ueox2lPS40XdEBn2Umv4u/66nwiST2oLPp8+esYlu8xOa0ODHeuI+5ya
E5byUlt+qYTo1iVCtYswGD/AIQCFjaDycBST2RSPfIPpY/cCPlPKniYuX9JokRfS
3GgEOCJ6lynBSByn7roDDOc/SbE4dUQ6tXvwVx16KwaXOPOXhDJz+LtUTb9X4ShC
54jI4In+cKe+gBOBXpeGiS6/bPjwCGdNXJ1YN/hyBJy+3L45JKZR5e4nzly7Ebpk
/3WGW9dRZb210rEH5OllKA==
-----END ENCRYPTED PRIVATE KEY-----

Modified tests/certs/server.key from [5e8ad5b667] to [059d0c4e1d].

1
2
3
4






5
6
7
8
9
10
11
12
13
14



















15
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

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

-----BEGIN RSA PRIVATE KEY-----
MIICXAIBAAKBgQDCE6cHPOkPnOSpobuRDKTLcvjdmh1vAYmwOvXLcBkpN+PkN443
2KURytg0rw4w7+HDS+KV13pAF5D5mSl/OOsfwQzi/dQKSVF0zlbz5L7rcBqIt2cG
Xz7gsX8VRMycXH0XC3QAAZUW32zYeo0G28uCttAh6wt8YCKu99+TNhRIWQIDAQAB
MIIEowIBAAKCAQEArSh1yY1FEue1zn9rlugTp+T1StUiRHWyVs9K5rIQjlBB38zv
JUfACZcuCNa8yo8ZGVdgDfB/BnCpmRKNle3qDRiNJDMkP0eiZjDp+ZslaWLhDOLv
97WFI6A9zHPKaz3WvjFTyEfTKGEy+kT6zQqi/AOgA74+7o6NK9ig9me5W/0i1eOW
5SH0NrV+E3VQlSw1j9UfeqNvsRnwq0TiTWp1FeK/eoaJ07wR/OH9nfaBKinKdH/w
DG8FOGNKSwYQt+6cjwf3sHg5iDAIe6CRFr75QGfU7XVKQ+vCzhYta5wOwEPBOq8S
p1Ga9PvPyzrBXxM8vBEldnjk0wuhzIcfq4hgnQIDAQABAoIBAQCSLzZBkiJec3/p
AoGAaMHQ48BGEO5gIwwwwW+wuDycBom8n4GV/7EjoaclfbE0aqhuNMjU+RCjuXRQ
Vav2EcOxT65ax6Ow1nmNA6YGi1GUAcktgMmY+Cl72iVyEqz8kUwUS1TBj0EqysCW
E57CJo6S9Htnhq9/qrJL1LvW2iH9mWobZnMbI6+jN8C/eTECQQDmrnS72ZzNJcLc
yU9uahH5BaX2vUWpWdurjYend3L9sHII3hZznYTOBn5a4kCfF2CD1FYlL7LMuV4q
qab8O5QNAkEA12CzTV3lpK8LOFX5CTT4gM5XAZvP0+YiThnRrGh15JRgZoV6Larn
X+Tvk8qYGRZdjILnNaOCqp9j3z7Mpvt2fQJAR+Z6dg6m4/5wFTcd7fFbtr1+9EAc
VWOvp3IOpTEDA3WapY7reo/PVBQMEDHTKIM1zwFA9IhAd7UTV8LXTGkZhQJAVUBU
mLojDRWwdkMpiShreOiz7dIT6Ic+avWzVfAfQjQtGEebPfpZDU8cOb7Gh5+ftd+W
z1eCgDEJIjPEZBBDLQJBAKnXJh9w47et8NZHsXjdqV/nWiZ2uzxijbEBCQTgLhcT
e4oSQidcpEPRAB5jsCZAa5czv74kDIRqYCjFL8fAT+4=
dWk/XW46r/Dl3EmxwittXlO9r1aKzvbOGhVLQ+e8MQWMML3xxB1MZ5eQLRkQNsz3
jdI6YUDXDYMarJJNWgygeWsObwyGjBOy7WPpnDVqfj2t/ZNGNk61Aq/YxcperLB8
2P9jWzd9yxGsF1DJ1U8ZVSmO3MKABTCllTlflFeGWlFo8rPHxh6JbY5IBj6CB0eb
JKUsabMM3LykEefbzAh37ff647XA7292wfQ/+aZVBQnQ01xMuGnkxrFcyYpE3NJx
6GBjdwrlEtZPb3TzXWdCoj5U0YT/4L3Up654MZ9Zhyw8ah8AT/m9XbDUdInwXG+/
vfm5RmuBAoGBAOHMN4YmWWyFw5oFZ3oSmPQmbhONurjInJpga8k/HjGWBctsBKCD
hXZ3MIaGPDLyNOMrsjBNcKmnY1+Jk8fxVgKnTiut3aSFRIVeHrlmGMj1w55csMBw
V38i4L1vJUXU7ErOTPGzNXJQMc3KWqBMx3nnz335j4SHhpk5da+I351HAoGBAMRR
wFrUCnWBCcRauzv1WhL/CahT3ZRfD5QF8TsIAq3aG7AXnrp2UkaEG9k3lMTLjQkp
e2AWuvXHlQV0K77t4ocdP2UXNUZS10SQk2CX0HfS3pI0pWzLDf8dnfcPfZ/TVDc/
8Gb82GKh8hsoTgNDPD30kt/2vgBT7gJfoH8hU3T7AoGAJsU+/2zUS/sH5AlrhB1v
X/S9T+Q1HIdtxGAsAckxsQf2hMBOZxVONFIw5dhku8a06BDXrs2NO8Q/HudrlZhN
0XTSylM3TImJg3Duy5zJQrBYX3fA7boce/sMJdrQxpXR4OJded7wnWlBs/k76Gxm
j/sKuLHCP9pZdTPVjkdtRf8CgYA9PO8OphP5IV5FlLPQ+TC2uj1t93Mn5Bs85jmg
W1hSmLWIUWXe7iet/WmecVsDpCcDU6A7kfuRzUbr45f9v8CouvPaecnRfOfPaHXA
bLrHlcx9uNRdQl3EVZ2/wmJCZ65eaaB4z6hD5BZcaE8lb2SsQs1J9XLBMW0N6nxr
C5833wKBgCZNl1qA8avepAOnqm/e2Pl54xsPjhzli2z8Ppe9S6rhe9QvYv2OsJkQ
8Ja7zGTqRXJU4Rahcs6OYULommkgq5LpVCsszOTZDQH5WgICLvhBsxo2dEGyd3ov
RTWdXnPYoWlj77ofnSdOsejF4kM4nHRD9Btq+VZ4NEAxe3FiUYbH
-----END RSA PRIVATE KEY-----

Modified tests/certs/server.pem from [f68c9dc63c] to [fafd25f6df].

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
15
16
17
18
19

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

-----BEGIN CERTIFICATE-----
MIICHzCCAYgCAQAwDQYJKoZIhvcNAQEEBQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNV
BAgTEEJyaXRpc2ggQ29sdW1iaWExEjAQBgNVBAcTCVZhbmNvdXZlcjEaMBgGA1UE
ChMRU2FtcGxlIENlcnRzIEludGwwHhcNMDEwNjIxMjAyODUyWhcNMDEwNzIxMjAy
ODUyWjBYMQswCQYDVQQGEwJDQTEZMBcGA1UECBMQQnJpdGlzaCBDb2x1bWJpYTES
MBAGA1UEBxMJVmFuY291dmVyMRowGAYDVQQKExFTYW1wbGUgQ2VydHMgSW50bDCB
nzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAwhOnBzzpD5zkqaG7kQyky3L43Zod
bwGJsDr1y3AZKTfj5DeON9ilEcrYNK8OMO/hw0vildd6QBeQ+ZkpfzjrH8EM4v3U
CklRdM5W8+S+63AaiLdnBl8+4LF/FUTMnFx9Fwt0AAGVFt9s2HqNBtvLgrbQIesL
fGAirvffkzYUSFkCAwEAATANBgkqhkiG9w0BAQQFAAOBgQBXJZfVMqZw9T4EgXQo
MIIDJDCCAgwCAQMwDQYJKoZIhvcNAQELBQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNV
BAgMEEJyaXRpc2ggQ29sdW1iaWExEjAQBgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UE
CgwRU2FtcGxlIENlcnRzIEludGwwHhcNMTkwNzE4MTEzMTUzWhcNMTkwODE3MTEz
MTUzWjBYMQswCQYDVQQGEwJDQTEZMBcGA1UECAwQQnJpdGlzaCBDb2x1bWJpYTES
MBAGA1UEBwwJVmFuY291dmVyMRowGAYDVQQKDBFTYW1wbGUgQ2VydHMgSW50bDCC
ASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAK0odcmNRRLntc5/a5boE6fk
9UrVIkR1slbPSuayEI5QQd/M7yVHwAmXLgjWvMqPGRlXYA3wfwZwqZkSjZXt6g0Y
jSQzJD9HomYw6fmbJWli4Qzi7/e1hSOgPcxzyms91r4xU8hH0yhhMvpE+s0KovwD
oAO+Pu6OjSvYoPZnuVv9ItXjluUh9Da1fhN1UJUsNY/VH3qjb7EZ8KtE4k1qdRXi
v3qGidO8Efzh/Z32gSopynR/8AxvBThjSksGELfunI8H97B4OYgwCHugkRa++UBn
1O11SkPrws4WLWucDsBDwTqvEqdRmvT7z8s6wV8TPLwRJXZ45NMLocyHH6uIYJ0C
AwEAATANBgkqhkiG9w0BAQsFAAOCAQEAj5gWwGYUjNK3v9fvIRu58bvg7r43SK7e
nM0geAByeqyOCoR+4dPv4hipf/c1m8sZgG1SxrXVThey4i4UkZenKz+VlPGDX0++
sJBKod+aa24wcR5IQBTDuxzwduwuKkbjzGG+zdBXjOgxdcLxw7ozNciSSALYVnez
0uX7n/lAP92SlcEXhoUroMjeLQ==
4w1UEe7x8ZyquG7flomqdBoI5SwQo4C3VMu0Ds9c+psG6GUjnUB5Gki9GE34pkQS
LOlfOyitvJYO+UaD4C+H0ZWyPAvHPfVwAk4CofKoIBp5eNkTIZASzgYXPbNSuO6K
59cOM9/hPq4sJ0Pr+XEMYTYYozc5ewvjzRzCvPPkO2DT5kIoyslpRxnidG9+Ugxx
Bo1WG05QQLN8HYH40fmUNou0omN1T8D7CCcTkWp1EU28vir6omwke0YTaEiFYqMH
6CFN7/Z5sn0Vj3b3+f7w8Wdqw7DfsyL6DJD7vl8UjuYDHXDLLYVbUw==
-----END CERTIFICATE-----

Modified tests/certs/server.req from [026a8de463] to [984c60695f].

1
2
3
4
5
6
7









8
9
10






11
1






2
3
4
5
6
7
8
9
10



11
12
13
14
15
16
17

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

-----BEGIN CERTIFICATE REQUEST-----
MIIBmDCCAQECAQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNVBAgTEEJyaXRpc2ggQ29s
dW1iaWExEjAQBgNVBAcTCVZhbmNvdXZlcjEaMBgGA1UEChMRU2FtcGxlIENlcnRz
IEludGwwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBAMITpwc86Q+c5Kmhu5EM
pMty+N2aHW8BibA69ctwGSk34+Q3jjfYpRHK2DSvDjDv4cNL4pXXekAXkPmZKX84
6x/BDOL91ApJUXTOVvPkvutwGoi3ZwZfPuCxfxVEzJxcfRcLdAABlRbfbNh6jQbb
y4K20CHrC3xgIq7335M2FEhZAgMBAAGgADANBgkqhkiG9w0BAQQFAAOBgQBsiv9V
MIICnTCCAYUCAQAwWDELMAkGA1UEBhMCQ0ExGTAXBgNVBAgMEEJyaXRpc2ggQ29s
dW1iaWExEjAQBgNVBAcMCVZhbmNvdXZlcjEaMBgGA1UECgwRU2FtcGxlIENlcnRz
IEludGwwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCtKHXJjUUS57XO
f2uW6BOn5PVK1SJEdbJWz0rmshCOUEHfzO8lR8AJly4I1rzKjxkZV2AN8H8GcKmZ
Eo2V7eoNGI0kMyQ/R6JmMOn5myVpYuEM4u/3tYUjoD3Mc8prPda+MVPIR9MoYTL6
RPrNCqL8A6ADvj7ujo0r2KD2Z7lb/SLV45blIfQ2tX4TdVCVLDWP1R96o2+xGfCr
ROJNanUV4r96honTvBH84f2d9oEqKcp0f/AMbwU4Y0pLBhC37pyPB/eweDmIMAh7
oJEWvvlAZ9TtdUpD68LOFi1rnA7AQ8E6rxKnUZr0+8/LOsFfEzy8ESV2eOTTC6HM
hx+riGCdAgMBAAGgADANBgkqhkiG9w0BAQsFAAOCAQEAhSwccC2Oke5E6j/f7CjT
OdF/lp3ovGfYj3DF3QyfH6p0fCuUADKgReLKOilMDPR77WE/kExxqRR9dTzlTY4n
dEmvzfmV3Vbj8KKs3L9NoLo6vF/ZeSt+RyJQlJblzXuFqxMlpZJoYcFSZO1E0Jl8
iHe6QMOI58MBe/waEPxvIyFo2L30wScEyy/Ynw==
SK4ExJfi/1Ze1OBkzaxLny0hSxMbK8iARSciOD7LLcJ1ZAq6aWwnxutHRLpGfO1t
Nw+OG/AXeoonfLQJzLcU+w/GFOyfSjrSrNo8ePrflOzH6WKMuVH7tNw6PNWDggdG
khDNq+VklBt6YxZ0X4FbPFuOKjOvjAfKyYY5ZfMSnOYtiZBb7aQEEoeBwcJkiL8D
QQfwvtlKF8SWdeM61R8fibEw02XelXoIyyQZpL+7BIVPe84AMaJEUI5ijJ/dDOsP
JFCpozCuNS8P49INvxH+2FdXk05V+/AcMmqJpNEJ916PecwjSTAlcmFmnq43+jM8
rA==
-----END CERTIFICATE REQUEST-----

Modified tests/ciphers.test from [9bef3a5541] to [cef4d88462].

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







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

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







    EXP-EDH-DSS-DES-CBC-SHA
    EXP-DES-CBC-SHA
    EXP-RC2-CBC-MD5
    EXP-RC4-MD5
}

set ::EXPECTEDCIPHERS(openssl) {
    ECDHE-RSA-AES256-SHA
    DHE-PSK-AES256-CCM
    DHE-PSK-AES128-GCM-SHA256
    AES128-SHA
    AES256-SHA
    DES-CBC-SHA
    ECDHE-RSA-AES128-SHA256
    DHE-PSK-AES256-GCM-SHA384
    AES256-SHA256
    ECDHE-PSK-CHACHA20-POLY1305
    DES-CBC3-SHA
    DHE-DSS-AES128-SHA
    DHE-DSS-AES256-SHA
    ECDHE-ECDSA-AES128-SHA256
    AES256-CCM
    DHE-DSS-RC4-SHA
    DHE-RSA-AES128-SHA
    ECDHE-RSA-AES128-GCM-SHA256
    DHE-RSA-AES256-SHA
    ECDHE-ECDSA-AES128-GCM-SHA256
    PSK-AES128-GCM-SHA256
    ECDHE-ECDSA-AES256-SHA
    ECDHE-RSA-AES256-GCM-SHA384
    EDH-DSS-DES-CBC-SHA
    EDH-DSS-DES-CBC3-SHA
    EDH-RSA-DES-CBC-SHA
    EDH-RSA-DES-CBC3-SHA
    EXP-DES-CBC-SHA
    EXP-EDH-DSS-DES-CBC-SHA
    EXP-EDH-RSA-DES-CBC-SHA
    EXP-RC2-CBC-MD5
    EXP-RC4-MD5
    EXP1024-DES-CBC-SHA
    EXP1024-DHE-DSS-DES-CBC-SHA
    EXP1024-DHE-DSS-RC4-SHA
    EXP1024-RC2-CBC-MD5
    ECDHE-PSK-AES256-CBC-SHA
    ECDHE-ECDSA-AES256-GCM-SHA384
    AES128-SHA
    PSK-AES256-GCM-SHA384
    PSK-AES128-CBC-SHA
    ECDHE-RSA-AES128-SHA
    AES128-GCM-SHA256
    ECDHE-PSK-AES128-CBC-SHA256
    AES256-GCM-SHA384
    TLS_AES_128_GCM_SHA256
    DHE-RSA-AES128-SHA256
    DHE-PSK-CHACHA20-POLY1305
    DHE-PSK-AES128-CCM
    TLS_AES_256_GCM_SHA384
    DHE-RSA-AES256-CCM
    DHE-RSA-AES128-GCM-SHA256
    ECDHE-ECDSA-AES256-CCM
    PSK-AES256-CCM
    DHE-RSA-AES256-GCM-SHA384
    AES128-CCM
    ECDHE-RSA-CHACHA20-POLY1305
    DHE-PSK-AES256-CBC-SHA
    DHE-RSA-AES128-SHA
    ECDHE-ECDSA-CHACHA20-POLY1305
    PSK-CHACHA20-POLY1305
    DHE-PSK-AES128-CBC-SHA256
    ECDHE-ECDSA-AES128-SHA
    ECDHE-PSK-AES128-CBC-SHA
    EXP1024-RC4-MD5
    EXP1024-RC4-SHA
    IDEA-CBC-SHA
    RC4-MD5
    RC4-SHA
    AES128-SHA256
    PSK-AES128-CBC-SHA256
    DHE-RSA-CHACHA20-POLY1305
    DHE-RSA-AES128-CCM
    DHE-RSA-AES256-SHA256
    ECDHE-ECDSA-AES128-CCM
    PSK-AES128-CCM
    TLS_CHACHA20_POLY1305_SHA256
    DHE-PSK-AES128-CBC-SHA
    AES256-SHA
    PSK-AES256-CBC-SHA
}

set ::EXPECTEDCIPHERS(openssl0.9.8) {
    DHE-RSA-AES256-SHA
    DHE-DSS-AES256-SHA
    AES256-SHA
    EDH-RSA-DES-CBC3-SHA
130
131
132
133
134
135
136
137

138
139
140
141

142

143
144
145
146
147
148
149
157
158
159
160
161
162
163

164




165

166
167
168
169
170
171
172
173







-
+
-
-
-
-
+
-
+








test ciphers-1.2 {Tls::ciphers for tls1} {rsabsafe} {
    # This will fail if you compiled against OpenSSL.
    # Change the constraint setting above.
    listcompare $::EXPECTEDCIPHERS(rsabsafe) [tls::ciphers tls1]
} {}

test ciphers-1.3 {Tls::ciphers for ssl3} {openssl} {
test ciphers-1.3 {Tls::ciphers for ssl3} -constraints openssl -body {
    # This will fail if you compiled against RSA bsafe or with a
    # different set of defines than the default.
    # Change the constraint setting above.
    listcompare $::EXPECTEDCIPHERS(openssl$version) [tls::ciphers ssl3]
    tls::ciphers ssl3
} {}
} -returnCodes 1 -result {ssl3: protocol not supported}

# This version of the test is correct for OpenSSL only.
# An equivalent test for the RSA BSAFE SSL-C is earlier in this file.

test ciphers-1.4 {Tls::ciphers for tls1} {openssl} {
    # This will fail if you compiled against RSA bsafe or with a
    # different set of defines than the default.

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

267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
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= 
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
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 
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
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
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 -certfile server.pem
tls::init -cafile server.pem
#tls::init 
#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
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/simpleClient.tcl from [abd896c23b] to [4d694417ae].

1
2
3

4
5
6
7
8
9
10
1
2

3
4
5
6
7
8
9
10


-
+







#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh8.3 "$0" ${1+"$@"}
exec tclsh "$0" ${1+"$@"}

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]

Modified tests/simpleServer.tcl from [ca9a28f88d] to [0be01a94d0].

1
2
3

4
5
6
7
8
9
10
1
2

3
4
5
6
7
8
9
10


-
+







#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh8.3 "$0" ${1+"$@"}
exec tclsh "$0" ${1+"$@"}

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]

Modified tests/tlsIO.test from [1df3d39a1f] to [5132bf407b].

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







-
+
















-
+







    removeFile script
    set f [open script w]
    puts $f [list set auto_path $auto_path]
    puts $f {
	package require tls
	set timer [after 2000 "set x done"]
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr [info hostname] 8831 \]"
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr localhost 8831 \]"
    puts $f {
	proc accept {sock addr port} {
            global x
            puts "[gets $sock]"
            close $sock
            set x done
	}
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list $::tcltest::tcltest script] 2> /dev/null" r]
    gets $f x
    if {[catch {tls::socket -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey [info hostname] 8831} sock]} {
	-keyfile $clientKey localhost 8831} sock]} {
        set x $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    }
564
565
566
567
568
569
570
571

572
573
574
575
576
577
578
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 { 
             } else {
	         incr i
                 puts $s $l
             }
	}
	set i 0
	puts ready
	set timer [after 20000 "set x done"]
631
632
633
634
635
636
637
638

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

638
639
640
641
642
643
644
645







-
+







    proc readit {s} {
	global done
	gets $s
	close $s
	set done 1
    }
    set cs [tls::socket -certfile $clientCert -cafile $caCert \
	-keyfile $clientKey [info hostname] 8830]
	-keyfile $clientKey localhost 8830]
    close $cs

    vwait done
    after cancel $timer
    set done
} 1

1038
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052
1038
1039
1040
1041
1042
1043
1044

1045
1046
1047
1048
1049
1050
1051
1052







-
+







    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set s1 [tls::socket \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
    	[info hostname] 8823]
    	localhost 8823]
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    close $s1
    set l ""
    lappend l [lindex $x 2] [llength $x]
1091
1092
1093
1094
1095
1096
1097
1098

1099
1100
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
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







-
+









+







	# 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 \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    -async [info hostname] 8830]
	    -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} {
1135
1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1136
1137
1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1150







-
+







		-buffering none]
    }
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	    -server accept 8831]
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    [info hostname] 8831]
	    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
    close $c
    set timer [after 10000 "set done timed_out"]
    vwait done
1182
1183
1184
1185
1186
1187
1188
1189

1190
1191
1192
1193
1194
1195
1196
1183
1184
1185
1186
1187
1188
1189

1190
1191
1192
1193
1194
1195
1196
1197







-
+







	close $s
    }
    set s [tls::socket \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	    -server accept 8832]
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    [info hostname] 8832]
	    localhost 8832]
    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 ...]\" \
1226
1227
1228
1229
1230
1231
1232
1233

1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250

1251
1252
1253
1254
1255
1256
1257
1227
1228
1229
1230
1231
1232
1233

1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250

1251
1252
1253
1254
1255
1256
1257
1258







-
+
















-
+







	}
    }
    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} {
	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 \
	    -server accept 8833]
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    [info hostname] 8833]
	    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}
1461
1462
1463
1464
1465
1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
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    
} 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]
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
1980
1981
1982
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 { 
             } 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"}}
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
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







-
-
+

-
-
-
+
+












-
+




-
+





-
-
-
+
+
+

-
+
-
-
+
-





-
+
+







	}
    }
    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 -certfile $serverCert -cafile $caCert -keyfile $serverKey \
	    -server accept 8831]
    set c [tls::socket \
	    -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    [info hostname] 8831]
    set c [tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey \
	    localhost 8831]
    # only the client gets tls::import
    set res [tls::unimport $c]
    list $res [catch {close $c} err] $err \
	[catch {close $s} err] $err
} {{} 0 {} 0 {}}

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

    # Server - Only accept TLS 1.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 \
               -server Accept 8831]
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey -request 0 \
	    -require 0 -ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 1 \
	    -server Accept 8831]
    # Client - Only propose TLS1.0
    set c [tls::socket -async \
    set c [tls::socket -async -cafile $caCert -request 0 -require 0 \
               -cafile $caCert \
               -request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 \
	    -ssl2 0 -ssl3 0 -tls1 1 -tls1.1 0 -tls1.2 0 localhost 8831]
               [info hostname] 8831]
    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: wrong ssl version" -
        "handshake failed: unsupported protocol" {
            set ::done "handshake failed: wrong version number"
        }
    }
    set ::done
} {handshake failed: wrong version number}

# cleanup

Deleted tls.c version [b7a88587d1].

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
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
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
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
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
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
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
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
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
1233
1234
1235
1236
1237
1238
1239
1240
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
1397
1398
1399
1400
1401
1402
1403
1404
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
1462
1463
1464
1465
1466
1467
1468
1469
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
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
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
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
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
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
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
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
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
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









































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Copyright (C) 1997-1999 Matt Newman <[email protected]>
 * some modifications:
 *	Copyright (C) 2000 Ajuba Solutions
 *	Copyright (C) 2002 ActiveState Corporation
 *	Copyright (C) 2004 Starfish Systems 
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built (almost) from scratch based upon observation of
 * OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), 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)
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <stdlib.h>

/*
 * External functions
 */

/*
 * Forward declarations
 */

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

static void	InfoCallback(CONST SSL *ssl, int where, int ret);

static int	CiphersObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	HandshakeObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	ImportObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	StatusObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	VersionObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	MiscObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

static int	UnimportObjCmd(ClientData clientData,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);

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 *CAdir, char *CAfile,
      char *ciphers, char *DHparams);

static int	TlsLibInit(int uninitialize);

#define TLS_PROTO_SSL2		0x01
#define TLS_PROTO_SSL3		0x02
#define TLS_PROTO_TLS1		0x04
#define TLS_PROTO_TLS1_1	0x08
#define TLS_PROTO_TLS1_2	0x10
#define TLS_PROTO_TLS1_3	0x20
#define ENABLED(flag, mask)	(((flag) & (mask)) == (mask))

/*
 * Static data structures
 */

#ifndef OPENSSL_NO_DH
#include "dh_params.h"
#endif

/*
 * We lose the tcl password callback when we use the RSA BSAFE SSL-C 1.1.2
 * libraries instead of the current OpenSSL libraries.
 */

#ifdef BSAFE
#define PRE_OPENSSL_0_9_4 1
#endif

/*
 * Pre OpenSSL 0.9.4 Compat
 */

#ifndef STACK_OF
#define STACK_OF(x)			STACK
#define sk_SSL_CIPHER_num(sk)		sk_num((sk))
#define sk_SSL_CIPHER_value( sk, index)	(SSL_CIPHER*)sk_value((sk), (index))
#endif

/*
 * Thread-Safe TLS Code
 */

#ifdef TCL_THREADS
#define OPENSSL_THREAD_DEFINES
#include <openssl/opensslconf.h>

#ifdef OPENSSL_THREADS
#include <openssl/crypto.h>

/*
 * Threaded operation requires locking callbacks
 * Based from /crypto/cryptlib.c of OpenSSL and NSOpenSSL.
 */

static Tcl_Mutex *locks = NULL;
static int locksCount = 0;
static Tcl_Mutex init_mx;

void CryptoThreadLockCallback(int mode, int n, const char *file, int line) {

	if (mode & CRYPTO_LOCK) {
		/* This debugging is turned off by default -- it's too noisy. */
		/* dprintf("Called to lock (n=%i of %i)", n, locksCount); */
		Tcl_MutexLock(&locks[n]);
	} else {
		/* dprintf("Called to unlock (n=%i of %i)", n, locksCount); */
		Tcl_MutexUnlock(&locks[n]);
	}

	/* dprintf("Returning"); */

	return;
	file = file;
	line = line;
}

unsigned long CryptoThreadIdCallback(void) {
	unsigned long ret;

	dprintf("Called");

	ret = (unsigned long) Tcl_GetCurrentThread();

	dprintf("Returning %lu", ret);

	return(ret);
}
#endif /* OPENSSL_THREADS */
#endif /* TCL_THREADS */


/*
 *-------------------------------------------------------------------
 *
 * InfoCallback --
 *
 *	monitors SSL connection process
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Calls callback (if defined)
 *-------------------------------------------------------------------
 */
static void
InfoCallback(CONST SSL *ssl, int where, int ret)
{
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Obj *cmdPtr;
    char *major; char *minor;

    dprintf("Called");

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

    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

#if 0
    if (where & SSL_CB_ALERT) {
	sev = SSL_alert_type_string_long(ret);
	if (strcmp( sev, "fatal")==0) {	/* Map to error */
	    Tls_Error(statePtr, SSL_ERROR(ssl, 0));
	    return;
	}
    }
#endif
    if (where & SSL_CB_HANDSHAKE_START) {
	major = "handshake";
	minor = "start";
    } else if (where & SSL_CB_HANDSHAKE_DONE) {
	major = "handshake";
	minor = "done";
    } else {
	if (where & SSL_CB_ALERT)		major = "alert";
	else if (where & SSL_ST_CONNECT)	major = "connect";
	else if (where & SSL_ST_ACCEPT)		major = "accept";
	else					major = "unknown";

	if (where & SSL_CB_READ)		minor = "read";
	else if (where & SSL_CB_WRITE)		minor = "write";
	else if (where & SSL_CB_LOOP)		minor = "loop";
	else if (where & SSL_CB_EXIT)		minor = "exit";
	else					minor = "unknown";
    }

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
	    Tcl_NewStringObj( "info", -1));

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( major, -1) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( minor, -1) );

    if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
    } else if (where & SSL_CB_ALERT) {
	CONST char *cp = (char *) SSL_alert_desc_string_long(ret);

	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( cp, -1) );
    } else {
	Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( SSL_state_string_long(ssl), -1) );
    }
    Tcl_Preserve( (ClientData) statePtr->interp);
    Tcl_Preserve( (ClientData) statePtr);

    Tcl_IncrRefCount( cmdPtr);
    (void) Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount( cmdPtr);

    Tcl_Release( (ClientData) statePtr);
    Tcl_Release( (ClientData) statePtr->interp);

}

/*
 *-------------------------------------------------------------------
 *
 * VerifyCallback --
 *
 *	Monitors SSL certificate validation process.
 *	This is called whenever a certificate is inspected
 *	or decided invalid.
 *
 * Results:
 *	A callback bound to the socket may return one of:
 *	    0			- the certificate is deemed invalid
 *	    1			- the certificate is deemed valid
 *	    empty string	- no change to certificate validation
 *
 * 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, X509_STORE_CTX *ctx)
{
    Tcl_Obj *cmdPtr, *result;
    char *errStr, *string;
    int length;
    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
    X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
    State *statePtr	= (State*)SSL_get_app_data(ssl);
    int depth		= X509_STORE_CTX_get_error_depth(ctx);
    int err		= X509_STORE_CTX_get_error(ctx);

    dprintf("Verify: %d", ok);

    if (!ok) {
	errStr = (char*)X509_verify_cert_error_string(err);
    } else {
	errStr = (char *)0;
    }

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	if (statePtr->vflags & SSL_VERIFY_FAIL_IF_NO_PEER_CERT) {
	    return ok;
	} else {
	    return 1;
	}
    }
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
	    Tcl_NewStringObj( "verify", -1));

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr, 
	    Tcl_NewStringObj( Tcl_GetChannelName(statePtr->self), -1) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewIntObj( depth) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tls_NewX509Obj( statePtr->interp, cert) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewIntObj( ok) );

    Tcl_ListObjAppendElement( statePtr->interp, cmdPtr,
	    Tcl_NewStringObj( errStr ? errStr : "", -1) );

    Tcl_Preserve( (ClientData) statePtr->interp);
    Tcl_Preserve( (ClientData) statePtr);

    statePtr->flags |= TLS_TCL_CALLBACK;

    Tcl_IncrRefCount( cmdPtr);
    if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
	/* It got an error - reject the certificate.		*/
	Tcl_BackgroundError( statePtr->interp);
	ok = 0;
    } else {
	result = Tcl_GetObjResult(statePtr->interp);
	string = Tcl_GetStringFromObj(result, &length);
	/* An empty result leaves verification unchanged.	*/
	if (string != NULL && length > 0) {
	    if (Tcl_GetIntFromObj(statePtr->interp, result, &ok) != TCL_OK) {
		Tcl_BackgroundError(statePtr->interp);
		ok = 0;
	    }
	}
    }
    Tcl_DecrRefCount( cmdPtr);

    statePtr->flags &= ~(TLS_TCL_CALLBACK);

    Tcl_Release( (ClientData) statePtr);
    Tcl_Release( (ClientData) statePtr->interp);

    return(ok);	/* By default, leave verification unchanged.	*/
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Error --
 *
 *	Calls callback with $fd and $msg - so the callback can decide
 *	what to do with errors.
 *
 * 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_Obj *cmdPtr;

    dprintf("Called");

    if (msg && *msg) {
	Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL);
    } else {
	msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL);
    }
    statePtr->err = msg;

    if (statePtr->callback == (Tcl_Obj*)NULL) {
	char buf[BUFSIZ];
	sprintf(buf, "SSL channel \"%s\": error: %s",
	    Tcl_GetChannelName(statePtr->self), msg);
	Tcl_SetResult( statePtr->interp, buf, TCL_VOLATILE);
	Tcl_BackgroundError( statePtr->interp);
	return;
    }
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, 
	    Tcl_NewStringObj("error", -1));

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, 
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    Tcl_ListObjAppendElement(statePtr->interp, cmdPtr,
	    Tcl_NewStringObj(msg, -1));

    Tcl_Preserve((ClientData) statePtr->interp);
    Tcl_Preserve((ClientData) statePtr);

    Tcl_IncrRefCount(cmdPtr);
    if (Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL) != TCL_OK) {
	Tcl_BackgroundError(statePtr->interp);
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) statePtr->interp);
}

/*
 *-------------------------------------------------------------------
 *
 * PasswordCallback -- 
 *
 *	Called when a password is needed to unpack RSA and PEM keys.
 *	Evals any bound password script and returns the result as
 *	the password string.
 *-------------------------------------------------------------------
 */
#ifdef PRE_OPENSSL_0_9_4
/*
 * No way to handle user-data therefore no way without a global
 * variable to access the Tcl interpreter.
*/
static int
PasswordCallback(char *buf, int size, int verify)
{
    return -1;
    	buf = buf;
	size = size;
	verify = verify;
}
#else
static int
PasswordCallback(char *buf, int size, int verify, void *udata)
{
    State *statePtr	= (State *) udata;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int result;

    dprintf("Called");

    if (statePtr->password == NULL) {
	if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL)
		== TCL_OK) {
	    char *ret = (char *) Tcl_GetStringResult(interp);
	    strncpy(buf, ret, (size_t) size);
	    return (int)strlen(ret);
	} else {
	    return -1;
	}
    }

    cmdPtr = Tcl_DuplicateObj(statePtr->password);

    Tcl_Preserve((ClientData) statePtr->interp);
    Tcl_Preserve((ClientData) statePtr);

    Tcl_IncrRefCount(cmdPtr);
    result = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (result != TCL_OK) {
	Tcl_BackgroundError(statePtr->interp);
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);
    Tcl_Release((ClientData) statePtr->interp);

    if (result == TCL_OK) {
	char *ret = (char *) Tcl_GetStringResult(interp);
	strncpy(buf, ret, (size_t) size);
	return (int)strlen(ret);
    } else {
	return -1;
    }
    	verify = verify;
}
#endif

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd -- list available ciphers
 *
 *	This procedure is invoked to process the "tls::ciphers" command
 *	to list available ciphers, based upon protocol selected.
 *
 * Results:
 *	A standard Tcl result list.
 *
 * Side effects:
 *	constructs and destroys SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
static int
CiphersObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
{
    static CONST84 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
    };
    Tcl_Obj *objPtr;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    char *cp, buf[BUFSIZ];
    int index, verbose = 0;

    dprintf("Called");

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj( interp, objv[1], protocols, "protocol", 0,
	&index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc > 2 && Tcl_GetBooleanFromObj( interp, objv[2],
	&verbose) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum protocol)index) {
    case TLS_SSL2:
#if defined(NO_SSL2)
		Tcl_AppendResult(interp, "protocol not supported", NULL);
		return TCL_ERROR;
#else
		ctx = SSL_CTX_new(SSLv2_method()); break;
#endif
    case TLS_SSL3:
#if defined(NO_SSL3)
		Tcl_AppendResult(interp, "protocol not supported", NULL);
		return TCL_ERROR;
#else
		ctx = SSL_CTX_new(SSLv3_method()); break;
#endif
    case TLS_TLS1:
#if defined(NO_TLS1)
		Tcl_AppendResult(interp, "protocol not supported", NULL);
		return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_method()); break;
#endif
    case TLS_TLS1_1:
#if defined(NO_TLS1_1)
		Tcl_AppendResult(interp, "protocol not supported", NULL);
		return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_1_method()); break;
#endif
    case TLS_TLS1_2:
#if defined(NO_TLS1_2)
		Tcl_AppendResult(interp, "protocol not supported", NULL);
		return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLSv1_2_method()); break;
#endif
    case TLS_TLS1_3:
#if defined(NO_TLS1_3)
		Tcl_AppendResult(interp, "protocol not supported", NULL);
		return TCL_ERROR;
#else
		ctx = SSL_CTX_new(TLS_method()); break;
                SSL_CTX_set_min_proto_version (ctx, TLS1_3_VERSION);
                SSL_CTX_set_max_proto_version (ctx, TLS1_3_VERSION);
#endif
    default:
		break;
    }
    if (ctx == NULL) {
	Tcl_AppendResult(interp, REASON(), (char *) NULL);
	return TCL_ERROR;
    }
    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, REASON(), (char *) NULL);
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }
    objPtr = Tcl_NewListObj( 0, NULL);

    if (!verbose) {
	for (index = 0; ; index++) {
	    cp = (char*)SSL_get_cipher_list( ssl, index);
	    if (cp == NULL) break;
	    Tcl_ListObjAppendElement( interp, objPtr,
		Tcl_NewStringObj( cp, -1) );
	}
    } else {
	sk = SSL_get_ciphers(ssl);

	for (index = 0; index < sk_SSL_CIPHER_num(sk); index++) {
	    register size_t i;
	    SSL_CIPHER_description( sk_SSL_CIPHER_value( sk, index),
				    buf, sizeof(buf));
	    for (i = strlen(buf) - 1; i ; i--) {
		if (buf[i] == ' ' || buf[i] == '\n' ||
		    buf[i] == '\r' || buf[i] == '\t') {
		    buf[i] = '\0';
		} else {
		    break;
		}
	    }
	    Tcl_ListObjAppendElement( interp, objPtr,
		Tcl_NewStringObj( buf, -1) );
	}
    }
    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult( interp, objPtr);
    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * HandshakeObjCmd --
 *
 *	This command is used to verify whether the handshake is complete
 *	or not.
 *
 * Results:
 *	A standard Tcl result. 1 means handshake complete, 0 means pending.
 *
 * Side effects:
 *	May force SSL negotiation to take place.
 *
 *-------------------------------------------------------------------
 */

static int HandshakeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
	Tcl_Channel chan;		/* The channel to set a mode on. */
	State *statePtr;		/* client state for ssl socket */
	CONST char *errStr = NULL;
	int ret = 1;
	int err = 0;

	dprintf("Called");

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "channel");
		return(TCL_ERROR);
	}

	chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
	if (chan == (Tcl_Channel) NULL) {
		return(TCL_ERROR);
	}

	/*
	 * Make sure to operate on the topmost channel
	 */
	chan = Tcl_GetTopChannel(chan);
	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
		Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
		return(TCL_ERROR);
	}
	statePtr = (State *)Tcl_GetChannelInstanceData(chan);

	dprintf("Calling Tls_WaitForConnect");
	ret = Tls_WaitForConnect(statePtr, &err, 1);
	dprintf("Tls_WaitForConnect returned: %i", ret);

	if (
	    ret < 0 && \
	    ((statePtr->flags & TLS_TCL_ASYNC) && err == EAGAIN)
	) {
		dprintf("Async set and err = EAGAIN");
		ret = 0;
	} else if (ret < 0) {
		errStr = statePtr->err;
		Tcl_ResetResult(interp);
		Tcl_SetErrno(err);

		if (!errStr || *errStr == 0) {
			errStr = Tcl_PosixError(interp);
		}

		Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL);
		dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
		return(TCL_ERROR);
	} else {
		if (err != 0) {
			dprintf("Got an error with a completed handshake: err = %i", err);
		}

		ret = 1;
	}

	dprintf("Returning TCL_OK with data \"%i\"", ret);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(ret));
	return(TCL_OK);

    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *
 *	This procedure is invoked to process the "ssl" command
 *
 *	The ssl command pushes SSL over a (newly connected) tcp socket
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */

static int
ImportObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST objv[];
{
    Tcl_Channel chan;		/* The channel to set a mode on. */
    State *statePtr;		/* client state for ssl socket */
    SSL_CTX *ctx	        = NULL;
    Tcl_Obj *script	        = NULL;
    Tcl_Obj *password	        = NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx, len;
    int flags		        = TLS_TCL_INIT;
    int server		        = 0;	/* is connection incoming or outgoing? */
    char *keyfile	        = NULL;
    char *certfile	        = NULL;
    unsigned char *key  	= NULL;
    int key_len                 = 0;
    unsigned char *cert         = NULL;
    int cert_len                = 0;
    char *ciphers	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
#ifndef OPENSSL_NO_TLSEXT
    char *servername	        = NULL;	/* hostname for Server Name Indication */
#endif
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0;
    int verify = 0, require = 0, request = 1;

    dprintf("Called");

#if defined(NO_TLS1) && defined(NO_TLS1_1) && defined(NO_TLS1_2) && defined(NO_SSL3) && !defined(NO_SSL2)
    ssl2 = 1;
#endif
#if defined(NO_TLS1) && defined(NO_TLS1_1) && defined(NO_TLS1_2) && defined(NO_SSL2) && !defined(NO_SSL3)
    ssl3 = 1;
#endif
#if defined(NO_TLS1)
    tls1 = 0;
#endif
#if defined(NO_TLS1_1)
    tls1_1 = 0;
#endif
#if defined(NO_TLS1_2)
    tls1_2 = 0;
#endif
#if defined(NO_TLS1_3)
    tls1_3 = 0;
#endif

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

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);

    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

	if (opt[0] != '-')
	    break;

	OPTSTR( "-cadir", CAdir);
	OPTSTR( "-cafile", CAfile);
	OPTSTR( "-certfile", certfile);
	OPTSTR( "-cipher", ciphers);
	OPTOBJ( "-command", script);
	OPTSTR( "-dhparams", DHparams);
	OPTSTR( "-keyfile", keyfile);
	OPTSTR( "-model", model);
	OPTOBJ( "-password", password);
	OPTBOOL( "-require", require);
	OPTBOOL( "-request", request);
	OPTBOOL( "-server", server);
#ifndef OPENSSL_NO_TLSEXT
        OPTSTR( "-servername", servername);
#endif

	OPTBOOL( "-ssl2", ssl2);
	OPTBOOL( "-ssl3", ssl3);
	OPTBOOL( "-tls1", tls1);
	OPTBOOL( "-tls1.1", tls1_1);
	OPTBOOL( "-tls1.2", tls1_2);
	OPTBOOL( "-tls1.3", tls1_3);
  OPTBYTE("-cert", cert, cert_len);
  OPTBYTE("-key", key, key_len);

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

	return TCL_ERROR;
    }
    if (request)	    verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (verify == 0)	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);

    /* reset to NULL if blank string provided */
    if (cert && !*cert)		        cert	        = NULL;
    if (key && !*key)		        key	        = NULL;
    if (certfile && !*certfile)         certfile	= NULL;
    if (keyfile && !*keyfile)		keyfile	        = NULL;
    if (ciphers && !*ciphers)	        ciphers	        = NULL;
    if (CAfile && !*CAfile)	        CAfile	        = NULL;
    if (CAdir && !*CAdir)	        CAdir	        = NULL;
    if (DHparams && !*DHparams)	        DHparams        = NULL;

    /* new SSL state */
    statePtr		= (State *) ckalloc((unsigned) sizeof(State));
    memset(statePtr, 0, sizeof(State));

    statePtr->flags	= flags;
    statePtr->interp	= interp;
    statePtr->vflags	= verify;
    statePtr->err	= "";

    /* allocate script */
    if (script) {
	(void) Tcl_GetStringFromObj(script, &len);
	if (len) {
	    statePtr->callback = script;
	    Tcl_IncrRefCount(statePtr->callback);
	}
    }

    /* allocate password */
    if (password) {
	(void) Tcl_GetStringFromObj(password, &len);
	if (len) {
	    statePtr->password = password;
	    Tcl_IncrRefCount(statePtr->password);
	}
    }

    if (model != NULL) {
	int mode;
	/* Get the "model" context */
	chan = Tcl_GetChannel(interp, model, &mode);
	if (chan == (Tcl_Channel) NULL) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}

        /*
         * Make sure to operate on the topmost channel
         */
        chan = Tcl_GetTopChannel(chan);
	if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	    Tcl_AppendResult(interp, "bad channel \"",
		    Tcl_GetChannelName(chan), "\": not a TLS channel", NULL);
	    Tls_Free((char *) 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, CAdir, CAfile, ciphers,
    DHparams)) == (SSL_CTX*)0) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;

    /*
     * We need to make sure that the channel works in binary (for the
     * encryption not to get goofed up).
     * We only want to adjust the buffering in pre-v2 channels, where
     * each channel in the stack maintained its own buffers.
     */
    Tcl_DStringInit(&upperChannelTranslation);
    Tcl_DStringInit(&upperChannelBlocking);
    Tcl_DStringInit(&upperChannelEOFChar);
    Tcl_DStringInit(&upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-eofchar", &upperChannelEOFChar);
    Tcl_GetChannelOption(interp, chan, "-encoding", &upperChannelEncoding);
    Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation);
    Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking);
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    Tcl_SetChannelOption(interp, chan, "-blocking", "true");
    dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan));
    statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE), chan);
    dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self));
    if (statePtr->self == (Tcl_Channel) NULL) {
	/*
	 * No use of Tcl_EventuallyFree because no possible Tcl_Preserve.
	 */
	Tls_Free((char *) statePtr);
	return TCL_ERROR;
    }

    Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation));
    Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding));
    Tcl_SetChannelOption(interp, statePtr->self, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar));
    Tcl_SetChannelOption(interp, statePtr->self, "-blocking", Tcl_DStringValue(&upperChannelBlocking));

    /*
     * SSL Initialization
     */

    statePtr->ssl = SSL_new(statePtr->ctx);
    if (!statePtr->ssl) {
	/* SSL library error */
	Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(),
		(char *) NULL);
	Tls_Free((char *) statePtr);
	return TCL_ERROR;
    }

#ifndef OPENSSL_NO_TLSEXT
    if (servername) {
        if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
            Tcl_AppendResult(interp, "setting TLS host name extension failed",
                (char *) NULL);
            Tls_Free((char *) statePtr);
            return TCL_ERROR;
        }
    }
#endif

    /*
     * SSL Callbacks
     */

    SSL_set_app_data(statePtr->ssl, (VOID *)statePtr);	/* point back to us */

    SSL_set_verify(statePtr->ssl, verify, VerifyCallback);

    SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback);

    /* Create Tcl_Channel BIO Handler */
    statePtr->p_bio	= BIO_new_tcl(statePtr, BIO_NOCLOSE);
    statePtr->bio	= BIO_new(BIO_f_ssl());

    if (server) {
	statePtr->flags |= TLS_TCL_SERVER;
	SSL_set_accept_state(statePtr->ssl);
    } else {
	SSL_set_connect_state(statePtr->ssl);
    }
    SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio);
    BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE);

    /*
     * End of SSL Init
     */
    dprintf("Returning %s", Tcl_GetChannelName(statePtr->self));
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self),
	    TCL_VOLATILE);
    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * UnimportObjCmd --
 *
 *	This procedure is invoked to remove the topmost channel filter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *-------------------------------------------------------------------
 */

static int
UnimportObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST objv[];
{
    Tcl_Channel chan;		/* The channel to set a mode on. */

    dprintf("Called");

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);

    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", NULL);
	return TCL_ERROR;
    }

    if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
	return TCL_ERROR;
    }

    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * CTX_Init -- construct a SSL_CTX instance
 *
 * Results:
 *	A valid SSL_CTX instance or NULL.
 *
 * Side effects:
 *	constructs SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */

static SSL_CTX *
CTX_Init(statePtr, isServer, proto, keyfile, certfile, key, cert,
         key_len, cert_len, CAdir, CAfile, ciphers, DHparams)
    State *statePtr;
    int isServer;
    int proto;
    char *keyfile;
    char *certfile;
    unsigned char *key;
    unsigned char *cert;
    int key_len;
    int cert_len;
    char *CAdir;
    char *CAfile;
    char *ciphers;
    char *DHparams;
{
    Tcl_Interp *interp = statePtr->interp;
    SSL_CTX *ctx = NULL;
    Tcl_DString ds;
    Tcl_DString ds1;
    int off = 0;
    int load_private_key;
    const SSL_METHOD *method;

    dprintf("Called");

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

    /* create SSL context */
#if defined(NO_SSL2)
    if (ENABLED(proto, TLS_PROTO_SSL2)) {
	Tcl_AppendResult(interp, "protocol not supported", NULL);
	return (SSL_CTX *)0;
    }
#endif
#if defined(NO_SSL3)
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
	Tcl_AppendResult(interp, "protocol not supported", NULL);
	return (SSL_CTX *)0;
    }
#endif
#if defined(NO_TLS1)
    if (ENABLED(proto, TLS_PROTO_TLS1)) {
	Tcl_AppendResult(interp, "protocol not supported", NULL);
	return (SSL_CTX *)0;
    }
#endif
#if defined(NO_TLS1_1)
    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
	Tcl_AppendResult(interp, "protocol not supported", NULL);
	return (SSL_CTX *)0;
    }
#endif
#if defined(NO_TLS1_2)
    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
	Tcl_AppendResult(interp, "protocol not supported", NULL);
	return (SSL_CTX *)0;
    }
#endif
#if defined(NO_TLS1_3)
    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
	Tcl_AppendResult(interp, "protocol not supported", NULL);
	return (SSL_CTX *)0;
    }
#endif

    switch (proto) {
#if !defined(NO_SSL2)
    case TLS_PROTO_SSL2:
	method = SSLv2_method ();
	break;
#endif
#if !defined(NO_SSL3)
    case TLS_PROTO_SSL3:
	method = SSLv3_method ();
	break;
#endif
#if !defined(NO_TLS1)
    case TLS_PROTO_TLS1:
	method = TLSv1_method ();
	break;
#endif
#if !defined(NO_TLS1_1)
    case TLS_PROTO_TLS1_1:
	method = TLSv1_1_method ();
	break;
#endif
#if !defined(NO_TLS1_2)
    case TLS_PROTO_TLS1_2:
	method = TLSv1_2_method ();
	break;
#endif
#if !defined(NO_TLS1_3)
    case TLS_PROTO_TLS1_3:
        /*
         * The version range is constrained below,
         * after the context is created.  Use the
         * generic method here.
         */
	method = TLS_method ();
	break;
#endif
    default:
#ifdef HAVE_TLS_METHOD
        method = TLS_method ();
#else
        method = SSLv23_method ();
#endif
#if !defined(NO_SSL2)
	off |= (ENABLED(proto, TLS_PROTO_SSL2)   ? 0 : SSL_OP_NO_SSLv2);
#endif
#if !defined(NO_SSL3)
	off |= (ENABLED(proto, TLS_PROTO_SSL3)   ? 0 : SSL_OP_NO_SSLv3);
#endif
#if !defined(NO_TLS1)
	off |= (ENABLED(proto, TLS_PROTO_TLS1)   ? 0 : SSL_OP_NO_TLSv1);
#endif
#if !defined(NO_TLS1_1)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1);
#endif
#if !defined(NO_TLS1_2)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
#if !defined(NO_TLS1_3)
	off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3);
#endif
	break;
    }
    
    ctx = SSL_CTX_new (method);

    if (!ctx) {
        return(NULL);
    }

#if !defined(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
    
    SSL_CTX_set_app_data( ctx, (VOID*)interp);	/* remember the interpreter */
    SSL_CTX_set_options( ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options( ctx, off);	/* all SSL bug workarounds */
    SSL_CTX_sess_set_cache_size( ctx, 128);

    if (ciphers != NULL)
	SSL_CTX_set_cipher_list(ctx, ciphers);

    /* set some callbacks */
    SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback);

#ifndef BSAFE
    SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr);
#endif

    /* read a Diffie-Hellman parameters file, or use the built-in one */
#ifdef OPENSSL_NO_DH
    if (DHparams != NULL) {
	Tcl_AppendResult(interp,
	    "DH parameter support not available", (char *) NULL);
	SSL_CTX_free(ctx);
	return (SSL_CTX *)0;
    }
#else
    {
	DH* dh;
	if (DHparams != NULL) {
	    BIO *bio;
	    Tcl_DStringInit(&ds);
	    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 (SSL_CTX *)0;
	    }
	    
	    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);
		SSL_CTX_free(ctx);
		return (SSL_CTX *)0;
	    }
	} else {
	    dh = get_dhParams();
	}
	SSL_CTX_set_tmp_dh(ctx, dh);
	DH_free(dh);
    }
#endif

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

	Tcl_DStringInit(&ds);

	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, ": ",
			     REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
	}
    } else if (cert != NULL) {
	load_private_key = 1;
	if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
			     "unable to set certificate: ",
			     REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
	}
    } else {
	certfile = (char*)X509_get_default_cert_file();

	if (SSL_CTX_use_certificate_file(ctx, certfile,
					SSL_FILETYPE_PEM) <= 0) {
#if 0
	    Tcl_DStringFree(&ds);
	    Tcl_AppendResult(interp,
			     "unable to use default certificate file ", certfile, ": ",
			     REASON(), (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
#endif
	}
    }

    /* 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 */
	    if (keyfile == NULL) {
		keyfile = certfile;
	    }

	    if (SSL_CTX_use_PrivateKey_file(ctx, F2N( keyfile, &ds), SSL_FILETYPE_PEM) <= 0) {
		Tcl_DStringFree(&ds);
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp,
			         "unable to set public key file ", keyfile, " ",
			         REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return (SSL_CTX *)0;
	    }

	    Tcl_DStringFree(&ds);
	} else if (key != NULL) {
	    if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) {
		Tcl_DStringFree(&ds);
		/* flush the passphrase which might be left in the result */
		Tcl_SetResult(interp, NULL, TCL_STATIC);
		Tcl_AppendResult(interp,
		                 "unable to set public key: ",
		                 REASON(), (char *) NULL);
		SSL_CTX_free(ctx);
		return (SSL_CTX *)0;
	    }
	}
	/* Now we know that a key and cert have been set against
	 * the SSL context */
	if (!SSL_CTX_check_private_key(ctx)) {
	    Tcl_AppendResult(interp,
			     "private key does not match the certificate public key",
			     (char *) NULL);
	    SSL_CTX_free(ctx);
	    return (SSL_CTX *)0;
	}
    }

    /* Set verification CAs */
    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&ds1);
    if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CAdir, &ds1)) ||
	!SSL_CTX_set_default_verify_paths(ctx)) {
#if 0
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&ds1);
	/* Don't currently care if this fails */
	Tcl_AppendResult(interp, "SSL default verify paths: ",
		REASON(), (char *) NULL);
	SSL_CTX_free(ctx);
	return (SSL_CTX *)0;
#endif
    }

    /* https://sourceforge.net/p/tls/bugs/57/ */
    /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */
    if ( CAfile != NULL ) {
        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);
    Tcl_DStringFree(&ds1);
    return ctx;
}

/*
 *-------------------------------------------------------------------
 *
 * StatusObjCmd -- return certificate for connected peer.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
StatusObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
{
    State *statePtr;
    X509 *peer;
    Tcl_Obj *objPtr;
    Tcl_Channel chan;
    char *channelName, *ciphers;
    int mode;

    dprintf("Called");

    switch (objc) {
	case 2:
	    channelName = Tcl_GetStringFromObj(objv[1], NULL);
	    break;

	case 3:
	    if (!strcmp (Tcl_GetString (objv[1]), "-local")) {
		channelName = Tcl_GetStringFromObj(objv[2], NULL);
		break;
	    }
	    /* else fall... */
	default:
	    Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
	    return TCL_ERROR;
    }

    chan = Tcl_GetChannel(interp, channelName, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
    /*
     * Make sure to operate on the topmost channel
     */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
		"\": not a TLS channel", NULL);
	return TCL_ERROR;
    }
    statePtr = (State *) Tcl_GetChannelInstanceData(chan);
    if (objc == 2) {
	peer = SSL_get_peer_certificate(statePtr->ssl);
    } else {
	peer = SSL_get_certificate(statePtr->ssl);
    }
    if (peer) {
	objPtr = Tls_NewX509Obj(interp, peer);
	if (objc == 2) { X509_free(peer); }
    } else {
	objPtr = Tcl_NewListObj(0, NULL);
    }

    Tcl_ListObjAppendElement (interp, objPtr,
	    Tcl_NewStringObj ("sbits", -1));
    Tcl_ListObjAppendElement (interp, objPtr,
	    Tcl_NewIntObj (SSL_get_cipher_bits (statePtr->ssl, NULL)));

    ciphers = (char*)SSL_get_cipher(statePtr->ssl);
    if (ciphers != NULL && strcmp(ciphers, "(NONE)")!=0) {
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj("cipher", -1));
	Tcl_ListObjAppendElement(interp, objPtr,
		Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
    }

    Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_NewStringObj("version", -1));
    Tcl_ListObjAppendElement(interp, objPtr,
	Tcl_NewStringObj(SSL_get_version(statePtr->ssl), -1));

    Tcl_SetObjResult( interp, objPtr);
    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * VersionObjCmd -- return version string from OpenSSL.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
VersionObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
{
    Tcl_Obj *objPtr;

    dprintf("Called");

    objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
    	clientData = clientData;
    	objc = objc;
    	objv = objv;
}

/*
 *-------------------------------------------------------------------
 *
 * MiscObjCmd -- misc commands
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
MiscObjCmd(clientData, interp, objc, objv)
    ClientData clientData;	/* Not used. */
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj	*CONST objv[];
{
    static CONST84 char *commands [] = { "req", NULL };
    enum command { C_REQ, C_DUMMY };
    int cmd;

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], commands,
	    "command", 0,&cmd) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum command) cmd) {
	case C_REQ: {
	    EVP_PKEY *pkey=NULL;
	    X509 *cert=NULL;
	    X509_NAME *name=NULL;
	    Tcl_Obj **listv;
	    int listc,i;

	    BIO *out=NULL;

	    char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
	    char *keyout,*pemout,*str;
	    int keysize,serial=0,days=365;
	    
	    if ((objc<5) || (objc>6)) {
		Tcl_WrongNumArgs(interp, 2, objv, "keysize keyfile certfile ?info?");
		return TCL_ERROR;
	    }

	    if (Tcl_GetIntFromObj(interp, objv[2], &keysize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    keyout=Tcl_GetString(objv[3]);
	    pemout=Tcl_GetString(objv[4]);

	    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;
		}
		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;
		    } else if (strcmp(str,"serial")==0) {
			if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK)
			    return TCL_ERROR;
		    } else if (strcmp(str,"serial")==0) {
			if (Tcl_GetIntFromObj(interp,listv[i+1],&serial)!=TCL_OK)
			    return TCL_ERROR;
		    } else if (strcmp(str,"C")==0) {
			k_C=Tcl_GetString(listv[i+1]);
		    } else if (strcmp(str,"ST")==0) {
			k_ST=Tcl_GetString(listv[i+1]);
		    } else if (strcmp(str,"L")==0) {
			k_L=Tcl_GetString(listv[i+1]);
		    } else if (strcmp(str,"O")==0) {
			k_O=Tcl_GetString(listv[i+1]);
		    } else if (strcmp(str,"OU")==0) {
			k_OU=Tcl_GetString(listv[i+1]);
		    } else if (strcmp(str,"CN")==0) {
			k_CN=Tcl_GetString(listv[i+1]);
		    } else if (strcmp(str,"Email")==0) {
			k_Email=Tcl_GetString(listv[i+1]);
		    } else {
			Tcl_SetResult(interp,"Unknown parameter",NULL);
			return TCL_ERROR;
		    }
		}
	    }
	    if ((pkey = EVP_PKEY_new()) != NULL) {
		if (!EVP_PKEY_assign_RSA(pkey,
			RSA_generate_key(keysize, 0x10001, NULL, NULL))) {
		    Tcl_SetResult(interp,"Error generating private key",NULL);
		    EVP_PKEY_free(pkey);
		    return TCL_ERROR;
		}
		out=BIO_new(BIO_s_file());
		BIO_write_filename(out,keyout);
		PEM_write_bio_PrivateKey(out,pkey,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);
		    return(TCL_ERROR);
		}

		X509_set_version(cert,2);
		ASN1_INTEGER_set(X509_get_serialNumber(cert),serial);
		X509_gmtime_adj(X509_get_notBefore(cert),0);
		X509_gmtime_adj(X509_get_notAfter(cert),(long)60*60*24*days);
		X509_set_pubkey(cert,pkey);
		
		name=X509_get_subject_name(cert);

		X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (unsigned char *) k_C, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (unsigned char *) k_ST, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (unsigned char *) k_L, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (unsigned char *) k_O, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (unsigned char *) k_OU, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, (unsigned char *) k_CN, -1, -1, 0);
		X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, (unsigned char *) k_Email, -1, -1, 0);

		X509_set_subject_name(cert,name);

		if (!X509_sign(cert,pkey,EVP_md5())) {
		    X509_free(cert);
		    EVP_PKEY_free(pkey);
		    Tcl_SetResult(interp,"Error signing certificate",NULL);
		    return TCL_ERROR;
		}

		out=BIO_new(BIO_s_file());
		BIO_write_filename(out,pemout);

		PEM_write_bio_X509(out,cert);
		BIO_free_all(out);

		X509_free(cert);
		EVP_PKEY_free(pkey);
	    } else {
		Tcl_SetResult(interp,"Error generating private key",NULL);
		return TCL_ERROR;
	    }
	}
	break;
    default:
	break;
    }
    return TCL_OK;
    	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * 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( char *blockPtr )
{
    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) {
    dprintf("Called");

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

    if (statePtr->bio) {
	/* This will call SSL_shutdown. Bug 1414045 */
	dprintf("BIO_free_all(%p)", statePtr->bio);
	BIO_free_all(statePtr->bio);
	statePtr->bio = NULL;
    }
    if (statePtr->ssl) {
	dprintf("SSL_free(%p)", statePtr->ssl);
	SSL_free(statePtr->ssl);
	statePtr->ssl = NULL;
    }
    if (statePtr->ctx) {
	SSL_CTX_free(statePtr->ctx);
	statePtr->ctx = NULL;
    }
    if (statePtr->callback) {
	Tcl_DecrRefCount(statePtr->callback);
	statePtr->callback = NULL;
    }
    if (statePtr->password) {
	Tcl_DecrRefCount(statePtr->password);
	statePtr->password = NULL;
    }

    dprintf("Returning");
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_Init --
 *
 *	This is a package initialization procedure, which is called
 *	by Tcl when this package is to be added to an interpreter.
 *
 * Results:  Ssl configured and loaded
 *
 * Side effects:
 *	 create the ssl command, initialise ssl context
 *
 *-------------------------------------------------------------------
 */

DLLEXPORT int Tls_Init(Tcl_Interp *interp) {
	const char tlsTclInitScript[] = {
#include "tls.tcl.h"
            0x00
	};

        dprintf("Called");

	/*
	 * We only support Tcl 8.4 or newer
	 */
	if (
#ifdef USE_TCL_STUBS
	    Tcl_InitStubs(interp, "8.4", 0)
#else
	    Tcl_PkgRequire(interp, "Tcl", "8.4", 0)
#endif
	     == NULL) {
		return TCL_ERROR;
	}

	if (TlsLibInit(0) != TCL_OK) {
		Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
		return TCL_ERROR;
	}

	Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

	if (interp) {
		Tcl_Eval(interp, tlsTclInitScript);
	}

	return(Tcl_PkgProvide(interp, "tls", PACKAGE_VERSION));
}

/*
 *------------------------------------------------------*
 *
 *	Tls_SafeInit --
 *
 *	------------------------------------------------*
 *	Standard procedure required by 'load'. 
 *	Initializes this extension for a safe interpreter.
 *	------------------------------------------------*
 *
 *	Sideeffects:
 *		As of 'Tls_Init'
 *
 *	Result:
 *		A standard Tcl error code.
 *
 *------------------------------------------------------*
 */

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

/*
 *------------------------------------------------------*
 *
 *	TlsLibInit --
 *
 *	------------------------------------------------*
 *	Initializes SSL library once per application
 *	------------------------------------------------*
 *
 *	Side effects:
 *		initilizes 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

	if (uninitialize) {
		if (!initialized) {
			dprintf("Asked to uninitialize, but we are not initialized");

			return(TCL_OK);
		}

		dprintf("Asked to uninitialize");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
		Tcl_MutexLock(&init_mx);

		CRYPTO_set_locking_callback(NULL);
		CRYPTO_set_id_callback(NULL);

		if (locks) {
			free(locks);
			locks = NULL;
			locksCount = 0;
		}
#endif
		initialized = 0;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
		Tcl_MutexUnlock(&init_mx);
#endif

		return(TCL_OK);
	}

	if (initialized) {
		dprintf("Called, but using cached value");
		return(status);
	}

	dprintf("Called");

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexLock(&init_mx);
#endif
	initialized = 1;

#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	num_locks = CRYPTO_num_locks();
	locksCount = num_locks;
	locks = malloc(sizeof(*locks) * num_locks);
	memset(locks, 0, sizeof(*locks) * num_locks);

	CRYPTO_set_locking_callback(CryptoThreadLockCallback);
	CRYPTO_set_id_callback(CryptoThreadIdCallback);
#endif

	if (SSL_library_init() != 1) {
		status = TCL_ERROR;
		goto done;
	}

	SSL_load_error_strings();
	ERR_load_crypto_strings();

	BIO_new_tcl(NULL, 0);

#if 0
	/*
	 * XXX:TODO: Remove this code and replace it with a check
	 * for enough entropy and do not try to create our own
	 * terrible entropy
	 */
    /*
     * Seed the random number generator in the SSL library,
     * using the do/while construct because of the bug note in the
     * OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1
     *
     * The crux of the problem is that Solaris 7 does not have a 
     * /dev/random or /dev/urandom device so it cannot gather enough
     * entropy from the RAND_seed() when TLS initializes and refuses
     * to go further. Earlier versions of OpenSSL carried on regardless.
     */
    srand((unsigned int) time((time_t *) NULL));
    do {
	for (i = 0; i < 16; i++) {
	    rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0));
	}
	RAND_seed(rnd_seed, sizeof(rnd_seed));
    } while (RAND_status() != 1);
#endif

done:
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
	Tcl_MutexUnlock(&init_mx);
#endif

	return(status);
}

Deleted tls.h version [625cff2305].

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





























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), 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)
 *
 */
#ifndef _TLS_H
#define _TLS_H

#include <tcl.h>

/*
 * Initialization routines -- our entire public C API.
 */
DLLEXPORT int Tls_Init(Tcl_Interp *interp);
DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp);

#endif /* _TLS_H */

Deleted tls.htm version [54230bffc5].

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





































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"> 

<html>

<head>
<meta http-equiv="Content-Type"
content="text/html; charset=iso-8859-1">
<meta name="Copyright" content="1999 Matt Newman / 2004 Starfish Systems">
<title>TLS (SSL) Tcl Commands</title>
</head>

<body bgcolor="#FFFFFF">

<dl>
    <dd><a href="#NAME">NAME</a> <dl>
            <dd><strong>tls</strong> - binding to <strong>OpenSSL</strong>
                toolkit.</dd>
        </dl>
    </dd>
    <dd><a href="#SYNOPSIS">SYNOPSIS</a> </dd>
    <dd><dl>
            <dd><b>package require Tcl </b><em>?8.4?</em></dd>
            <dd><b>package require tls </b><em>?@@VERS@@?</em></dd>
            <dt>&nbsp;</dt>
            <dd><b>tls::init </b><i>?options?</i> </dd>
            <dd><b>tls::socket </b><em>?options? host port</em></dd>
            <dd><b>tls::socket</b><em> ?-server command?
                ?options? port</em></dd>
            <dd><b>tls::handshake</b><em> channel</em></dd>
            <dd><b>tls::status </b><em>?-local? channel</em></dd>
            <dd><b>tls::import</b><em> channel ?options?</em></dd>
            <dd><b>tls::unimport</b><em> channel</em></dd>
            <dd><b>tls::ciphers </b><em>protocol ?verbose?</em></dd>
            <dd><b>tls::version</b></dd>
        </dl>
    </dd>
    <dd><a href="#COMMANDS">COMMANDS</a></dd>
    <dd><a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a></dd>
    <dd><a href="#HTTPS EXAMPLE">HTTPS EXAMPLE</a></dd>
    <dd><a href="#SEE ALSO">SPECIAL CONSIDERATIONS</a></dd>
    <dd><a href="#SEE ALSO">SEE ALSO</a></dd>
</dl>

<hr>

<h3><a name="NAME">NAME</a></h3>

<p><strong>tls</strong> - binding to <strong>OpenSSL</strong>
toolkit.</p>

<h3><a name="SYNOPSIS">SYNOPSIS</a></h3>

<p><b>package require Tcl 8.4</b><br>
<b>package require tls @@VERS@@</b><br>
<br>
<a href="#tls::init"><b>tls::init </b><i>?options?</i><br>
</a><a href="#tls::socket"><b>tls::socket </b><em>?options? host
port</em><br>
<b>tls::socket</b><em> ?-server command? ?options? port</em><br>
</a><a href="#tls::status"><b>tls::status </b><em>?-local? channel</em><br>
</a><a href="#tls::handshake"><b>tls::handshake</b><em> channel</em></a><br>
<br>
<a href="#tls::import"><b>tls::import </b><i>channel ?options?</i></a><br>
<a href="#tls::unimport"><b>tls::unimport </b><i>channel</i></a><br>
<a href="#tls::ciphers protocol ?verbose?"><strong>tls::ciphers</strong>
<em>protocol ?verbose?</em></a><br>
<a href="#tls::version"><b>tls::version</b></a>
</p>

<h3><a name="DESCRIPTION">DESCRIPTION</a></h3>

<p>This extension provides a generic binding to <a
href="http://www.openssl.org/">OpenSSL</a>, utilizing the
<strong>Tcl_StackChannel</strong>
API for Tcl 8.2 and higher. The sockets behave exactly the same
as channels created using Tcl's built-in <strong>socket</strong>
command with additional options for controlling the SSL session.
To use TLS with an earlier version of Tcl than 8.4, please obtain
TLS 1.3.
</p>

<h3><a name="COMMANDS">COMMANDS</a></h3>

<p>Typically one would use the <strong>tls::socket </strong>command
which provides compatibility with the native Tcl <strong>socket</strong>
command. In such cases <strong>tls::import</strong> should not be
used directly.</p>

<dl>
    <dt><a name="tls::init"><b>tls::init </b><i>?options?</i></a></dt>
    <dd>This routine sets the default options used by <strong>tls::socket</strong>
        and is <em>optional</em>. If you call <strong>tls::import</strong>
        directly this routine has no effect. Any of the options
        that <strong>tls::socket</strong> accepts can be set
        using this command, though you should limit your options
        to only TLS related ones.</dd>
    <dt>&nbsp;</dt>
    <dt><a name="tls::socket"><b>tls::socket </b><em>?options?
        host port</em></a></dt>
    <dt><b>tls::socket</b><em> ?-server command? ?options? port</em></dt>
    <dd>This is a helper function that utilizes the underlying
        commands (<strong>tls::import</strong>). It behaves
        exactly the same as the native Tcl <strong>socket</strong>
        command except that the options can include any of the
        applicable <a href="#tls::import"><strong>tls:import</strong></a>
        options with one additional option:
<blockquote>
    <dl>
        <dt><strong>-autoservername</strong> <em>bool</em></dt>
        <dd>Automatically send the -servername as the <em>host</em> argument
            (<strong>default</strong>: <em>false</em>)</dd>
    </dl>
</blockquote>
    <dt>&nbsp;</dt>
    <dt><a name="tls::handshake"><strong>tls::handshake</strong> <em>channel</em></a></dt>
    <dd>Forces handshake to take place, and returns 0 if
        handshake is still in progress (non-blocking), or 1 if
        the handshake was successful. If the handshake failed
        this routine will throw an error.</dd>
    <dt>&nbsp;</dt>
    <dt><a name="tls::status"><strong>tls::status</strong>
    <em>?-local? channel</em></a></dt>
    <dd>Returns the current security status of an SSL channel. The
        result is a list of key-value pairs describing the
        connected peer. If the result is an empty list then the
        SSL handshake has not yet completed.
        If <em>-local</em> is given, then the certificate information
        is the one used locally.</dd>
</dl>

<blockquote>
    <dl>
        <dt><strong>issuer</strong> <em>dn</em></dt>
        <dd>The distinguished name (DN) of the certificate
            issuer.</dd>
        <dt><strong>subject</strong> <em>dn</em></dt>
        <dd>The distinguished name (DN) of the certificate
            subject.</dd>
        <dt><strong>notBefore</strong> <em>date</em></dt>
        <dd>The begin date for the validity of the certificate.</dd>
        <dt><strong>notAfter</strong> <em>date</em></dt>
        <dd>The expiry date for the certificate.</dd>
        <dt><strong>serial</strong> <em>n</em></dt>
        <dd>The serial number of the certificate.</dd>
        <dt><strong>cipher</strong> <em>cipher</em></dt>
        <dd>The current cipher in use between the client and
            server channels.</dd>
        <dt><strong>sbits</strong> <em>n</em></dt>
        <dd>The number of bits used for the session key.</dd>
        <dt><strong>certificate</strong> <em>n</em></dt>
        <dd>The PEM encoded certificate.</dd>
        <dt><strong>version</strong> <em>value</em></dt>
        <dd>The protocol version used for the connection:
	  SSLv2, SSLv3, TLSv1, TLSv1.1, TLSv1.2, unknown</dd>
    </dl>
</blockquote>

<dl>
    <dt><a name="tls::import"><b>tls::import </b><i>channel
        ?options?</i></a></dt>
    <dd>SSL-enable a regular Tcl channel - it need not be a
        socket, but must provide bi-directional flow. Also
        setting session parameters for SSL handshake.</dd>
</dl>

<blockquote>
    <dl>
        <dt><strong>-cadir</strong> <em>dir</em></dt>
        <dd>Provide the directory containing the CA certificates.</dd>
        <dt><strong>-cafile </strong><em>filename</em></dt>
        <dd>Provide the CA file.</dd>
        <dt><strong>-certfile</strong> <em>filename</em></dt>
        <dd>Provide the name of a file containing certificate to use.</dd>
        <dt><strong>-cert</strong> <em>filename</em></dt>
        <dd>Provide the contents of a certificate to use, as a DER encoded binary value (X.509 DER).</dd>
        <dt><strong>-cipher </strong><em>string</em></dt>
        <dd>Provide the cipher suites to use. Syntax is as per
            OpenSSL.</dd>
        <dt><strong>-command</strong> <em>callback</em></dt>
        <dd>If specified, this callback will be invoked at several points
            during the OpenSSL handshake.  It can pass errors and tracing
            information, and it can allow Tcl scripts to perform
            their own validation of the certificate in place of the
            default validation provided by OpenSSL.
            <br>
            See <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a> for
            further discussion.</dd>
        <dt><strong>-dhparams </strong><em>filename</em></dt>
        <dd>Provide a Diffie-Hellman parameters file.</dd>
        <dt><strong>-keyfile</strong> <em>filename</em></dt>
        <dd>Provide the private key file. (<strong>default</strong>:
            value of -certfile)</dd>
        <dt><strong>-key</strong> <em>filename</em></dt>
        <dd>Provide the private key to use as a DER encoded value (PKCS#1 DER)</dd>
        <dt><strong>-model</strong> <em>channel</em></dt>
        <dd>This will force this channel to share the same <em><strong>SSL_CTX</strong></em>
            structure as the specified <em>channel</em>, and
            therefore share callbacks etc.</dd>
        <dt><strong>-password</strong> <em>callback</em></dt>
        <dd>If supplied, this callback will be invoked when OpenSSL needs
            to obtain a password, typically to unlock the private key of
	    a certificate.
            The callback should return a string which represents the
            password to be used.
            <br>
            See <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a> for
            further discussion.</dd>
        <dt><strong>-request </strong><em>bool</em></dt>
        <dd>Request a certificate from peer during SSL handshake.
            (<strong>default</strong>: <em>true</em>)</dd>
        <dt><strong>-require</strong> <em>bool</em></dt>
        <dd>Require a valid certificate from peer during SSL
            handshake. If this is set to true then <strong>-request</strong>
            must also be set to true. (<strong>default</strong>: <em>false</em>)</dd>
        <dt><strong>-server</strong> <em>bool</em></dt>
        <dd>Handshake as server if true, else handshake as
            client.(<strong>default</strong>: <em>false</em>)</dd>
        <dt><strong>-servername</strong> <em>host</em></dt>
        <dd>Only available if the OpenSSL library the package is linked
	    against supports the TLS hostname extension for 'Server Name
	    Indication' (SNI). Use to name the logical host we are talking
	    to and expecting a certificate for</dd>
        <dt><strong>-ssl2</strong> <em>bool</em></dt>
        <dd>Enable use of SSL v2. (<strong>default</strong>: <em>false</em>)</dd>
        <dt><strong>-ssl3 </strong><em>bool</em></dt>
        <dd>Enable use of SSL v3. (<strong>default</strong>: <em>false</em>)</dd>
        <dt>-<strong>tls1</strong> <em>bool</em></dt>
        <dd>Enable use of TLS v1. (<strong>default</strong>: <em>true</em>)</dd>
        <dt>-<strong>tls1.1</strong> <em>bool</em></dt>
        <dd>Enable use of TLS v1.1 (<strong>default</strong>: <em>true</em>)</dd>
        <dt>-<strong>tls1.2</strong> <em>bool</em></dt>
        <dd>Enable use of TLS v1.2 (<strong>default</strong>: <em>true</em>)</dd>
        <dt>-<strong>tls1.3</strong> <em>bool</em></dt>
        <dd>Enable use of TLS v1.3 (<strong>default</strong>: <em>true</em>)</dd>
    </dl>
</blockquote>

<dl>
    <dt><a name="tls::unimport"><b>tls::unimport </b><i>channel</i></a></dt>
    <dd>Provided for symmetry to <strong>tls::import</strong>, this
      unstacks the SSL-enabling of a regular Tcl channel.  An error
      is thrown if TLS is not the top stacked channel type.</dd>
</dl>

<dl>
    <dt><a name="tls::ciphers protocol ?verbose?"><strong>tls::ciphers</strong>
        <em>protocol ?verbose?</em></a></dt>
    <dd>Returns list of supported ciphers based on the <em>protocol</em>
        you supply, which must be one of <em>ssl2, ssl3, or tls1</em>.
        If <em>verbose</em> is specified as true then a verbose,
        semi-human readable list is returned providing additional
        information on the nature of the cipher support. In each
        case the result is a Tcl list.</dd>
</dl>

<dl>
    <dt><a name="tls::version"><strong>tls::version</strong></a></dt>
    <dd>Returns the version string defined by OpenSSL.</dd>
</dl>

<h3><a name="CALLBACK OPTIONS">CALLBACK OPTIONS</a></h3>

<p>
As indicated above, individual channels can be given their own callbacks
to handle intermediate processing by the OpenSSL library, using the
<em>-command</em> and <em>-password</em> options passed to either of
<strong>tls::socket</strong> or <strong>tls::import</strong>.
</p>

<blockquote>
<dl>

    <dt><strong>-command</strong> <em>callback</em></dt>
    <dd>
	Invokes the specified <em>callback</em> script at
	several points during the OpenSSL handshake.
	Except as indicated below, values returned from the
	callback are ignored.
	Arguments appended to the script upon callback take one of the
	following forms:

	<br>
	<br>

	<dl>

<!--	This form of callback is disabled.

	<dt>
	  <strong>error</strong> <em>channel message</em>
	</dt>
	<dd>
	  The <em>message</em> argument contains an error message generated
	  by the OpenSSL function
	  <code>ERR_reason_error_string()</code>.
	</dd>

	<br>
-->

	<dt>
	  <strong>info</strong> <em>channel major minor message</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_CTX_set_info_callback()</code>.
	  <br>
	  The <em>major</em> and <em>minor</em> arguments are used to
	  represent the state information bitmask.
	  <dl>
	  <dt>Possible values for <em>major</em> are:</dt>
	  <dd><code>handshake, alert, connect, accept</code>.</dd>
	  <dt>Possible values for <em>minor</em> are:</dt>
	  <dd><code>start, done, read, write, loop, exit</code>.</dd>
	  </dl>
	  The <em>message</em> argument is a descriptive string which may
	  be generated either by
	  <code>SSL_state_string_long()</code> or by
	  <code>SSL_alert_desc_string_long()</code>,
	  depending on context.
	</dd>

	<br>

	<dt>
	  <strong>verify</strong> <em>channel depth cert status error</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_set_verify()</code>.
	  <br>
	  The <em>depth</em> argument is an integer representing the
	  current depth on the certificate chain, with
	  <code>0</code> as the subject certificate and higher values
	  denoting progressively more indirect issuer certificates.
	  <br>
	  The <em>cert</em> argument is a list of key-value pairs similar
	  to those returned by
	  <a href="#tls::status"><strong>tls::status</strong></a>.
	  <br>
	  The <em>status</em> argument is an integer representing the
	  current validity of the certificate.
	  A value of <code>0</code> means the certificate is deemed invalid.
	  A value of <code>1</code> means the certificate is deemed valid.
	  <br>
	  The <em>error</em> argument supplies the message, if any, generated
	  by
	  <code>X509_STORE_CTX_get_error()</code>.
	  <br>
	  <br>
	  The callback may override normal validation processing by explicitly
	  returning one of the above <em>status</em> values.
	</dd>

	</dl>
    </dd>

    <br>

    <dt><strong>-password</strong> <em>callback</em></dt>
    <dd>
	Invokes the specified <em>callback</em> script when OpenSSL needs to
	obtain a password.  The callback should return a string which
	represents the password to be used.
	No arguments are appended to the script upon callback.
    </dd>
</dl>
</blockquote>

<p>
Reference implementations of these callbacks are provided in the
distribution as <strong>tls::callback</strong> and
<strong>tls::password</strong> respectively.  Note that these are
<em>sample</em> implementations only.  In a more realistic deployment
you would specify your own callback scripts on each TLS channel
using the <em>-command</em> and <em>-password</em> options.
</p>

<p>
The default behavior when the <em>-command</em> option is not specified is for
TLS to process the associated library callbacks internally.
The default behavior when the <em>-password</em> option is not specified is for
TLS to process the associated library callbacks by attempting to call
<strong>tls::password</strong>.
The difference between these two behaviors is a consequence of maintaining
compatibility with earlier implementations.
</p>

<p>
The <strong>tls::debug</strong> variable provides some additional
control over these reference callbacks.  Its value is zero by default.
Higher values produce more diagnostic output, and will also force the
verify method in <strong>tls::callback</strong> to accept the
certificate, even when it is invalid.
</p>

<p>
<em>
The use of the reference callbacks <strong>tls::callback</strong> and
<strong>tls::password</strong> is not recommended.  They may be removed
from future releases.
</em>
</p>

<p>
<em>
The use of the variable <strong>tls::debug</strong> is not recommended.
It may be removed from future releases.
</em>
</p>

<h3><a name="HTTPS EXAMPLE">HTTPS EXAMPLE</a></h3>

<p>This example uses a sample server.pem provided with the TLS release,
courtesy of the <strong>OpenSSL</strong> project.</p>

<pre><code>
package require http
package require tls

http::register https 443 [list ::tls::socket -autoservername true -require true -cadir /etc/ssl/certs]

set tok [http::geturl https://www.tcl.tk/]
</code></pre>

<h3><a name="SPECIAL CONSIDERATIONS">SPECIAL CONSIDERATIONS</a></h3>

<p>The capabilities of this package can vary enormously based
upon how your OpenSSL library was configured and built. At the
most macro-level OpenSSL supports a &quot;no patents&quot; build,
which disables RSA, IDEA, RC(2,4,5) and SSL2 - if your OpenSSL is
configured this way then you will need to build TLS with the
-DNO_PATENTS option - and the resultant module will function
correctly and also support ADH certificate-less encryption,
however you will be unable to utilize this to speak to normal Web
Servers, which typically require RSA support. Please see <a
href="http://www.openssl.org/">http://www.openssl.org/</a> for
more information on the whole issue of patents and US export
restrictions. </p>

<h3><a name="SEE ALSO">SEE ALSO</a></h3>

<p><strong>socket</strong>, <strong>fileevent, </strong><a
href="http://www.openssl.org/"><strong>OpenSSL</strong></a></p>

<hr>

<pre>
Copyright &copy; 1999 Matt Newman.
Copyright &copy; 2004 Starfish Systems.
</pre>
</body>
</html>

Deleted tls.tcl version [ae8c7a0664].

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














































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#
# Copyright (C) 1997-2000 Matt Newman <[email protected]> 
#
namespace eval tls {
    variable logcmd tclLog
    variable debug 0
 
    # Default flags passed to tls::import
    variable defaults {}

    # Maps UID to Server Socket
    variable srvmap
    variable srvuid 0

    # Over-ride this if you are using a different socket command
    variable socketCmd
    if {![info exists socketCmd]} {
        set socketCmd [info command ::socket]
    }

    # This is the possible arguments to tls::socket and tls::init
    # The format of this is a list of lists
    ## Each inner list contains the following elements
    ### Server (matched against "string match" for 0/1)
    ### Option name
    ### Variable to add the option to:
    #### sopts: [socket] option
    #### iopts: [tls::import] option
    ### How many arguments the following the option to consume
    variable socketOptionRules {
        {0 -async sopts 0}
        {* -myaddr sopts 1}
        {0 -myport sopts 1}
        {* -type sopts 1}
        {* -cadir iopts 1}
        {* -cafile iopts 1}
        {* -cert iopts 1}
        {* -certfile iopts 1}
        {* -cipher iopts 1}
        {* -command iopts 1}
        {* -dhparams iopts 1}
        {* -key iopts 1}
        {* -keyfile iopts 1}
        {* -password iopts 1}
        {* -request iopts 1}
        {* -require iopts 1}
        {* -autoservername discardOpts 1}
        {* -servername iopts 1}
        {* -ssl2 iopts 1}
        {* -ssl3 iopts 1}
        {* -tls1 iopts 1}
        {* -tls1.1 iopts 1}
        {* -tls1.2 iopts 1}
        {* -tls1.3 iopts 1}
    }

    # tls::socket and tls::init options as a humane readable string
    variable socketOptionsNoServer
    variable socketOptionsServer

    # Internal [switch] body to validate options
    variable socketOptionsSwitchBody
}

proc tls::_initsocketoptions {} {
    variable socketOptionRules
    variable socketOptionsNoServer
    variable socketOptionsServer
    variable socketOptionsSwitchBody

    # Do not re-run if we have already been initialized
    if {[info exists socketOptionsSwitchBody]} {
        return
    }

    # Create several structures from our list of options
    ## 1. options: a text representation of the valid options for the current
    ##             server type
    ## 2. argSwitchBody: Switch body for processing arguments
    set options(0) [list]
    set options(1) [list]
    set argSwitchBody [list]
    foreach optionRule $socketOptionRules {
        set ruleServer [lindex $optionRule 0]
        set ruleOption [lindex $optionRule 1]
        set ruleVarToUpdate [lindex $optionRule 2]
        set ruleVarArgsToConsume [lindex $optionRule 3]

        foreach server [list 0 1] {
            if {![string match $ruleServer $server]} {
                continue
            }

            lappend options($server) $ruleOption
        }

        switch -- $ruleVarArgsToConsume {
            0 {
                set argToExecute {
                    lappend @VAR@ $arg
                    set argsArray($arg) true
                } 
            }
            1 {
                set argToExecute {
                    incr idx
                    if {$idx >= [llength $args]} {
                        return -code error "\"$arg\" option must be followed by value"
                    }
                    set argValue [lindex $args $idx]
                    lappend @VAR@ $arg $argValue
                    set argsArray($arg) $argValue
                }
            }
            default {
                return -code error "Internal argument construction error"
            }
        }

        lappend argSwitchBody $ruleServer,$ruleOption [string map [list @VAR@ $ruleVarToUpdate] $argToExecute]
    }

    # Add in the final options
    lappend argSwitchBody {*,-*} {return -code error "bad option \"$arg\": must be one of $options"}
    lappend argSwitchBody default break

    # Set the final variables
    set socketOptionsNoServer   [join $options(0) {, }]
    set socketOptionsServer     [join $options(1) {, }]
    set socketOptionsSwitchBody $argSwitchBody
}

proc tls::initlib {dir dll} {
    # Package index cd's into the package directory for loading.
    # Irrelevant to unixoids, but for Windows this enables the OS to find
    # the dependent DLL's in the CWD, where they may be.
    set cwd [pwd]
    catch {cd $dir}
    if {[string equal $::tcl_platform(platform) "windows"] &&
	![string equal [lindex [file system $dir] 0] "native"]} {
	# If it is a wrapped executable running on windows, the openssl
	# dlls must be copied out of the virtual filesystem to the disk
	# where Windows will find them when resolving the dependency in
	# the tls dll. We choose to make them siblings of the executable.
	package require starkit
	set dst [file nativename [file dirname $starkit::topdir]]
	foreach sdll [glob -nocomplain -directory $dir -tails *eay32.dll] {
	    catch {file delete -force            $dst/$sdll}
	    catch {file copy   -force $dir/$sdll $dst/$sdll}
	}
    }
    set res [catch {uplevel #0 [list load [file join [pwd] $dll]]} err]
    catch {cd $cwd}
    if {$res} {
	namespace eval [namespace parent] {namespace delete tls}
	return -code $res $err
    }
    rename tls::initlib {}
}


#
# Backwards compatibility, also used to set the default
# context options
#
proc tls::init {args} {
    variable defaults
    variable socketOptionsNoServer
    variable socketOptionsServer
    variable socketOptionsSwitchBody

    tls::_initsocketoptions

    # Technically a third option should be used here: Options that are valid
    # only a both servers and non-servers
    set server -1
    set options $socketOptionsServer

    # Validate arguments passed
    set initialArgs $args
    set argc [llength $args]

    array set argsArray [list]
    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg $socketOptionsSwitchBody
    }

    set defaults $initialArgs
}
#
# Helper function - behaves exactly as the native socket command.
#
proc tls::socket {args} {
    variable socketCmd
    variable defaults
    variable socketOptionsNoServer
    variable socketOptionsServer
    variable socketOptionsSwitchBody

    tls::_initsocketoptions

    set idx [lsearch $args -server]
    if {$idx != -1} {
	set server 1
	set callback [lindex $args [expr {$idx+1}]]
	set args [lreplace $args $idx [expr {$idx+1}]]

	set usage "wrong # args: should be \"tls::socket -server command ?options? port\""
        set options $socketOptionsServer
    } else {
	set server 0

	set usage "wrong # args: should be \"tls::socket ?options? host port\""
        set options $socketOptionsNoServer
    }

    # Combine defaults with current options
    set args [concat $defaults $args]

    set argc [llength $args]
    set sopts {}
    set iopts [list -server $server]

    array set argsArray [list]
    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg $socketOptionsSwitchBody
    }

    if {$server} {
	if {($idx + 1) != $argc} {
	    return -code error $usage
	}
	set uid [incr ::tls::srvuid]

	set port [lindex $args [expr {$argc-1}]]
	lappend sopts $port
	#set sopts [linsert $sopts 0 -server $callback]
	set sopts [linsert $sopts 0 -server [list tls::_accept $iopts $callback]]
	#set sopts [linsert $sopts 0 -server [list tls::_accept $uid $callback]]
    } else {
	if {($idx + 2) != $argc} {
	    return -code error $usage
	}

	set host [lindex $args [expr {$argc-2}]]
	set port [lindex $args [expr {$argc-1}]]

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

	lappend sopts $host $port
    }
    #
    # Create TCP/IP socket
    #
    set chan [eval $socketCmd $sopts]
    if {!$server && [catch {
	#
	# Push SSL layer onto socket
	#
	eval [list tls::import] $chan $iopts
    } err]} {
	set info ${::errorInfo}
	catch {close $chan}
	return -code error -errorinfo $info $err
    }
    return $chan
}

# tls::_accept --
#
#   This is the actual accept that TLS sockets use, which then calls
#   the callback registered by tls::socket.
#
# Arguments:
#   iopts	tls::import opts
#   callback	server callback to invoke
#   chan	socket channel to accept/deny
#   ipaddr	calling IP address
#   port	calling port
#
# Results:
#   Returns an error if the callback throws one.
#
proc tls::_accept { iopts callback chan ipaddr port } {
    log 2 [list tls::_accept $iopts $callback $chan $ipaddr $port]

    set chan [eval [list tls::import $chan] $iopts]

    lappend callback $chan $ipaddr $port
    if {[catch {
	uplevel #0 $callback
    } err]} {
	log 1 "tls::_accept error: ${::errorInfo}"
	close $chan
	error $err $::errorInfo $::errorCode
    } else {
	log 2 "tls::_accept - called \"$callback\" succeeded"
    }
}
#
# Sample callback for hooking: -
#
# error
# verify
# info
#
proc tls::callback {option args} {
    variable debug

    #log 2 [concat $option $args]

    switch -- $option {
	"error"	{
	    foreach {chan msg} $args break

	    log 0 "TLS/$chan: error: $msg"
	}
	"verify"	{
	    # poor man's lassign
	    foreach {chan depth cert rc err} $args break

	    array set c $cert

	    if {$rc != "1"} {
		log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)"
	    } else {
		log 2 "TLS/$chan: verify/$depth: $c(subject)"
	    }
	    if {$debug > 0} {
		return 1;	# FORCE OK
	    } else {
		return $rc
	    }
	}
	"info"	{
	    # poor man's lassign
	    foreach {chan major minor state msg} $args break

	    if {$msg != ""} {
		append state ": $msg"
	    }
	    # For tracing
	    upvar #0 tls::$chan cb
	    set cb($major) $minor

	    log 2 "TLS/$chan: $major/$minor: $state"
	}
	default	{
	    return -code error "bad option \"$option\":\
		    must be one of error, info, or verify"
	}
    }
}

proc tls::xhandshake {chan} {
    upvar #0 tls::$chan cb

    if {[info exists cb(handshake)] && \
	$cb(handshake) == "done"} {
	return 1
    }
    while {1} {
	vwait tls::${chan}(handshake)
	if {![info exists cb(handshake)]} {
	    return 0
	}
	if {$cb(handshake) == "done"} {
	    return 1
	}
    }
}

proc tls::password {} {
    log 0 "TLS/Password: did you forget to set your passwd!"
    # Return the worlds best kept secret password.
    return "secret"
}

proc tls::log {level msg} {
    variable debug
    variable logcmd

    if {$level > $debug || $logcmd == ""} {
	return
    }
    set cmd $logcmd
    lappend cmd $msg
    uplevel #0 $cmd
}

Deleted tlsBIO.c version [7f6303ee40].

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
309
310
311
312
313
314
315
316
317
318
319































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Provides BIO layer to interface openssl to Tcl.
 */

#include "tlsInt.h"

#ifdef TCLTLS_OPENSSL_PRE_1_1_API
#define BIO_get_data(bio)                ((bio)->ptr)
#define BIO_get_init(bio)                ((bio)->init)
#define BIO_get_shutdown(bio)            ((bio)->shutdown)
#define BIO_set_data(bio, val)           (bio)->ptr = (val)
#define BIO_set_init(bio, val)           (bio)->init = (val)
#define BIO_set_shutdown(bio, val)       (bio)->shutdown = (val)

/* XXX: This assumes the variable being assigned to is BioMethods */
#define BIO_meth_new(type_, name_)       (BIO_METHOD *)Tcl_Alloc(sizeof(BIO_METHOD)); \
                                         memset(BioMethods, 0, sizeof(BIO_METHOD)); \
                                         BioMethods->type = type_; \
                                         BioMethods->name = name_;
#define BIO_meth_set_write(bio, val)     (bio)->bwrite = val;
#define BIO_meth_set_read(bio, val)      (bio)->bread = val;
#define BIO_meth_set_puts(bio, val)      (bio)->bputs = val;
#define BIO_meth_set_ctrl(bio, val)      (bio)->ctrl = val;
#define BIO_meth_set_create(bio, val)    (bio)->create = val;
#define BIO_meth_set_destroy(bio, val)   (bio)->destroy = val;
#endif

/*
 * Forward declarations
 */

static int BioWrite _ANSI_ARGS_((BIO *h, CONST char *buf, int num));
static int BioRead  _ANSI_ARGS_((BIO *h, char *buf, int num));
static int BioPuts  _ANSI_ARGS_((BIO *h, CONST char *str));
static long BioCtrl _ANSI_ARGS_((BIO *h, int cmd, long arg1, void *ptr));
static int BioNew   _ANSI_ARGS_((BIO *h));
static int BioFree  _ANSI_ARGS_((BIO *h));

BIO *BIO_new_tcl(State *statePtr, int flags) {
	BIO *bio;
	static BIO_METHOD *BioMethods = NULL;
#ifdef TCLTLS_SSL_USE_FASTPATH
	Tcl_Channel parentChannel;
	const Tcl_ChannelType *parentChannelType;
	void *parentChannelFdIn_p, *parentChannelFdOut_p;
	int parentChannelFdIn, parentChannelFdOut, parentChannelFd;
	int validParentChannelFd;
	int tclGetChannelHandleRet;
#endif

	dprintf("BIO_new_tcl() called");

	if (BioMethods == NULL) {
		BioMethods = BIO_meth_new(BIO_TYPE_TCL, "tcl");
		BIO_meth_set_write(BioMethods, BioWrite);
		BIO_meth_set_read(BioMethods, BioRead);
		BIO_meth_set_puts(BioMethods, BioPuts);
		BIO_meth_set_ctrl(BioMethods, BioCtrl);
		BIO_meth_set_create(BioMethods, BioNew);
		BIO_meth_set_destroy(BioMethods, BioFree);
	}

	if (statePtr == NULL) {
		dprintf("Asked to setup a NULL state, just creating the initial configuration");

		return(NULL);
	}

#ifdef TCLTLS_SSL_USE_FASTPATH
	/*
	 * If the channel can be mapped back to a file descriptor, just use the file descriptor
	 * with the SSL library since it will likely be optimized for this.
	 */
	parentChannel = Tls_GetParent(statePtr, 0);
	parentChannelType = Tcl_GetChannelType(parentChannel);

	validParentChannelFd = 0;
	if (strcmp(parentChannelType->typeName, "tcp") == 0) {
		tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_READABLE, (ClientData) &parentChannelFdIn_p);
		if (tclGetChannelHandleRet == TCL_OK) {
			tclGetChannelHandleRet = Tcl_GetChannelHandle(parentChannel, TCL_WRITABLE, (ClientData) &parentChannelFdOut_p);
			if (tclGetChannelHandleRet == TCL_OK) {
				parentChannelFdIn = PTR2INT(parentChannelFdIn_p);
				parentChannelFdOut = PTR2INT(parentChannelFdOut_p);
				if (parentChannelFdIn == parentChannelFdOut) {
					parentChannelFd = parentChannelFdIn;
					validParentChannelFd = 1;
				}
			}
		}
	}

	if (validParentChannelFd) {
		dprintf("We found a shortcut, this channel is backed by a socket: %i", parentChannelFdIn);
		bio = BIO_new_socket(parentChannelFd, flags);
		statePtr->flags |= TLS_TCL_FASTPATH;
		return(bio);
	}

	dprintf("Falling back to Tcl I/O for this channel");
#endif

	bio = BIO_new(BioMethods);
	BIO_set_data(bio, statePtr);
	BIO_set_shutdown(bio, flags);
	BIO_set_init(bio, 1);

	return(bio);
}

static int BioWrite(BIO *bio, CONST char *buf, int bufLen) {
	Tcl_Channel chan;
	int ret;
	int tclEofChan, tclErrno;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);

	ret = Tcl_WriteRaw(chan, buf, bufLen);

	tclEofChan = Tcl_Eof(chan);
	tclErrno = Tcl_GetErrno();

	dprintf("[chan=%p] BioWrite(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, Tcl_GetErrno());

	BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);

	if (tclEofChan && ret <= 0) {
		dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
		Tcl_SetErrno(ECONNRESET);
		ret = 0;
	} else if (ret == 0) {
		dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
		dprintf("Setting retry read flag");
		BIO_set_retry_read(bio);
	} else if (ret < 0) {
		dprintf("We got some kind of I/O error");

		if (tclErrno == EAGAIN) {
			dprintf("It's EAGAIN");
		} else {
			dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
		}
	} else {
		dprintf("Successfully wrote some data");
	}

	if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
		if (BIO_should_read(bio)) {
			dprintf("Setting should retry read flag");

			BIO_set_retry_read(bio);
		}
	}

	return(ret);
}

static int BioRead(BIO *bio, char *buf, int bufLen) {
	Tcl_Channel chan;
	int ret = 0;
	int tclEofChan, tclErrno;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

	dprintf("[chan=%p] BioRead(%p, <buf>, %d)", (void *) chan, (void *) bio, bufLen);

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

	ret = Tcl_ReadRaw(chan, buf, bufLen);

	tclEofChan = Tcl_Eof(chan);
	tclErrno = Tcl_GetErrno();

	dprintf("[chan=%p] BioRead(%d) -> %d [tclEof=%d; tclErrno=%d]", (void *) chan, bufLen, ret, tclEofChan, tclErrno);

	BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);

	if (tclEofChan && ret <= 0) {
		dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
		Tcl_SetErrno(ECONNRESET);
		ret = 0;
	} else if (ret == 0) {
		dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0");
		dprintf("Setting retry read flag");
		BIO_set_retry_read(bio);
	} else if (ret < 0) {
		dprintf("We got some kind of I/O error");

		if (tclErrno == EAGAIN) {
			dprintf("It's EAGAIN");
		} else {
			dprintf("It's an unepxected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
		}
	} else {
		dprintf("Successfully read some data");
	}

	if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
		if (BIO_should_write(bio)) {
			dprintf("Setting should retry write flag");

			BIO_set_retry_write(bio);
		}
	}

	dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);

	return(ret);
}

static int BioPuts(BIO *bio, CONST char *str) {
	dprintf("BioPuts(%p, <string:%p>) called", bio, str);

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

static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
	Tcl_Channel chan;
	long ret = 1;

	chan = Tls_GetParent((State *) BIO_get_data(bio), 0);

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

	switch (cmd) {
		case BIO_CTRL_RESET:
			dprintf("Got BIO_CTRL_RESET");
			num = 0;
		case BIO_C_FILE_SEEK:
			dprintf("Got BIO_C_FILE_SEEK");
		case BIO_C_FILE_TELL:
			dprintf("Got BIO_C_FILE_TELL");
			ret = 0;
			break;
		case BIO_CTRL_INFO:
			dprintf("Got BIO_CTRL_INFO");
			ret = 1;
			break;
		case BIO_C_SET_FD:
			dprintf("Unsupported call: BIO_C_SET_FD");
			ret = -1;
			break;
		case BIO_C_GET_FD:
			dprintf("Unsupported call: BIO_C_GET_FD");
			ret = -1;
			break;
		case BIO_CTRL_GET_CLOSE:
			dprintf("Got BIO_CTRL_CLOSE");
			ret = BIO_get_shutdown(bio);
			break;
		case BIO_CTRL_SET_CLOSE:
			dprintf("Got BIO_SET_CLOSE");
			BIO_set_shutdown(bio, num);
			break;
		case BIO_CTRL_EOF:
			dprintf("Got BIO_CTRL_EOF");
			ret = Tcl_Eof(chan);
			break;
		case BIO_CTRL_PENDING:
			dprintf("Got BIO_CTRL_PENDING");
			ret = ((chan) ? Tcl_InputBuffered(chan) : 0);
			dprintf("BIO_CTRL_PENDING(%d)", (int) ret);
			break;
		case BIO_CTRL_WPENDING:
			dprintf("Got BIO_CTRL_WPENDING");
			ret = 0;
			break;
		case BIO_CTRL_DUP:
			dprintf("Got BIO_CTRL_DUP");
			break;
		case BIO_CTRL_FLUSH:
			dprintf("Got BIO_CTRL_FLUSH");
			ret = ((Tcl_WriteRaw(chan, "", 0) >= 0) ? 1 : -1);
			dprintf("BIO_CTRL_FLUSH returning value %li", ret);
			break;
		default:
			dprintf("Got unknown control command (%i)", cmd);
			ret = -2;
			break;
	}

	return(ret);
}

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

	BIO_set_init(bio, 0);
	BIO_set_data(bio, NULL);
	BIO_clear_flags(bio, -1);

	return(1);
}

static int BioFree(BIO *bio) {
	if (bio == NULL) {
		return(0);
	}

	dprintf("BioFree(%p) called", bio);

	if (BIO_get_shutdown(bio)) {
		if (BIO_get_init(bio)) {
			/*shutdown(bio->num, 2) */
			/*closesocket(bio->num) */
		}

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

	return(1);
}

Deleted tlsIO.c version [a0890258d8].

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




















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 * Copyright (C) 2000 Ajuba Solutions
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), 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)
 *
 */

#include "tlsInt.h"

/*
 * Forward declarations
 */
static int  TlsBlockModeProc _ANSI_ARGS_((ClientData instanceData, int mode));
static int  TlsCloseProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp));
static int  TlsInputProc _ANSI_ARGS_((ClientData instanceData, char *buf, int bufSize, int *errorCodePtr));
static int  TlsOutputProc _ANSI_ARGS_((ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr));
static int  TlsGetOptionProc _ANSI_ARGS_((ClientData instanceData, Tcl_Interp *interp, CONST84 char *optionName, Tcl_DString *dsPtr));
static void TlsWatchProc _ANSI_ARGS_((ClientData instanceData, int mask));
static int  TlsGetHandleProc _ANSI_ARGS_((ClientData instanceData, int direction, ClientData *handlePtr));
static int  TlsNotifyProc _ANSI_ARGS_((ClientData instanceData, int mask));
#if 0
static void TlsChannelHandler _ANSI_ARGS_((ClientData clientData, int mask));
#endif
static void TlsChannelHandlerTimer _ANSI_ARGS_((ClientData clientData));

/*
 * TLS Channel Type
 */
static Tcl_ChannelType *tlsChannelType = NULL;

/*
 *-------------------------------------------------------------------
 *
 * Tls_ChannelType --
 *
 *	Return the correct TLS channel driver info
 *
 * Results:
 *	The correct channel driver for the current version of Tcl.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
Tcl_ChannelType *Tls_ChannelType(void) {
	unsigned int size;

	/*
	 * Initialize the channel type if necessary
	 */
	if (tlsChannelType == NULL) {
		/*
		 * Allocation of a new channeltype structure is not easy, because of
		 * the various verson of the core and subsequent changes to the
		 * structure. The main challenge is to allocate enough memory for
		 * modern versions even if this extsension is compiled against one
		 * of the older variant!
		 *
		 * (1) Versions before stubs (8.0.x) are simple, because they are
		 *     supported only if the extension is compiled against exactly
		 *     that version of the core.
		 *
		 * (2) With stubs we just determine the difference between the older
		 *     and modern variant and overallocate accordingly if compiled
		 *     against an older variant.
		 */
		size = sizeof(Tcl_ChannelType); /* Base size */

		tlsChannelType = (Tcl_ChannelType *) ckalloc(size);
		memset((VOID *) tlsChannelType, 0, size);

		/*
		 * Common elements of the structure (no changes in location or name)
		 * close2Proc, seekProc, setOptionProc stay NULL.
		 */

		tlsChannelType->typeName	= "tls";
		tlsChannelType->closeProc	= TlsCloseProc;
		tlsChannelType->inputProc	= TlsInputProc;
		tlsChannelType->outputProc	= TlsOutputProc;
		tlsChannelType->getOptionProc	= TlsGetOptionProc;
		tlsChannelType->watchProc	= TlsWatchProc;
		tlsChannelType->getHandleProc	= TlsGetHandleProc;

		/*
		 * Compiled against 8.3.2+. Direct access to all elements possible. Use
		 * channelTypeVersion information to select the values to use.
		 */

		/*
		 * For the 8.3.2 core we present ourselves as a version 2
		 * driver. This means a special value in version (ex
		 * blockModeProc), blockModeProc in a different place and of
		 * course usage of the handlerProc.
		 */
		tlsChannelType->version       = TCL_CHANNEL_VERSION_2;
		tlsChannelType->blockModeProc = TlsBlockModeProc;
		tlsChannelType->handlerProc   = TlsNotifyProc;
	}

	return(tlsChannelType);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsBlockModeProc --
 *
 *	This procedure is invoked by the generic IO level
 *       to set blocking and nonblocking modes
 * Results:
 *	0 if successful, errno when failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *
 *-------------------------------------------------------------------
 */
static int TlsBlockModeProc(ClientData instanceData, int mode) {
	State *statePtr = (State *) instanceData;

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

	return(0);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsCloseProc --
 *
 *	This procedure is invoked by the generic IO level to perform
 *	channel-type-specific cleanup when a SSL socket based channel
 *	is closed.
 *
 *	Note: we leave the underlying socket alone, is this right?
 *
 * Results:
 *	0 if successful, the value of Tcl_GetErrno() if failed.
 *
 * Side effects:
 *	Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
	State *statePtr = (State *) instanceData;

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

	Tls_Clean(statePtr);
	Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);

	dprintf("Returning TCL_OK");

	return(TCL_OK);

	/* Interp is unused. */
	interp = interp;
}

/*
 *------------------------------------------------------*
 *
 *	Tls_WaitForConnect --
 *
 *	Sideeffects:
 *		Issues SSL_accept or SSL_connect
 *
 *	Result:
 *		None.
 *
 *------------------------------------------------------*
 */
int Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent) {
	unsigned long backingError;
	int err, rc;
	int bioShouldRetry;

	dprintf("WaitForConnect(%p)", (void *) statePtr);
	dprintFlags(statePtr);

	if (!(statePtr->flags & TLS_TCL_INIT)) {
		dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
		*errorCodePtr = 0;
		return(0);
	}

	if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
		/*
		 * 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 (;;) {
		/* Not initialized yet! */
		if (statePtr->flags & TLS_TCL_SERVER) {
			dprintf("Calling SSL_accept()");

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

			err = SSL_connect(statePtr->ssl);
		}

		if (err > 0) {
			dprintf("That seems to have gone okay");

			err = BIO_flush(statePtr->bio);

			if (err <= 0) {
				dprintf("Flushing the lower layers failed, this will probably terminate this session");
			}
		}

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

		dprintf("Got error: %i (rc = %i)", err, rc);

		bioShouldRetry = 0;
		if (err <= 0) {
			if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
				bioShouldRetry = 1;
			} else if (BIO_should_retry(statePtr->bio)) {
				bioShouldRetry = 1;
			} else if (rc == SSL_ERROR_SYSCALL && Tcl_GetErrno() == EAGAIN) {
				bioShouldRetry = 1;
			}
		} else {
			if (!SSL_is_init_finished(statePtr->ssl)) {
				bioShouldRetry = 1;
			}
		}

		if (bioShouldRetry) {
			dprintf("The I/O did not complete -- but we should try it again");

			if (statePtr->flags & TLS_TCL_ASYNC) {
				dprintf("Returning EAGAIN so that it can be retried later");

				*errorCodePtr = EAGAIN;

				return(-1);
			} else {
				dprintf("Doing so now");

				continue;
			}
		}

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


	*errorCodePtr = EINVAL;

	switch (rc) {
		case SSL_ERROR_NONE:
			/* The connection is up, we are done here */
			dprintf("The connection is up");
			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("SSL_ERROR_ZERO_RETURN: Connect returned an invalid value...")
			return(-1);
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();

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

			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;

			return(-1);
		case SSL_ERROR_SSL:
			dprintf("Got permanent fatal SSL error, aborting immediately");
			Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
			*errorCodePtr = ECONNABORTED;
			return(-1);
		case SSL_ERROR_WANT_CONNECT:
		case SSL_ERROR_WANT_ACCEPT:
		case SSL_ERROR_WANT_X509_LOOKUP:
		default:
			dprintf("We got a confusing reply: %i", rc);
			*errorCodePtr = Tcl_GetErrno();
			dprintf("ERR(%d, %d) ", rc, *errorCodePtr);
			return(-1);
	}

#if 0
	if (statePtr->flags & TLS_TCL_SERVER) {
		dprintf("This is an TLS server, checking the certificate for the peer");

		err = SSL_get_verify_result(statePtr->ssl);
		if (err != X509_V_OK) {
			dprintf("Invalid certificate, returning in failure");

			Tls_Error(statePtr, (char *)X509_verify_cert_error_string(err));
			statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
			*errorCodePtr = ECONNABORTED;
			return(-1);
		}
	}
#endif

	dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
	statePtr->flags &= ~TLS_TCL_INIT;

	dprintf("Returning in success");
	*errorCodePtr = 0;

	return(0);
}

/*
 *-------------------------------------------------------------------
 *
 * TlsInputProc --
 *
 *	This procedure is invoked by the generic IO level
 *       to read input from a SSL socket based channel.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains the POSIX error code on error, or zero if no
 *	error occurred.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int bytesRead;
	int tlsConnect;
	int err;

	*errorCodePtr = 0;

	dprintf("BIO_read(%d)", bufSize);

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		/* don't process any bytes while verify callback is running */
		dprintf("Callback is running, reading 0 bytes");
		return(0);
	}

	dprintf("Calling Tls_WaitForConnect");
	tlsConnect = Tls_WaitForConnect(statePtr, errorCodePtr, 0);
	if (tlsConnect < 0) {
		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;
		}

		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
	 * correctly.  Similar fix in TlsOutputProc. - hobbs
	 */
	ERR_clear_error();
	bytesRead = BIO_read(statePtr->bio, buf, bufSize);
	dprintf("BIO_read -> %d", bytesRead);

	err = SSL_get_error(statePtr->ssl, bytesRead);

#if 0
	if (bytesRead <= 0) {
		if (BIO_should_retry(statePtr->bio)) {
			dprintf("I/O failed, will retry based on EAGAIN");
			*errorCodePtr = EAGAIN;
		}
	}
#endif

	switch (err) {
		case SSL_ERROR_NONE:
			dprintBuffer(buf, bytesRead);
			break;
		case SSL_ERROR_SSL:
			dprintf("SSL negotiation error, indicating that the connection has been aborted");

			Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, bytesRead));
			*errorCodePtr = ECONNABORTED;
			bytesRead = -1;

			break;
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();

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

			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
			bytesRead = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf("Got SSL_ERROR_WANT_READ, mapping this to EAGAIN");
			bytesRead = -1;
			*errorCodePtr = EAGAIN;
			break;
		default:
			dprintf("Unknown error (err = %i), mapping to EOF", err);
			*errorCodePtr = 0;
			bytesRead = 0;
			break;
	}

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

/*
 *-------------------------------------------------------------------
 *
 * TlsOutputProc --
 *
 *	This procedure is invoked by the generic IO level
 *       to write output to a SSL socket based channel.
 *
 * Results:
 *	The number of bytes written is returned. An output argument is
 *	set to a POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *-------------------------------------------------------------------
 */

static int TlsOutputProc(ClientData instanceData, CONST char *buf, int toWrite, int *errorCodePtr) {
	unsigned long backingError;
	State *statePtr = (State *) instanceData;
	int written, err;
	int tlsConnect;

	*errorCodePtr = 0;

	dprintf("BIO_write(%p, %d)", (void *) statePtr, toWrite);
	dprintBuffer(buf, toWrite);

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Don't process output while callbacks are running")
		written = -1;
		*errorCodePtr = EAGAIN;
		return(-1);
	}

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

		return(written);
	}

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

		if (err <= 0) {
			dprintf("Flushing failed");

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

		written = 0;
		*errorCodePtr = 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
	 * work correctly.  Similar fix in TlsInputProc. - hobbs
	 */
	ERR_clear_error();
	written = BIO_write(statePtr->bio, buf, toWrite);
	dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);

	err = SSL_get_error(statePtr->ssl, written);
	switch (err) {
		case SSL_ERROR_NONE:
			if (written < 0) {
				written = 0;
			}
			break;
		case SSL_ERROR_WANT_WRITE:
			dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
			*errorCodePtr = EAGAIN;
			written = -1;
			break;
		case SSL_ERROR_WANT_READ:
			dprintf(" write R BLOCK");
			break;
		case SSL_ERROR_WANT_X509_LOOKUP:
			dprintf(" write X BLOCK");
			break;
		case SSL_ERROR_ZERO_RETURN:
			dprintf(" closed");
			written = 0;
			*errorCodePtr = 0;
			break;
		case SSL_ERROR_SYSCALL:
			backingError = ERR_get_error();

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

			break;
		case SSL_ERROR_SSL:
			Tls_Error(statePtr, TCLTLS_SSL_ERROR(statePtr->ssl, written));
			*errorCodePtr = ECONNABORTED;
			written = -1;
			break;
		default:
			dprintf(" unknown err: %d", err);
			break;
	}

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

/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *
 * 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.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	CONST84 char *optionName,	/* Name of the option to
					 * retrieve the value for, or
					 * NULL to get all options and
					 * their values. */
	Tcl_DString *dsPtr)		/* Where to store the computed value
					 * initialized by caller. */
{
    State *statePtr = (State *) instanceData;

   Tcl_Channel downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);
   Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
        return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan), interp, optionName, dsPtr);
    } else if (optionName == (char*) NULL) {
        /*
         * Request is query for all options, this is ok.
         */
         return TCL_OK;
    }
    /*
     * Request for a specific option has to fail, we don't have any.
     */
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------
 *
 * TlsWatchProc --
 *
 *	Initialize the notifier to watch Tcl_Files from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel
 *	will be seen by Tcl.
 *
 *-------------------------------------------------------------------
 */

static void
TlsWatchProc(ClientData instanceData,	/* The socket state. */
             int mask)			/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
{
    Tcl_Channel     downChan;
    State *statePtr = (State *) instanceData;

    dprintf("TlsWatchProc(0x%x)", mask);

    /* Pretend to be dead as long as the verify callback is running. 
     * Otherwise that callback could be invoked recursively. */
    if (statePtr->flags & TLS_TCL_CALLBACK) {
        dprintf("Callback is on-going, doing nothing");
        return;
    }

    dprintFlags(statePtr);

    downChan = Tls_GetParent(statePtr, TLS_TCL_FASTPATH);

    if (statePtr->flags & TLS_TCL_HANDSHAKE_FAILED) {
        dprintf("Asked to watch a socket with a failed handshake -- nothing can happen here");

	dprintf("Unregistering interest in the lower channel");
	(Tcl_GetChannelType(downChan))->watchProc(Tcl_GetChannelInstanceData(downChan), 0);

	statePtr->watchMask = 0;

        return;
    }

	statePtr->watchMask = mask;

	/* No channel handlers any more. We will be notified automatically
	 * about events on the channel below via a call to our
	 * 'TransformNotifyProc'. But we have to pass the interest down now.
	 * We are allowed to add additional 'interest' to the mask if we want
	 * to. But this transformation has no such interest. It just passes
	 * the request down, unchanged.
	 */


        dprintf("Registering our interest in the lower channel (chan=%p)", (void *) downChan);
	(Tcl_GetChannelType(downChan))
	    ->watchProc(Tcl_GetChannelInstanceData(downChan), mask);

	/*
	 * Management of the internal timer.
	 */

	if (statePtr->timer != (Tcl_TimerToken) NULL) {
            dprintf("A timer was found, deleting it");
	    Tcl_DeleteTimerHandler(statePtr->timer);
	    statePtr->timer = (Tcl_TimerToken) NULL;
	}

	if (mask & TCL_READABLE) {
		if (Tcl_InputBuffered(statePtr->self) > 0 || BIO_ctrl_pending(statePtr->bio) > 0) {
			/*
			 * There is interest in readable events and we actually have
			 * data waiting, so generate a timer to flush that.
			 */
			dprintf("Creating a new timer since data appears to be waiting");
			statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
		}
	}
}

/*
 *-------------------------------------------------------------------
 *
 * TlsGetHandleProc --
 *
 *	Called from Tcl_GetChannelFile to retrieve o/s file handler
 *	from the SSL socket based channel.
 *
 * Results:
 *	The appropriate Tcl_File or NULL if not present. 
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int TlsGetHandleProc(ClientData instanceData, int direction, ClientData *handlePtr) {
	State *statePtr = (State *) instanceData;

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

/*
 *-------------------------------------------------------------------
 *
 * TlsNotifyProc --
 *
 *	Handler called by Tcl to inform us of activity
 *	on the underlying channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May process the incoming event by itself.
 *
 *-------------------------------------------------------------------
 */

static int TlsNotifyProc(ClientData instanceData, int mask) {
	State *statePtr = (State *) instanceData;
	int errorCode;

	/*
	 * An event occured in the underlying channel.  This
	 * transformation doesn't process such events thus returns the
	 * incoming mask unchanged.
	 */
	if (statePtr->timer != (Tcl_TimerToken) NULL) {
		/*
		 * 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 WatchProc).
		 */
		Tcl_DeleteTimerHandler(statePtr->timer);
		statePtr->timer = (Tcl_TimerToken) NULL;
	}

	if (statePtr->flags & TLS_TCL_CALLBACK) {
		dprintf("Returning 0 due to callback");
		return 0;
	}

	dprintf("Calling Tls_WaitForConnect");
	errorCode = 0;
	if (Tls_WaitForConnect(statePtr, &errorCode, 1) < 0) {
		if (errorCode == EAGAIN) {
			dprintf("Async flag could be set (didn't check) and errorCode == EAGAIN:  Returning 0");

			return 0;
		}

		dprintf("Tls_WaitForConnect returned an error");
	}

	dprintf("Returning %i", mask);

	return(mask);
}

#if 0
/*
 *------------------------------------------------------*
 *
 *      TlsChannelHandler --
 *
 *      ------------------------------------------------*
 *      Handler called by Tcl as a result of
 *      Tcl_CreateChannelHandler - to inform us of activity
 *      on the underlying channel.
 *      ------------------------------------------------*
 *
 *      Sideeffects:
 *              May generate subsequent calls to
 *              Tcl_NotifyChannel.
 *
 *      Result:
 *              None.
 *
 *------------------------------------------------------*
 */

static void
TlsChannelHandler (clientData, mask)
    ClientData     clientData;
    int            mask;
{
    State *statePtr = (State *) clientData;

    dprintf("HANDLER(0x%x)", mask);
    Tcl_Preserve( (ClientData)statePtr);

    if (mask & TCL_READABLE) {
	BIO_set_flags(statePtr->p_bio, BIO_FLAGS_READ);
    } else {
	BIO_clear_flags(statePtr->p_bio, BIO_FLAGS_READ);
    }

    if (mask & TCL_WRITABLE) {
	BIO_set_flags(statePtr->p_bio, BIO_FLAGS_WRITE);
    } else {
	BIO_clear_flags(statePtr->p_bio, BIO_FLAGS_WRITE);
    }

    mask = 0;
    if (BIO_wpending(statePtr->bio)) {
	mask |= TCL_WRITABLE;
    }
    if (BIO_pending(statePtr->bio)) {
	mask |= TCL_READABLE;
    }

    /*
     * The following NotifyChannel calls seems to be important, but
     * we don't know why.  It looks like if the mask is ever non-zero
     * that it will enter an infinite loop.
     *
     * Notify the upper channel of the current BIO state so the event
     * continues to propagate up the chain.
     *
     * stanton: It looks like this could result in an infinite loop if
     * the upper channel doesn't cause ChannelHandler to be removed
     * before Tcl_NotifyChannel calls channel handlers on the lower channel.
     */
    
    Tcl_NotifyChannel(statePtr->self, mask);
    
    if (statePtr->timer != (Tcl_TimerToken)NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken)NULL;
    }
    if ((mask & TCL_READABLE) && Tcl_InputBuffered(statePtr->self) > 0) {
	/*
	 * Data is waiting, flush it out in short time
	 */
	statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY,
		TlsChannelHandlerTimer, (ClientData) statePtr);
    }
    Tcl_Release( (ClientData)statePtr);
}
#endif

/*
 *------------------------------------------------------*
 *
 *	TlsChannelHandlerTimer --
 *
 *	------------------------------------------------*
 *	Called by the notifier (-> timer) to flush out
 *	information waiting in channel buffers.
 *	------------------------------------------------*
 *
 *	Sideeffects:
 *		As of 'TlsChannelHandler'.
 *
 *	Result:
 *		None.
 *
 *------------------------------------------------------*
 */

static void TlsChannelHandlerTimer(ClientData clientData) {
	State *statePtr = (State *) clientData;
	int mask = 0;

	dprintf("Called");

	statePtr->timer = (Tcl_TimerToken) NULL;

	if (BIO_wpending(statePtr->bio)) {
		dprintf("[chan=%p] BIO writable", statePtr->self);

		mask |= TCL_WRITABLE;
	}

	if (BIO_pending(statePtr->bio)) {
		dprintf("[chan=%p] BIO readable", statePtr->self);

		mask |= TCL_READABLE;
	}

	dprintf("Notifying ourselves");
	Tcl_NotifyChannel(statePtr->self, mask);

	dprintf("Returning");

	return;
}

Tcl_Channel Tls_GetParent(State *statePtr, int maskFlags) {
	dprintf("Requested to get parent of channel %p", statePtr->self);

	if ((statePtr->flags & ~maskFlags) & TLS_TCL_FASTPATH) {
		dprintf("Asked to get the parent channel while we are using FastPath -- returning NULL");
		return(NULL);
	}

	return(Tcl_GetStackedChannel(statePtr->self));
}

Deleted tlsInt.h version [b78d815874].

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




















































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built from scratch based upon observation of OpenSSL 0.9.2B
 *
 * Addition credit is due for Andreas Kupries ([email protected]), 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)
 *
 */
#ifndef _TLSINT_H
#define _TLSINT_H

#include "tls.h"
#include <errno.h>
#include <string.h>
#include <stdint.h>

#ifdef __WIN32__
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <wincrypt.h> /* OpenSSL needs this on Windows */
#endif

/* Handle tcl8.3->tcl8.4 CONST changes */
#ifndef CONST84
#define CONST84
#endif

#ifdef NO_PATENTS
#  define NO_IDEA
#  define NO_RC2
#  define NO_RC4
#  define NO_RC5
#  define NO_RSA
#  ifndef NO_SSL2
#    define NO_SSL2
#  endif
#endif

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

/*
 * Determine if we should use the pre-OpenSSL 1.1.0 API
 */
#undef TCLTLS_OPENSSL_PRE_1_1
#if (defined(LIBRESSL_VERSION_NUMBER)) || OPENSSL_VERSION_NUMBER < 0x10100000L
#  define TCLTLS_OPENSSL_PRE_1_1_API 1
#endif

#ifndef ECONNABORTED
#define ECONNABORTED	130	/* Software caused connection abort */
#endif
#ifndef ECONNRESET
#define ECONNRESET	131	/* Connection reset by peer */
#endif

#ifdef TCLEXT_TCLTLS_DEBUG
#include <ctype.h>
#define dprintf(...) { \
                       char dprintfBuffer[8192], *dprintfBuffer_p; \
                       dprintfBuffer_p = &dprintfBuffer[0]; \
                       dprintfBuffer_p += sprintf(dprintfBuffer_p, "%s:%i:%s():", __FILE__, __LINE__, __func__); \
                       dprintfBuffer_p += sprintf(dprintfBuffer_p, __VA_ARGS__); \
                       fprintf(stderr, "%s\n", dprintfBuffer); \
                     }
#define dprintBuffer(bufferName, bufferLength) { \
                                                 int dprintBufferIdx; \
                                                 unsigned char dprintBufferChar; \
                                                 fprintf(stderr, "%s:%i:%s():%s[%llu]={", __FILE__, __LINE__, __func__, #bufferName, (unsigned long long) bufferLength); \
                                                 for (dprintBufferIdx = 0; dprintBufferIdx < bufferLength; dprintBufferIdx++) { \
                                                         dprintBufferChar = bufferName[dprintBufferIdx]; \
                                                         if (isalpha(dprintBufferChar) || isdigit(dprintBufferChar)) { \
                                                                 fprintf(stderr, "'%c' ", dprintBufferChar); \
                                                         } else { \
                                                                 fprintf(stderr, "%02x ", (unsigned int) dprintBufferChar); \
                                                         }; \
                                                 }; \
                                                 fprintf(stderr, "}\n"); \
                                               }
#define dprintFlags(statePtr) { \
                                char dprintfBuffer[8192], *dprintfBuffer_p; \
                                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_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) /**/
#endif

#define TCLTLS_SSL_ERROR(ssl,err) ((char*)ERR_reason_error_string((unsigned long)SSL_get_error((ssl),(err))))
/*
 * OpenSSL BIO Routines
 */
#define BIO_TYPE_TCL	(19|0x0400)

/*
 * 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 further I/O will result
                                         * in ECONNABORTED errors. */
#define TLS_TCL_FASTPATH (1<<6)         /* The parent channel is being used directly by the SSL library */
#define TLS_TCL_DELAY (5)

/*
 * This structure describes the per-instance state
 * of an ssl channel.
 *
 * The SSL processing context is maintained here, in the ClientData
 */
typedef struct State {
	Tcl_Channel self;       /* this socket channel */
	Tcl_TimerToken timer;

	int flags;              /* see State.flags above  */
	int watchMask;          /* current WatchProc mask */
	int mode;               /* current mode of parent channel */

	Tcl_Interp *interp;     /* interpreter in which this resides */
	Tcl_Obj *callback;      /* script called for tracing, verifying and errors */
	Tcl_Obj *password;      /* script called for certificate password */ 

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

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

/*
 * Forward declarations
 */
Tcl_ChannelType *Tls_ChannelType(void);
Tcl_Channel     Tls_GetParent(State *statePtr, int maskFlags);

Tcl_Obj         *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert);
void            Tls_Error(State *statePtr, char *msg);
void            Tls_Free(char *blockPtr);
void            Tls_Clean(State *statePtr);
int             Tls_WaitForConnect(State *statePtr, int *errorCodePtr, int handshakeFailureIsPermanent);

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

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

#endif /* _TLSINT_H */

Deleted tlsX509.c version [ecfb13f8ce].

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

















































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Copyright (C) 1997-2000 Sensus Consulting Ltd.
 * Matt Newman <[email protected]>
 */
#include "tlsInt.h"

/*
 *  Ensure these are not macros - known to be defined on Win32 
 */
#ifdef min
#undef min
#endif

#ifdef max
#undef max
#endif

static int min(int a, int b)
{
    return (a < b) ? a : b;
}

static int max(int a, int b)
{
    return (a > b) ? a : b;
}

/*
 * ASN1_UTCTIME_tostr --
 */
static char *
ASN1_UTCTIME_tostr(ASN1_UTCTIME *tm)
{
    static char bp[128];
    char *v;
    int gmt=0;
    static char *mon[12]={
        "Jan","Feb","Mar","Apr","May","Jun",
        "Jul","Aug","Sep","Oct","Nov","Dec"};
    int i;
    int y=0,M=0,d=0,h=0,m=0,s=0;
    
    i=tm->length;
    v=(char *)tm->data;
    
    if (i < 10) goto err;
    if (v[i-1] == 'Z') gmt=1;
    for (i=0; i<10; i++)
        if ((v[i] > '9') || (v[i] < '0')) goto err;
    y= (v[0]-'0')*10+(v[1]-'0');
    if (y < 70) y+=100;
    M= (v[2]-'0')*10+(v[3]-'0');
    if ((M > 12) || (M < 1)) goto err;
    d= (v[4]-'0')*10+(v[5]-'0');
    h= (v[6]-'0')*10+(v[7]-'0');
    m=  (v[8]-'0')*10+(v[9]-'0');
    if (	(v[10] >= '0') && (v[10] <= '9') &&
		(v[11] >= '0') && (v[11] <= '9'))
        s=  (v[10]-'0')*10+(v[11]-'0');
    
    sprintf(bp,"%s %2d %02d:%02d:%02d %d%s",
                   mon[M-1],d,h,m,s,y+1900,(gmt)?" GMT":"");
    return bp;
 err:
    return "Bad time value";
}

/*
 *------------------------------------------------------*
 *
 *	Tls_NewX509Obj --
 *
 *	------------------------------------------------*
 *	Converts a X509 certificate into a Tcl_Obj
 *	------------------------------------------------*
 *
 *	Sideeffects:
 *		None
 *
 *	Result:
 *		A Tcl List Object representing the provided
 *		X509 certificate.
 *
 *------------------------------------------------------*
 */

#define CERT_STR_SIZE 16384

Tcl_Obj*
Tls_NewX509Obj( interp, cert)
    Tcl_Interp *interp;
    X509 *cert;
{
    Tcl_Obj *certPtr = Tcl_NewListObj( 0, NULL);
    BIO *bio;
    int n;
    unsigned long flags;
    char subject[BUFSIZ];
    char issuer[BUFSIZ];
    char serial[BUFSIZ];
    char notBefore[BUFSIZ];
    char notAfter[BUFSIZ];
    char certStr[CERT_STR_SIZE], *certStr_p;
    int certStr_len, toRead;
#ifndef NO_SSL_SHA
    int shai;
    char sha_hash_ascii[SHA_DIGEST_LENGTH * 2 + 1];
    unsigned char sha_hash_binary[SHA_DIGEST_LENGTH];
    const char *shachars="0123456789ABCDEF";

    sha_hash_ascii[SHA_DIGEST_LENGTH * 2] = '\0';
#endif

    certStr[0] = 0;
    if ((bio = BIO_new(BIO_s_mem())) == NULL) {
	subject[0] = 0;
	issuer[0]  = 0;
	serial[0]  = 0;
    } else {
	flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
	flags &= ~ASN1_STRFLGS_ESC_MSB;

	X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags); 
	n = BIO_read(bio, subject, min(BIO_pending(bio), BUFSIZ - 1));
	n = max(n, 0);
	subject[n] = 0;
	(void)BIO_flush(bio);

	X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags);
	n = BIO_read(bio, issuer, min(BIO_pending(bio), BUFSIZ - 1));
	n = max(n, 0);
	issuer[n] = 0;
	(void)BIO_flush(bio);

	i2a_ASN1_INTEGER(bio, X509_get_serialNumber(cert));
	n = BIO_read(bio, serial, min(BIO_pending(bio), BUFSIZ - 1));
	n = max(n, 0);
	serial[n] = 0;
	(void)BIO_flush(bio);

        if (PEM_write_bio_X509(bio, cert)) {
            certStr_p = certStr;
            certStr_len = 0;
            while (1) {
                toRead = min(BIO_pending(bio), CERT_STR_SIZE - certStr_len - 1);
                toRead = min(toRead, BUFSIZ);
                if (toRead == 0) {
                    break;
                }
                dprintf("Reading %i bytes from the certificate...", toRead);
                n = BIO_read(bio, certStr_p, toRead);
                if (n <= 0) {
                    break;
                }
                certStr_len += n;
                certStr_p   += n;
            }
            *certStr_p = '\0';
            (void)BIO_flush(bio);
        }

	BIO_free(bio);
    }

    strcpy( notBefore, ASN1_UTCTIME_tostr( X509_get_notBefore(cert) ));
    strcpy( notAfter, ASN1_UTCTIME_tostr( X509_get_notAfter(cert) ));

#ifndef NO_SSL_SHA
    X509_digest(cert, EVP_sha1(), sha_hash_binary, NULL);
    for (shai = 0; shai < SHA_DIGEST_LENGTH; shai++) {
        sha_hash_ascii[shai * 2]     = shachars[(sha_hash_binary[shai] & 0xF0) >> 4];
        sha_hash_ascii[shai * 2 + 1] = shachars[(sha_hash_binary[shai] & 0x0F)];
    }
    Tcl_ListObjAppendElement( interp, certPtr, Tcl_NewStringObj("sha1_hash", -1) );
    Tcl_ListObjAppendElement( interp, certPtr, Tcl_NewStringObj(sha_hash_ascii, SHA_DIGEST_LENGTH * 2) );

#endif
    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( "subject", -1) );
    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( subject, -1) );

    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( "issuer", -1) );
    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( issuer, -1) );

    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( "notBefore", -1) );
    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( notBefore, -1) );

    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( "notAfter", -1) );
    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( notAfter, -1) );

    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( "serial", -1) );
    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( serial, -1) );

    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( "certificate", -1) );
    Tcl_ListObjAppendElement( interp, certPtr,
	    Tcl_NewStringObj( certStr, -1) );

    return certPtr;
}

Modified win/README.txt from [c9eebede2e] to [f0c3d36851].

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



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


+


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

-
-
-
+
-
-
-
-

-
-
-
+
-
-
+
-
-
+
-

-
-
-



-
+
-
-
+
-
-
+
-
-





-
+

+
-
+
+

-
+

+
-
+
+



-
+

-

-
-
+
+
+
	Windows DLL Build instructions using nmake build system
	2020-10-15 [email protected]
	2023-08-22 Kevin Walzer ([email protected])

Properties:
- 32 bit DLL
- VisualStudio 2015
- 64 bit DLL
- VisualStudio 2019
Note: Vuisual C++ 6 does not build OpenSSL (long long syntax error)
- Cygwin32 (temporary helper, please help to replace by tclsh)
- WSL
- OpenSSL statically linked to TCLTLS DLL.
Note: Dynamic linking also works but results in a DLL dependeny on OPENSSL DLL's

- OpenSSL dynamically linked to TCLTLS DLL. We used a freely redistributable build of OpenSSL from https://www.firedaemon.com/firedaemon-openssl. Unzip and install OpenSSL in an accessible place (we used the lib subdirectory of our Tcl installation).
1) Build OpenSSL static libraries:

OpenSSL source distribtution unpacked in:
c:\test\tcltls\Openssl_1_1_1h

1. Visual Studio x64 native prompt. Update environmental variables for building Tcltls. Customize the below entries for your setup.
- Install Perl from http://strawberryperl.com/download/5.32.0.1/strawberry-perl-5.32.0.1-32bit.msi
  to C:\perl
  (ActivePerl failed due to missing 32 bit console module)
- Install NASM Assembler:

https://www.nasm.us/pub/nasm/releasebuilds/2.15.05/win32/nasm-2.15.05-installer-x86.exe
  to C:\Program Files (x86)\NASM
  
set PATH=%PATH%;C:\tcl-trunk\lib\openssl-3\x64\bin
-> Visual Studio x86 native prompt.

set INCLUDE=%INCLUDE%;C:\tcl-trunk\tcl\lib\openssl-3\x64\include\openssl
set Path=%PATH%;C:\Program Files (x86)\NASM;C:\Perl\perl\bin

set LIB=%LIB%;C:\tcl-trunk\tcl\lib\openssl-3\x64\bin
perl Configure VC-WIN32 --prefix=c:\test\tcltls\openssl --openssldir=c:\test\tcltls\openssldir no-shared no-filenames threads

nmake
nmake test
namke install

2) Build TCLTLS

Unzip distribution in:
-> Unzip distribution on your system.
c:\test\tcltls\tcltls-1.7.22

-> Start WSL.
-> start cygwin bash prompt

-> cd /mnt/c/path/to/tcltls
cd /cygdrive/c/test/tcltls/tcltls-1.7.22
./gen_dh_params > dh_params.h

od -A n -v -t xC < 'tls.tcl' > tls.tcl.h.new.1
sed 's@[^0-9A-Fa-f]@@g;s@..@0x&, @g' < tls.tcl.h.new.1 > tls.tcl.h
rm -f tls.tcl.h.new.1

-> Visual Studio x86 native prompt.
-> Visual Studio x64 native prompt.

cd C:path\to\tcltls\win
cd C:\test\tcltls\tcltls-1.7.22\win

Run the following commands (modify the flags to your specific installations).

nmake -f makefile.vc TCLDIR=c:\test\tcl8610 SSL_INSTALL_FOLDER=C:\test\tcltls\openssl
nmake -f makefile.vc TCLDIR=c:\users\wordt\tcl INSTALLDIR=c:\tcl-trunk\tcl\lib SSL_INSTALL_FOLDER=C:\tcl-trunk\tcl\lib\openssl-3\x64

nmake -f makefile.vc TCLDIR=c:\users\wordt\tcl INSTALLDIR=c:\tcl-trunk\tcl\lib SSL_INSTALL_FOLDER=C:\tcl-trunk\tcl\lib\openssl-3\x64 install
nmake -f makefile.vc install TCLDIR=c:\test\tcl8610 INSTALLDIR=c:\test\tcltls SSL_INSTALL_FOLDER=C:\test\tcltls\openssl

The resulting installation will include both the tcltls package and also have libcrypto.dll and libssl.dll copied into the same directory.

3) Test

Start tclsh or wish
Start tclsh

lappend auto_path {C:\test\tcltls\tls1.7.22}
package require tls

A small "1.7.22" showing up is hopefully the end of this long way...
package require http
http::register https 443 [list ::tls::socket -autoservername true]
set tok [http::data [http::geturl https://www.tcl-lang.org]]

Added win/gitmanifest.in version [efa71fcbca].


1
+
git-

Modified win/makefile.vc from [88282c8491] to [90843e9af1].






1
2
3














4
5


6











7
8




9








10
11
12
13
14


15
16
17
18














19
20
21






22
23


24


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

-
+
+

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

+
+
+
+
+
+
+
+





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

-
-
+
+
+
+
+
+

-
+
+

+
+
#------------------------------------------------------------- -*- makefile -*-
#
# Makefile for TclTLS extensions.
#
# Basic build, test and install
# call nmake with additional parameter SSL_INSTALL_FOLDER= with the
# OpenSSL instalation folder following.

#   nmake /f makefile.vc INSTALLDIR=c:\path\to\tcl
#   nmake /f makefile.vc INSTALLDIR=c:\path\to\tcl test
#   nmake /f makefile.vc INSTALLDIR=c:\path\to\tcl install
#
# For other build options (debug, static etc.),
# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for
# detailed documentation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

# The name of the package
PROJECT=tls
DOTVERSION = 1.7.22

!include "rules-ext.vc"

# Define the object files and resource file that make up the extension.
# Note the resource file does not makes sense if doing a static library build
# hence it is under that condition. TMP_DIR is the output directory
# defined by rules for object files.
PRJ_OBJS = $(TMP_DIR)\tls.obj \
	$(TMP_DIR)\tlsBIO.obj \
	$(TMP_DIR)\tlsIO.obj \
	$(TMP_DIR)\tlsX509.obj

# Define any additional project include flags
# SSL_INSTALL_FOLDER = with the OpenSSL installation folder following.
PRJ_INCLUDES	= -I"$(SSL_INSTALL_FOLDER)\include"
PRJ_DEFINES =  -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS
PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -I"$(OPENSSL_INSTALL_DIR)\include"

# Define any additional compiler flags that might be required for the project
PRJ_DEFINES = -D_CRT_SECURE_NO_WARNINGS

# SSL Libs:
#    1. ${LIBCRYPTO}.dll
#    2. ${LIBSSL}.dll
# Where LIBCRYPTO (#1.) and LIBSSL (#2.) are defined as follows:
#    v1.1: libcrypto-1.1-x64.dll and libssl-1.1-x64.dll
#    v3: libcrypto-3-x64.dll and libssl-3-x64.dll
# On *nix libcrypto.so.* and libssl.so.* (where suffix is a version indicator).
#
PRJ_LIBS = \
	"$(SSL_INSTALL_FOLDER)\lib\libssl.lib" \
	"$(SSL_INSTALL_FOLDER)\lib\libcrypto.lib" \
	WS2_32.LIB GDI32.LIB ADVAPI32.LIB CRYPT32.LIB USER32.LIB

# Define the standard targets
!include "$(_RULESDIR)\targets.vc"
PRJ_OBJS = $(TMP_DIR)\tls.obj \
               $(TMP_DIR)\tlsBIO.obj \
               $(TMP_DIR)\tlsIO.obj \
               $(TMP_DIR)\tlsX509.obj

# Project specific targets

# We must define a pkgindex target that will create a pkgIndex.tcl
# file in the $(OUT_DIR) directory. We can just redirect to the
# default-pkgindex target for our sample extension.
pkgindex: default-pkgindex

$(ROOT)\manifest.uuid:
   copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid
   git rev-parse HEAD >>$(ROOT)\manifest.uuid

$(TMP_DIR)\tlsUuid.h:	$(ROOT)\manifest.uuid
	copy $(WIN_DIR)\tlsUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\tlsUuid.h

!include "rules-ext.vc"
!include "targets.vc"

# The default install target only installs binaries and scripts so add
# an additional target for our documentation. Note this *adds* a target
# since no commands are listed after it. The original targets for
# install (from targets.vc) will remain.
install: default-pkgindex-tea default-install default-install-docs-html

pkgindex: default-pkgindex
# Explicit dependency rules
$(GENERICDIR)\tls.c: $(TMP_DIR)\tlsUuid.h

# Test package
test: default-test

Added win/nmakehlp.c version [570fb959d3].



















































































































































































































































































































































































































































































































































































































































































































































































































































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
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
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
813
814
815
816
817
818
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * ----------------------------------------------------------------------------
 * nmakehlp.c --
 *
 *	This is used to fix limitations within nmake and the environment.
 *
 * Copyright (c) 2002 David Gravereaux.
 * Copyright (c) 2006 Pat Thoyts
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ----------------------------------------------------------------------------
 */

#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#endif
#include <stdio.h>
#include <math.h>

/*
 * This library is required for x64 builds with _some_ versions of MSVC
 */
#if defined(_M_IA64) || defined(_M_AMD64)
#if _MSC_VER >= 1400 && _MSC_VER < 1500
#pragma comment(lib, "bufferoverflowU")
#endif
#endif

/* ISO hack for dumb VC++ */
#if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900
#define   snprintf	_snprintf
#endif


/* protos */

static int CheckForCompilerFeature(const char *option);
static int CheckForLinkerFeature(char **options, int count);
static int IsIn(const char *string, const char *substring);
static int SubstituteFile(const char *substs, const char *filename);
static int QualifyPath(const char *path);
static int LocateDependency(const char *keyfile);
static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
static DWORD WINAPI ReadFromPipe(LPVOID args);

/* globals */

#define CHUNK	25
#define STATICBUFFERSIZE    1000
typedef struct {
    HANDLE pipe;
    char buffer[STATICBUFFERSIZE];
} pipeinfo;

pipeinfo Out = {INVALID_HANDLE_VALUE, ""};
pipeinfo Err = {INVALID_HANDLE_VALUE, ""};

/*
 * exitcodes: 0 == no, 1 == yes, 2 == error
 */

int
main(
    int argc,
    char *argv[])
{
    char msg[300];
    DWORD dwWritten;
    int chars;
    const char *s;

    /*
     * Make sure children (cl.exe and link.exe) are kept quiet.
     */

    SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);

    /*
     * Make sure the compiler and linker aren't effected by the outside world.
     */

    SetEnvironmentVariable("CL", "");
    SetEnvironmentVariable("LINK", "");

    if (argc > 1 && *argv[1] == '-') {
	switch (*(argv[1]+1)) {
	case 'c':
	    if (argc != 3) {
		chars = snprintf(msg, sizeof(msg) - 1,
		        "usage: %s -c <compiler option>\n"
			"Tests for whether cl.exe supports an option\n"
			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
			&dwWritten, NULL);
		return 2;
	    }
	    return CheckForCompilerFeature(argv[2]);
	case 'l':
	    if (argc < 3) {
		chars = snprintf(msg, sizeof(msg) - 1,
	       		"usage: %s -l <linker option> ?<mandatory option> ...?\n"
			"Tests for whether link.exe supports an option\n"
			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
			&dwWritten, NULL);
		return 2;
	    }
	    return CheckForLinkerFeature(&argv[2], argc-2);
	case 'f':
	    if (argc == 2) {
		chars = snprintf(msg, sizeof(msg) - 1,
			"usage: %s -f <string> <substring>\n"
			"Find a substring within another\n"
			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
			&dwWritten, NULL);
		return 2;
	    } else if (argc == 3) {
		/*
		 * If the string is blank, there is no match.
		 */

		return 0;
	    } else {
		return IsIn(argv[2], argv[3]);
	    }
	case 's':
	    if (argc == 2) {
		chars = snprintf(msg, sizeof(msg) - 1,
			"usage: %s -s <substitutions file> <file>\n"
			"Perform a set of string map type substutitions on a file\n"
			"exitcodes: 0\n",
			argv[0]);
		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
			&dwWritten, NULL);
		return 2;
	    }
	    return SubstituteFile(argv[2], argv[3]);</