Changes On Branch d2d04c75a0763f30

Changes In Branch crypto Through [d2d04c75a0] Excluding Merge-Ins

This is equivalent to a diff from 594dfd3195 to d2d04c75a0

2023-12-29
21:12
Cast unused parameters to void to prevent unused parameter warnings Source: https://core.tcl-lang.org/tcltls/tktview/086954612f check-in: 41e1203724 user: bohagan tags: trunk
21:09
Cast unused parameters to void to prevent unused parameter warnings Source: https://core.tcl-lang.org/tcltls/tktview/086954612f check-in: f586ebd433 user: bohagan tags: crypto
03:09
Merged in master changes check-in: d2d04c75a0 user: bohagan tags: crypto
03:09
Merged in dh branch check-in: 594dfd3195 user: bohagan tags: trunk
03:09
Updated to auto set DH parameters. Updated to use well known Diffie-Hellman (DH) parameters that have built-in support in OpenSSL. This means the DH parameters will be selected to be consistent with the size of the key associated with the server's certificate. If there is no certificate (e.g. for PSK ciphersuites), then it it will be consistent with the size of the negotiated symmetric cipher key. Closed-Leaf check-in: d3d16ea77f user: bohagan tags: dh
2023-12-28
05:05
More documentation updates check-in: d371821677 user: bohagan tags: crypto
2023-12-21
19:56
Optimized Init stub load and package require. Use general pkhIndex.tcl file. check-in: c498845865 user: bohagan tags: trunk

Modified configure from [3a830b9e57] to [db3c76f46d].
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
# 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.
#-----------------------------------------------------------------------


    vars="tls.c tlsBIO.c tlsIO.c tlsX509.c"
    for i in $vars; do
	case $i in
	    \$*)
		# allow $-var names
		PKG_SOURCES="$PKG_SOURCES $i"
		PKG_OBJECTS="$PKG_OBJECTS $i"
		;;







|







5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
# 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.
#-----------------------------------------------------------------------


    vars="tls.c tlsBIO.c tlsDigest.c tlsEncrypt.c tlsInfo.c tlsIO.c tlsKDF.c tlsRand.c tlsUtil.c tlsX509.c"
    for i in $vars; do
	case $i in
	    \$*)
		# allow $-var names
		PKG_SOURCES="$PKG_SOURCES $i"
		PKG_OBJECTS="$PKG_OBJECTS $i"
		;;
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
# 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.
#-----------------------------------------------------------------------

TEA_ADD_SOURCES([tls.c tlsBIO.c tlsIO.c tlsX509.c])
TEA_ADD_HEADERS([generic/tls.h])
TEA_ADD_INCLUDES([])
TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
TEA_ADD_STUB_SOURCES([])
TEA_ADD_TCL_SOURCES([library/tls.tcl])








|







67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
# 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.
#-----------------------------------------------------------------------

TEA_ADD_SOURCES([tls.c tlsBIO.c tlsDigest.c tlsEncrypt.c tlsInfo.c tlsIO.c tlsKDF.c tlsRand.c tlsUtil.c tlsX509.c])
TEA_ADD_HEADERS([generic/tls.h])
TEA_ADD_INCLUDES([])
TEA_ADD_LIBS([])
TEA_ADD_CFLAGS([])
TEA_ADD_STUB_SOURCES([])
TEA_ADD_TCL_SOURCES([library/tls.tcl])

Added doc/docs.css version [0ab4787813].
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
<!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><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>?8.4?</em></dd>
	    <dd><b>package require tls</b></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::connection </b> <em>channel</em></dd>
	    <dd><b>tls::import</b> <em>channel ?options?</em></dd>
	    <dd><b>tls::unimport</b> <em>channel</em></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::ciphers </b> <em>protocol ?verbose? ?supported?</em></dd>
	    <dd><b>tls::protocols</b></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</b><br>
<br>
<a href="#tls::init"><b>tls::init</b> <i>?options?</i></a><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?options? host port</i><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?-server command? ?options? port</i></a><br>
<a href="#tls::status"><b>tls::status</b> <i>?-local? channel</i></a><br>
<a href="#tls::connection"><b>tls::connection</b> <i>channel</i></a><br>
<a href="#tls::handshake"><b>tls::handshake</b> <i>channel</i></a><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>
<br>
<a href="#tls::ciphers"><b>tls::ciphers</b> <i>protocol ?verbose? ?supported?</i></a><br>
<a href="#tls::protocols"><b>tls::protocols</b></a>
<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>
<
<
|
|




|
>


>
|
>




|
>




|




|

|
|



<















|
|



|











<
|
|









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


<!DOCTYPE html>
<html lang="en">
<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>
<link rel="stylesheet" href="docs.css" type="text/css" media="all">
</head>

<body class="vsc-initialized">

<h2>Tcl Tls Extension Documentation</h2>

<dl>
    <dd><a href="#NAME">NAME</a>
    <dl>
	<dd><b>tls</b> - binding to <b>OpenSSL</b> library
	for socket and I/O channel communications.</dd>
    </dl>
    </dd>
    <dd><a href="#SYNOPSIS">SYNOPSIS</a> </dd>
    <dd><dl>
	    <dd><b>package require Tcl</b> <em>?8.5?</em></dd>
	    <dd><b>package require tls</b></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::connection</b> <em>channel</em></dd>
	    <dd><b>tls::import</b> <em>channel ?options?</em></dd>
	    <dd><b>tls::unimport</b> <em>channel</em></dd>
	    <dt>&nbsp;</dt>

	    <dd><b>tls::protocols</b></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> library
for socket and I/O channel communications.</p>

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

<p><b>package require Tcl 8.5</b><br>
<b>package require tls</b><br>
<br>
<a href="#tls::init"><b>tls::init</b> <i>?options?</i></a><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?options? host port</i><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?-server command? ?options? port</i></a><br>
<a href="#tls::status"><b>tls::status</b> <i>?-local? channel</i></a><br>
<a href="#tls::connection"><b>tls::connection</b> <i>channel</i></a><br>
<a href="#tls::handshake"><b>tls::handshake</b> <i>channel</i></a><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>
<br>

<a href="#tls::protocols"><b>tls::protocols</b></a><br>
<a href="#tls::version"><b>tls::version</b></a><br>
</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>
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
    <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><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>

<blockquote>
    <dl>
	<dt><strong>-alpn</strong> <em>list</em></dt>
	<dd>List of protocols to offer during Application-Layer
	    Protocol Negotiation (ALPN). For example: <em>h2</em> and
	    <em>http/1.1</em>, but not <em>h3</em> or <em>quic</em>.</dd>







|

|



|
|





|
|
|







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
    <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 the options can also include any of the
	applicable <a href="#tls::import"><strong>tls:import</strong></a>
	options with one additional option:</dd>
<blockquote>
    <dl>
	<dt><strong>-autoservername</strong> <em>bool</em></dt>
	<dd>Automatically set the -servername argument to the <em>host</em>
	    argument (default is <em>false</em>).</dd>
    </dl>
</blockquote>

    <dt><a name="tls::import"><b>tls::import </b><i>channel
	?options?</i></a></dt>
    <dd>Add SSL/TLS encryption to a regular Tcl channel. It need
	not be a socket, but must provide bi-directional flow. Also
	set session parameters for SSL handshake.</dd>

<blockquote>
    <dl>
	<dt><strong>-alpn</strong> <em>list</em></dt>
	<dd>List of protocols to offer during Application-Layer
	    Protocol Negotiation (ALPN). For example: <em>h2</em> and
	    <em>http/1.1</em>, but not <em>h3</em> or <em>quic</em>.</dd>
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
	<dt><strong>-certfile</strong> <em>filename</em></dt>
	<dd>Specify the filename with the certificate to use.</dd>
	<dt><strong>-cert</strong> <em>filename</em></dt>
	<dd>Specify 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>List of ciphers to use. String is a colon (":") separated list
	    of ciphers or cipher suites. Cipher suites can be combined
	    using the <b>+</b> character. Prefixes can be used to permanently
	    remove ("!"), delete ("-"), or move a cypher to the end of
	    the list ("+"). Keywords <b>@STRENGTH</b> (sort by algorithm
	    key length), <b>@SECLEVEL=</b><i>n</i> (set security level to
	    n), and <b>DEFAULT</b> (use default cipher list, at start only)
	    can also be specified. See OpenSSL documentation for the full
	    list of valid values. (TLS 1.2 and earlier only)</dd>
	<dt><strong>-ciphersuites</strong> <em>string</em></dt>
	<dd>List of cipher suites to use. String is a colon (":")
	    separated list of cipher suite names. (TLS 1.3 only)</dd>
	<dt><strong>-command</strong> <em>callback</em></dt>
	<dd>Callback to invoke at several points during the handshake.
	    This is used to pass errors and tracing information, and
	    it can allow Tcl scripts to perform their own certificate
	    validation in place of the default validation provided by
	    OpenSSL. See <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a>
	    for further discussion.</dd>
	<dt><strong>-dhparams </strong><em>filename</em></dt>
	<dd>Specify the Diffie-Hellman parameters file.</dd>
	<dt><strong>-keyfile</strong> <em>filename</em></dt>
	<dd>Specify the private key file. (default is
	    value of -certfile)</dd>
	<dt><strong>-key</strong> <em>filename</em></dt>
	<dd>Specify the private key to use as a DER encoded value (PKCS#1 DER)</dd>
	<dt><strong>-model</strong> <em>channel</em></dt>
	<dd>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>Callback to invoke 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. See <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a>
	    for further discussion.</dd>
	<dt><strong>-post_handshake</strong> <em>bool</em></dt>
	<dd>Allow post-handshake ticket updates.</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>-security_level</strong> <em>integer</em></dt>
	<dd>Set security level. Must be 0 to 5. The security level affects
	    cipher suite encryption algorithms, supported ECC curves,
	    supported signature algorithms, DH parameter sizes, certificate
	    key sizes and signature algorithms. The default is 1.
	    Level 3 and higher disable support for session tickets and only
	    accept cipher suites that provide forward secrecy.</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>Specify server hostname. 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>-session_id</strong> <em>string</em></dt>
	<dd>Session id to resume session.</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>
	<dt><strong>-validatecommand</strong> <em>callback</em></dt>
	<dd>Callback to invoke to verify or validate protocol config
	    parameters during the protocol negotiation phase. See
	    <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a>
	    for further discussion.</dd>
    </dl>
</blockquote>

    <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>
    <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 status of the certificate for an SSL
	channel. The result is a list of key-value pairs describing
	the certificate. If the result is an empty list then the
	SSL handshake has not yet completed. If <em>-local</em> is

	specified, then the local certificate is used.</dd>
<blockquote>
	<b>SSL Status</b>
    <dl>
	<dt><strong>alpn</strong> <em>protocol</em></dt>
	<dd>The protocol selected after Application-Layer Protocol
	    Negotiation (ALPN).</dd>
	<dt><strong>cipher</strong> <em>cipher</em></dt>
	<dd>The current cipher in use between the client and
	    server channels.</dd>
	<dt><strong>peername</strong> <em>name</em></dt>
	<dd>The peername from the certificate.</dd>
	<dt><strong>protocol</strong> <em>version</em></dt>
	<dd>The protocol version used for the connection:
	    SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.</dd>
	<dt><strong>sbits</strong> <em>n</em></dt>
	<dd>The number of bits used for the session key.</dd>







|











|

















|
|











>
>
|


|





>
|
|

|
<
|
|
>















|








|


|
>






|
|
|
<
|
>
|







|
<







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
	<dt><strong>-certfile</strong> <em>filename</em></dt>
	<dd>Specify the filename with the certificate to use.</dd>
	<dt><strong>-cert</strong> <em>filename</em></dt>
	<dd>Specify 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>List of ciphers to use. String is a colon (":") separated list
	    of ciphers. Ciphers can be combined
	    using the <b>+</b> character. Prefixes can be used to permanently
	    remove ("!"), delete ("-"), or move a cypher to the end of
	    the list ("+"). Keywords <b>@STRENGTH</b> (sort by algorithm
	    key length), <b>@SECLEVEL=</b><i>n</i> (set security level to
	    n), and <b>DEFAULT</b> (use default cipher list, at start only)
	    can also be specified. See OpenSSL documentation for the full
	    list of valid values. (TLS 1.2 and earlier only)</dd>
	<dt><strong>-ciphersuites</strong> <em>string</em></dt>
	<dd>List of cipher suites to use. String is a colon (":")
	    separated list of cipher suite names. (TLS 1.3 only)</dd>
	<dt><strong>-command</strong> <em>callback</em></dt>
	<dd>Callback command to invoke at several points during the handshake.
	    This is used to pass errors and tracing information, and
	    it can allow Tcl scripts to perform their own certificate
	    validation in place of the default validation provided by
	    OpenSSL. See <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a>
	    for further discussion.</dd>
	<dt><strong>-dhparams </strong><em>filename</em></dt>
	<dd>Specify the Diffie-Hellman parameters file.</dd>
	<dt><strong>-keyfile</strong> <em>filename</em></dt>
	<dd>Specify the private key file. (default is
	    value of -certfile)</dd>
	<dt><strong>-key</strong> <em>filename</em></dt>
	<dd>Specify the private key to use as a DER encoded value (PKCS#1 DER)</dd>
	<dt><strong>-model</strong> <em>channel</em></dt>
	<dd>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>Callback command to invoke when OpenSSL needs to obtain a password.
	    Typically used to unlock the private key of a certificate. The
	    callback should return a string which represents the password
	    to be used. See <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a>
	    for further discussion.</dd>
	<dt><strong>-post_handshake</strong> <em>bool</em></dt>
	<dd>Allow post-handshake ticket updates.</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 and a either a -cadir, -cafile, or platform
	    default must be provided in order to validate against.
	    (default is <em>false</em>)</dd>
	<dt><strong>-security_level</strong> <em>integer</em></dt>
	<dd>Set security level. Must be 0 to 5. The security level affects
	    the cipher suite encryption algorithms, supported ECC curves,
	    supported signature algorithms, DH parameter sizes, certificate
	    key sizes and signature algorithms. The default is 1.
	    Level 3 and higher disable support for session tickets and only
	    accept cipher suites that provide forward secrecy.</dd>
	<dt><strong>-server</strong> <em>bool</em></dt>
	<dd>Set to act as a server and respond with a server handshake when
	    a client connects and provides a client handshake.
	    (default is <em>false</em>)</dd>
	<dt><strong>-servername</strong> <em>host</em></dt>
	<dd>Specify server's hostname. Used to set the TLS 'Server Name

	    Indication' (SNI) extension. Set to the expected servername
	    in the server's certificate or one of the subjectAltName
	    alternates.</dd>
	<dt><strong>-session_id</strong> <em>string</em></dt>
	<dd>Session id to resume session.</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>
	<dt><strong>-validatecommand</strong> <em>callback</em></dt>
	<dd>Callback command to invoke to verify or validate protocol config
	    parameters during the protocol negotiation phase. See
	    <a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a>
	    for further discussion.</dd>
    </dl>
</blockquote>

    <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 encryption of a regular Tcl channel. An error
      is thrown if TLS is not the top stacked channel type.</dd>
    <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>?</em><b>-local</b><em>? channel</em></a></dt>
    <dd>Returns the current status of an SSL channel. The result is a list
	of key-value pairs describing the SSL, certificate, and certificate

	verification status. If the SSL handshake has not yet completed,
	an empty list is returned. If <b>-local</b> is specified, then the
	local certificate is used.</dd>
<blockquote>
	<b>SSL Status</b>
    <dl>
	<dt><strong>alpn</strong> <em>protocol</em></dt>
	<dd>The protocol selected after Application-Layer Protocol
	    Negotiation (ALPN).</dd>
	<dt><strong>cipher</strong> <em>cipher</em></dt>
	<dd>The current cipher in use between for the channel.</dd>

	<dt><strong>peername</strong> <em>name</em></dt>
	<dd>The peername from the certificate.</dd>
	<dt><strong>protocol</strong> <em>version</em></dt>
	<dd>The protocol version used for the connection:
	    SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.</dd>
	<dt><strong>sbits</strong> <em>n</em></dt>
	<dd>The number of bits used for the session key.</dd>
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
    <dl>
	<dt><strong>all</strong> <em>string</em></dt>
	<dd>Dump of all certificate info.</dd>

	<dt><strong>version</strong> <em>value</em></dt>
	<dd>The certificate version.</dd>
	<dt><strong>serialNumber</strong> <em>n</em></dt>
	<dd>The serial number of the certificate as hex string.</dd>
	<dt><strong>signature</strong> <em>algorithm</em></dt>
	<dd>Cipher algorithm used for certificate signature.</dd>
	<dt><strong>issuer</strong> <em>dn</em></dt>
	<dd>The distinguished name (DN) of the certificate issuer.</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>







|







277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
    <dl>
	<dt><strong>all</strong> <em>string</em></dt>
	<dd>Dump of all certificate info.</dd>

	<dt><strong>version</strong> <em>value</em></dt>
	<dd>The certificate version.</dd>
	<dt><strong>serialNumber</strong> <em>n</em></dt>
	<dd>The serial number of the certificate as a hex string.</dd>
	<dt><strong>signature</strong> <em>algorithm</em></dt>
	<dd>Cipher algorithm used for certificate signature.</dd>
	<dt><strong>issuer</strong> <em>dn</em></dt>
	<dd>The distinguished name (DN) of the certificate issuer.</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>
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

	<dt><strong>num_extensions</strong> <em>n</em></dt>
	<dd>Number of certificate extensions.</dd>
	<dt><strong>extensions</strong> <em>list</em></dt>
	<dd>List of certificate extension names.</dd>
	<dt><strong>authorityKeyIdentifier</strong> <em>string</em></dt>
	<dd>(AKI) Key identifier of the Issuing CA certificate that signed
	    the SSL certificate as hex string. This value matches the SKI
	    value of the Intermediate CA certificate.</dd>
	<dt><strong>subjectKeyIdentifier</strong> <em>string</em></dt>
	<dd>(SKI) Hash of the public key inside the certificate as hex
	   string. Used to identify certificates that contain a particular
	   public key.</dd>
	<dt><strong>subjectAltName</strong> <em>list</em></dt>
	<dd>List of all of the alternative domain names, sub domains,
	    and IP addresses that are secured by the certificate.</dd>
	<dt><strong>ocsp</strong> <em>list</em></dt>
	<dd>List of all Online Certificate Status Protocol (OCSP) URLs.</dd>

	<dt><strong>certificate</strong> <em>cert</em></dt>
	<dd>The PEM encoded certificate.</dd>

	<dt><strong>signatureAlgorithm</strong> <em>algorithm</em></dt>
	<dd>Cipher algorithm used for certificate signature.</dd>
	<dt><strong>signatureValue</strong> <em>string</em></dt>
	<dd>Certificate signature as hex string.</dd>
	<dt><strong>signatureDigest</strong> <em>version</em></dt>
	<dd>Certificate signing digest.</dd>
	<dt><strong>publicKeyAlgorithm</strong> <em>algorithm</em></dt>
	<dd>Certificate signature public key algorithm.</dd>
	<dt><strong>publicKey</strong> <em>string</em></dt>
	<dd>Certificate signature public key as hex string.</dd>
	<dt><strong>bits</strong> <em>n</em></dt>
	<dd>Number of bits used for certificate signature key</dd>
	<dt><strong>self_signed</strong> <em>boolean</em></dt>
	<dd>Is certificate signature self signed.</dd>

	<dt><strong>sha1_hash</strong> <em>hash</em></dt>
	<dd>The SHA1 hash of the certificate as hex string.</dd>
	<dt><strong>sha256_hash</strong> <em>hash</em></dt>
	<dd>The SHA256 hash of the certificate as hex string.</dd>
    </dl>
</blockquote>

    <dt><a name="tls::connection"><strong>tls::connection</strong>
    <em>channel</em></a></dt>
    <dd>Returns the current connection status of an SSL channel. The
	result is a list of key-value pairs describing the
	connected peer.</dd>
<blockquote>
	<b>SSL Status</b>
    <dl>
	<dt><strong>state</strong> <em>state</em></dt>
	<dd>State of the connection.</dd>
	<dt><strong>servername</strong> <em>name</em></dt>
	<dd>The name of the connected to server.</dd>
	<dt><strong>protocol</strong> <em>version</em></dt>
	<dd>The protocol version used for the connection:
	    SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.</dd>
	<dt><strong>renegotiation</strong> <em>boolean</em></dt>
	<dd>Whether protocol renegotiation is supported or not.</dd>
	<dt><strong>securitylevel</strong> <em>level</em></dt>
	<dd>The security level used for selection of ciphers, key size, etc.</dd>
	<dt><strong>session_reused</strong> <em>boolean</em></dt>
	<dd>Whether the session has been reused or not.</dd>
	<dt><strong>is_server</strong> <em>boolean</em></dt>
	<dd>Whether the connection is configured as a server (1) or client (0).</dd>
	<dt><strong>compression</strong> <em>mode</em></dt>
	<dd>Compression method.</dd>
	<dt><strong>expansion</strong> <em>mode</em></dt>
	<dd>Expansion method.</dd>


    </dl>
</blockquote>
<blockquote>
	<b>Cipher Info</b>
    <dl>
	<dt><strong>cipher</strong> <em>cipher</em></dt>
	<dd>The current cipher in use for the connection.</dd>
	<dt><strong>standard_name</strong> <em>name</em></dt>
	<dd>The standard RFC name of cipher.</dd>
	<dt><strong>bits</strong> <em>n</em></dt>
	<dd>The number of processed bits used for cipher.</dd>
	<dt><strong>secret_bits</strong> <em>n</em></dt>
	<dd>The number of secret bits used for cipher.</dd>
	<dt><strong>min_version</strong> <em>version</em></dt>
	<dd>The minimum protocol version for cipher.</dd>



	<dt><strong>id</strong> <em>id</em></dt>
	<dd>The OpenSSL cipher id.</dd>
	<dt><strong>description</strong> <em>string</em></dt>
	<dd>A text description of the cipher.</dd>


    </dl>
</blockquote>
<blockquote>
	<b>Session Info</b>
    <dl>
	<dt><strong>alpn</strong> <em>protocol</em></dt>
	<dd>The protocol selected after Application-Layer Protocol
	    Negotiation (ALPN).</dd>
	<dt><strong>resumable</strong> <em>boolean</em></dt>
	<dd>Can the session be resumed or not.</dd>
	<dt><strong>start_time</strong> <em>seconds</em></dt>
	<dd>Time since session started in seconds since epoch.</dd>
	<dt><strong>timeout</strong> <em>seconds</em></dt>
	<dd>Max duration of session in seconds before time-out.</dd>
	<dt><strong>lifetime</strong> <em>seconds</em></dt>
	<dd>Session ticket lifetime hint in seconds.</dd>
	<dt><strong>session_id</strong> <em>binary_string</em></dt>
	<dd>Unique session id for use in resuming the session.</dd>
	<dt><strong>session_ticket</strong> <em>binary_string</em></dt>
	<dd>Unique session ticket for use in resuming the session.</dd>
	<dt><strong>ticket_app_data</strong> <em>binary_string</em></dt>
	<dd>Unique session ticket application data.</dd>
	<dt><strong>master_key</strong> <em>binary_string</em></dt>
	<dd>Unique session master key.</dd>
	<dt><strong>session_cache_mode</strong> <em>mode</em></dt>
	<dd>Server cache mode (client, server, or both).</dd>
    </dl>
</blockquote>

    <dt><a name="tls::ciphers"><strong>tls::ciphers</strong>
    <em>protocol ?verbose? ?supported?</em></a></dt>
    <dd>Returns a list of supported ciphers available for <em>protocol</em>,
	where protocol must be one of <b>ssl2, ssl3, tls1, tls1.1,
	tls1.2,</b> or <b>tls1.3</b>. If <em>verbose</em> is specified as
	true then a verbose, human readable list is returned with
	additional information on the cipher. If <em>supported</em>
	is specified as true, then only the ciphers supported for protocol
	will be listed.</dd>

    <dt><a name="tls::protocols"><strong>tls::protocols</strong></a></dt>
    <dd>Returns a list of supported protocols. Valid values are:
	<b>ssl2</b>, <b>ssl3</b>, <b>tls1</b>, <b>tls1.1</b>, <b>tls1.2</b>,
	and <b>tls1.3</b>. Exact list depends on OpenSSL version and
	compile time flags.</dd>

    <dt><a name="tls::version"><strong>tls::version</strong></a></dt>
    <dd>Returns the OpenSSL version string.</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
<strong>-command</strong>, <strong>-password</strong>, and
<strong>-validate_command</strong> options passed to either of
<strong>tls::socket</strong> or <strong>tls::import</strong>.
If the callback generates an error, the <b>bgerror</b> command with be
invoked with the error information.
</p>

<blockquote>
<dl>

    <dt><strong>-command</strong> <em>callback</em></dt>







|


|












|

|

|



|

|

|


|

|






|
<










|

|









>
>









|





>
>
>
|



>
>









|



















<
<
<
<
<
<
<
<
<
<

|
















|







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

	<dt><strong>num_extensions</strong> <em>n</em></dt>
	<dd>Number of certificate extensions.</dd>
	<dt><strong>extensions</strong> <em>list</em></dt>
	<dd>List of certificate extension names.</dd>
	<dt><strong>authorityKeyIdentifier</strong> <em>string</em></dt>
	<dd>(AKI) Key identifier of the Issuing CA certificate that signed
	    the SSL certificate as a hex string. This value matches the SKI
	    value of the Intermediate CA certificate.</dd>
	<dt><strong>subjectKeyIdentifier</strong> <em>string</em></dt>
	<dd>(SKI) Hash of the public key inside the certificate as a hex
	   string. Used to identify certificates that contain a particular
	   public key.</dd>
	<dt><strong>subjectAltName</strong> <em>list</em></dt>
	<dd>List of all of the alternative domain names, sub domains,
	    and IP addresses that are secured by the certificate.</dd>
	<dt><strong>ocsp</strong> <em>list</em></dt>
	<dd>List of all Online Certificate Status Protocol (OCSP) URLs.</dd>

	<dt><strong>certificate</strong> <em>cert</em></dt>
	<dd>The PEM encoded certificate.</dd>

	<dt><strong>signatureAlgorithm</strong> <em>algorithm</em></dt>
	<dd>Cipher algorithm used for the certificate signature.</dd>
	<dt><strong>signatureValue</strong> <em>string</em></dt>
	<dd>Certificate signature as a hex string.</dd>
	<dt><strong>signatureDigest</strong> <em>version</em></dt>
	<dd>Certificate signing digest as a hex string.</dd>
	<dt><strong>publicKeyAlgorithm</strong> <em>algorithm</em></dt>
	<dd>Certificate signature public key algorithm.</dd>
	<dt><strong>publicKey</strong> <em>string</em></dt>
	<dd>Certificate signature public key as a hex string.</dd>
	<dt><strong>bits</strong> <em>n</em></dt>
	<dd>Number of bits used for certificate signature key.</dd>
	<dt><strong>self_signed</strong> <em>boolean</em></dt>
	<dd>Whether the certificate signature is self signed.</dd>

	<dt><strong>sha1_hash</strong> <em>hash</em></dt>
	<dd>The SHA1 hash of the certificate as a hex string.</dd>
	<dt><strong>sha256_hash</strong> <em>hash</em></dt>
	<dd>The SHA256 hash of the certificate as a hex string.</dd>
    </dl>
</blockquote>

    <dt><a name="tls::connection"><strong>tls::connection</strong>
    <em>channel</em></a></dt>
    <dd>Returns the current connection status of an SSL channel. The
	result is a list of key-value pairs describing the connection.</dd>

<blockquote>
	<b>SSL Status</b>
    <dl>
	<dt><strong>state</strong> <em>state</em></dt>
	<dd>State of the connection.</dd>
	<dt><strong>servername</strong> <em>name</em></dt>
	<dd>The name of the connected to server.</dd>
	<dt><strong>protocol</strong> <em>version</em></dt>
	<dd>The protocol version used for the connection:
	    SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.</dd>
	<dt><strong>renegotiation_allowed</strong> <em>boolean</em></dt>
	<dd>Whether protocol renegotiation is supported or not.</dd>
	<dt><strong>security_level</strong> <em>level</em></dt>
	<dd>The security level used for selection of ciphers, key size, etc.</dd>
	<dt><strong>session_reused</strong> <em>boolean</em></dt>
	<dd>Whether the session has been reused or not.</dd>
	<dt><strong>is_server</strong> <em>boolean</em></dt>
	<dd>Whether the connection is configured as a server (1) or client (0).</dd>
	<dt><strong>compression</strong> <em>mode</em></dt>
	<dd>Compression method.</dd>
	<dt><strong>expansion</strong> <em>mode</em></dt>
	<dd>Expansion method.</dd>
	<dt><strong>caList</strong> <em>list</em></dt>
	<dd>List of Certificate Authorities (CA) for X.509 certificate.</dd>
    </dl>
</blockquote>
<blockquote>
	<b>Cipher Info</b>
    <dl>
	<dt><strong>cipher</strong> <em>cipher</em></dt>
	<dd>The current cipher in use for the connection.</dd>
	<dt><strong>standard_name</strong> <em>name</em></dt>
	<dd>The standard RFC name of cipher.</dd>
	<dt><strong>algorithm_bits</strong> <em>n</em></dt>
	<dd>The number of processed bits used for cipher.</dd>
	<dt><strong>secret_bits</strong> <em>n</em></dt>
	<dd>The number of secret bits used for cipher.</dd>
	<dt><strong>min_version</strong> <em>version</em></dt>
	<dd>The minimum protocol version for cipher.</dd>
	<dt><strong>cipher_is_aead</strong> <em>boolean</em></dt>
	<dd>Whether the cipher is Authenticated Encryption with
	Associated Data (AEAD).</dd>
	<dt><strong>cipher_id</strong> <em>id</em></dt>
	<dd>The OpenSSL cipher id.</dd>
	<dt><strong>description</strong> <em>string</em></dt>
	<dd>A text description of the cipher.</dd>
	<dt><strong>handshake_digest</strong> <em>boolean</em></dt>
	<dd>Digest used during handshake.</dd>
    </dl>
</blockquote>
<blockquote>
	<b>Session Info</b>
    <dl>
	<dt><strong>alpn</strong> <em>protocol</em></dt>
	<dd>The protocol selected after Application-Layer Protocol
	    Negotiation (ALPN).</dd>
	<dt><strong>resumable</strong> <em>boolean</em></dt>
	<dd>Whether the session can be resumed or not.</dd>
	<dt><strong>start_time</strong> <em>seconds</em></dt>
	<dd>Time since session started in seconds since epoch.</dd>
	<dt><strong>timeout</strong> <em>seconds</em></dt>
	<dd>Max duration of session in seconds before time-out.</dd>
	<dt><strong>lifetime</strong> <em>seconds</em></dt>
	<dd>Session ticket lifetime hint in seconds.</dd>
	<dt><strong>session_id</strong> <em>binary_string</em></dt>
	<dd>Unique session id for use in resuming the session.</dd>
	<dt><strong>session_ticket</strong> <em>binary_string</em></dt>
	<dd>Unique session ticket for use in resuming the session.</dd>
	<dt><strong>ticket_app_data</strong> <em>binary_string</em></dt>
	<dd>Unique session ticket application data.</dd>
	<dt><strong>master_key</strong> <em>binary_string</em></dt>
	<dd>Unique session master key.</dd>
	<dt><strong>session_cache_mode</strong> <em>mode</em></dt>
	<dd>Server cache mode (client, server, or both).</dd>
    </dl>
</blockquote>











    <dt><a name="tls::protocols"><strong>tls::protocols</strong></a></dt>
    <dd>Returns a list of the supported protocols. Valid values are:
	<b>ssl2</b>, <b>ssl3</b>, <b>tls1</b>, <b>tls1.1</b>, <b>tls1.2</b>,
	and <b>tls1.3</b>. Exact list depends on OpenSSL version and
	compile time flags.</dd>

    <dt><a name="tls::version"><strong>tls::version</strong></a></dt>
    <dd>Returns the OpenSSL version string.</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
<strong>-command</strong>, <strong>-password</strong>, and
<strong>-validate_command</strong> options passed to either of
<strong>tls::socket</strong> or <strong>tls::import</strong>.
If the callback generates an error, the <b>bgerror</b> command will be
invoked with the error information.
</p>

<blockquote>
<dl>

    <dt><strong>-command</strong> <em>callback</em></dt>
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
internally. The default behavior when the <strong>-password</strong> 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>,
<strong>tls::password</strong>, and <strong>tls::validate_command</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="DEBUG">DEBUG</a></h3>

TLS key logging can be enabled by setting the environment variable
<b>SSLKEYLOGFILE</b> to the name of the file to log to. Then whenever TLS
key material is generated or received it will be logged to the file. This
is useful for logging key data for network logging tools to use to
decrypt the data.
















<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. New versions may obsolete older
protocol versions, add or remove ciphers, change default values, etc. Use the
<strong>tls::ciphers</strong> and <strong>tls::protocols</strong> commands to
obtain the supported versions.</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>







<
<
<
<
<
<
<
<








<
<
<
<
<
<
<








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
















|
|
|
|
|







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
internally. The default behavior when the <strong>-password</strong> 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>
<em>
The use of the reference callbacks <strong>tls::callback</strong>,
<strong>tls::password</strong>, and <strong>tls::validate_command</strong>
is not recommended.  They may be removed from future releases.
</em>
</p>








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

TLS key logging can be enabled by setting the environment variable
<b>SSLKEYLOGFILE</b> to the name of the file to log to. Then whenever TLS
key material is generated or received it will be logged to the file. This
is useful for logging key data for network logging tools to use to
decrypt the data.

<p>
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 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 the
linked to OpenSSL library was configured and built. New versions may obsolete
older protocol versions, add or remove ciphers, change default values, etc.
Use the <strong>tls::protocols</strong> commands to obtain the supported
protocol versions.</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>
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 <matt@novadigm.com>
 *
 * 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_GetStringFromObj(objv[idx], (Tcl_Size *)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 */

<
<
|
<





|
|
<
<
<
<
<
|
|
|
>
>
|

|
|
>
|
<
|
|
|
|
<
>
|
<
|
|
|
|
<
<
|
|
|
|
<
|
|
<

|
<
|
<
|
|
<
<
<


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


 * Convenient option processing

 */

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define GET_OPT_BOOL(objPtr, varPtr) \
    if (Tcl_GetBooleanFromObj(interp, objPtr, varPtr) != TCL_OK) {	\





	return TCL_ERROR;					\
    }

#define GET_OPT_INT(objPtr, varPtr) \
    if (Tcl_GetIntFromObj(interp, objPtr, varPtr) != TCL_OK) {	\
	return TCL_ERROR;					\
    }

#define GET_OPT_LONG(objPtr, varPtr) \
    if (Tcl_GetLongFromObj(interp, objPtr, varPtr) != TCL_OK) {	\
	return TCL_ERROR;					\

    }

#define GET_OPT_WIDE(objPtr, varPtr) \
    if (Tcl_GetWideIntFromObj(interp, objPtr, varPtr) != TCL_OK) {	\

	return TCL_ERROR;					\
    }


#define GET_OPT_BIGNUM(objPtr, varPtr) \
    if (Tcl_GetBignumFromObj(interp, objPtr, varPtr) != TCL_OK) {	\
	return TCL_ERROR;					\


    }

#define GET_OPT_STRING(objPtr, var, lenPtr) \
    if ((var = Tcl_GetStringFromObj(objPtr, lenPtr)) == NULL) {	\

	return TCL_ERROR;					\
    }								\


#define GET_OPT_BYTE_ARRAY(objPtr, var, lenPtr) \

    if ((var = Tcl_GetByteArrayFromObj(objPtr, lenPtr)) == NULL) {	\

	return TCL_ERROR;					\
    }								\




#endif /* _TCL_OPTS_H */
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
 *
 */

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




#include <openssl/rsa.h>
#include <openssl/safestack.h>

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

/*
 * 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 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 *ciphersuites, int level, char *DHparams);

static int	TlsLibInit(int uninitialize);







>
>
>
>



















<







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

#include "tlsInt.h"
#include "tclOpts.h"
#include <stdio.h>
#include <stdlib.h>
#include <openssl/crypto.h>
#include <openssl/ssl.h>
#include <openssl/evp.h>
#include <openssl/objects.h>
#include <openssl/rsa.h>
#include <openssl/safestack.h>

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

/*
 * External functions
 */

/*
 * 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 *CAdir, char *CAfile,
		char *ciphers, char *ciphersuites, int level, char *DHparams);

static int	TlsLibInit(int uninitialize);
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
/********************/
/* 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(ClientData clientData, 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;
    char *cp, buf[BUFSIZ];
    int index, verbose = 0, use_supported = 0;
    const SSL_METHOD *method;

    dprintf("Called");

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?");
	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;
    }
    if ((objc > 3) && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK) {
	return TCL_ERROR;
    }

    ERR_clear_error();

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

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

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

    /* Use list and order as would be sent in a ClientHello or all available ciphers */
    if (use_supported) {
	sk = SSL_get1_supported_ciphers(ssl);
    } else {
	sk = SSL_get_ciphers(ssl);
    }

    if (sk != NULL) {
	if (!verbose) {
	    objPtr = Tcl_NewListObj(0, NULL);
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

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

	} else {
	    objPtr = Tcl_NewStringObj("",0);
	    for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) {
		const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i);
		if (c == NULL) continue;

		/* textual description of the cipher */
		if (SSL_CIPHER_description(c, buf, sizeof(buf)) != NULL) {
		    Tcl_AppendToObj(objPtr, buf, (Tcl_Size) strlen(buf));
		} else {
		    Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8);
		}
	    }
	}
	if (use_supported) {
	    sk_SSL_CIPHER_free(sk);
	}
    }
    SSL_free(ssl);
    SSL_CTX_free(ctx);

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * ProtocolsObjCmd -- list available protocols
 *
 *	This procedure is invoked to process the "tls::protocols" command
 *	to list available protocols.
 *
 * Results:
 *	A standard Tcl result list.
 *
 * Side effects:
 *	none
 *
 *-------------------------------------------------------------------
 */
static int
ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr;

    dprintf("Called");

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

    ERR_clear_error();

    objPtr = Tcl_NewListObj(0, NULL);

#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL2], -1));
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1));
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1));
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1));
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1));
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1));
#endif

    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.







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







919
920
921
922
923
924
925
























































































































































































































926
927
928
929
930
931
932
/********************/
/* Commands         */
/********************/

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
























































































































































































































 * 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.
1213
1214
1215
1216
1217
1218
1219














1220
1221
1222
1223
1224
1225
1226

    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
 *







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







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

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

static const char *command_opts [] = {
    "-alpn", "-cadir", "-cafile", "-cert", "-certfile", "-cipher", "-ciphers", "-ciphersuites",
    "-command", "-dhparams", "-key", "-keyfile", "-model", "-password", "-post_handshake",
    "-request", "-require", "-security_level", "-server", "-servername", "-session_id", "-ssl2",
    "-ssl3", "-tls1", "-tls1.1", "-tls1.2", "-tls1.3", "-validatecommand", "-vcmd", NULL};

enum _command_opts {
    _opt_alpn, _opt_cadir, _opt_cafile, _opt_cert, _opt_certfile, _opt_cipher, _opt_ciphers,
    _opt_ciphersuite, _opt_cmd, _opt_dhparams, _opt_key, _opt_keyfile, _opt_model, _opt_password,
    _opt_handshake, _opt_request, _opt_require, _opt_security_level, _opt_server, _opt_servername,
    _opt_session_id, _opt_ssl2, _opt_ssl3, _opt_tls1, _opt_tls11, _opt_tls12, _opt_tls13,
    _opt_validate, _opt_vcmd
};

/*
 *-------------------------------------------------------------------
 *
 * ImportObjCmd --
 *
 *	This procedure is invoked to process the "ssl" command
 *
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
 *-------------------------------------------------------------------
 */
static int
ImportObjCmd(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 */
    SSL_CTX *ctx	        = NULL;
    Tcl_Obj *script	        = NULL;
    Tcl_Obj *password	        = NULL;
    Tcl_Obj *vcmd	        = 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 *ciphersuites	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
    char *servername	        = NULL;	/* hostname for Server Name Indication */
    const unsigned char *session_id = NULL;

    Tcl_Obj *alpn		= NULL;
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0, level = -1;
    int verify = 0, require = 0, request = 1, post_handshake = 0;

    dprintf("Called");








|
|



|
















>
|







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
 *-------------------------------------------------------------------
 */
static int
ImportObjCmd(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 */
    SSL_CTX *ctx	        = NULL;
    Tcl_Obj *cmdObj	        = NULL;
    Tcl_Obj *passwdObj	        = NULL;
    Tcl_Obj *vcmd	        = NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx;
    Tcl_Size fn, 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 *ciphersuites	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
    char *servername	        = NULL;	/* hostname for Server Name Indication */
    const unsigned char *session_id = NULL;
    Tcl_Size sess_len                = 0;
    Tcl_Obj *alpnObj		= NULL;
    int ssl2 = 0, ssl3 = 0;
    int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1;
    int proto = 0, level = -1;
    int verify = 0, require = 0, request = 1, post_handshake = 0;

    dprintf("Called");

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
	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], (Tcl_Size *)NULL);





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



















































































	    break;

	OPTOBJ("-alpn", alpn);
	OPTSTR("-cadir", CAdir);
	OPTSTR("-cafile", CAfile);
	OPTBYTE("-cert", cert, cert_len);
	OPTSTR("-certfile", certfile);
	OPTSTR("-cipher", ciphers);
	OPTSTR("-ciphers", ciphers);
	OPTSTR("-ciphersuites", ciphersuites);
	OPTOBJ("-command", script);
	OPTSTR("-dhparams", DHparams);
	OPTBYTE("-key", key, key_len);
	OPTSTR("-keyfile", keyfile);
	OPTSTR("-model", model);
	OPTOBJ("-password", password);
	OPTBOOL("-post_handshake", post_handshake);
	OPTBOOL("-request", request);
	OPTBOOL("-require", require);
	OPTINT("-security_level", level);
	OPTBOOL("-server", server);
	OPTSTR("-servername", servername);
	OPTSTR("-session_id", session_id);
	OPTBOOL("-ssl2", ssl2);
	OPTBOOL("-ssl3", ssl3);
	OPTBOOL("-tls1", tls1);
	OPTBOOL("-tls1.1", tls1_1);
	OPTBOOL("-tls1.2", tls1_2);
	OPTBOOL("-tls1.3", tls1_3);
	OPTOBJ("-validatecommand", vcmd);
	OPTOBJ("-vcmd", vcmd);

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

	return TCL_ERROR;
    }
    if (request)		verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require)	verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (request && post_handshake)	verify |= SSL_VERIFY_POST_HANDSHAKE;
    if (verify == 0)		verify = SSL_VERIFY_NONE;

    proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
    proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);







>
>
>
|
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<

<
<







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

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

    for (idx = 2; idx < objc; idx++) {
	if (Tcl_GetIndexFromObj(interp, objv[idx], command_opts, "option", 0, &fn) != TCL_OK) {
	    return TCL_ERROR;
	}

	/* Validate arg has value */
	if (++idx >= objc) {
	    Tcl_AppendResult(interp, "No value for option \"", command_opts[fn], "\"", (char *) NULL);
	    return TCL_ERROR;
	}

	switch(fn) {
	case _opt_alpn:
	    alpnObj = objv[idx];
	    break;
	case _opt_cadir:
	    GET_OPT_STRING(objv[idx], CAdir, NULL);
	    break;
	case _opt_cafile:
	    GET_OPT_STRING(objv[idx], CAfile, NULL);
	    break;
	case _opt_cert:
	    GET_OPT_BYTE_ARRAY(objv[idx], cert, &cert_len);
	    break;
	case _opt_certfile:
	    GET_OPT_STRING(objv[idx], certfile, NULL);
	    break;
	case _opt_cipher:
	case _opt_ciphers:
	    GET_OPT_STRING(objv[idx], ciphers, NULL);
	    break;
	case _opt_ciphersuite:
	    GET_OPT_STRING(objv[idx], ciphersuites, NULL);
	    break;
	case _opt_cmd:
	    cmdObj = objv[idx];
	    break;
	case _opt_dhparams:
	    GET_OPT_STRING(objv[idx], DHparams, NULL);
	    break;
	case _opt_key:
	    GET_OPT_BYTE_ARRAY(objv[idx], key, &key_len);
	    break;
	case _opt_keyfile:
	    GET_OPT_STRING(objv[idx], keyfile, NULL);
	    break;
	case _opt_model:
	    GET_OPT_STRING(objv[idx], model, NULL);
	    break;
	case _opt_password:
	    passwdObj = objv[idx];
	    break;
	case _opt_handshake:
	    GET_OPT_BOOL(objv[idx], &post_handshake);
	    break;
	case _opt_request:
	    GET_OPT_BOOL(objv[idx], &request);
	    break;
	case _opt_require:
	    GET_OPT_BOOL(objv[idx], &require);
	    break;
	case _opt_security_level:
	    GET_OPT_INT(objv[idx], &level);
	    break;
	case _opt_server:
	    GET_OPT_BOOL(objv[idx], &server);
	    break;
	case _opt_servername:
	    GET_OPT_STRING(objv[idx], servername, NULL);
	    break;
	case _opt_session_id:
	    GET_OPT_BYTE_ARRAY(objv[idx], session_id, &sess_len);
	    break;
	case _opt_ssl2:
	    GET_OPT_INT(objv[idx], &ssl2);
	    break;
	case _opt_ssl3:
	    GET_OPT_INT(objv[idx], &ssl3);
	    break;
	case _opt_tls1:
	    GET_OPT_INT(objv[idx], &tls1);
	    break;
	case _opt_tls11:
	    GET_OPT_INT(objv[idx], &tls1_1);
	    break;
	case _opt_tls12:
	    GET_OPT_INT(objv[idx], &tls1_2);
	    break;
	case _opt_tls13:
	    GET_OPT_INT(objv[idx], &tls1_3);
	    break;
	case _opt_validate:
	case _opt_vcmd:
	    vcmd = objv[idx];
	    break;
	}





























    }




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

    proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
    proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);
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

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

    /* allocate validate command */
    if (vcmd) {
	(void) Tcl_GetStringFromObj(vcmd, &len);







|
|

|





|
|

|







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

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

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

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

    /* allocate validate command */
    if (vcmd) {
	(void) Tcl_GetStringFromObj(vcmd, &len);
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
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

    /* Resume session id */
    if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) {
	/* SSL_set_session() */
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) strlen(session_id))) {
	    Tcl_AppendResult(interp, "Resume session id ", session_id, " failed", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

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

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

	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);







|

|









|







|







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
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

    /* Resume session id */
    if (session_id && sess_len <= SSL_MAX_SID_CTX_LENGTH) {
	/* SSL_set_session() */
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) sess_len)) {
	    Tcl_AppendResult(interp, "Resume session id ", session_id, " failed", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

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

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

	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);
1558
1559
1560
1561
1562
1563
1564

1565
1566
1567
1568
1569
1570
1571
	statePtr->protos_len = 0;
    }

    /*
     * SSL Callbacks
     */
    SSL_set_app_data(statePtr->ssl, (void *)statePtr);	/* point back to us */

    SSL_set_verify(statePtr->ssl, verify, VerifyCallback);
    SSL_set_info_callback(statePtr->ssl, InfoCallback);

    /* Callback for observing protocol messages */
#ifndef OPENSSL_NO_SSL_TRACE
    /* void SSL_CTX_set_msg_callback_arg(statePtr->ctx, (void *)statePtr);
    void SSL_CTX_set_msg_callback(statePtr->ctx, MessageCallback); */







>







1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
	statePtr->protos_len = 0;
    }

    /*
     * SSL Callbacks
     */
    SSL_set_app_data(statePtr->ssl, (void *)statePtr);	/* point back to us */

    SSL_set_verify(statePtr->ssl, verify, VerifyCallback);
    SSL_set_info_callback(statePtr->ssl, InfoCallback);

    /* Callback for observing protocol messages */
#ifndef OPENSSL_NO_SSL_TRACE
    /* void SSL_CTX_set_msg_callback_arg(statePtr->ctx, (void *)statePtr);
    void SSL_CTX_set_msg_callback(statePtr->ctx, MessageCallback); */
2084
2085
2086
2087
2088
2089
2090

2091
2092
2093
2094
2095
2096
2097

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







>







1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959

    /* 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;
	}
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
    const EVP_MD *md;

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

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)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()) {







|







2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
    const EVP_MD *md;

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

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *) 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()) {
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279

2280
2281
2282




2283
2284
2285
2286
2287
2288
2289
	LAPPEND_INT(interp, objPtr, "algorithm_bits", alg_bits);
	/* alg_bits is actual key secret bits. If use bits and secret (algorithm) bits differ,
	   the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) */

	/* Indicates which SSL/TLS protocol version first defined the cipher */
	LAPPEND_STR(interp, objPtr, "min_version", SSL_CIPHER_get_version(cipher), -1);

	/* Cipher NID */
	LAPPEND_STR(interp, objPtr, "cipherNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_cipher_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "digestNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_digest_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "keyExchangeNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_kx_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "authenticationNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_auth_nid(cipher)), -1);

	/* message authentication code - Cipher is AEAD (e.g. GCM or ChaCha20/Poly1305) or not */
	/* Authenticated Encryption with associated data (AEAD) check */
	LAPPEND_BOOL(interp, objPtr, "cipher_is_aead", SSL_CIPHER_is_aead(cipher));

	/* Digest used during the SSL/TLS handshake when using the cipher. */
	md = SSL_CIPHER_get_handshake_digest(cipher);
	LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1);

	/* Get OpenSSL-specific ID, not IANA ID */
	LAPPEND_INT(interp, objPtr, "cipher_id", (int) SSL_CIPHER_get_id(cipher));

	/* Two-byte ID used in the TLS protocol of the given cipher */
	LAPPEND_INT(interp, objPtr, "protocol_id", (int) SSL_CIPHER_get_protocol_id(cipher));

	/* Textual description of the cipher */

	if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) {
	    LAPPEND_STR(interp, objPtr, "description", buf, -1);
	}




    }

    /* Session info */
    session = SSL_get_session(ssl);
    if (session != NULL) {
	const unsigned char *ticket;
	size_t len2;







|









<
<
<
<






|
>



>
>
>
>







2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130




2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
	LAPPEND_INT(interp, objPtr, "algorithm_bits", alg_bits);
	/* alg_bits is actual key secret bits. If use bits and secret (algorithm) bits differ,
	   the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) */

	/* Indicates which SSL/TLS protocol version first defined the cipher */
	LAPPEND_STR(interp, objPtr, "min_version", SSL_CIPHER_get_version(cipher), -1);

	/* Cipher NID, digest NID (none for AEAD cipher suites), Key Exchange NID, and authentication NID */
	LAPPEND_STR(interp, objPtr, "cipherNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_cipher_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "digestNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_digest_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "keyExchangeNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_kx_nid(cipher)), -1);
	LAPPEND_STR(interp, objPtr, "authenticationNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_auth_nid(cipher)), -1);

	/* message authentication code - Cipher is AEAD (e.g. GCM or ChaCha20/Poly1305) or not */
	/* Authenticated Encryption with associated data (AEAD) check */
	LAPPEND_BOOL(interp, objPtr, "cipher_is_aead", SSL_CIPHER_is_aead(cipher));





	/* Get OpenSSL-specific ID, not IANA ID */
	LAPPEND_INT(interp, objPtr, "cipher_id", (int) SSL_CIPHER_get_id(cipher));

	/* Two-byte ID used in the TLS protocol of the given cipher */
	LAPPEND_INT(interp, objPtr, "protocol_id", (int) SSL_CIPHER_get_protocol_id(cipher));

	/* Textual description of the cipher. Includes: cipher name, protocol version, key
	   exchange, authentication, symmetric encryption method, message authentication code */
	if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) {
	    LAPPEND_STR(interp, objPtr, "description", buf, -1);
	}

	/* Digest used during the SSL/TLS handshake when using the cipher. */
	md = SSL_CIPHER_get_handshake_digest(cipher);
	LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1);
    }

    /* Session info */
    session = SSL_get_session(ssl);
    if (session != NULL) {
	const unsigned char *ticket;
	size_t len2;
2374
2375
2376
2377
2378
2379
2380

2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429

    /* CA List */
    /* IF not a server, same as SSL_get0_peer_CA_list. If server same as SSL_CTX_get_client_CA_list */
    listPtr = Tcl_NewListObj(0, NULL);
    STACK_OF(X509_NAME) *ca_list;
    if ((ca_list = SSL_get_client_CA_list(ssl)) != NULL) {
	char buffer[BUFSIZ];

	for (int i = 0; i < sk_X509_NAME_num(ca_list); i++) {
	    X509_NAME *name = sk_X509_NAME_value(ca_list, i);
	    if (name) {
		X509_NAME_oneline(name, buffer, BUFSIZ);
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1));
	    }
	}
    }
    LAPPEND_OBJ(interp, objPtr, "caList", listPtr);
    LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list));

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * VersionObjCmd -- return version string from OpenSSL.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
VersionObjCmd(ClientData clientData, 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
 *







>











<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

<


<
<







2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255



2256





















2257

2258
2259


2260
2261
2262
2263
2264
2265
2266

    /* CA List */
    /* IF not a server, same as SSL_get0_peer_CA_list. If server same as SSL_CTX_get_client_CA_list */
    listPtr = Tcl_NewListObj(0, NULL);
    STACK_OF(X509_NAME) *ca_list;
    if ((ca_list = SSL_get_client_CA_list(ssl)) != NULL) {
	char buffer[BUFSIZ];

	for (int i = 0; i < sk_X509_NAME_num(ca_list); i++) {
	    X509_NAME *name = sk_X509_NAME_value(ca_list, i);
	    if (name) {
		X509_NAME_oneline(name, buffer, BUFSIZ);
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1));
	    }
	}
    }
    LAPPEND_OBJ(interp, objPtr, "caList", listPtr);
    LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list));


























    Tcl_SetObjResult(interp, objPtr);

    return TCL_OK;
	clientData = clientData;


}

/*
 *-------------------------------------------------------------------
 *
 * MiscObjCmd -- misc commands
 *
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780

2781
2782
2783
2784

2785


2786
2787
2788
2789
2790
2791
2792
    }

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

    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (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);

    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);



    if (interp) {
	Tcl_Eval(interp, tlsTclInitScript);
    }

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}







<



>


|
|
>
|
>
>







2607
2608
2609
2610
2611
2612
2613

2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
    }

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


    Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (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::misc", MiscObjCmd, (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);

    Tls_DigestCommands(interp);
    Tls_EncryptCommands(interp);
    Tls_InfoCommands(interp);
    Tls_KDFCommands(interp);
    Tls_RandCommands(interp);

    if (interp) {
	Tcl_Eval(interp, tlsTclInitScript);
    }

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
		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);
	dprintf("Got error: %s", ERR_reason_error_string(ERR_get_error()));

	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;







|







159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
		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);
	dprintf("Got error: %s", REASON());

	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;
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
	    }

	    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:







|







230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
	    }

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

	case SSL_ERROR_SSL:
	    dprintf("Got permanent fatal SSL error, aborting immediately");
	    Tls_Error(statePtr, (char *)REASON());
	    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:
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
#ifndef CONST86
#   if TCL_MAJOR_VERSION > 8
#	define CONST86 const
#   else
#	define CONST86
#   endif
#endif

/*
 * Backwards compatibility for size type change
 */
#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7
    #ifndef Tcl_Size
        typedef int Tcl_Size;
    #endif







<







33
34
35
36
37
38
39

40
41
42
43
44
45
46
#ifndef CONST86
#   if TCL_MAJOR_VERSION > 8
#	define CONST86 const
#   else
#	define CONST86
#   endif
#endif

/*
 * Backwards compatibility for size type change
 */
#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7
    #ifndef Tcl_Size
        typedef int Tcl_Size;
    #endif
100
101
102
103
104
105
106

107
108
109
110
111
112
113
#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))))


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







>







99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
#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 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) {\
194
195
196
197
198
199
200





201
202










203
204
205
206

Tcl_Obj         *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert);
Tcl_Obj		*Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer);
void            Tls_Error(State *statePtr, char *msg);
void            Tls_Free(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 */







>
>
>
>
>


>
>
>
>
>
>
>
>
>
>




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

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

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

EVP_CIPHER	*Util_GetCipher(Tcl_Interp *interp, Tcl_Obj *cipherObj, int no_null);
EVP_MD		*Util_GetDigest(Tcl_Interp *interp, Tcl_Obj *digestObj, int no_null);
unsigned char	*Util_GetIV(Tcl_Interp *interp, Tcl_Obj *ivObj, int *len, int max, int no_null);
unsigned char	*Util_GetKey(Tcl_Interp *interp, Tcl_Obj *keyObj, int *len, char *name, int max, int no_null);
unsigned char	*Util_GetSalt(Tcl_Interp *interp, Tcl_Obj *saltObj, int *len, int max, int no_null);
int		Util_GetInt(Tcl_Interp *interp, Tcl_Obj *dataObj, int *value, char *name, int min, int max);
#if OPENSSL_VERSION_NUMBER >= 0x30000000L
EVP_MAC		*Util_GetMAC(Tcl_Interp *interp, Tcl_Obj *MacObj, int no_null);
#endif

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

#endif /* _TLSINT_H */
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 */
Tcl_Obj *Tls_x509Identifier(ASN1_OCTET_STRING *astring) {
    Tcl_Obj *resultPtr = NULL;
    int len = 0;
    char buffer[1024];

    if (astring != NULL) {
	len = String_to_Hex((char *)ASN1_STRING_get0_data(astring),
	    ASN1_STRING_length(astring), buffer, 1024);
    }
    resultPtr = Tcl_NewStringObj(buffer, (Tcl_Size) len);
    return resultPtr;
}

/*







|







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 */
Tcl_Obj *Tls_x509Identifier(ASN1_OCTET_STRING *astring) {
    Tcl_Obj *resultPtr = NULL;
    int len = 0;
    char buffer[1024];

    if (astring != NULL) {
	len = String_to_Hex(ASN1_STRING_get0_data(astring),
	    ASN1_STRING_length(astring), buffer, 1024);
    }
    resultPtr = Tcl_NewStringObj(buffer, (Tcl_Size) len);
    return resultPtr;
}

/*
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
    /* Subject identifies the entity associated with the public key stored in
	the subject public key field. RFC 5280 section 4.1.2.6 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "subject", buffer, (Tcl_Size) len);

    /* SHA1 Digest (Fingerprint) of cert - DER representation */
    if (X509_digest(cert, EVP_sha1(), md, &len)) {
    len = String_to_Hex(md, len, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, (Tcl_Size) len);
    }

    /* SHA256 Digest (Fingerprint) of cert - DER representation */
    if (X509_digest(cert, EVP_sha256(), md, &len)) {
    len = String_to_Hex(md, len, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, (Tcl_Size) len);
    }

    /* Subject Public Key Info specifies the public key and identifies the
	algorithm with which the key is used. RFC 5280 section 4.1.2.7 */
    if (X509_get_signature_info(cert, &mdnid, &pknid, &bits, &xflags)) {
	ASN1_BIT_STRING *key;







|





|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
    /* Subject identifies the entity associated with the public key stored in
	the subject public key field. RFC 5280 section 4.1.2.6 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "subject", buffer, (Tcl_Size) len);

    /* SHA1 Digest (Fingerprint) of cert - DER representation */
    if (X509_digest(cert, EVP_sha1(), md, &len)) {
	len = String_to_Hex(md, len, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, (Tcl_Size) len);
    }

    /* SHA256 Digest (Fingerprint) of cert - DER representation */
    if (X509_digest(cert, EVP_sha256(), md, &len)) {
	len = String_to_Hex(md, len, buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, (Tcl_Size) len);
    }

    /* Subject Public Key Info specifies the public key and identifies the
	algorithm with which the key is used. RFC 5280 section 4.1.2.7 */
    if (X509_get_signature_info(cert, &mdnid, &pknid, &bits, &xflags)) {
	ASN1_BIT_STRING *key;
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
    LAPPEND_STR(interp, certPtr, "purpose", Tls_x509Purpose(cert), -1);
    LAPPEND_OBJ(interp, certPtr, "certificatePurpose", Tls_x509Purposes(interp, cert));

    /* Get extensions flags */
    xflags = X509_get_extension_flags(cert);
    LAPPEND_INT(interp, certPtr, "extFlags", xflags);

	/* Check if cert was issued by CA cert issuer or self signed */
    LAPPEND_BOOL(interp, certPtr, "selfIssued", xflags & EXFLAG_SI);
    LAPPEND_BOOL(interp, certPtr, "selfSigned", xflags & EXFLAG_SS);
    LAPPEND_BOOL(interp, certPtr, "isProxyCert", xflags & EXFLAG_PROXY);
    LAPPEND_BOOL(interp, certPtr, "extInvalid", xflags & EXFLAG_INVALID);
    LAPPEND_BOOL(interp, certPtr, "isCACert", X509_check_ca(cert));

    /* The Unique Ids are used to handle the possibility of reuse of subject
	and/or issuer names over time. RFC 5280 section 4.1.2.8 */
    {
	const ASN1_BIT_STRING *iuid, *suid;
        X509_get0_uids(cert, &iuid, &suid);

	Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1));
	if (iuid != NULL) {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, (Tcl_Size) iuid->length));
	} else {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
	}







|










|







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
    LAPPEND_STR(interp, certPtr, "purpose", Tls_x509Purpose(cert), -1);
    LAPPEND_OBJ(interp, certPtr, "certificatePurpose", Tls_x509Purposes(interp, cert));

    /* Get extensions flags */
    xflags = X509_get_extension_flags(cert);
    LAPPEND_INT(interp, certPtr, "extFlags", xflags);

    /* Check if cert was issued by CA cert issuer or self signed */
    LAPPEND_BOOL(interp, certPtr, "selfIssued", xflags & EXFLAG_SI);
    LAPPEND_BOOL(interp, certPtr, "selfSigned", xflags & EXFLAG_SS);
    LAPPEND_BOOL(interp, certPtr, "isProxyCert", xflags & EXFLAG_PROXY);
    LAPPEND_BOOL(interp, certPtr, "extInvalid", xflags & EXFLAG_INVALID);
    LAPPEND_BOOL(interp, certPtr, "isCACert", X509_check_ca(cert));

    /* The Unique Ids are used to handle the possibility of reuse of subject
	and/or issuer names over time. RFC 5280 section 4.1.2.8 */
    {
	const ASN1_BIT_STRING *iuid, *suid;
	X509_get0_uids(cert, &iuid, &suid);

	Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1));
	if (iuid != NULL) {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, (Tcl_Size) iuid->length));
	} else {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
	}
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
    LAPPEND_INT(interp, certPtr, "extCount", X509_get_ext_count(cert));
    LAPPEND_OBJ(interp, certPtr, "extensions", Tls_x509Extensions(interp, cert));

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

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

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







|







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

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

    /* Key usage extension defines the purpose (e.g., encipherment, signature, certificate
	signing) of the key in the certificate. RFC 5280 section 4.2.1.3, NID_key_usage */
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
# We should ensure that the testsDirectory is absolute.
# This was introduced in Tcl 8.3+'s tcltest, so we need a catch.
catch {::tcltest::normalizePath ::tcltest::testsDirectory}

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

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

#  Exit code: 0=all passed, 1=one or more failed
exit $exitCode







|


|







|





|
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
# We should ensure that the testsDirectory is absolute.
# This was introduced in Tcl 8.3+'s tcltest, so we need a catch.
catch {::tcltest::normalizePath ::tcltest::testsDirectory}

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

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

#  Exit code: 0=all passed, 1=one or more failed
exit $::exitCode
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
command,,,,,,,,,,
command,# Find default CA certificates directory,,,,,,,,,
command,if {[info exists ::env(SSL_CERT_FILE)]} {set ::cafile $::env(SSL_CERT_FILE)} else {set ::cafile [file normalize {C:\Users\Brian\Documents\Source\Build\SSL-1.1\certs\cacert.pem}]},,,,,,,,,
command,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3],,,,,,,,,
command,foreach protocol $protocols {::tcltest::testConstraint $protocol 0},,,,,,,,,
command,foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1},,,,,,,,,
command,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc badssl {url} {set port 443;lassign [split $url "":""] url port;if {$port eq """"} {set port 443};set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}",,,,,,,,,
command,,,,,,,,,,
command,# BadSSL.com Tests,,,,,,,,,
BadSSL,1000-sans,,,badssl 1000-sans.badssl.com,,,handshake failed: certificate verify failed due to: certificate has expired,,,1
BadSSL,10000-sans,,,badssl 10000-sans.badssl.com,,,handshake failed: excessive message size,,,1
BadSSL,3des,,,badssl 3des.badssl.com,,,handshake failed: sslv3 alert handshake failure,,,1
BadSSL,captive-portal,,,badssl captive-portal.badssl.com,,,handshake failed: certificate verify failed due to: Hostname mismatch,,,1
BadSSL,cbc,,,badssl cbc.badssl.com,,,,,,
BadSSL,client-cert-missing,,,badssl client-cert-missing.badssl.com,,,,,,


|


|

|
<
<
|


|







1
2
3
4
5
6
7
8


9
10
11
12
13
14
15
16
17
18
19
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Find default CA certificates directory,,,,,,,,,
command,if {[info exists ::env(SSL_CERT_FILE)]} {set ::cafile $::env(SSL_CERT_FILE)} else {set ::cafile [file normalize {C:\Users\Brian\Documents\Source\Build\SSL-1.1\certs\cacert.pem}]},,,,,,,,,
,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,source common.tcl,,,,,,,,,


,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc badssl {url} {set port 443;lassign [split $url "":""] url port;if {$port eq """"} {set port 443};set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}",,,,,,,,,
,,,,,,,,,,
command,# BadSSL.com Tests,,,,,,,,,
BadSSL,1000-sans,,,badssl 1000-sans.badssl.com,,,handshake failed: certificate verify failed due to: certificate has expired,,,1
BadSSL,10000-sans,,,badssl 10000-sans.badssl.com,,,handshake failed: excessive message size,,,1
BadSSL,3des,,,badssl 3des.badssl.com,,,handshake failed: sslv3 alert handshake failure,,,1
BadSSL,captive-portal,,,badssl captive-portal.badssl.com,,,handshake failed: certificate verify failed due to: Hostname mismatch,,,1
BadSSL,cbc,,,badssl cbc.badssl.com,,,,,,
BadSSL,client-cert-missing,,,badssl client-cert-missing.badssl.com,,,,,,
10
11
12
13
14
15
16
17
18
19
20
21



22


23
24
25
26
27
28
29

package require tls

# Find default CA certificates directory
if {[info exists ::env(SSL_CERT_FILE)]} {set ::cafile $::env(SSL_CERT_FILE)} else {set ::cafile [file normalize {C:\Users\Brian\Documents\Source\Build\SSL-1.1\certs\cacert.pem}]}

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

# Helper functions



proc badssl {url} {set port 443;lassign [split $url ":"] url port;if {$port eq ""} {set port 443};set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}



# BadSSL.com Tests


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







|
<
<


>
>
>
|
>
>







10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

package require tls

# Find default CA certificates directory
if {[info exists ::env(SSL_CERT_FILE)]} {set ::cafile $::env(SSL_CERT_FILE)} else {set ::cafile [file normalize {C:\Users\Brian\Documents\Source\Build\SSL-1.1\certs\cacert.pem}]}

# Constraints
source common.tcl



# Helper functions
proc badssl {url} {set port 443
	lassign [split $url ":"] url port
	if {$port eq ""} {set port 443}
	set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port]
	if {[catch {tls::handshake $ch} err]} {close $ch
	return -code error $err} else {close $ch}}

# BadSSL.com Tests


test BadSSL-1.1 {1000-sans} -body {
	badssl 1000-sans.badssl.com
    } -result {handshake failed: certificate verify failed due to: certificate has expired} -returnCodes {1}
Deleted tests/ciphers.csv version [f4aff3652a].
Deleted tests/ciphers.test version [212c1bf055].
Added tests/info.csv version [fa6b9dae2b].
Added tests/info.test version [f5b53d50c6].
Added tests/kdf.csv version [ecd5209032].
Added tests/kdf.test version [e9cb54f939].
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
		if {$group ne $prev} {
		    incr test
		    set prev $group
		    puts $out ""
		}

		# Test case

		set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name]



		foreach opt [list -constraints -setup -body -cleanup -match -result -output -errorOutput -returnCodes] {
		    set cmd [string trim [set [string trimleft $opt "-"]]]
		    if {$cmd ne ""} {
			if {$opt in [list -setup -body -cleanup]} {
			    append buffer " " $opt " \{\n"
			    foreach line [split $cmd ";"] {
				append buffer \t [string trim $line] \n
			    }
			    append buffer "    \}"
			} elseif {$opt in [list -output -errorOutput]} {
			    append buffer " " $opt " {" $cmd \n "}"
			} elseif {$opt in [list -result]} {
			    if {[string index $cmd 0] in [list \[ \" \{]} {
				append buffer " " $opt " " $cmd
			    } elseif {[string match {*[\\$]*} $cmd]} {
				append buffer " " $opt " \"" [string map [list \\\\\" \\\"] [string map [list \" \\\" ] $cmd]] "\""
			    } else {
				append buffer " " $opt " {" $cmd "}"
			    }
			} else {
			    append buffer " " $opt " {" $cmd "}"
			}
		    }
		}
		puts $out $buffer

	    } else {
		# Empty line

	    }
	    break
	}
    }

    # Output clean-up commands
    puts $out "\n# Cleanup\n::tcltest::cleanupTests\nreturn"







>
|
>
>
>












|















>







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
		if {$group ne $prev} {
		    incr test
		    set prev $group
		    puts $out ""
		}

		# Test case
		if {[string index $name 0] ne {$}} {
		    set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name]
		} else {
		    set buffer [format "\ntest %s-%d.%d %s" $group $test [incr cases($group)] $name]
		}
		foreach opt [list -constraints -setup -body -cleanup -match -result -output -errorOutput -returnCodes] {
		    set cmd [string trim [set [string trimleft $opt "-"]]]
		    if {$cmd ne ""} {
			if {$opt in [list -setup -body -cleanup]} {
			    append buffer " " $opt " \{\n"
			    foreach line [split $cmd ";"] {
				append buffer \t [string trim $line] \n
			    }
			    append buffer "    \}"
			} elseif {$opt in [list -output -errorOutput]} {
			    append buffer " " $opt " {" $cmd \n "}"
			} elseif {$opt in [list -result]} {
			    if {[string index $cmd 0] in [list \[ \" \{ \$]} {
				append buffer " " $opt " " $cmd
			    } elseif {[string match {*[\\$]*} $cmd]} {
				append buffer " " $opt " \"" [string map [list \\\\\" \\\"] [string map [list \" \\\" ] $cmd]] "\""
			    } else {
				append buffer " " $opt " {" $cmd "}"
			    }
			} else {
			    append buffer " " $opt " {" $cmd "}"
			}
		    }
		}
		puts $out $buffer

	    } else {
		# Empty line
		puts $out ""
	    }
	    break
	}
    }

    # Output clean-up commands
    puts $out "\n# Cleanup\n::tcltest::cleanupTests\nreturn"
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

# 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" -I"$(OPENSSL_INSTALL_DIR)\include"

# Define any additional compiler flags that might be required for the project
PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -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 "targets.vc"

# 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

# 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

# Test package
test: default-test







>
>
>

>
>
>








|
>


















>
>
>
>













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

# 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)\tlsDigest.obj \
	$(TMP_DIR)\tlsEncrypt.obj \
	$(TMP_DIR)\tlsInfo.obj \
	$(TMP_DIR)\tlsIO.obj \
	$(TMP_DIR)\tlsKDF.obj \
	$(TMP_DIR)\tlsRand.obj \
	$(TMP_DIR)\tlsUtil.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" -I"$(OPENSSL_INSTALL_DIR)\include"

# Define any additional compiler flags that might be required for the project
PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -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 "targets.vc"

# Project specific targets

all:

clean: default-clean

# 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

# 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

# Test package
test: default-test