Changes On Branch e58f2c78c8eb6676
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

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

This is equivalent to a diff from 5a33efb87b to e58f2c78c8

2024-02-05
01:37
Added provider command to load non-default providers in OpenSSL 3.0 check-in: b6001442d1 user: bohagan tags: crypto
00:55
Code updates for gcc warnings check-in: 7e672606f5 user: bohagan tags: trunk
2024-02-04
23:25
Code updates for gcc warnings check-in: e58f2c78c8 user: bohagan tags: crypto
03:31
Merged changes from master branch check-in: fa17431520 user: bohagan tags: crypto
02:58
Added code to handle unexpected EOF on OpenSSL 3 check-in: 5a33efb87b user: bohagan tags: trunk
2024-02-03
03:15
Added more IO logging and error callback messages. Removed duplicate messages. check-in: a3728bd654 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
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"
    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"
		;;

Modified configure.ac from [d5f3ebd9b3] to [1108be8f97].

67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
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_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/cryptography.html version [b81dbf8537].
































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
<!DOCTYPE html>
<html lang="en">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<meta name="Copyright" content="2023 Brian O'Hagan">
<title>The Tcl Cryptography Package</title>
<link rel="stylesheet" href="docs.css" type="text/css" media="all">
</head>

<body class="vsc-initialized">

<h2>Tcl Cryptography Documentation</h2>

<dl>
    <dd><a href="#NAME">NAME</a>
	<dl><dd><b>tls</b> - binding to <b>OpenSSL</b> toolkit.</dd></dl>
    </dd>
    <dd><a href="#DESCRIPTION">DESCRIPTION</a> </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::cipher</b> <em>name</em></dd>
	    <dd><b>tls::ciphers</b> <em>?protocol? ?verbose? ?supported?</em></dd>
	    <dd><b>tls::digests</b> <em>?name?</em></dd>
	    <dd><b>tls::kdfs</b></dd>
	    <dd><b>tls::macs</b></dd>
	    <dd><b>tls::protocols</b></dd>
	    <dd><b>tls::version</b></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::cmac</b> <b>-cipher</b> <em>name</em> <b>-key</b> <em>key ?options?</em></dd>
	    <dd><b>tls::hmac</b> <b>-digest</b> <em>name</em> <b>-key</b> <em>key ?options?</em></dd>
	    <dd><b>tls::md</b> <b>-digest</b> <em>name ?options?</em></dd>
	    <dd><b>tls::md4</b> <em>data</em></dd>
	    <dd><b>tls::md5</b> <em>data</em></dd>
	    <dd><b>tls::sha1</b> <em>data</em></dd>
	    <dd><b>tls::sha256</b> <em>data</em></dd>
	    <dd><b>tls::sha512</b> <em>data</em></dd>
	    <dd><b>tls::unstack</b> <em>channelId</em></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::encrypt</b> <b>-cipher</b> <em>name</em> <b>-key</b> <em>key ?options?</em></dd>
	    <dd><b>tls::decrypt</b> <b>-cipher</b> <em>name</em> <b>-key</b> <em>key ?options?</em></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::hkdf -digest</b> <em>digest</em> <b>-key</b> <em>key ?options?</em></dd>
	    <dd><b>tls::pbkdf2 -size</b> <em>length</em> <b>-digest</b> <em>digest ?options?</em></dd>
	    <dd><b>tls::scrypt -password</b> <em>string</em> <b>-salt</b> <em>string ?options?</em></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::random</b> <em>?</em><b>-private</b><em>? length</em></dd>
	</dl>
    </dd>
    <dd><a href="#OPTIONS">OPTIONS</a></dd>
    <dd><a href="#COMMANDS">COMMANDS</a></dd>
    <dd><a href="#GLOSSARY">GLOSSARY</a> </dd>
    <dd><a href="#EXAMPLES">EXAMPLES</a></dd>
    <dd><a href="#SPECIAL">SPECIAL CONSIDERATIONS</a></dd>
</dl>

<br>

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

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

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

<p>This extension provides a generic interface to the
<a href="http://www.openssl.org/">OpenSSL</a> cryptography functions. The
provided commands can be used to ensure the confidentiality, authenticity,
and integrity of messages and data.</p>

<br>
<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::cipher"><b>tls::cipher</b> <i>name</i></a><br>
<a href="#tls::ciphers"><b>tls::ciphers</b> <i>?protocol? ?verbose? ?supported?</i></a><br>
<a href="#tls::digests"><b>tls::digests</b> <i>?name?</i></a><br>
<a href="#tls::kdfs"><b>tls::kdfs</b></a><br>
<a href="#tls::macs"><b>tls::macs</b></a><br>
<a href="#tls::protocols"><b>tls::protocols</b></a><br>
<a href="#tls::version"><b>tls::version</b></a><br>
<br>
<a href="#tls::cmac"><b>tls::cmac</b> <b>-cipher</b> <i>name</i> <b>-key</b> <i>key ?options?</i></a><br>
<a href="#tls::hmac"><b>tls::hmac</b> <b>-digest</b> <i>name</i> <b>-key</b> <i>key ?options?</i></a><br>
<a href="#tls::md"><b>tls::md</b> <b>-digest</b> <i>name ?options?</i></a><br>
<a href="#tls::md4"><b>tls::md4</b> <i>data</i></a><br>
<a href="#tls::md5"><b>tls::md5</b> <i>data</i></a><br>
<a href="#tls::sha1"><b>tls::sha1</b> <i>data</i></a><br>
<a href="#tls::sha256"><b>tls::sha256</b> <i>data</i></a><br>
<a href="#tls::sha512"><b>tls::sha512</b> <i>data</i></a><br>
<a href="#tls::unstack"><b>tls::unstack</b> <i>channelId</i></a><br>
<br>
<a href="#tls::encrypt"><b>tls::encrypt</b> <b>-cipher</b> <i>name</i> <b>-key</b> <i>key ?options?</i></a><br>
<a href="#tls::decrypt"><b>tls::decrypt</b> <b>-cipher</b> <i>name</i> <b>-key</b> <i>key ?options?</i></a><br>
<br>
<a href="#tls::hkdf"><b>tls::hkdf -digest</b> <i>digest</i> <b>-key</b> <i>key ?options?</i></a><br>
<a href="#tls::pbkdf2"><b>tls::pbkdf2 -size</b> <i>length</i> <b>-digest</b> <i>digest ?options?</i></a><br>
<a href="#tls::scrypt"><b>tls::scrypt -password</b> <i>string</i> <b>-salt</b> <i>string ?options?</i></a><br>
<br>
<a href="#tls::random"><b>tls::random</b> <i>?</i><b>-private</b><i>? length</i></a><br>

</p>

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

<p>The following options are used by the cryptography commands.</p>
<br>
<h4>Cryptographic Options</h4>

<dl>
    <dt><a name="-aad_data"><strong>-aad_data</strong> <em>string</em></a></dt>
    <dd>Additional Authenticated Data (AAD).</dd>
</dl>

<dl>
    <dt><a name="-cipher"><strong>-cipher</strong> <em>name</em></a></dt>
    <dd>Name of symmetric cipher to use. Used by encrypt/decrypt command
    and CMAC &amp; GMAC hash algorithms. For CMAC, it must be one of
    <b>AES-128-CBC</b>, <b>AES-192-CBC</b>, <b>AES-256-CBC</b>, or
    <b>DES-EDE3-CBC</b>. For GMAC it should be a GCM mode cipher (e.g.
    AES-128-GCM). See <a href="#tls::ciphers"><b>tls::ciphers</b></a>
    command for the valid values. Only CCM and GCM modes (also  known as Authenticated
    Encryption with Associated Data (AEAD) modes) provide both confidentially
    and integrity protection.</dd>
</dl>

<dl>
    <dt><a name="-digest"><strong>-digest</strong> <em>name</em></a></dt>
    <dt><a name="-hash"><strong>-hash</strong> <em>name</em></a></dt>
    <dd>Name of hash function (aka message digest) to use.
    See <a href="#tls::digests"><b>tls::digests</b></a> command for the valid values.</dd>
</dl>

<dl>
    <dt><a name="-info"><strong>-info</strong> <em>string</em></a></dt>
    <dd>Optional context and application specific information. Can be a binary
    or text string. Max length is 1024 bytes for OpenSSL 1.1 and 2048 bytes for 3.0.</dd>
</dl>

<dl>
    <dt><a name="-iterations"><strong>-iterations</strong> <em>count</em></a></dt>
    <dd>Number (integer &gt; 0) of iterations to use in deriving the encryption
    key. Default is 2048. Some <a href="#KDF"><b>KDF</b></a> implementations
    require an iteration count.</dd>
</dl>

<dl>
    <dt><a name="-iv"><strong>-iv</strong> <em>string</em></a></dt>
    <dd>Initialization vector (IV) to use. Required for some ciphers and GMAC.
    Other MACs use a fixed IV.
    Cipher modes CBC, CFB, and OFB all need an IV, while ECB and CTR modes do not.
    A new, random IV should be created for each use. Think of the IV as a nonce
    (number used once), it's public but random and unpredictable. See the
   <a href="#tls::cipher"><b>tls::cipher</b></a> for iv_length and when
   required (length > 0). Max is 16 bytes. If not set, it will default to \x00
   fill data.</dd>
</dl>

<dl>
    <dt><a name="-key"><strong>-key</strong> <em>string</em></a></dt>
    <dd>Encryption key to use for cryptography function. Can be a binary or
    text string. Longer keys provide better protection. Used by ciphers, HMAC,
    some CMAC, and some KDF implementations. If the length of the key is &lt;
    <b>key_length</b> it will be padded. Max is 64 bytes. If &gt; key_length, it will be rejected.
    See the <a href="#tls::cipher"><b>tls::cipher</b></a> for key_length.</dd>
</dl>

<dl>
    <dt><a name="-mac"><strong>-mac</strong> <em>name</em></a></dt>
    <dd>Name of Message Authentication Code (MAC) to use.
    See <a href="#tls::mac"><b>tls::macs</b></a> command for the valid values.</dd>
</dl>

<dl>
    <dt><a name="-password"><strong>-password</strong> <em>string</em></a></dt>
    <dd>Password to use for some KDF functions. If not specified, the default
    value is used. Can be a binary or text string. For KDF commands, this is
    the same as the <b>-key</b> option.</dd>
</dl>

<dl>
    <dt><a name="-properties"><strong>-properties</strong> <em>list</em></a></dt>
    <dd>List of additional properties to pass to cryptographic function.</dd>
</dl>

<dl>
    <dt><a name="-salt"><strong>-salt</strong> <em>string</em></a></dt>
    <dd>Specifies salt value to use when encrypting data. Can be a binary or
    text string. Default is to use a string of \0's. It is best to use a
    uniquely and randomly generated value. This option is used by BLAKE2 MAC
    and some KDF implementations use a non-secret unique cryptographic salt.</dd>
</dl>

<dl>
    <dt><a name="-length"><strong>-length</strong> <em>integer</em></a></dt>
    <dt><a name="-size"><strong>-size</strong> <em>integer</em></a></dt>
    <dd>Set the output hash or KDF length in bytes. Used by KDFs, KMAC128, and
    KMAC256 to specify an output length in bytes. The default size
    for KMAC128 is 32 bytes and KMAC256 is 64 bytes.</dd>
</dl>

<dl>
    <dt><a name="-auth_tag"><strong>-tag</strong> <em>string</em></a></dt>
    <dt><a name="-tag"><strong>-tag</strong> <em>string</em></a></dt>
    <dd>Authenticated Encryption and Authenticated Data (AEAD) tag.
    Can be a binary or text string. Max is 16 bytes. A minimum of 12
    bytes is recommended.</dd>
</dl>

<dl>
    <dt><a name="-xof"><strong>-xof</strong> <em>boolean</em></a></dt>
    <dd>Set whether to use XOF. This option is used by KMAC.</dd>
</dl>

<br>
<h4>Input/Output Options</h4>

<dl>
    <dt><a name="-chan"><strong>-chan</strong> <em>channelId</em></a></dt>
    <dt><a name="-chan"><strong>-channel</strong> <em>channelId</em></a></dt>
    <dd>Add the cryptographic transformation on top of channel
	<em>channelId</em>. Automatically sets channel to binary mode. Works
	like <b>chan push</b> to create a stacked channel. If the command
	<b>fileevent</b> is to be used for channel event monitoring, all
	channels in the stack should be set to non-blocking mode. If not,
	the system may hang while waiting for data. When done, use either the
	close command or <a href="#tls::unstack"><strong>tls::unstack</strong></a>
	to remove the transform from the channel. Additional transforms cannot
	be added to channel. Example code:</dd></dl>
    <blockquote><code>
		set ch [open test_file.txt rb]<br>
		::tls::digest -digest sha256 -chan $ch<br>
		set data ""<br>
		while {![eof $ch]} {append data [read $ch 4096]}<br>
		close $ch<br>
		puts $data
    </code></blockquote>

<dl>
    <dt><a name="-command"><strong>-command</strong> <em>cmdName</em></a></dt>
    <dd>Create and return <em>cmdName</em> which is used to incrementally add
	data to a cryptographic function. To add data to the function, call
	&quot;<em>cmdName</em> <b>update</b> <em>data</em>&quot;, where
	<em>data</em> is the data to add. When done, call
	&quot;<em>cmdName</em> <b>finalize</b>&quot; to return the resulting
	value and delete <em>cmdName</em>. Example code:</dd></dl>
    <blockquote><code>
		set cmd [::tls::digest -digest sha256 -command ::tls::temp]<br>
		set data ""<br>
		append data [$cmd update "Some data. "]<br>
		append data [$cmd update "More data."]<br>
		append data [$cmd finalize]<br>
		puts $data
    </code></blockquote>

<dl>
    <dt><a name="-data"><strong>-data</strong> <em>string</em></a></dt>
    <dd>Perform the cryptographic function on <em>data</em> and return the
    result. Example code:</dd></dl>
    <blockquote><code>
		set md [::tls::digest sha256 "Some example data."]<br>
		puts $md
    </code></blockquote>

<dl>
    <dt><a name="-file"><strong>-file</strong> <em>filename</em></a></dt>
    <dt><a name="-file"><strong>-filename</strong> <em>filename</em></a></dt>
    <dd>Perform the cryptographic function on file <em>filename</em> and return
    the result. This operation will open file, read the file data, close the
    file, and return the result using the TCL file APIs, so VFS files are
    supported. Example code:</dd></dl>
    <blockquote><code>
		set md [::tls::digest -digest sha256 -file test_file.txt]<br>
		puts $md
    </code></blockquote>

<dl>
    <dt><a name="-infile"><strong>-infile</strong> <em>filename</em></a></dt>
    <dd>Specifies the file to use as data input source. This option uses the
    TCL file APIs, so VFS files are supported. Example code:</dd></dl>
    <blockquote><code>
		::tls::encrypt -cipher aes-128-cbc -key "Test key"
		-infile unencrypted.txt -outfile encrypted.dat
    </code></blockquote>

<dl>
    <dt><a name="-outfile"><strong>-outfile</strong> <em>filename</em></a></dt>
    <dd>Specifies the file to output the encryption results to. This option
    uses the TCL file APIs, so VFS files are supported. Example code:</dd></dl>
    <blockquote><code>
		::tls::decrypt -cipher aes-128-cbc -key "Test key"
		-infile encrypted.dat -outfile unencrypted.txt
    </code></blockquote>

<dl>
    <dt><a name="-keyfile"><strong>-keyfile</strong> <em>filename</em></a></dt>
    <dd>Specifies the file to get the encryption key from.</dd></dl>

<br>

<h4>Format Options</h4>

<dl>
    <dt><a name="-base64"><strong>-base64</strong></a></dt>
    <dd>Base64 encode data after encryption or decode before decryption.</dd>
</dl>

<dl>
    <dt><a name="-bin"><strong>-bin</strong></a></dt>
    <dt><a name="-bin"><strong>-binary</strong></a></dt>
    <dd>Output result of function as a binary string.</dd>
</dl>

<dl>
    <dt><a name="-hex"><strong>-hex</strong></a></dt>
    <dt><a name="-hex"><strong>-hexadecimal</strong></a></dt>
    <dd>Output result of function as a hexadecimal string. This is the default
	option unless otherwise specified.</dd>
</dl>

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

<p>The following commands provide access to the OpenSSL cryptography functions.</p>

<dl>

<h4><a name="Info">Info Commands</a></h4>
These commands provide information about the available ciphers, digests, etc. and their properties.
<br>
<br>
    <dt><a name="tls::cipher"><strong>tls::cipher</strong> <em>name</em></a></dt>
    <dd>Returns a list of property name and value pairs describing cipher
	<i>name</i>. Properties are:</dd>
    <blockquote><table>
	<tr><td><b>nid</b></td><td>Internal id of cipher. This is the same as <i>name</i>.<td></tr>
	<tr><td><b>name</b></td><td>Name or alias of the cipher.<td></tr>
	<tr><td><b>description</b></td><td>Description of the cipher. OpenSSL 3.0+ only.<td></tr>
	<tr><td><b>block_size</b></td><td>Block size of the cipher. Stream ciphers are set to 1.<td></tr>
	<tr><td><b>key_length</b></td><td>key length of a cipher in bytes.<td></tr>
	<tr><td><b>iv_length</b></td><td>IV length of a cipher in bytes or 0 if not used.<td></tr>
	<tr><td><b>type</b></td><td>Base type of this cipher or undefined if none.<td></tr>
	<tr><td><b>provider</b></td><td>Provider of the cipher. OpenSSL 3.0+ only.<td></tr>
	<tr><td><b>mode</b></td><td>Block cipher mode or <b>stream</b> for a stream cipher.<td></tr>
	<tr><td><b>flags</b></td><td>Flags associated with the cipher. Includes: Variable Length, AEAD Cipher, Non FIPS Allow, etc.<td></tr>
    </table></blockquote>

    <dt><a name="tls::ciphers"><strong>tls::ciphers</strong>
    <em>?protocol? ?verbose? ?supported?</em></a></dt>
    <dd>Without any args, returns a list of all symmetric ciphers for use with
	the <a href="#-cipher"><b>-cipher</b></a> option. With <em>protocol</em>,
	only the ciphers supported for that protocol are returned. See
	 <a href="#tls::protocols"><b>tls::protocols</b></a> command for the supported protocols. 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::digests"><strong>tls::digests</strong> <em>?name?</em></a></dt>
    <dd>Without <em>name</em>, returns a list of the supported message digests
	(aka hash algorithms) for use with the <a href="#-digest"><b>-digest</b></a>
	option. With <em>name</em>, returns a list of property name and value
	pairs describing message digest <i>name</i>. Properties are:</dd>
    <blockquote><table>
	<tr><td><b>name</b></td><td>Name or alias of the digest.<td></tr>
	<tr><td><b>description</b></td><td>Description of the digest. OpenSSL 3.0+ only.<td></tr>
	<tr><td><b>size</b></td><td>Size of the digest in bits.<td></tr>
	<tr><td><b>block_size</b></td><td>Block size of digest in bytes.<td></tr>
	<tr><td><b>provider</b></td><td>Provider of the digest. OpenSSL 3.0+ only.<td></tr>
	<tr><td><b>type</b></td><td>Base type of this digest or undefined if none.<td></tr>
	<tr><td><b>pkey_type</b></td><td>Pkey associated with digest.<td></tr>
	<tr><td><b>flags</b></td><td>Flags associated with the digest. Includes: One-shot, XOF, etc.<td></tr>
    </table></blockquote>

    <dt><a name="tls::kdfs"><strong>tls::kdfs</strong></a></dt>
    <dd>Returns a list of the available Key Derivation Function (KDF)
	algorithms. Each item in the list corresponds to a command with the same name.</dd>

    <dt><a name="tls::macs"><strong>tls::macs</strong></a></dt>
    <dd>Returns a list of the available Message Authentication Codes (MAC).
	Each item in the list corresponds to a command with the same name.</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>

<br>

<h4><a name="MD_MAC">Message Digest (MD) and Message Authentication Code (MAC) Commands</a></h4>
These commands calculate a message digest or message authentication code for data.
<br>
<br>
    <dt><a name="tls::cmac"><strong>tls::cmac</strong>
	<em>?</em><b>-cipher</b><em>? name</em>
	<b>-key</b> <em>key ?</em>
	<b>-bin</b>|<b>-hex</b>
	<em>?[</em><b>-chan</b> <em>channelId |</em> <b>-command</b> <em>cmdName |</em>
	<b>-file</b> <em>filename | ?</em><b>-data</b><em>? data]</em></a></dt>
    <dd>Calculate the Cipher-based Message Authentication Code (CMAC) where
	<em>key</em> is a shared key and output the result per the I/O options
	in the specified format. MACs are used to ensure authenticity and the
	integrity of data. See <a href="#OPTIONS"><b>options</b></a> for usage
	info. Option <b>-key</b> is only used for some ciphers.</dd>

    <dt><a name="tls::hmac"><strong>tls::hmac</strong>
	<em>?</em><b>-digest</b><em>? name</em>
	<b>-key</b> <em>key ?</em>
	<b>-bin</b>|<b>-hex</b>
	<em>?[</em><b>-chan</b> <em>channelId |</em> <b>-command</b> <em>cmdName |</em>
	<b>-file</b> <em>filename | ?</em><b>-data</b><em>? data]</em></a></dt>
    <dd>Calculate the Hash-based Message Authentication Code (HMAC) where
	<em>key</em> is a shared secret key and output the result per the I/O
	options in the specified format. The cryptographic strength depends
	upon the size of the key and the security of the hash function used.
	See <a href="#OPTIONS"><b>options</b></a> for usage info.</dd>

    <dt><a name="tls::mac"><strong>tls::mac</strong>
	<em>?</em><b>-mac</b><em>? name</em>
	<b>-cipher</b> <em>name</em>
	<b>-digest</b> <em>name</em>
	<b>-key</b> <em>key ?</em>
	<b>-bin</b>|<b>-hex</b>
	<em>?[</em><b>-chan</b> <em>channelId |</em> <b>-command</b> <em>cmdName |</em>
	<b>-file</b> <em>filename | ?</em><b>-data</b><em>? data]</em></a></dt>
    <dd>(OpenSSL 3.0+) Calculate the Message Authentication Code (MAC) where
	<em>key</em> is a shared key and output the result per the I/O options
	in the specified format. MACs are used to ensure authenticity and
	the integrity of data. See <a href="#OPTIONS"><b>options</b></a>
	for usage info.</dd>

    <dt><a name="tls::md"><strong>tls::md</strong>
	<em>?</em><b>-digest</b><em>? name</em>
	<em>?</em><b>-bin</b>|<b>-hex</b>
	<em>?[</em><b>-chan</b> <em>channelId |</em> <b>-command</b> <em>cmdName |</em>
	<b>-file</b> <em>filename | ?</em><b>-data</b><em>? data]</em></a></dt>
    <dd>Calculate the message digest (MD) using hash function <em>name</em>
	and output the result per the I/O options in the specified format.
	MDs are used to ensure the integrity of data. See
	<a href="#OPTIONS"><b>options</b></a> for usage info.</dd>

    <dt><a name="tls::md4"><strong>tls::md4</strong> <em>data</em></a></dt>
    <dd>Returns the MD4 message-digest for <em>data</em> as a hex string.</dd>

    <dt><a name="tls::md5"><strong>tls::md5</strong> <em>data</em></a></dt>
    <dd>Returns the MD5 message-digest for <em>data</em> as a hex string.</dd>

    <dt><a name="tls::sha1"><strong>tls::sha1</strong> <em>data</em></a></dt>
    <dd>Returns the SHA1 secure hash algorithm digest for <em>data</em> as a hex string.</dd>

    <dt><a name="tls::sha256"><strong>tls::sha256</strong> <em>data</em></a></dt>
    <dd>Returns the SHA-2 SHA256 secure hash algorithm digest for <em>data</em> as a hex string.</dd>

    <dt><a name="tls::sha512"><strong>tls::sha512</strong> <em>data</em></a></dt>
    <dd>Returns the SHA-2 SHA512 secure hash algorithm digest for <em>data</em> as a hex string.</dd>

    <dt><a name="tls::unstack"><strong>tls::unstack</strong> <em>channelId</em></a></dt>
    <dd>Removes the top level cryptographic transform from channel <em>channelId</em>.</dd>

<br>

<h4><a name="Cipher">Encryption and Decryption Commands</a></h4>
These commands encrypt plaintext into ciphertext or vice versa.
<br>
<br>
    <dt><a name="tls::encrypt"><strong>tls::encrypt</strong>
	<em>?</em><b>-cipher</b><em>? name</em>
	<b>-digest</b> <em>name</em>
	<b>-key</b> <em>key ?</em>
	<b>-iv</b> <em>string?</em>
	<em>[</em><b>-chan</b> <em>channelId |</em> <b>-command</b> <em>cmdName |</em>
	<b>-infile</b> <em>filename</em> <b>-outfile</b> <em>filename |</em>
	<b>-data</b><em> data]</em></a></dt>
    <dd>Encrypt the data using cipher <em>cipher</em> and output the result per
	the I/O options. Ciphers are used to create the cipher text from the
	input data. See <a href="#OPTIONS"><b>options</b></a> for usage
	info. Option <b>-iv</b> is only used for some ciphers. See the
	<a href="#tls::cipher"><b>tls::cipher</b></a> command for key and iv
	sizes and for when the <b>-iv</b> option is used (iv_length &gt; 0).</dd>

    <dt><a name="tls::decrypt"><strong>tls::decrypt</strong>
	<em>?</em><b>-cipher</b><em>? name</em>
	<b>-key</b> <em>key ?</em>
	<b>-iv</b> <em>string?</em>
	<em>[</em><b>-chan</b> <em>channelId |</em> <b>-command</b> <em>cmdName |</em>
	<b>-infile</b> <em>filename</em> <b>-outfile</b> <em>filename |</em>
	<b>-data</b><em> data]</em></a></dt>
    <dd>Decrypt the data using cipher <em>cipher</em> and output the result per
	the I/O options. This command is the opposite of the <b>tls::encrypt</b>
	command. See <a href="#OPTIONS"><b>options</b></a> for usage info.
	The <b>-iv</b> option is only used for some ciphers. See the
	<a href="#tls::cipher"><b>tls::cipher</b></a> command for key and iv
	sizes and for when the <b>-iv</b> option is used (iv_length &gt; 0).</dd>

<br>

<h4><a name="KDF">Key Derivation Function (KDF) Commands</a></h4>
These commands are a more secure way to generate keys and ivs for use by the
<a href="#tls::encrypt"><b>tls::encrypt</b></a> command then regular strings and random values.
<br>
<br>
    <dt><a name="tls::hkdf"><strong>tls::hkdf</strong>
	<b>-digest</b> <em>digest</em>
	<b>-key</b> <em>string</em>
	<em>?</em><b>-info</b> <em>string?</em>
	<em>?</em><b>-salt</b> <em>string?</em>
	<em>?</em><b>-size</b> <em>derived_length?</em></a></dt>
    <dd>Derive a key of size <i>size</i> using the HMAC-based Extract-and-Expand
	Key Derivation Function (HKDF).
	See <a href="#OPTIONS"><b>options</b></a> for usage info. </dd>

    <dt><a name="tls::pbkdf2"><strong>tls::pbkdf2</strong>
	<em>[</em><b>-cipher</b> <em>cipher |</em>
	<b>-size</b> <em>derived_length]</em>
	<b>-digest</b> <em>digest</em>
	<em>?</em><b>-iterations</b> <em>count?</em>
	<em>?</em><b>-password</b> <em>string?</em>
	<em>?</em><b>-salt</b> <em>string?</em></a></dt>
    <dd>Derive a key and initialization vector (iv) from a password and salt
	value using PKCS5_PBKDF2_HMAC. 
	See <a href="#OPTIONS"><b>options</b></a> for usage info. If <b>-cipher</b>
	is specified, then the derived key and iv sized for that cipher are
	returned as a key-value list. If not or if <b>-size</b> is specified,
	then the derived key (DK) of <em>size</em> bytes is returned.</dd>

    <dt><a name="tls::scrypt"><strong>tls::scrypt</strong>
	<b>-password</b> <em>string</em>
	<b>-salt</b> <em>string</em>
	<em>?</em><b>-N</b> <em>costParameter?</em>
	<em>?</em><b>-r</b> <em>blockSize?</em>
	<em>?</em><b>-p</b> <em>parallelization?</em>
	<em>?</em><b>-size</b> <em>derived_length?</em></a></dt>
    <dd>Derive a key of size <i>size</i> using the scrypt password based key derivation function.
	See <a href="#OPTIONS"><b>options</b></a> for usage info. 
	See RFC 7914 for more details. Can consume a large amount of memory.
	RAM used is roughly (128 * N * r * p) bytes. Memory is limited to
	1025 MiB. The custom options are:</dd>
    <blockquote><table>
	<tr><td><b>-N</b></td><td>The CPU/Memory cost parameter
	must be larger than 1, a power of 2, and less than
	2^(128 * r / 8). Default is 1048576.<td></tr>
	<tr><td><b>-r</b></td><td>The blockSize parameter specifies the
	block size. Must be greater than 0. Default is 8.<td></tr>
	<tr><td><b>-p</b></td><td>The parallelization parameter
	must be a positive integer less than or equal
	to ((2^32-1) * 32) / (128 * r). Default is 1.<td></tr>
    </table></blockquote>

<br>

<h4><a name="RAND">Random Bytes Commands</a></h4>
These commands provide randomly generated byte strings for use when random data is needed.
<br>
<br>
    <dt><a name="tls::random"><strong>tls::random</strong>
	<em>?</em><b>-private</b><em>? length</em></a></dt>
    <dd>Generate <i>length</i> random bytes using a cryptographically secure
	pseudo random generator (CSPRNG). OpenSSL uses a security level of 256
	bits. Will return an error if a trusted entropy source such as the OS
	isn't available. Use <b>-private</b> option if the values are intended
	to remain private in case the public PRNG is compromised.</dd>

</dl>

<br>
<h3><a name="GLOSSARY">GLOSSARY</a></h3>

<p>The following is a list of the terminology used in this package along with
brief definitions. For more details, please consult with the OpenSSL documentation.</p>


<br>
<h3><a name="EXAMPLES">EXAMPLES</a></h3>

<p>TBS</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>

<br>
<h3><a name="SPECIAL">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
ciphers, digests, MACs, etc. or change default values. Use the
info commands to obtain the supported values.</p>
<br>

<pre>
Copyright &copy; 2023 Brian O'Hagan.
</pre>
</body>
</html>

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


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

Modified doc/tls.html from [ec5645fd47] to [12b4e9e9d7].

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




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>

<!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>
<title>TLS (SSL) TCL Commands</title>
<link rel="stylesheet" href="docs.css" type="text/css" media="all">
</head>

<body class="vsc-initialized">
<body bgcolor="#FFFFFF">

<h2>Tcl Tls Extension Documentation</h2>

<dl>
    <dd><a href="#NAME">NAME</a>
    <dl>
	<dd><b>tls</b> - binding to <b>OpenSSL</b> toolkit.</dd>
	<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.4?</em></dd>
	    <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::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::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>
<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.4</b><br>
<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::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>
<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
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
	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:
	options with one additional option:</dd>
<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>
	<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>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>
    <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
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 or cipher suites. Cipher suites can be combined
	    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 to invoke at several points during the handshake.
	<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 to invoke when OpenSSL needs to obtain a password,
	    typically to unlock the private key of a certificate. The
	<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.
	    also be set to true. (default is <em>false</em>)</dd>
	    (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,
	    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
	<dd>Handshake as server if true, else handshake as
	    client. (default is <em>false</em>)</dd>
	    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 hostname. Only available if the OpenSSL library
	<dd>Specify server's hostname. Used to set the TLS 'Server Name
	    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>
	    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 to invoke to verify or validate protocol config
	<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 SSL-enabling of a regular Tcl channel.  An error
      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>
    <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
    <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
	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>
	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 the client and
	<dd>The current cipher in use between for the channel.</dd>
	    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>
274
275
276
277
278
279
280
281

282
283
284
285
286
287
288
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 hex string.</dd>
	<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
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 hex string. This value matches the SKI
	    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 hex
	<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 certificate signature.</dd>
	<dd>Cipher algorithm used for the certificate signature.</dd>
	<dt><strong>signatureValue</strong> <em>string</em></dt>
	<dd>Certificate signature as hex string.</dd>
	<dd>Certificate signature as a hex string.</dd>
	<dt><strong>signatureDigest</strong> <em>version</em></dt>
	<dd>Certificate signing digest.</dd>
	<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 hex string.</dd>
	<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>
	<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>
	<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 hex string.</dd>
	<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 hex string.</dd>
	<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
	result is a list of key-value pairs describing the connection.</dd>
	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>
	<dt><strong>renegotiation_allowed</strong> <em>boolean</em></dt>
	<dd>Whether protocol renegotiation is supported or not.</dd>
	<dt><strong>securitylevel</strong> <em>level</em></dt>
	<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>bits</strong> <em>n</em></dt>
	<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>id</strong> <em>id</em></dt>
	<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>Can the session be resumed or not.</dd>
	<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::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:
    <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 with be
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
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>
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.

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

Modified generic/tclOpts.h from [fee5089a30] to [6a496a0d8f].

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

-
-
-
+
-





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

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

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


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

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPT_PROLOG(option)			\
    if (strcmp(opt, (option)) == 0) {		\
#define GET_OPT_BOOL(objPtr, varPtr) \
    if (Tcl_GetBooleanFromObj(interp, objPtr, varPtr) != TCL_OK) {	\
	if (++idx >= objc) {			\
	    Tcl_AppendResult(interp,		\
		"no argument given for ",	\
		(option), " option",		\
		(char *) NULL);			\
	    return TCL_ERROR;			\
	}
#define OPT_POSTLOG()				\
	continue;				\
	return TCL_ERROR;					\
    }

#define GET_OPT_INT(objPtr, varPtr) \
    if (Tcl_GetIntFromObj(interp, objPtr, varPtr) != TCL_OK) {	\
	return TCL_ERROR;					\
    }
#define OPTOBJ(option, var)			\
    OPT_PROLOG(option)				\
    var = objv[idx];				\

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

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

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

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

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

#define OPTBOOL(option, var)			\
    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
    }

#define GET_OPT_STRING(objPtr, var, lenPtr) \
    if ((var = Tcl_GetStringFromObj(objPtr, lenPtr)) == NULL) {	\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
	return TCL_ERROR;					\
    }								\
    OPT_POSTLOG()

#define OPTBYTE(option, var, lvar)			\
#define GET_OPT_BYTE_ARRAY(objPtr, var, lenPtr) \
    OPT_PROLOG(option)				\
    var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
    if ((var = Tcl_GetByteArrayFromObj(objPtr, lenPtr)) == NULL) {	\
    OPT_POSTLOG()

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

#endif /* _TCL_OPTS_H */

Modified generic/tls.c from [893e5c4546] to [0f9a22b39e].

22
23
24
25
26
27
28




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







+
+
+
+







 *
 */

#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
290
291
292
293
294
295
296

297
298
299

300
301
302
303
304
305
306
307
308

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

314
315
316
317
318
319
320
321







+



+








-
+







	break;
    case SSL3_RT_HANDSHAKE:
	type = "Handshake";
	break;
    case SSL3_RT_APPLICATION_DATA:
	type = "App Data";
	break;
#if OPENSSL_VERSION_NUMBER < 0x30000000L
    case DTLS1_RT_HEARTBEAT:
	type = "Heartbeat";
	break;
#endif
    default:
	type = "unknown";
    }

    /* Needs compile time option "enable-ssl-trace". */
    if ((bio = BIO_new(BIO_s_mem())) != NULL) {
	int n;
	SSL_trace(write_p, version, content_type, buf, len, ssl, (void *)bio);
	n = BIO_read(bio, buffer, min(BIO_pending(bio), 14999));
	n = BIO_read(bio, buffer, BIO_pending(bio) < 15000 ? BIO_pending(bio) : 14999);
	n = (n<0) ? 0 : n;
	buffer[n] = 0;
	(void)BIO_flush(bio);
	BIO_free(bio);
   }

    /* Create command to eval */
363
364
365
366
367
368
369
370

371
372
373
374
375
376
377
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383







-
+







 *	  to a string describing the SSL negotiation failure reason
 *
 *-------------------------------------------------------------------
 */
static int
VerifyCallback(int ok, X509_STORE_CTX *ctx) {
    Tcl_Obj *cmdPtr;
    SSL   *ssl		= (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
    SSL   *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx());
    X509  *cert		= X509_STORE_CTX_get_current_cert(ctx);
    State *statePtr	= (State*)SSL_get_app_data(ssl);
    Tcl_Interp *interp	= statePtr->interp;
    int depth		= X509_STORE_CTX_get_error_depth(ctx);
    int err		= X509_STORE_CTX_get_error(ctx);

    dprintf("Called");
588
589
590
591
592
593
594
595

596
597
598
599
600
601
602
594
595
596
597
598
599
600

601
602
603
604
605
606
607
608







-
+







 * Return codes:
 *	0 = error where session will be immediately removed from the internal cache.
 *	1 = success where app retains session in session cache, and must call SSL_SESSION_free() when done.
 *
 *-------------------------------------------------------------------
 */
static int
SessionCallback(const SSL *ssl, SSL_SESSION *session) {
SessionCallback(SSL *ssl, SSL_SESSION *session) {
    State *statePtr = (State*)SSL_get_app_data((SSL *)ssl);
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    const unsigned char *ticket;
    const unsigned char *session_id;
    size_t len2;
    unsigned int ulen;
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
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







-
+













-
+

















-
+







 *	    supplied list and the server configuration. The connection will be aborted.
 *	SSL_TLSEXT_ERR_NOACK: ALPN protocol not selected, e.g., because no ALPN
 *	    protocols are configured for this connection. The connection continues.
 *
 *-------------------------------------------------------------------
 */
static int
ALPNCallback(const SSL *ssl, const unsigned char **out, unsigned char *outlen,
ALPNCallback(SSL *ssl, const unsigned char **out, unsigned char *outlen,
	const unsigned char *in, unsigned int inlen, void *arg) {
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code, res;

    dprintf("Called");

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

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

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

    /* Create command to eval */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(*out, -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj((const char *) *out, -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewBooleanObj(res == SSL_TLSEXT_ERR_OK));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
    if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) {
	res = SSL_TLSEXT_ERR_NOACK;
    } else if (code == 1) {
777
778
779
780
781
782
783
784

785
786
787
788
789
790
791
783
784
785
786
787
788
789

790
791
792
793
794
795
796
797







-
+







 */
static int
SNICallback(const SSL *ssl, int *alert, void *arg) {
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code, res;
    char *servername = NULL;
    const char *servername = NULL;

    dprintf("Called");

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

844
845
846
847
848
849
850
851

852
853
854
855
856
857
858
850
851
852
853
854
855
856

857
858
859
860
861
862
863
864







-
+







 *	SSL_CLIENT_HELLO_RETRY: suspend the handshake, and the handshake function will return immediately
 *	SSL_CLIENT_HELLO_ERROR: failure, terminate connection. Set alert to error code.
 *	SSL_CLIENT_HELLO_SUCCESS: success
 *
 *-------------------------------------------------------------------
 */
static int
HelloCallback(const SSL *ssl, int *alert, void *arg) {
HelloCallback(SSL *ssl, int *alert, void *arg) {
    State *statePtr = (State*)arg;
    Tcl_Interp *interp	= statePtr->interp;
    Tcl_Obj *cmdPtr;
    int code, res;
    const char *servername;
    const unsigned char *p;
    size_t len, remaining;
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
932
933
934
935
936
937
938
























































































































































































































939
940
941
942
943
944
945







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







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

    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, GET_ERR_REASON(), NULL);
	return TCL_ERROR;
    }

    ssl = SSL_new(ctx);
    if (ssl == NULL) {
	Tcl_AppendResult(interp, GET_ERR_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;
}

/*
 *-------------------------------------------------------------------
 *
 * 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;
    (void) clientData;

    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;
}

/*
 *-------------------------------------------------------------------
 *
 * 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.
1219
1220
1221
1222
1223
1224
1225














1226
1227
1228
1229
1230
1231
1232
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







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







    }

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

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
 *
1241
1242
1243
1244
1245
1246
1247
1248
1249


1250
1251
1252
1253

1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269

1270

1271
1272
1273
1274
1275
1276
1277
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







-
-
+
+



-
+
















+
-
+







 *-------------------------------------------------------------------
 */
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 *cmdObj	        = NULL;
    Tcl_Obj *passwdObj	        = NULL;
    Tcl_Obj *vcmd	        = NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx;
    Tcl_Size len;
    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 *alpn		= NULL;
    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;
    (void) clientData;

    dprintf("Called");
1301
1302
1303
1304
1305
1306
1307



1308
1309
1310


























































































1311
1312

1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342

1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115



1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206

1207






























1208

1209


1210
1211
1212
1213
1214
1215
1216







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

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

-
-







	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;
	}
	char *opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL);

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

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

	}
	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);
1373
1374
1375
1376
1377
1378
1379
1380
1381


1382
1383

1384
1385
1386
1387
1388
1389
1390


1391
1392

1393
1394
1395
1396
1397
1398
1399
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







-
-
+
+

-
+





-
-
+
+

-
+








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

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

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

    /* allocate validate command */
    if (vcmd) {
	(void) Tcl_GetStringFromObj(vcmd, &len);
1497
1498
1499
1500
1501
1502
1503
1504

1505
1506

1507
1508
1509
1510
1511
1512
1513
1514
1515
1516

1517
1518
1519
1520
1521
1522
1523
1524

1525
1526
1527
1528
1529
1530
1531
1360
1361
1362
1363
1364
1365
1366

1367
1368

1369
1370
1371
1372
1373
1374
1375
1376
1377
1378

1379
1380
1381
1382
1383
1384
1385
1386

1387
1388
1389
1390
1391
1392
1393
1394







-
+

-
+









-
+







-
+







	    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) {
    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) strlen(session_id))) {
	if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) sess_len)) {
	    Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (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) {
    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, alpn, &cnt, &list) != TCL_OK) {
	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);
1566
1567
1568
1569
1570
1571
1572

1573
1574
1575
1576
1577
1578
1579
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443







+







	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); */
2092
2093
2094
2095
2096
2097
2098

2099
2100
2101
2102
2103
2104
2105
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970







+








    /* 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;
	}
2190
2191
2192
2193
2194
2195
2196
2197

2198
2199
2200
2201
2202
2203
2204
2055
2056
2057
2058
2059
2060
2061

2062
2063
2064
2065
2066
2067
2068
2069







-
+







    (void) clientData;

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

    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
    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()) {
2220
2221
2222
2223
2224
2225
2226
2227

2228
2229
2230
2231
2232
2233
2234
2085
2086
2087
2088
2089
2090
2091

2092
2093
2094
2095
2096
2097
2098
2099







-
+







	/* Get SNI requested server name */
	LAPPEND_STR(interp, objPtr, "servername", SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1);

	/* Get protocol */
	LAPPEND_STR(interp, objPtr, "protocol", SSL_get_version(ssl), -1);

	/* Renegotiation allowed */
	LAPPEND_BOOL(interp, objPtr, "renegotiation_allowed", SSL_get_secure_renegotiation_support(ssl));
	LAPPEND_BOOL(interp, objPtr, "renegotiation_allowed", SSL_get_secure_renegotiation_support((SSL *) ssl));

	/* Get security level */
	LAPPEND_INT(interp, objPtr, "security_level", SSL_get_security_level(ssl));

	/* Session info */
	LAPPEND_BOOL(interp, objPtr, "session_reused", SSL_session_reused(ssl));

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
2290




2291
2292
2293
2294
2295
2296
2297
2298
2299
2300

2301
2302
2303
2304
2305
2306
2307
2125
2126
2127
2128
2129
2130
2131

2132
2133
2134
2135
2136
2137
2138
2139
2140
2141




2142
2143
2144
2145
2146
2147

2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165

2166
2167
2168
2169
2170
2171
2172
2173







-
+









-
-
-
-






-
+
+



+
+
+
+









-
+







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

	/* 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 */
	/* 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;
	unsigned int ulen;
	const unsigned char *session_id, *proto;
	char buffer[SSL_MAX_MASTER_KEY_LENGTH];
	unsigned char buffer[SSL_MAX_MASTER_KEY_LENGTH];

	/* Report the selected protocol as a result of the ALPN negotiation */
	SSL_SESSION_get0_alpn_selected(session, &proto, &len2);
	LAPPEND_STR(interp, objPtr, "alpn", (char *) proto, (Tcl_Size) len2);

	/* Report the selected protocol as a result of the NPN negotiation */
#ifdef USE_NPN
2330
2331
2332
2333
2334
2335
2336

2337

2338

2339
2340
2341
2342
2343
2344
2345
2196
2197
2198
2199
2200
2201
2202
2203

2204
2205
2206
2207
2208
2209
2210
2211
2212
2213







+
-
+

+







	SSL_SESSION_get0_ticket(session, &ticket, &len2);
	LAPPEND_BARRAY(interp, objPtr, "session_ticket", ticket, (Tcl_Size) len2);

	/* Session ticket lifetime hint (in seconds) */
	LAPPEND_LONG(interp, objPtr, "lifetime", SSL_SESSION_get_ticket_lifetime_hint(session));

	/* Ticket app data */
#if OPENSSL_VERSION_NUMBER < 0x30000000L
	SSL_SESSION_get0_ticket_appdata(session, &ticket, &len2);
	SSL_SESSION_get0_ticket_appdata((SSL_SESSION *) session, &ticket, &len2);
	LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (Tcl_Size) len2);
#endif

	/* Get master key */
	len2 = SSL_SESSION_get_master_key(session, buffer, SSL_MAX_MASTER_KEY_LENGTH);
	LAPPEND_BARRAY(interp, objPtr, "master_key", buffer, (Tcl_Size) len2);

	/* Compression id */
	unsigned int id = SSL_SESSION_get_compress_id(session);
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
2430
2431
2432
2433
2434
2435
2250
2251
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







+











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

-








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


/*
 *-------------------------------------------------------------------
 *
 * 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;
    (void) clientData;
    (void) objc;
    (void) objv;

    dprintf("Called");

    objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
    Tcl_SetObjResult(interp, objPtr);

    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * MiscObjCmd -- misc commands
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787

2788
2789
2790
2791
2792






2793
2794
2795
2796
2797
2798
2799
2619
2620
2621
2622
2623
2624
2625

2626
2627
2628
2629
2630
2631



2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644







-



+


-
-
-
+
+
+
+
+
+







    }

    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) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    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);
}
2919
2920
2921
2922
2923
2924
2925
2926

2927
2928
2929
2930
2764
2765
2766
2767
2768
2769
2770

2771
2772
2773
2774
2775







-
+




	    rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0));
	}
	RAND_seed(rnd_seed, sizeof(rnd_seed));
    } while (RAND_status() != 1);
#endif

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

    return(status);
}

Added generic/tlsDigest.c version [b9cf69269c].





























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Message Digest (MD) and Message Authentication Code (MAC) Module
 *
 * Provides commands to calculate a Message Digest (MD) or a Message
 * Authentication Code (MAC).
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <tcl.h>
#include <stdio.h>
#include <string.h>
#include <openssl/evp.h>
#include <openssl/cmac.h>
#include <openssl/hmac.h>

/* Constants */
const char *hex = "0123456789abcdef";

/* Macros */
#define BUFFER_SIZE	65536
#define CHAN_EOF	0x10
#define READ_DELAY	5

/* Digest format and operation */
#define BIN_FORMAT	0x01
#define HEX_FORMAT	0x02
#define IS_XOF		0x08
#define TYPE_MD		0x10
#define TYPE_HMAC	0x20
#define TYPE_CMAC	0x40
#define TYPE_MAC	0x80

/*******************************************************************/

/*
 * This structure defines the per-instance state of a digest operation.
 */
typedef struct DigestState {
	Tcl_Channel self;	/* This socket channel */
	Tcl_TimerToken timer;	/* Timer for read events */

	int flags;		/* Chan config flags */
	int watchMask;		/* Current WatchProc mask */
	int mode;		/* Current mode of parent channel */
	int format;		/* Digest format and operation */

	Tcl_Interp *interp;	/* Current interpreter */
	EVP_MD_CTX *ctx;	/* MD Context */
	HMAC_CTX *hctx;		/* HMAC context */
	CMAC_CTX *cctx;		/* CMAC context */
	Tcl_Command token;	/* Command token */
} DigestState;

/*
 *-------------------------------------------------------------------
 *
 * DigestStateNew --
 *
 *	This function creates a per-instance state data structure
 *
 * Returns:
 *	Digest structure pointer
 *
 * Side effects:
 *	Creates structure
 *
 *-------------------------------------------------------------------
 */
DigestState *DigestStateNew(Tcl_Interp *interp, int format) {
    DigestState *statePtr;

    statePtr = (DigestState *) ckalloc((unsigned) sizeof(DigestState));
    if (statePtr != NULL) {
	memset(statePtr, 0, sizeof(DigestState));
	statePtr->self	= NULL;		/* This socket channel */
	statePtr->timer = NULL;		/* Timer to flush data */
	statePtr->flags = 0;		/* Chan config flags */
	statePtr->watchMask = 0;	/* Current WatchProc mask */
	statePtr->mode	= 0;		/* Current mode of parent channel */
	statePtr->format = format;	/* Digest format and operation */
	statePtr->interp = interp;	/* Current interpreter */
	statePtr->ctx = NULL;		/* MD Context */
	statePtr->hctx = NULL;		/* HMAC Context */
	statePtr->cctx = NULL;		/* CMAC Context */
	statePtr->token = NULL;		/* Command token */
    }
    return statePtr;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestStateFree --
 *
 *	This function deletes a digest state structure
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	Removes structure
 *
 *-------------------------------------------------------------------
 */
void DigestStateFree(DigestState *statePtr) {
    if (statePtr == (DigestState *) NULL) {
	return;
    }

    /* Remove pending timer */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
    }

    /* Free context structures */
    if (statePtr->ctx != (EVP_MD_CTX *) NULL) {
	EVP_MD_CTX_free(statePtr->ctx);
    }
    if (statePtr->hctx != (HMAC_CTX *) NULL) {
	HMAC_CTX_free(statePtr->hctx);
    }
    if (statePtr->cctx != (CMAC_CTX *) NULL) {
	CMAC_CTX_free(statePtr->cctx);
    }
    ckfree(statePtr);
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestInitialize --
 *
 *	Initialize a hash function
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR for failure with result set
 *	to error message.
 *
 * Side effects:
 *	No result or error message
 *
 *-------------------------------------------------------------------
 */
int DigestInitialize(Tcl_Interp *interp, DigestState *statePtr, Tcl_Obj *digestObj,
	Tcl_Obj *cipherObj, Tcl_Obj *keyObj, Tcl_Obj *macObj) {
    int res = 0, type = statePtr->format & 0xFF0;
    const EVP_MD *md = NULL;
    const EVP_CIPHER *cipher = NULL;
    const void *key = NULL;
    Tcl_Size key_len = 0;

    dprintf("Called");

    /* Get digest */
    md = Util_GetDigest(interp, digestObj, type != TYPE_CMAC);
    if (md == NULL && type != TYPE_CMAC) {
	return TCL_ERROR;
    }

    /* Get cipher */
    cipher = Util_GetCipher(interp, cipherObj, type == TYPE_CMAC);
    if (cipher == NULL && type == TYPE_CMAC) {
	return TCL_ERROR;
    }

    /* Get key */
    key = (const void *) Util_GetKey(interp, keyObj, &key_len, "key", 0, type != TYPE_MD);
    if (key == NULL && type != TYPE_MD) {
	return TCL_ERROR;
    }

    /* Create contexts */
    switch(type) {
    case TYPE_MD:
	statePtr->ctx = EVP_MD_CTX_new();
	res = (statePtr->ctx != NULL);
	break;
    case TYPE_HMAC:
	statePtr->hctx = HMAC_CTX_new();
	res = (statePtr->hctx != NULL);
	break;
    case TYPE_CMAC:
	statePtr->cctx = CMAC_CTX_new();
	res = (statePtr->cctx != NULL);
	break;
    }

    if (!res) {
	Tcl_AppendResult(interp, "Create context failed", (char *) NULL);
	return TCL_ERROR;
    }

    /* Initialize cryptography function */
    switch(type) {
    case TYPE_MD:
	res = EVP_DigestInit_ex(statePtr->ctx, md, NULL);
	break;
    case TYPE_HMAC:
	res = HMAC_Init_ex(statePtr->hctx, key, (int) key_len, md, NULL);
	break;
    case TYPE_CMAC:
	res = CMAC_Init(statePtr->cctx, key, (int) key_len, cipher, NULL);
	break;
    }

    if (!res) {
	Tcl_AppendResult(interp, "Initialize failed: ", GET_ERR_REASON(), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestUpdate --
 *
 *	Update a hash function with data
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR for failure with result set
 *	to error message if do_result is true.
 *
 * Side effects:
 *	Adds buf data to hash function or sets result to error message
 *
 *-------------------------------------------------------------------
 */
int DigestUpdate(DigestState *statePtr, char *buf, Tcl_Size read, int do_result) {
    int res = 0;

    dprintf("Called");

    switch(statePtr->format & 0xFF0) {
    case TYPE_MD:
        res = EVP_DigestUpdate(statePtr->ctx, buf, (size_t) read);
	break;
    case TYPE_HMAC:
        res = HMAC_Update(statePtr->hctx, (const unsigned char *) buf, (size_t) read);
	break;
    case TYPE_CMAC:
        res = CMAC_Update(statePtr->cctx, buf, (size_t) read);
	break;
    }

    if (!res && do_result) {
	Tcl_AppendResult(statePtr->interp, "Update failed: ", GET_ERR_REASON(), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestFinalize --
 *
 *	Finalize a hash function and return the message digest
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR for failure with result set
 *	to error message.
 *
 * Side effects:
 *	Sets result to message digest or an error message.
 *
 *-------------------------------------------------------------------
 */
int DigestFinalize(Tcl_Interp *interp, DigestState *statePtr, Tcl_Obj **resultObj) {
    unsigned char md_buf[EVP_MAX_MD_SIZE];
    unsigned int ulen;
    int res = 0, md_len = 0, type = statePtr->format & 0xFF0;

    dprintf("Called");

    /* Finalize cryptography function and get result */
    switch(type) {
    case TYPE_MD:
	if (!(statePtr->format & IS_XOF)) {
	    res = EVP_DigestFinal_ex(statePtr->ctx, md_buf, &ulen);
	    md_len = (int) ulen;
	} else {
	    res = EVP_DigestFinalXOF(statePtr->ctx, md_buf, (size_t) EVP_MAX_MD_SIZE);
	    md_len = EVP_MAX_MD_SIZE;
	}
	break;
    case TYPE_HMAC:
	res = HMAC_Final(statePtr->hctx, md_buf, &ulen);
	md_len = (int) ulen;
	break;
    case TYPE_CMAC:
	size_t size;
	res = CMAC_Final(statePtr->cctx, md_buf, &size);
	md_len = (int) size;
	break;
    }

    if (!res) {
	if (resultObj == NULL) {
	    Tcl_AppendResult(interp, "Finalize failed: ", GET_ERR_REASON(), (char *) NULL);
	}
	return TCL_ERROR;
    }

    /* Return message digest as either a binary or hex string */
    if (statePtr->format & BIN_FORMAT) {
	if (resultObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(md_buf, (Tcl_Size) md_len));
	} else {
	    *resultObj = Tcl_NewByteArrayObj(md_buf, (Tcl_Size) md_len);
	    Tcl_IncrRefCount(*resultObj);
	}

    } else {
	Tcl_Obj *newObj = Tcl_NewObj();
	unsigned char *ptr = Tcl_SetByteArrayLength(newObj, (Tcl_Size) md_len*2);

	for (int i = 0; i < md_len; i++) {
	    *ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
	    *ptr++ = hex[md_buf[i] & 0x0F];
	}

	if (resultObj == NULL) {
	    Tcl_SetObjResult(interp, newObj);
	} else {
	    *resultObj = newObj;
	    Tcl_IncrRefCount(*resultObj);
	}
    }
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestBlockModeProc --
 *
 *	This function is invoked by the generic IO level
 *	to set blocking and nonblocking modes.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *	Can call Tcl_SetChannelError.
 *
 *-------------------------------------------------------------------
 */
static int DigestBlockModeProc(ClientData clientData, int mode) {
    DigestState *statePtr = (DigestState *) clientData;

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

/*
 *-------------------------------------------------------------------
 *
 * DigestCloseProc --
 *
 *	This function is invoked by the generic IO level to perform
 *	channel-type specific cleanup when the channel is closed. All
 *	queued output is flushed prior to calling this function.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Deletes stored state data.
 *
 *-------------------------------------------------------------------
 */
int DigestCloseProc(ClientData clientData, Tcl_Interp *interp) {
    DigestState *statePtr = (DigestState *) clientData;

    /* Cancel active timer, if any */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    /* Output message digest if not already done */
    if (!(statePtr->flags & CHAN_EOF)) {
	Tcl_Channel parent = Tcl_GetStackedChannel(statePtr->self);
	Tcl_Obj *resultObj;
	Tcl_Size written, toWrite;

	if (DigestFinalize(statePtr->interp, statePtr, &resultObj) == TCL_OK) {
	    unsigned char *data = Tcl_GetByteArrayFromObj(resultObj, &toWrite);
	    written = Tcl_WriteRaw(parent, (const char *) data, toWrite);
            if (written != toWrite) {
                /* Error */
            }
	    Tcl_DecrRefCount(resultObj);
	}
	statePtr->flags |= CHAN_EOF;
    }

    /* Clean-up */
    DigestStateFree(statePtr);
    return 0;
}

/*
 * Same as DigestCloseProc but with individual read and write close control
 */
static int DigestClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags) {

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

/*
 *----------------------------------------------------------------------
 *
 * DigestInputProc --
 *
 *	Called by the generic IO system to read data from transform and
 *	place in buf. Transform gets data from the underlying channel.
 *
 * Returns:
 *	Total bytes read or -1 for an error along with a POSIX error
 *	code in errorCodePtr. Use EAGAIN for nonblocking and no data.
 *
 * Side effects:
 *	Read data from transform and write to buf
 *
 *----------------------------------------------------------------------
 */
int DigestInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_Size read;
    *errorCodePtr = 0;

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

    /* Get bytes from underlying channel */
    parent = Tcl_GetStackedChannel(statePtr->self);
    read = Tcl_ReadRaw(parent, buf, (Tcl_Size) toRead);

    /* Update hash function */
    if (read > 0) {
	/* Have data */
	if (DigestUpdate(statePtr, buf, read, 0) != TCL_OK) {
	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", GET_ERR_REASON()));
	    *errorCodePtr = EINVAL;
	    return 0;
	}
	/* This is correct */
	read = -1;
	*errorCodePtr = EAGAIN;

    } else if (read < 0) {
	/* Error */
	*errorCodePtr = Tcl_GetErrno();

    } else if (!(statePtr->flags & CHAN_EOF)) {
	/* EOF */
	Tcl_Obj *resultObj;
	if (DigestFinalize(statePtr->interp, statePtr, &resultObj) == TCL_OK) {
	    unsigned char *data = Tcl_GetByteArrayFromObj(resultObj, &read);
	    memcpy(buf, data, (int) read);
	    Tcl_DecrRefCount(resultObj);

	} else {
	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", GET_ERR_REASON()));
	    *errorCodePtr = EINVAL;
	    read = 0;
	}
	statePtr->flags |= CHAN_EOF;
    }
    return (int) read;
}

/*
 *----------------------------------------------------------------------
 *
 * DigestOutputProc --
 *
 *	Called by the generic IO system to write data in buf to transform.
 *	The transform writes the result to the underlying channel.
 *
 * Returns:
 *	Total bytes written or -1 for an error along with a POSIX error
 *	code in errorCodePtr. Use EAGAIN for nonblocking and can't write data.
 *
 * Side effects:
 *	Get data from buf and update digest
 *
 *----------------------------------------------------------------------
 */
 int DigestOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    *errorCodePtr = 0;

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

    /* Update hash function */
    if (DigestUpdate(statePtr, (char *) buf, (Tcl_Size) toWrite, 0) != TCL_OK) {
	Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", GET_ERR_REASON()));
	*errorCodePtr = EINVAL;
	return 0;
    }
    return toWrite;
}

/*
 *----------------------------------------------------------------------
 *
 * DigestSetOptionProc --
 *
 *	Called by the generic IO system to set channel option name to value.
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR if failed along with an error
 *	message in interp and Tcl_SetErrno.
 *
 * Side effects:
 *	Updates channel option to new value.
 *
 *----------------------------------------------------------------------
 */
static int DigestSetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
	const char *optionValue) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverSetOptionProc *setOptionProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Delegate options downstream */
    parent = Tcl_GetStackedChannel(statePtr->self);
    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
    if (setOptionProc != NULL) {
	return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    } else {
	Tcl_SetErrno(EINVAL);
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DigestGetOptionProc --
 *
 *	Called by the generic IO system to get channel option name's value.
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR if failed along with an error
 *	message in interp and Tcl_SetErrno.
 *
 * Side effects:
 *	Sets result to option's value
 *
 *----------------------------------------------------------------------
 */
static int DigestGetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
	Tcl_DString *optionValue) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverGetOptionProc *getOptionProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Delegate options downstream */
    parent = Tcl_GetStackedChannel(statePtr->self);
    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));
    if (getOptionProc != NULL) {
	return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    } else if (optionName == (char*) NULL) {
	/* Request is query for all options, this is ok. */
	return TCL_OK;
    } else {
	Tcl_SetErrno(EINVAL);
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DigestTimerHandler --
 *
 *	Called by the notifier via timer to flush out pending input data.
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	May call Tcl_NotifyChannel
 *
 *----------------------------------------------------------------------
 */
static void DigestTimerHandler(ClientData clientData) {
    DigestState *statePtr = (DigestState *) clientData;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return;
    }

    /* Clear timer token */
    statePtr->timer = (Tcl_TimerToken) NULL;

    /* Fire event if there is pending data, skip otherwise */
    if ((statePtr->watchMask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) {
	Tcl_NotifyChannel(statePtr->self, TCL_READABLE);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DigestWatchProc --
 *
 *	Initialize the notifier to watch for events from this channel.
 *
 * Returns:
 *	Nothing (can't return error messages)
 *
 * Side effects:
 *	Configure notifier so future events on the channel will be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */
void DigestWatchProc(ClientData clientData, int mask) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverWatchProc *watchProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return;
    }

    /* Store OR-ed combination of TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION */
    statePtr->watchMask = mask;

    /* Propagate mask info to parent channel */
    parent = Tcl_GetStackedChannel(statePtr->self);
    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent));
    watchProc(Tcl_GetChannelInstanceData(parent), mask);

    /* Remove pending timer */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    /* If there is data pending, set new timer to call Tcl_NotifyChannel */
    if ((mask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) {
	statePtr->timer = Tcl_CreateTimerHandler(READ_DELAY, DigestTimerHandler, (ClientData) statePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DigestGetHandleProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS specific file handle
 *	from inside this channel. Not used for transformations?
 *
 * Returns:
 *	TCL_OK for success or TCL_ERROR for error or if not supported. If
 *	direction is TCL_READABLE, sets handlePtr to the handle used for
 *	input, or if TCL_WRITABLE sets to the handle used for output.
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
int DigestGetHandleProc(ClientData clientData, int direction, ClientData *handlePtr) {
    DigestState *statePtr = (DigestState *) clientData;
    Tcl_Channel parent;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    parent = Tcl_GetStackedChannel(statePtr->self);
    return Tcl_GetChannelHandle(parent, direction, handlePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DigestNotifyProc --
 *
 *	Called by Tcl to inform us of activity on the underlying channel.
 *
 * Returns:
 *	Unchanged interestMask which is an OR-ed combination of TCL_READABLE or TCL_WRITABLE
 *
 * Side effects:
 *	Cancels any pending timer.
 *
 *----------------------------------------------------------------------
 */
int DigestNotifyProc(ClientData clientData, int interestMask) {
    DigestState *statePtr = (DigestState *) clientData;

    /* Skip timer event as redundant */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }
    return interestMask;
}

/*
 *
 * Channel type structure definition for digest transformations.
 *
 */
static const Tcl_ChannelType digestChannelType = {
    "digest",			/* Type name */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    DigestCloseProc,		/* Close proc */
    DigestInputProc,		/* Input proc */
    DigestOutputProc,		/* Output proc */
    NULL,			/* Seek proc */
    DigestSetOptionProc,	/* Set option proc */
    DigestGetOptionProc,	/* Get option proc */
    DigestWatchProc,		/* Initialize notifier */
    DigestGetHandleProc,	/* Get OS handles out of channel */
    DigestClose2Proc,		/* close2proc */
    DigestBlockModeProc,	/* Set blocking/nonblocking mode*/
    NULL,			/* Flush proc */
    DigestNotifyProc,		/* Handling of events bubbling up */
    NULL,			/* Wide seek proc */
    NULL,			/* Thread action */
    NULL			/* Truncate */
};

/*
 *----------------------------------------------------------------------
 *
 * DigestChannelHandler --
 *
 *	Create a stacked channel for a message digest transformation.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Adds transform to channel and sets result to channel id or error message.
 *
 *----------------------------------------------------------------------
 */
static int DigestChannelHandler(Tcl_Interp *interp, const char *channel, Tcl_Obj *digestObj,
	Tcl_Obj *cipherObj, int format, Tcl_Obj *keyObj, Tcl_Obj *macObj) {
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
    Tcl_Channel chan;
    DigestState *statePtr;

    dprintf("Called");

    /* Validate args */
    if (channel == (const char *) NULL) {
	Tcl_AppendResult(interp, "No channel", (char *) NULL);
	return TCL_ERROR;
    }

    /* Get channel Id */
    chan = Tcl_GetChannel(interp, channel, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

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

    /* Configure channel */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");
    if (Tcl_GetChannelBufferSize(chan) < EVP_MAX_MD_SIZE * 2) {
	Tcl_SetChannelBufferSize(chan, EVP_MAX_MD_SIZE * 2);
    }

    /* Create state data structure */
    if ((statePtr = DigestStateNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }
    statePtr->self = chan;
    statePtr->mode = mode;

    /* Initialize hash function */
    if (DigestInitialize(interp, statePtr, digestObj, cipherObj, keyObj, macObj) != TCL_OK) {
	DigestStateFree(statePtr);
	return TCL_ERROR;
    }

    /* Stack channel */
    statePtr->self = Tcl_StackChannel(interp, &digestChannelType, (ClientData) statePtr, mode, chan);
    if (statePtr->self == (Tcl_Channel) NULL) {
	DigestStateFree(statePtr);
	return TCL_ERROR;
    }

    /* Set result to channel Id */
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(chan), TCL_VOLATILE);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Unstack Channel --
 *
 *	This function removes the stacked channel from the top of the
 *	channel stack if it is a digest channel.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Removes transform from channel or sets result to error message.
 *
 *----------------------------------------------------------------------
 */
static int DigestUnstackObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan;
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE  */
    (void) clientData;

    dprintf("Called");

    /* Validate arg count */
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }

    /* Get channel */
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *) NULL), &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

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

    /* Check if digest channel */
    if (Tcl_GetChannelType(chan) != &digestChannelType) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
	    "\": not a digest channel", NULL);
	Tcl_SetErrorCode(interp, "TLS", "UNSTACK", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Pop transform from channel */
    return Tcl_UnstackChannel(interp, chan);
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestInstanceObjCmd --
 *
 *	Handler for digest command instances. Used to add data to hash
 *	function or retrieve message digest.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Adds data to hash or returns message digest
 *
 *-------------------------------------------------------------------
 */
int DigestInstanceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    DigestState *statePtr = (DigestState *) clientData;
    int fn;
    Tcl_Size data_len = 0;
    unsigned char *data = NULL;
    static const char *instance_fns [] = { "finalize", "update", NULL };

    dprintf("Called");

    /* Validate arg count */
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "function ?data?");
	return TCL_ERROR;
    }

    /* Get function */
    if (Tcl_GetIndexFromObj(interp, objv[1], instance_fns, "function", 0, &fn) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Do function */
    if (fn) {
	/* Get data or return error if none */
	if (objc == 3) {
	    data = Tcl_GetByteArrayFromObj(objv[2], &data_len);
	} else {
	    Tcl_WrongNumArgs(interp, 1, objv, "update data");
	    return TCL_ERROR;
	}

	/* Update hash function */
	if (DigestUpdate(statePtr, (char *) data, data_len, 1) != TCL_OK) {
	    return TCL_ERROR;
	}

    } else {
	/* Finalize hash function and calculate message digest */
	if (DigestFinalize(interp, statePtr, NULL) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_DeleteCommandFromToken(interp, statePtr->token);
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestCommandDeleteHandler --
 *
 *	 Callback to clean-up when digest instance command is deleted.
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	Destroys state info structure
 *
 *-------------------------------------------------------------------
 */
void DigestCommandDeleteHandler(ClientData clientData) {
    DigestState *statePtr = (DigestState *) clientData;

    /* Clean-up */
    DigestStateFree(statePtr);
}

/*
 *-------------------------------------------------------------------
 *
 * DigestCommandHandler --
 *
 *	 Create command to allow user to add data to hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates command or error message
 *
 *-------------------------------------------------------------------
 */
int DigestCommandHandler(Tcl_Interp *interp, Tcl_Obj *cmdObj, Tcl_Obj *digestObj,
	Tcl_Obj *cipherObj, int format, Tcl_Obj *keyObj, Tcl_Obj *macObj) {
    DigestState *statePtr;
    char *cmdName = Tcl_GetStringFromObj(cmdObj, (Tcl_Size *) NULL);

    dprintf("Called");

    /* Create state data structure */
    if ((statePtr = DigestStateNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }

    /* Initialize hash function */
    if (DigestInitialize(interp, statePtr, digestObj, cipherObj, keyObj, macObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Create instance command */
    statePtr->token = Tcl_CreateObjCommand(interp, cmdName, DigestInstanceObjCmd,
	(ClientData) statePtr, DigestCommandDeleteHandler);
    if (statePtr->token == NULL) {
	DigestStateFree(statePtr);
	return TCL_ERROR;
    }

    /* Return command name */
    Tcl_SetObjResult(interp, cmdObj);
    return TCL_OK;
}


/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestDataHandler --
 *
 *	Return message digest for data using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
int DigestDataHandler(Tcl_Interp *interp, Tcl_Obj *dataObj, Tcl_Obj *digestObj,
	Tcl_Obj *cipherObj, int format, Tcl_Obj *keyObj, Tcl_Obj *macObj) {
    unsigned char *data;
    Tcl_Size data_len;
    DigestState *statePtr;

    dprintf("Called");

    /* Get data */
    data = Tcl_GetByteArrayFromObj(dataObj, &data_len);
    if (data == NULL) {
	Tcl_SetResult(interp, "No data", NULL);
	return TCL_ERROR;
    }

    /* Create state data structure */
    if ((statePtr = DigestStateNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }

    /* Calc Digest */
    if (DigestInitialize(interp, statePtr, digestObj, cipherObj, keyObj, macObj) != TCL_OK ||
	DigestUpdate(statePtr, (char *) data, data_len, 1) != TCL_OK ||
	DigestFinalize(interp, statePtr, NULL) != TCL_OK) {
	DigestStateFree(statePtr);
	return TCL_ERROR;
    }

    /* Clean-up */
    DigestStateFree(statePtr);
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestFileHandler --
 *
 *	Return message digest for file using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Result is message digest or error message
 *
 *-------------------------------------------------------------------
 */
int DigestFileHandler(Tcl_Interp *interp, Tcl_Obj *inFileObj, Tcl_Obj *digestObj,
	Tcl_Obj *cipherObj, int format, Tcl_Obj *keyObj, Tcl_Obj *macObj) {
    DigestState *statePtr;
    Tcl_Channel chan = NULL;
    unsigned char buf[BUFFER_SIZE];
    int res = TCL_OK;

    dprintf("Called");

    /* Create state data structure */
    if ((statePtr = DigestStateNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }

    /* Open file channel */
    chan = Tcl_FSOpenFileChannel(interp, inFileObj, "rb", 0444);
    if (chan == (Tcl_Channel) NULL) {
	DigestStateFree(statePtr);
	return TCL_ERROR;
    }

    /* Configure channel */
    if ((res = Tcl_SetChannelOption(interp, chan, "-translation", "binary")) != TCL_OK) {
	goto done;
    }
    Tcl_SetChannelBufferSize(chan, BUFFER_SIZE);

    /* Initialize hash function */
    if ((res = DigestInitialize(interp, statePtr, digestObj, cipherObj, keyObj, macObj)) != TCL_OK) {
	goto done;
    }

    /* Read file data and update hash function */
    while (!Tcl_Eof(chan)) {
	Tcl_Size len = Tcl_ReadRaw(chan, (char *) buf, BUFFER_SIZE);
	if (len > 0) {
	    if ((res = DigestUpdate(statePtr, (char *) &buf[0], len, 1)) != TCL_OK) {
		goto done;
	    }
	}
    }

    /* Finalize hash function and calculate message digest */
    res = DigestFinalize(interp, statePtr, NULL);

done:
    /* Close channel */
    if (Tcl_Close(interp, chan) == TCL_ERROR) {
	res = TCL_ERROR;
    }

    /* Clean-up */
    DigestStateFree(statePtr);
    return res;
}

/*******************************************************************/

static const char *command_opts [] = { "-bin", "-binary", "-hex", "-hexadecimal",
    "-chan", "-channel", "-cipher", "-command", "-data", "-digest", "-file", "-filename",
    "-hash", "-key", "-mac", NULL};

enum _command_opts {
    _opt_bin, _opt_binary, _opt_hex, _opt_hexadecimal, _opt_chan, _opt_channel, _opt_cipher,
    _opt_command, _opt_data, _opt_digest, _opt_file, _opt_filename, _opt_hash, _opt_key, _opt_mac
};

/*
 *-------------------------------------------------------------------
 *
 * DigestMain --
 *
 *	Return message digest or Message Authentication Code (MAC) of
 *	data using user specified hash function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
static int DigestMain(int type, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    int start = 1, format = HEX_FORMAT, res = TCL_OK;
    Tcl_Size fn;
    Tcl_Obj *cipherObj = NULL, *cmdObj = NULL, *dataObj = NULL, *digestObj = NULL;
    Tcl_Obj *fileObj = NULL, *keyObj = NULL, *macObj = NULL;
    const char *channel = NULL, *opt;

    dprintf("Called");

    /* Clear interp result */
    Tcl_ResetResult(interp);

    /* Validate arg count */
    if (objc < 3 || objc > 12) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]");
	return TCL_ERROR;
    }

    /* Special case of first arg is digest, cipher, or mac */
    opt = Tcl_GetStringFromObj(objv[start], (Tcl_Size *) NULL);
    if (opt[0] != '-') {
	switch(type) {
	case TYPE_MD:
	case TYPE_HMAC:
	    digestObj = objv[start++];
	    break;
	case TYPE_CMAC:
	    cipherObj = objv[start++];
	    break;
	case TYPE_MAC:
	    macObj = objv[start++];
	    break;
	}
    }

    /* Get options */
    for (int idx = start; idx < objc; idx++) {
	/* Special case for when last arg is data */
	if (idx == objc - 1) {
	    opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *) NULL);
	    if (opt[0] != '-' && dataObj == NULL) {
		dataObj = objv[idx];
		break;
	    }
	}

	/* Get option */
	if (Tcl_GetIndexFromObj(interp, objv[idx], command_opts, "option", 0, &fn) != TCL_OK) {
	    return TCL_ERROR;
	}

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

	switch(fn) {
	case _opt_bin:
	case _opt_binary:
	    format = BIN_FORMAT;
	    break;
	case _opt_hex:
	case _opt_hexadecimal:
	    format = HEX_FORMAT;
	    break;
	case _opt_chan:
	case _opt_channel:
    	    GET_OPT_STRING(objv[idx], channel, NULL);
	    break;
	case _opt_cipher:
	    cipherObj = objv[idx];
	    break;
	case _opt_command:
	    cmdObj = objv[idx];
	    break;
	case _opt_data:
	    dataObj = objv[idx];
	    break;
	case _opt_digest:
	case _opt_hash:
	    digestObj = objv[idx];
	    break;
	case _opt_file:
	case _opt_filename:
	    fileObj = objv[idx];
	    break;
	case _opt_key:
	    keyObj = objv[idx];
	    break;
	case _opt_mac:
	    macObj = objv[idx];
	    break;
	}
    }

    /* Check types */
    if (type == TYPE_MD) {
	 if (macObj != NULL) {
	    type = TYPE_MAC;
	} else if (cipherObj != NULL) {
	    type = TYPE_CMAC;
	} else if (keyObj != NULL) {
	    type = TYPE_HMAC;
	}
    }

    if (type == TYPE_MAC) {
	if (macObj != NULL) {
	    char *macName = Tcl_GetStringFromObj(macObj, (Tcl_Size *) NULL);
	    if (strcmp(macName,"cmac") == 0) {
		type = TYPE_CMAC;
	    } else if (strcmp(macName,"hmac") == 0) {
		type = TYPE_HMAC;
	    } else {
		Tcl_AppendResult(interp, "invalid MAC \"", macName, "\"", (char *) NULL);
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "no MAC", (char *) NULL);
	    return TCL_ERROR;
	}
    }

    /* Calc digest on file, stacked channel, using instance command, or data blob */
    if (fileObj != NULL) {
	res = DigestFileHandler(interp, fileObj, digestObj, cipherObj, format | type, keyObj, macObj);
    } else if (channel != NULL) {
	res = DigestChannelHandler(interp, channel, digestObj, cipherObj, format | type, keyObj, macObj);
    } else if (cmdObj != NULL) {
	res = DigestCommandHandler(interp, cmdObj, digestObj, cipherObj, format | type, keyObj, macObj);
    } else if (dataObj != NULL) {
	res = DigestDataHandler(interp, dataObj, digestObj, cipherObj, format | type, keyObj, macObj);
    } else {
	Tcl_AppendResult(interp, "No operation: Use -channel, -command, -data, or -file option", (char *) NULL);
	res = TCL_ERROR;
    }
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * Message Digest and Message Authentication Code Commands --
 *
 *	Return Message Digest (MD) or Message Authentication Code (MAC).
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
static int MdObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;
    return DigestMain(TYPE_MD, interp, objc, objv);
}

static int CMACObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;
    return DigestMain(TYPE_CMAC, interp, objc, objv);
}

static int HMACObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;
    return DigestMain(TYPE_HMAC, interp, objc, objv);
}

static int MACObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;
    return DigestMain(TYPE_MAC, interp, objc, objv);
}

/*
 *-------------------------------------------------------------------
 *
 * Message Digest Convenience Commands --
 *
 *	Convenience commands for select message digests.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to message digest or error message
 *
 *-------------------------------------------------------------------
 */
 int TemplateCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], char *digestName, int format) {
    Tcl_Obj *dataObj, *digestObj;
    int res;

    if (objc == 2) {
	dataObj = objv[1];
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

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

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

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

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

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

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestCommands --
 *
 *	Create digest commands
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_DigestCommands(Tcl_Interp *interp) {
    Tcl_CreateObjCommand(interp, "tls::digest", MdObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::md", MdObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::cmac", CMACObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::hmac", HMACObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::mac", MACObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::md4", MD4ObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::md5", MD5ObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::sha1", SHA1ObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::sha256", SHA256ObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::sha512", SHA512ObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::unstack", DigestUnstackObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

Added generic/tlsEncrypt.c version [892582a1b8].



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Encryption Functions Module
 *
 * This module provides commands that can be used to encrypt or decrypt data.
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <tcl.h>
#include <stdio.h>
#include <string.h>
#include <openssl/evp.h>
#if OPENSSL_VERSION_NUMBER >= 0x30000000L
#include <openssl/params.h>
#endif

/* Macros */
#define BUFFER_SIZE	32768
#define CHAN_EOF	0x10
#define READ_DELAY	5

/* Encryption functions */
#define TYPE_MD		0x010
#define TYPE_HMAC	0x020
#define TYPE_CMAC	0x040
#define TYPE_MAC	0x080
#define TYPE_ENCRYPT	0x100
#define TYPE_DECRYPT	0x200
#define TYPE_SIGN	0x400
#define TYPE_VERIFY	0x800

/*******************************************************************/

/*
 * This structure defines the per-instance state of a encrypt operation.
 */
typedef struct EncryptState {
	Tcl_Channel self;	/* This socket channel */
	Tcl_TimerToken timer;	/* Timer for read events */

	int flags;		/* Chan config flags */
	int watchMask;		/* Current WatchProc mask */
	int mode;		/* Current mode of parent channel */
	int type;		/* Operation type */

	Tcl_Interp *interp;	/* Current interpreter */
	EVP_CIPHER_CTX *ctx;	/* Cipher Context */
	Tcl_Command token;	/* Command token */
} EncryptState;


/*
 *-------------------------------------------------------------------
 *
 * EncryptStateNew --
 *
 *	This function creates a per-instance state data structure
 *
 * Returns:
 *	State structure pointer
 *
 * Side effects:
 *	Creates structure
 *
 *-------------------------------------------------------------------
 */
EncryptState *EncryptStateNew(Tcl_Interp *interp, int type) {
    EncryptState *statePtr = (EncryptState *) ckalloc((unsigned) sizeof(EncryptState));

    if (statePtr != NULL) {
	memset(statePtr, 0, sizeof(EncryptState));
	statePtr->self	= NULL;		/* This socket channel */
	statePtr->timer = NULL;		/* Timer to flush data */
	statePtr->flags = 0;		/* Chan config flags */
	statePtr->watchMask = 0;	/* Current WatchProc mask */
	statePtr->mode	= 0;		/* Current mode of parent channel */
	statePtr->type = type;		/* Operation type */
	statePtr->interp = interp;	/* Current interpreter */
	statePtr->ctx = NULL;		/* Cipher Context */
	statePtr->token = NULL;		/* Command token */
    }
    return statePtr;
}

/*
 *-------------------------------------------------------------------
 *
 * EncryptStateFree --
 *
 *	This function deletes a state data structure
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	Removes structure
 *
 *-------------------------------------------------------------------
 */
void EncryptStateFree(EncryptState *statePtr) {
    if (statePtr == (EncryptState *) NULL) {
	return;
    }

    /* Remove pending timer */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
    }

    /* Free context structures */
    if (statePtr->ctx != (EVP_CIPHER_CTX *) NULL) {
	EVP_CIPHER_CTX_free(statePtr->ctx);
    }
    ckfree(statePtr);
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * EncryptInitialize --
 *
 *	Initialize an encryption function
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR for failure with result set
 *	to error message.
 *
 * Side effects:
 *	No result or error message
 *
 *-------------------------------------------------------------------
 */
int EncryptInitialize(Tcl_Interp *interp, int type, EVP_CIPHER_CTX **ctx,
	Tcl_Obj *cipherObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
    const EVP_CIPHER *cipher;
    void *keyString = NULL, *ivString = NULL;
    Tcl_Size key_len = 0, iv_len = 0;
    int res, max;
    unsigned char key[EVP_MAX_KEY_LENGTH], iv[EVP_MAX_IV_LENGTH];

    dprintf("Called");

    /* Init buffers */
    memset(key, 0, EVP_MAX_KEY_LENGTH);
    memset(iv, 0, EVP_MAX_IV_LENGTH);

    /* Get cipher */
    cipher = Util_GetCipher(interp, cipherObj, 1);
    if (cipher == NULL) {
	return TCL_ERROR;
    }

    /*  Get key - Only support internally defined cipher lengths.
	Custom ciphers can be up to size_t bytes. */
    max = EVP_CIPHER_key_length(cipher);
    keyString = Util_GetKey(interp, keyObj, &key_len, "key", max, 0);
    if (keyString != NULL) {
	memcpy((void *) key, keyString, (size_t) key_len);
    } else if (keyObj != NULL)  {
	return TCL_ERROR;
    }

    /*  Get IV */
    max = EVP_CIPHER_iv_length(cipher);
    ivString = Util_GetIV(interp, ivObj, &iv_len, max, 0);
    if (ivString != NULL) {
	memcpy((void *) iv, ivString, (size_t) iv_len);
    } else if (ivObj != NULL) {
	return TCL_ERROR;
    }

    /* Create context */
    if((*ctx = EVP_CIPHER_CTX_new()) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }

    /* Initialize the operation. Need appropriate key and iv size. */
    if (type == TYPE_ENCRYPT) {
	res = EVP_EncryptInit_ex(*ctx, cipher, NULL, key, iv);
    } else {
	res = EVP_DecryptInit_ex(*ctx, cipher, NULL, key, iv);
    }

    if(!res) {
	Tcl_AppendResult(interp, "Initialize failed: ", GET_ERR_REASON(), (char *) NULL);
	return TCL_ERROR;
    }

    /* Erase buffers */
    memset(key, 0, EVP_MAX_KEY_LENGTH);
    memset(iv, 0, EVP_MAX_IV_LENGTH);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * EncryptUpdate --
 *
 *	Update an encryption function with data
 *
 * Returns:
 *	1 if successful or 0 for failure
 *
 * Side effects:
 *	Adds encrypted data to buffer or sets result to error message
 *
 *-------------------------------------------------------------------
 */
int EncryptUpdate(Tcl_Interp *interp, int type, EVP_CIPHER_CTX *ctx, unsigned char *out_buf,
	int *out_len, unsigned char *data, Tcl_Size data_len) {
    int res;

    dprintf("Called");

    /* Encrypt/decrypt data */
    if (type == TYPE_ENCRYPT) {
	res = EVP_EncryptUpdate(ctx, out_buf, out_len, data, (int) data_len);
    } else {
	res = EVP_DecryptUpdate(ctx, out_buf, out_len, data, (int) data_len);
    }

    if (res) {
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "Update failed: ", GET_ERR_REASON(), (char *) NULL);
	return TCL_ERROR;
    }
}

/*
 *-------------------------------------------------------------------
 *
 * EncryptFinalize --
 *
 *	Finalize an encryption function
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR for failure with result set
 *	to error message.
 *
 * Side effects:
 *	Adds encrypted data to buffer or sets result to error message
 *
 *-------------------------------------------------------------------
 */
int EncryptFinalize(Tcl_Interp *interp, int type, EVP_CIPHER_CTX *ctx, unsigned char *out_buf,
	int *out_len) {
    int res;

    dprintf("Called");

    /* Finalize data */
    if (type == TYPE_ENCRYPT) {
	res = EVP_EncryptFinal_ex(ctx, out_buf, out_len);
    } else {
	res = EVP_DecryptFinal_ex(ctx, out_buf, out_len);
    }

    if (res) {
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "Finalize failed: ", GET_ERR_REASON(), (char *) NULL);
	return TCL_ERROR;
    }
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * EncryptBlockModeProc --
 *
 *	This function is invoked by the generic IO level
 *	to set blocking and nonblocking modes.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *	Can call Tcl_SetChannelError.
 *
 *-------------------------------------------------------------------
 */
static int EncryptBlockModeProc(ClientData clientData, int mode) {
    EncryptState *statePtr = (EncryptState *) clientData;

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

/*
 *-------------------------------------------------------------------
 *
 * EncryptCloseProc --
 *
 *	This function is invoked by the generic IO level to perform
 *	channel-type specific cleanup when the channel is closed. All
 *	queued output is flushed prior to calling this function.
 *
 * Returns:
 *	0 if successful or POSIX error code if failed.
 *
 * Side effects:
 *	Deletes stored state data.
 *
 *-------------------------------------------------------------------
 */
int EncryptCloseProc(ClientData clientData, Tcl_Interp *interp) {
    EncryptState *statePtr = (EncryptState *) clientData;

    /* Cancel active timer, if any */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    /* Output remaining data, if any */
    if (!(statePtr->flags & CHAN_EOF)) {
	Tcl_Channel parent = Tcl_GetStackedChannel(statePtr->self);
	int out_len;
	unsigned char out_buf[EVP_MAX_BLOCK_LENGTH];

	/* Finalize function */
	if (EncryptFinalize(interp, statePtr->type, statePtr->ctx, out_buf, &out_len) == TCL_OK) {
	    if (out_len > 0) {
		Tcl_Size len = Tcl_WriteRaw(parent, (const char *) out_buf, (Tcl_Size) out_len);
		if (len < 0) {
		    return Tcl_GetErrno();
		}
	    }
	} else {
	    /* Error */
	}

	statePtr->flags |= CHAN_EOF;
    }

    /* Clean-up */
    EncryptStateFree(statePtr);
    return 0;
}

/*
 * Same as EncryptCloseProc but with individual read and write close control
 */
static int EncryptClose2Proc(ClientData instanceData, Tcl_Interp *interp, int flags) {
    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) {
	return EncryptCloseProc(instanceData, interp);
    }
    return EINVAL;
}

/*
 *----------------------------------------------------------------------
 *
 * EncryptInputProc --
 *
 *	Called by the generic IO system to read data from transform and
 *	place in buf. Transform gets data from the underlying channel.
 *
 * Returns:
 *	Total bytes read or -1 for an error along with a POSIX error
 *	code in errorCodePtr. Use EAGAIN for nonblocking and no data.
 *
 * Side effects:
 *	Read data from transform and write to buf
 *
 *----------------------------------------------------------------------
 */
int EncryptInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) {
    EncryptState *statePtr = (EncryptState *) clientData;
    Tcl_Channel parent;
    int out_len;
    Tcl_Size read;
    *errorCodePtr = 0;
    char *in_buf;
    
    /* Abort if nothing to process */
    if (toRead <= 0 || statePtr->self == (Tcl_Channel) NULL) {
	return 0;
    }

    /* Get bytes from underlying channel */
    in_buf = Tcl_Alloc((Tcl_Size) toRead);
    parent = Tcl_GetStackedChannel(statePtr->self);
    read = Tcl_ReadRaw(parent, in_buf, (Tcl_Size) toRead);

    /* Update function */
    if (read > 0) {
	/* Have data - Update function */
	if (EncryptUpdate(statePtr->interp, statePtr->type, statePtr->ctx, (unsigned char *) buf, &out_len, (unsigned char *) in_buf, read) == TCL_OK) {
	    /* If have data, put in buf, otherwise tell TCL to try again */
	    if (out_len > 0) {
		read = (Tcl_Size) out_len;
	    } else {
		*errorCodePtr = EAGAIN;
		read = -1;
	    }
	} else {
	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", GET_ERR_REASON()));
	    *errorCodePtr = EINVAL;
	    read = 0;
	}

    } else if (read < 0) {
	/* Error */
	*errorCodePtr = Tcl_GetErrno();

    } else if (!(statePtr->flags & CHAN_EOF)) {
	/* EOF - Finalize function and put any remaining data in buf */
	if (EncryptFinalize(statePtr->interp, statePtr->type, statePtr->ctx, (unsigned char *) buf, &out_len) == TCL_OK) {
	    read = (Tcl_Size) out_len;
	} else {
	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", GET_ERR_REASON()));
	    *errorCodePtr = EINVAL;
	    read = 0;
	}

	statePtr->flags |= CHAN_EOF;
    }
    Tcl_Free(in_buf);
    return (int) read;
}

/*
 *----------------------------------------------------------------------
 *
 * EncryptOutputProc --
 *
 *	Called by the generic IO system to write data in buf to transform.
 *	The transform writes the result to the underlying channel.
 *
 * Returns:
 *	Total bytes written or -1 for an error along with a POSIX error
 *	code in errorCodePtr. Use EAGAIN for nonblocking and can't write data.
 *
 * Side effects:
 *	Get data from buf and update encryption
 *
 *----------------------------------------------------------------------
 */
 int EncryptOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) {
    EncryptState *statePtr = (EncryptState *) clientData;
    int write = 0, out_len;
    *errorCodePtr = 0;
    char *out_buf;

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

    out_buf = Tcl_Alloc((Tcl_Size) toWrite+EVP_MAX_BLOCK_LENGTH);

    /* Update function */
    if (EncryptUpdate(statePtr->interp, statePtr->type, statePtr->ctx, (unsigned char *) out_buf, &out_len, (unsigned char *) buf, (Tcl_Size) toWrite) == TCL_OK) {
	/* If have data, output it, otherwise tell TCL to try again */
	if (out_len > 0) {
	    Tcl_Channel parent = Tcl_GetStackedChannel(statePtr->self);
	    write = (int) Tcl_WriteRaw(parent, (const char *) out_buf, (Tcl_Size) out_len);
	    write = toWrite;
	} else {
	    *errorCodePtr = EAGAIN;
	    write = -1;
	}

    } else {
	Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", GET_ERR_REASON()));
	*errorCodePtr = EINVAL;
	write = 0;
    }
    Tcl_Free(out_buf);
    return write;
}

/*
 *----------------------------------------------------------------------
 *
 * EncryptSetOptionProc --
 *
 *	Called by the generic IO system to set channel option name to value.
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR if failed along with an error
 *	message in interp and Tcl_SetErrno.
 *
 * Side effects:
 *	Updates channel option to new value.
 *
 *----------------------------------------------------------------------
 */
static int EncryptSetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
	const char *optionValue) {
    EncryptState *statePtr = (EncryptState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverSetOptionProc *setOptionProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Delegate options downstream */
    parent = Tcl_GetStackedChannel(statePtr->self);
    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
    if (setOptionProc != NULL) {
	return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    } else {
	Tcl_SetErrno(EINVAL);
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * EncryptGetOptionProc --
 *
 *	Called by the generic IO system to get channel option name's value.
 *
 * Returns:
 *	TCL_OK if successful or TCL_ERROR if failed along with an error
 *	message in interp and Tcl_SetErrno.
 *
 * Side effects:
 *	Sets result to option's value
 *
 *----------------------------------------------------------------------
 */
static int EncryptGetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName,
	Tcl_DString *optionValue) {
    EncryptState *statePtr = (EncryptState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverGetOptionProc *getOptionProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Delegate options downstream */
    parent = Tcl_GetStackedChannel(statePtr->self);
    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent));
    if (getOptionProc != NULL) {
	return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue);
    } else if (optionName == (char*) NULL) {
	/* Request is query for all options, this is ok. */
	return TCL_OK;
    } else {
	Tcl_SetErrno(EINVAL);
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * EncryptTimerHandler --
 *
 *	Called by the notifier via timer to flush out pending input data.
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	May call Tcl_NotifyChannel
 *
 *----------------------------------------------------------------------
 */
static void EncryptTimerHandler(ClientData clientData) {
    EncryptState *statePtr = (EncryptState *) clientData;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return;
    }

    /* Clear timer token */
    statePtr->timer = (Tcl_TimerToken) NULL;

    /* Fire event if there is pending data, skip otherwise */
    if ((statePtr->watchMask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) {
	Tcl_NotifyChannel(statePtr->self, TCL_READABLE);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * EncryptWatchProc --
 *
 *	Initialize the notifier to watch for events from this channel.
 *
 * Returns:
 *	Nothing (can't return error messages)
 *
 * Side effects:
 *	Configure notifier so future events on the channel will be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */
void EncryptWatchProc(ClientData clientData, int mask) {
    EncryptState *statePtr = (EncryptState *) clientData;
    Tcl_Channel parent;
    Tcl_DriverWatchProc *watchProc;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return;
    }

    /* Store OR-ed combination of TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION */
    statePtr->watchMask = mask;

    /* Propagate mask info to parent channel */
    parent = Tcl_GetStackedChannel(statePtr->self);
    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent));
    watchProc(Tcl_GetChannelInstanceData(parent), mask);

    /* Remove pending timer */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }

    /* If there is data pending, set new timer to call Tcl_NotifyChannel */
    if ((mask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) {
	statePtr->timer = Tcl_CreateTimerHandler(READ_DELAY, EncryptTimerHandler, (ClientData) statePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * EncryptGetHandleProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS specific file handle
 *	from inside this channel. Not used for transformations?
 *
 * Returns:
 *	TCL_OK for success or TCL_ERROR for error or if not supported. If
 *	direction is TCL_READABLE, sets handlePtr to the handle used for
 *	input, or if TCL_WRITABLE sets to the handle used for output.
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
int EncryptGetHandleProc(ClientData clientData, int direction, ClientData *handlePtr) {
    EncryptState *statePtr = (EncryptState *) clientData;
    Tcl_Channel parent;

    /* Abort if no channel */
    if (statePtr->self == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    parent = Tcl_GetStackedChannel(statePtr->self);
    return Tcl_GetChannelHandle(parent, direction, handlePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * EncryptNotifyProc --
 *
 *	Called by Tcl to inform us of activity on the underlying channel.
 *
 * Returns:
 *	Unchanged interestMask which is an OR-ed combination of TCL_READABLE or TCL_WRITABLE
 *
 * Side effects:
 *	Cancels any pending timer.
 *
 *----------------------------------------------------------------------
 */
int EncryptNotifyProc(ClientData clientData, int interestMask) {
    EncryptState *statePtr = (EncryptState *) clientData;

    /* Skip timer event as redundant */
    if (statePtr->timer != (Tcl_TimerToken) NULL) {
	Tcl_DeleteTimerHandler(statePtr->timer);
	statePtr->timer = (Tcl_TimerToken) NULL;
    }
    return interestMask;
}

/*
 *
 * Channel type structure definition for encryption transformations.
 *
 */
static const Tcl_ChannelType encryptChannelType = {
    "encryption",		/* Type name */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    EncryptCloseProc,		/* Close proc */
    EncryptInputProc,		/* Input proc */
    EncryptOutputProc,		/* Output proc */
    NULL,			/* Seek proc */
    EncryptSetOptionProc,	/* Set option proc */
    EncryptGetOptionProc,	/* Get option proc */
    EncryptWatchProc,		/* Initialize notifier */
    EncryptGetHandleProc,	/* Get OS handles out of channel */
    EncryptClose2Proc,		/* close2proc */
    EncryptBlockModeProc,	/* Set blocking/nonblocking mode*/
    NULL,			/* Flush proc */
    EncryptNotifyProc,		/* Handling of events bubbling up */
    NULL,			/* Wide seek proc */
    NULL,			/* Thread action */
    NULL			/* Truncate */
};

/*
 *----------------------------------------------------------------------
 *
 * EncryptChannelHandler --
 *
 *	Create a stacked channel for a message encryption transformation.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Adds transform to channel and sets result to channel id or error message.
 *
 *----------------------------------------------------------------------
 */
static int EncryptChannelHandler(Tcl_Interp *interp, int type, const char *channel,
	Tcl_Obj *cipherObj, Tcl_Obj *digestObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
    Tcl_Channel chan;
    EncryptState *statePtr;

    dprintf("Called");

    /* Validate args */
    if (channel == (const char *) NULL) {
	Tcl_AppendResult(interp, "No channel", (char *) NULL);
	return TCL_ERROR;
    }

    /* Get channel Id */
    chan = Tcl_GetChannel(interp, channel, &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

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

    /* Configure channel */
    Tcl_SetChannelOption(interp, chan, "-translation", "binary");

    /* Create state data structure */
    if ((statePtr = EncryptStateNew(interp, type)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }
    statePtr->self = chan;
    statePtr->mode = mode;

    /* Initialize function */
    if (EncryptInitialize(interp, type, &statePtr->ctx, cipherObj, keyObj, ivObj) != TCL_OK) {
	EncryptStateFree(statePtr);
	return TCL_ERROR;
    }

    /* Stack channel */
    statePtr->self = Tcl_StackChannel(interp, &encryptChannelType, (ClientData) statePtr, mode, chan);
    if (statePtr->self == (Tcl_Channel) NULL) {
	EncryptStateFree(statePtr);
	return TCL_ERROR;
    }

    /* Set result to channel Id */
    Tcl_SetResult(interp, (char *) Tcl_GetChannelName(chan), TCL_VOLATILE);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Unstack Channel --
 *
 *	This function removes the stacked channel from the top of the
 *	channel stack if it is a encryption channel.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Removes transform from channel or sets result to error message.
 *
 *----------------------------------------------------------------------
 */
static int EncryptUnstackObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Channel chan;
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE  */
    (void) clientData;

    dprintf("Called");

    /* Validate arg count */
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }

    /* Get channel */
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *) NULL), &mode);
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

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

    /* Check if encryption channel */
    if (Tcl_GetChannelType(chan) != &encryptChannelType) {
	Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
	    "\": not a encryption channel", NULL);
	Tcl_SetErrorCode(interp, "TLS", "UNSTACK", "CHANNEL", "INVALID", (char *) NULL);
	return TCL_ERROR;
    }

    /* Pop transform from channel */
    return Tcl_UnstackChannel(interp, chan);
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * EncryptInstanceObjCmd --
 *
 *	Handler for encrypt/decrypt command instances. Used to update
 *	and finalize data for encrypt/decrypt function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Adds data to encrypt/decrypt function
 *
 *-------------------------------------------------------------------
 */
int EncryptInstanceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    EncryptState *statePtr = (EncryptState *) clientData;
    int fn, out_len;
    Tcl_Size data_len = 0;
    unsigned char *data = NULL;
    Tcl_Obj *resultObj;
    unsigned char *out_buf;
    static const char *instance_fns [] = { "finalize", "update", NULL };

    dprintf("Called");

    /* Validate arg count */
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "function ?data?");
	return TCL_ERROR;
    }

    /* Get function */
    if (Tcl_GetIndexFromObj(interp, objv[1], instance_fns, "function", 0, &fn) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Allocate storage for result. Size should be data size + block size. */
    resultObj = Tcl_NewObj();
    out_buf = Tcl_SetByteArrayLength(resultObj, data_len+EVP_MAX_BLOCK_LENGTH);
    if (resultObj == NULL || out_buf == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	Tcl_DecrRefCount(resultObj);
	return TCL_ERROR;
    }

    /* Do function */
    if (fn) {
	/* Get data or return error if none */
	if (objc == 3) {
	    data = Tcl_GetByteArrayFromObj(objv[2], &data_len);
	} else {
	    Tcl_WrongNumArgs(interp, 1, objv, "update data");
	    Tcl_DecrRefCount(resultObj);
	    return TCL_ERROR;
	}

	/* Update function */
	if (EncryptUpdate(interp, statePtr->type, statePtr->ctx, out_buf, &out_len, data, data_len) == TCL_OK) {
	    out_buf = Tcl_SetByteArrayLength(resultObj, (Tcl_Size) out_len);
	    Tcl_SetObjResult(interp, resultObj);
	} else {
	    Tcl_DecrRefCount(resultObj);
	    return TCL_ERROR;
	}

    } else {
	/* Finalize function */
	if (EncryptFinalize(interp, statePtr->type, statePtr->ctx, out_buf, &out_len) == TCL_OK) {
	    out_buf = Tcl_SetByteArrayLength(resultObj, (Tcl_Size) out_len);
	    Tcl_SetObjResult(interp, resultObj);
	} else {
	    Tcl_DecrRefCount(resultObj);
	    return TCL_ERROR;
	}

	/* Clean-up */
	Tcl_DeleteCommandFromToken(interp, statePtr->token);
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * EncryptCommandDeleteHandler --
 *
 *	 Callback to clean-up when encrypt/decrypt command is deleted.
 *
 * Returns:
 *	Nothing
 *
 * Side effects:
 *	Destroys state info structure
 *
 *-------------------------------------------------------------------
 */
void EncryptCommandDeleteHandler(ClientData clientData) {
    EncryptState *statePtr = (EncryptState *) clientData;

    /* Clean-up */
    EncryptStateFree(statePtr);
}

/*
 *-------------------------------------------------------------------
 *
 * EncryptCommandHandler --
 *
 *	 Create command to add data to encrypt/decrypt function.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates command or error message
 *
 *-------------------------------------------------------------------
 */
int EncryptCommandHandler(Tcl_Interp *interp, int type, Tcl_Obj *cmdObj,
	Tcl_Obj *cipherObj, Tcl_Obj *digestObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
    EncryptState *statePtr;
    char *cmdName = Tcl_GetStringFromObj(cmdObj, (Tcl_Size *) NULL);

    dprintf("Called");

    if ((statePtr = EncryptStateNew(interp, type)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }

    /* Initialize function */
    if (EncryptInitialize(interp, type, &statePtr->ctx, cipherObj, keyObj, ivObj) != TCL_OK) {
	EncryptStateFree(statePtr);
	return TCL_ERROR;
    }

    /* Create instance command */
    statePtr->token = Tcl_CreateObjCommand(interp, cmdName, EncryptInstanceObjCmd,
	(ClientData) statePtr, EncryptCommandDeleteHandler);

    /* Return command name */
    Tcl_SetObjResult(interp, cmdObj);
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * EncryptDataHandler --
 *
 *	Perform encryption function on a block of data and return result.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result or error message
 *
 *-------------------------------------------------------------------
 */
int EncryptDataHandler(Tcl_Interp *interp, int type, Tcl_Obj *dataObj, Tcl_Obj *cipherObj,
	Tcl_Obj *digestObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
    EVP_CIPHER_CTX *ctx = NULL;
    int out_len = 0, len = 0, res = TCL_OK;
    Tcl_Size data_len = 0;
    unsigned char *data, *out_buf;
    Tcl_Obj *resultObj;

    dprintf("Called");

    /* Get data */
    if (dataObj != NULL) {
	data = Tcl_GetByteArrayFromObj(dataObj, &data_len);
    } else {
	Tcl_AppendResult(interp, "No data", (char *) NULL);
	return TCL_ERROR;
    }

    /* Allocate storage for result. Size should be data size + block size. */
    resultObj = Tcl_NewObj();
    out_buf = Tcl_SetByteArrayLength(resultObj, data_len+EVP_MAX_BLOCK_LENGTH);
    if (resultObj == NULL || out_buf == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	return TCL_ERROR;
    }

    /* Perform operation */
    if (EncryptInitialize(interp, type, &ctx, cipherObj, keyObj, ivObj) != TCL_OK ||
	EncryptUpdate(interp, type, ctx, out_buf, &out_len, data, data_len) != TCL_OK ||
	EncryptFinalize(interp, type, ctx, out_buf+out_len, &len) != TCL_OK) {
	res = TCL_ERROR;
	goto done;
    }
    out_len += len;

done:
    /* Set output result */
    if (res == TCL_OK) {
	out_buf = Tcl_SetByteArrayLength(resultObj, (Tcl_Size) out_len);
	Tcl_SetObjResult(interp, resultObj);
    } else {
	Tcl_DecrRefCount(resultObj);
	/* Result is error message */
    }

    /* Clean up */
    if (ctx != NULL) {
	EVP_CIPHER_CTX_free(ctx);
    }
    return res;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * EncryptFileHandler --
 *
 *	Perform encryption function on a block of data and return result.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Encrypts or decrypts inFile data to outFile and sets result to
 *	size of outFile, or an error message.
 *
 *-------------------------------------------------------------------
 */
int EncryptFileHandler(Tcl_Interp *interp, int type, Tcl_Obj *inFileObj, Tcl_Obj *outFileObj,
	Tcl_Obj *cipherObj, Tcl_Obj *digestObj, Tcl_Obj *keyObj, Tcl_Obj *ivObj) {
    EVP_CIPHER_CTX *ctx = NULL;
    int total = 0, res, out_len = 0, len;
    Tcl_Channel in = NULL, out = NULL;
    unsigned char in_buf[BUFFER_SIZE];
    unsigned char out_buf[BUFFER_SIZE+EVP_MAX_BLOCK_LENGTH];

    dprintf("Called");

    /* Open input file */
    if ((in = Tcl_FSOpenFileChannel(interp, inFileObj, "rb", 0444)) == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }

    /* Open output file */
    if ((out = Tcl_FSOpenFileChannel(interp, outFileObj, "wb", 0644)) == (Tcl_Channel) NULL) {
	Tcl_Close(interp, in);
	return TCL_ERROR;
    }

    /* Initialize operation */
    if ((res = EncryptInitialize(interp, type, &ctx, cipherObj, keyObj, ivObj)) != TCL_OK) {
	goto done;
    }

    /* Read file data from inFile, encrypt/decrypt it, then output to outFile */
    while (!Tcl_Eof(in)) {
	Tcl_Size read = Tcl_ReadRaw(in, (char *) in_buf, BUFFER_SIZE);
	if (read > 0) {
	    if ((res = EncryptUpdate(interp, type, ctx, out_buf, &out_len, in_buf, read)) == TCL_OK) {
		if (out_len > 0) {
		    len = (int) Tcl_WriteRaw(out, (const char *) out_buf, (Tcl_Size) out_len);
		    if (len >= 0) {
			total += len;
		    } else {
			Tcl_AppendResult(interp, "Write error: ", Tcl_ErrnoMsg(Tcl_GetErrno()), (char *) NULL);
			res = TCL_ERROR;
			goto done;
		    }
		}
	    } else {
		goto done;
	    }
	} else if (read < 0) {
	    Tcl_AppendResult(interp, "Read error: ", Tcl_ErrnoMsg(Tcl_GetErrno()), (char *) NULL);
	    res = TCL_ERROR;
	    goto done;
	}
    }

    /* Finalize data and write any remaining data in block */
    if ((res = EncryptFinalize(interp, type, ctx, out_buf, &out_len)) == TCL_OK) {
	if (out_len > 0) {
	    len = (int) Tcl_WriteRaw(out, (const char *) out_buf, (Tcl_Size) out_len);
	    if (len >= 0) {
		total += len;
	    } else {
		Tcl_AppendResult(interp, "Write error: ", Tcl_ErrnoMsg(Tcl_GetErrno()), (char *) NULL);
		res = TCL_ERROR;
		goto done;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
    } else {
	goto done;
    }

done:
    /* Clean up */
    if (in != NULL) {
	Tcl_Close(interp, in);
    }
    if (out != NULL) {
	Tcl_Close(interp, out);
    }
    if (ctx != NULL) {
	EVP_CIPHER_CTX_free(ctx);
    }
    return res;
}

/*******************************************************************/

static const char *command_opts [] = {
    "-chan", "-channel", "-cipher", "-command", "-data", "-digest", "-infile", "-filename",
    "-outfile", "-hash", "-iv", "-key", "-mac", NULL};

enum _command_opts {
    _opt_chan, _opt_channel, _opt_cipher, _opt_command, _opt_data, _opt_digest, _opt_infile,
    _opt_filename, _opt_outfile, _opt_hash, _opt_iv, _opt_key, _opt_mac
};

/*
 *-------------------------------------------------------------------
 *
 * EncryptMain --
 *
 *	Perform encryption function and return result.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result or error message
 *
 *-------------------------------------------------------------------
 */
static int EncryptMain(int type, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *cipherObj = NULL, *cmdObj = NULL, *dataObj = NULL, *digestObj = NULL;
    Tcl_Obj *inFileObj = NULL, *outFileObj = NULL, *keyObj = NULL, *ivObj = NULL, *macObj = NULL;
    const char *channel = NULL, *opt;
    int res, start = 1;
    Tcl_Size fn;

    dprintf("Called");

    /* Clear interp result */
    Tcl_ResetResult(interp);

    /* Validate arg count */
    if (objc < 3 || objc > 12) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-cipher? name ?-digest name? -key key ?-iv string? ?-mac name? [-channel chan | -command cmdName | -infile filename -outfile filename | ?-data? data]");
	return TCL_ERROR;
    }

    /* Special case of first arg is cipher */
    opt = Tcl_GetStringFromObj(objv[start], (Tcl_Size *) NULL);
    if (opt[0] != '-') {
	switch(type) {
	case TYPE_ENCRYPT:
	case TYPE_DECRYPT:
	    cipherObj = objv[start++];
	    break;
	}
    }

    /* Get options */
    for (int idx = start; idx < objc; idx++) {
	/* Special case for when last arg is data */
	if (idx == objc - 1) {
	opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *) NULL);
	    if (opt[0] != '-' && dataObj == NULL) {
		dataObj = objv[idx];
		break;
	    }
	}

	/* Get option */
	if (Tcl_GetIndexFromObj(interp, objv[idx], command_opts, "option", 0, &fn) != TCL_OK) {
	    return TCL_ERROR;
	}

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

	switch(fn) {
	case _opt_chan:
	case _opt_channel:
    	    GET_OPT_STRING(objv[idx], channel, NULL);
	    break;
	case _opt_cipher:
	    cipherObj = objv[idx];
	    break;
	case _opt_command:
	    cmdObj = objv[idx];
	    break;
	case _opt_data:
	    dataObj = objv[idx];
	    break;
	case _opt_digest:
	case _opt_hash:
	    digestObj = objv[idx];
	    break;
	case _opt_infile:
	case _opt_filename:
	    inFileObj = objv[idx];
	    break;
	case _opt_outfile:
	    outFileObj = objv[idx];
	    break;
	case _opt_iv:
	    ivObj = objv[idx];
	    break;
	case _opt_key:
	    keyObj = objv[idx];
	    break;
	case _opt_mac:
	    macObj = objv[idx];
	    break;
	}
    }

    /* Check for required options */
    if (cipherObj == NULL) {
	Tcl_AppendResult(interp, "No cipher", (char *) NULL);
    } else if (keyObj == NULL) {
	Tcl_AppendResult(interp, "No key", (char *) NULL);
	return TCL_ERROR;
    }

    /* Perform encryption function on file, stacked channel, using instance command, or data blob */
    if (inFileObj != NULL && outFileObj != NULL) {
	res = EncryptFileHandler(interp, type, inFileObj, outFileObj, cipherObj, digestObj, keyObj, ivObj);
    } else if (channel != NULL) {
	res = EncryptChannelHandler(interp, type, channel, cipherObj, digestObj, keyObj, ivObj);
    } else if (cmdObj != NULL) {
	res = EncryptCommandHandler(interp, type, cmdObj, cipherObj, digestObj, keyObj, ivObj);
    } else if (dataObj != NULL) {
	res = EncryptDataHandler(interp, type, dataObj, cipherObj, digestObj, keyObj, ivObj);
    } else {
	Tcl_AppendResult(interp, "No operation specified: Use -channel, -command, -data, or -infile option", (char *) NULL);
	res = TCL_ERROR;
    }
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * Encryption Commands --
 *
 *	Perform encryption function and return results
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Command dependent
 *
 *-------------------------------------------------------------------
 */
static int EncryptObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;
    return EncryptMain(TYPE_ENCRYPT, interp, objc, objv);
}

static int DecryptObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;
    return EncryptMain(TYPE_DECRYPT, interp, objc, objv);
}

/*
 *-------------------------------------------------------------------
 *
 * Encrypt_Initialize --
 *
 *	Create namespace, commands, and register package version
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_EncryptCommands(Tcl_Interp *interp) {
    Tcl_CreateObjCommand(interp, "tls::encrypt", EncryptObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::decrypt", DecryptObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::unstack2", EncryptUnstackObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

Modified generic/tlsIO.c from [89e79806f0] to [7b8e3f850c].

69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
69
70
71
72
73
74
75

76
77
78
79
80
81
82







-







 * Side effects:
 *    Closes the socket of the channel.
 *
 *-------------------------------------------------------------------
 */
static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
    State *statePtr = (State *) instanceData;
    (void) interp;

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

    Tls_Clean(statePtr);
    Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
    return(0);
}
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
149
150
151
152
153
154
155

156
157
158
159
160
161
162







-







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

	if (err > 0) {
	    dprintf("Accept or connect was successful");

	    err = BIO_flush(statePtr->bio);
	    if (err <= 0) {
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	} else {
	    dprintf("Accept or connect failed");
	}
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234

235
236
237
238
239
240
241
242

243
244
245
246
247
248
249
250
251
252

253
254
255

256
257
258
259
260
261
262
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







-











-
+







-
+









-
+


-
+







	    *errorCodePtr = EINVAL;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    return(-1);

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

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

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

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

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

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

	case SSL_ERROR_WANT_READ:
	case SSL_ERROR_WANT_WRITE:
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
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







-
+

















-











-
+





-
+







	    dprintBuffer(buf, bytesRead);
	    break;

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

#if OPENSSL_VERSION_NUMBER >= 0x30000000L
	    /* Unexpected EOF from the peer for OpenSSL 3.0+ */
	    if (ERR_GET_REASON(backingError) == SSL_R_UNEXPECTED_EOF_WHILE_READING) {
		dprintf("(Unexpected) EOF reached")
		*errorCodePtr = 0;
		bytesRead = 0;
		Tls_Error(statePtr, "EOF reached");
	    }    
#endif
	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */

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

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

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

	case SSL_ERROR_ZERO_RETURN:
	    dprintf("Got SSL_ERROR_ZERO_RETURN, this means an EOF has been reached");
	    bytesRead = 0;
	    *errorCodePtr = 0;
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570

571
572
573
574
575
576

577
578
579
580
581
582
583
584

585
586
587
588
589
590
591
548
549
550
551
552
553
554

555
556
557
558
559
560
561
562
563
564

565
566
567
568
569
570

571
572
573
574
575
576
577
578

579
580
581
582
583
584
585
586







-










-
+





-
+







-
+







	    written = 0;
	    *errorCodePtr = 0;
	    Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
	    break;

	case SSL_ERROR_SYSCALL:
	    /* Some non-recoverable, fatal I/O error occurred */

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

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

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

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

	default:
	    dprintf("unknown error: %d", err);
944
945
946
947
948
949
950
951

952
953
939
940
941
942
943
944
945

946
947
948







-
+


    NULL,			/* Flush proc */
    TlsNotifyProc,		/* Handling of events bubbling up */
    NULL,			/* Wide seek proc */
    NULL,			/* Thread action */
    NULL			/* Truncate */
};

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

Added generic/tlsInfo.c version [981453e7ce].































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Information Commands Module
 *
 * Provides commands that return info related to the OpenSSL config and data.
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include <openssl/crypto.h>
#include <openssl/ssl.h>
#include <openssl/safestack.h>

/*
 * Valid SSL and TLS Protocol Versions
 */
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
};

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * NamesCallback --
 *
 *	Callback to add algorithm or method names to a TCL list object.
 *
 * Results:
 *	Append name to TCL list object.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
void NamesCallback(const OBJ_NAME *obj, void *arg) {
    Tcl_Obj *listObj = (Tcl_Obj *) arg;

    /* Fields: (int) type and alias, (const char*) name (alias from) and data (alias to) */
    if (strstr(obj->name, "rsa") == NULL && strstr(obj->name, "RSA") == NULL) {
	Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewStringObj(obj->name, -1));
    }
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * CipherInfo --
 *
 *	Return a list of properties and values for cipher.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int CipherInfo(Tcl_Interp *interp, Tcl_Obj *nameObj) {
    const EVP_CIPHER *cipher;
    Tcl_Obj *resultObj, *listObj;
    unsigned long flags, mode;
    char *modeName = NULL;
    char *name = Tcl_GetStringFromObj(nameObj, (Tcl_Size *) NULL);

    /* Get cipher */
    cipher = EVP_get_cipherbyname(name);

    if (cipher == NULL) {
	Tcl_AppendResult(interp, "Invalid cipher \"", name, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /* Get properties */
    resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }
    LAPPEND_STR(interp, resultObj, "nid", OBJ_nid2ln(EVP_CIPHER_nid(cipher)), -1);
    LAPPEND_STR(interp, resultObj, "name", EVP_CIPHER_name(cipher), -1);
    LAPPEND_STR(interp, resultObj, "description", "", -1);
    LAPPEND_INT(interp, resultObj, "block_size", EVP_CIPHER_block_size(cipher));
    LAPPEND_INT(interp, resultObj, "key_length", EVP_CIPHER_key_length(cipher));
    LAPPEND_INT(interp, resultObj, "iv_length", EVP_CIPHER_iv_length(cipher));
    LAPPEND_STR(interp, resultObj, "type", OBJ_nid2ln(EVP_CIPHER_type(cipher)), -1);
    LAPPEND_STR(interp, resultObj, "provider", "", -1);
    flags = EVP_CIPHER_flags(cipher);
    mode  = EVP_CIPHER_mode(cipher);

    /* EVP_CIPHER_get_mode */
    switch(mode) {
	case EVP_CIPH_STREAM_CIPHER:
	    modeName = "STREAM";
	    break;
	case EVP_CIPH_ECB_MODE:
	    modeName = "ECB";
	    break;
	case EVP_CIPH_CBC_MODE:
	    modeName = "CBC";
	    break;
	case EVP_CIPH_CFB_MODE:
	    modeName = "CFB";
	    break;
	case EVP_CIPH_OFB_MODE:
	    modeName = "OFB";
	    break;
	case EVP_CIPH_CTR_MODE:
	    modeName = "CTR";
	    break;
	case EVP_CIPH_GCM_MODE:
	    modeName = "GCM";
	    break;
	case EVP_CIPH_XTS_MODE:
	    modeName = "XTS";
	    break;
	case EVP_CIPH_CCM_MODE:
	    modeName = "CCM";
	    break;
	case EVP_CIPH_OCB_MODE:
	    modeName = "OCB";
	    break;
	case EVP_CIPH_WRAP_MODE :
	    modeName = "WRAP";
	    break;
	default:
	    modeName = "unknown";
	    break;
    }
    LAPPEND_STR(interp, resultObj, "mode", modeName, -1);

    /* Flags */
    listObj = Tcl_NewListObj(0, NULL);
    LAPPEND_BOOL(interp, listObj, "Variable Length", flags & EVP_CIPH_VARIABLE_LENGTH);
    LAPPEND_BOOL(interp, listObj, "Always Call Init", flags & EVP_CIPH_ALWAYS_CALL_INIT);
    LAPPEND_BOOL(interp, listObj, "Custom IV", flags & EVP_CIPH_CUSTOM_IV);
    LAPPEND_BOOL(interp, listObj, "Control Init", flags & EVP_CIPH_CTRL_INIT);
    LAPPEND_BOOL(interp, listObj, "Custom Cipher", flags & EVP_CIPH_FLAG_CUSTOM_CIPHER);
    LAPPEND_BOOL(interp, listObj, "AEAD Cipher", flags & EVP_CIPH_FLAG_AEAD_CIPHER);
    LAPPEND_BOOL(interp, listObj, "Custom Copy", flags & EVP_CIPH_CUSTOM_COPY);
    LAPPEND_BOOL(interp, listObj, "Non FIPS Allow", flags & EVP_CIPH_FLAG_NON_FIPS_ALLOW);
    LAPPEND_OBJ(interp, resultObj, "flags", listObj);

    /* CTX only properties */
    {
	EVP_CIPHER_CTX *ctx = EVP_CIPHER_CTX_new();
	int tag_len = 0;

	EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL);
	if (mode == EVP_CIPH_GCM_MODE || mode == EVP_CIPH_OCB_MODE) {
	    tag_len = EVP_GCM_TLS_TAG_LEN; /* EVP_MAX_AEAD_TAG_LENGTH */
	} else if (mode == EVP_CIPH_CCM_MODE) {
	    tag_len = EVP_CCM_TLS_TAG_LEN;
	} else if (cipher == EVP_get_cipherbyname("chacha20-poly1305")) {
	    tag_len = EVP_CHACHAPOLY_TLS_TAG_LEN; /* POLY1305_BLOCK_SIZE */
	}
	EVP_CIPHER_CTX_free(ctx);
	LAPPEND_INT(interp, resultObj, "tag_length", tag_len);
    }
    
    /* AEAD properties */
    {
	int aad_len = 0;
	if (flags & EVP_CIPH_FLAG_AEAD_CIPHER) {
	    aad_len = EVP_AEAD_TLS1_AAD_LEN;
	}
	LAPPEND_INT(interp, resultObj, "aad_length", aad_len);
    }

    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * CipherList --
 *
 *	Return a list of all cipher algorithms
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int CipherList(Tcl_Interp *interp) {
    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }

    /* Same as EVP_CIPHER_do_all */
    OBJ_NAME_do_all(OBJ_NAME_TYPE_CIPHER_METH, NamesCallback, (void *) resultObj);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * CipherObjCmd --
 *
 *	Return a list of properties and values for cipherName.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int CipherObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc == 1) {
	return CipherList(interp);

    } else if (objc == 2) {
	return CipherInfo(interp, objv[1]);

    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd --
 *
 *	This procedure is invoked to process the "tls::ciphers" command
 *	to list available ciphers, based upon protocol selected.
 *
 * Results:
 *	A standard Tcl result list.
 *
 * Side effects:
 *	constructs and destroys SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
static int CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk = NULL;
    Tcl_Size index;
    int verbose = 0, use_supported = 0, res = TCL_OK;
    int min_version, max_version;
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?protocol? ?verbose? ?supported?");
	return TCL_ERROR;
    }

    /* List all ciphers */
    if (objc == 1) {
	return CipherList(interp);
    }

    /* Get options */
    if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK ||
	(objc > 2 && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) ||
	(objc > 3 && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK)) {
	return TCL_ERROR;
    }

    switch ((enum protocol)index) {
	case TLS_SSL2:
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL);
	    return TCL_ERROR;
	case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL);
	    return TCL_ERROR;
#else
            min_version = SSL3_VERSION;
            max_version = SSL3_VERSION;
	    break;
#endif
	case TLS_TLS1:
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL);
	    return TCL_ERROR;
#else
            min_version = TLS1_VERSION;
            max_version = TLS1_VERSION;
	    break;
#endif
	case TLS_TLS1_1:
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL);
	    return TCL_ERROR;
#else
            min_version = TLS1_1_VERSION;
            max_version = TLS1_1_VERSION;
	    break;
#endif
	case TLS_TLS1_2:
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL);
	    return TCL_ERROR;
#else
            min_version = TLS1_2_VERSION;
            max_version = TLS1_2_VERSION;
	    break;
#endif
	case TLS_TLS1_3:
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
	    Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL);
	    return TCL_ERROR;
#else
            min_version = TLS1_3_VERSION;
            max_version = TLS1_3_VERSION;
	    break;
#endif
	default:
            min_version = SSL3_VERSION;
            max_version = TLS1_3_VERSION;
	    break;
    }

    /* Create context */
    if ((ctx = SSL_CTX_new(TLS_server_method())) == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *) NULL);
	return TCL_ERROR;
    }

    /* Set protocol versions */
    if (SSL_CTX_set_min_proto_version(ctx, min_version) == 0 ||
	SSL_CTX_set_max_proto_version(ctx, max_version) == 0) {
	SSL_CTX_free(ctx);
	return TCL_ERROR;
    }

    /* Create SSL context */
    if ((ssl = SSL_new(ctx)) == NULL) {
	Tcl_AppendResult(interp, GET_ERR_REASON(), (char *) 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);
	/*sk = SSL_CTX_get_ciphers(ctx);*/
    }

    if (sk != NULL) {
	Tcl_Obj *resultObj = NULL;

	if (!verbose) {
	    const char *cp;
	    resultObj = Tcl_NewListObj(0, NULL);
	    if (resultObj == NULL) {
		res = TCL_ERROR;
		goto done;
	    }

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

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

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

	    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(resultObj, buf, (Tcl_Size) strlen(buf));
		} else {
		    Tcl_AppendToObj(resultObj, "UNKNOWN\n", 8);
		}
	    }
	}

	/* Clean up */
	if (use_supported) {
	    sk_SSL_CIPHER_free(sk);
	}
	Tcl_SetObjResult(interp, resultObj);
    }

done:
    SSL_free(ssl);
    SSL_CTX_free(ctx);
    return res;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * DigestInfo --
 *
 *	Return a list of properties and values for digest.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int DigestInfo(Tcl_Interp *interp, Tcl_Obj *nameObj) {
    const EVP_MD *md;
    Tcl_Obj *resultObj, *listObj;
    unsigned long flags;
    char *name = Tcl_GetStringFromObj(nameObj, (Tcl_Size *) NULL);

    /* Get message digest */
    md = EVP_get_digestbyname(name);

    if (md == NULL) {
	Tcl_AppendResult(interp, "Invalid digest \"", name, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /* Get properties */
    resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }
    LAPPEND_STR(interp, resultObj, "name", EVP_MD_name(md), -1);
    LAPPEND_STR(interp, resultObj, "description", "", -1);
    LAPPEND_INT(interp, resultObj, "size", EVP_MD_size(md));
    LAPPEND_INT(interp, resultObj, "block_size", EVP_MD_block_size(md));
    LAPPEND_STR(interp, resultObj, "provider", "", -1);
    LAPPEND_STR(interp, resultObj, "type", OBJ_nid2ln(EVP_MD_type(md)), -1);
    LAPPEND_STR(interp, resultObj, "pkey_type", OBJ_nid2ln(EVP_MD_pkey_type(md)), -1);
    flags = EVP_MD_flags(md);

    /* Flags */
    listObj = Tcl_NewListObj(0, NULL);
    LAPPEND_BOOL(interp, listObj, "One-shot", flags & EVP_MD_FLAG_ONESHOT);
    LAPPEND_BOOL(interp, listObj, "XOF", flags & EVP_MD_FLAG_XOF);
    LAPPEND_BOOL(interp, listObj, "DigestAlgorithmId_NULL", flags & EVP_MD_FLAG_DIGALGID_NULL);
    LAPPEND_BOOL(interp, listObj, "DigestAlgorithmId_Abscent", flags & EVP_MD_FLAG_DIGALGID_ABSENT);
    LAPPEND_BOOL(interp, listObj, "DigestAlgorithmId_Custom", flags & EVP_MD_FLAG_DIGALGID_CUSTOM);
    LAPPEND_BOOL(interp, listObj, "FIPS", flags & EVP_MD_FLAG_FIPS);
    LAPPEND_OBJ(interp, resultObj, "flags", listObj);

    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestList --
 *
 *	Return a list of all digest algorithms
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int DigestList(Tcl_Interp *interp) {
    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }

    /* Same as EVP_MD_do_all */
    OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) resultObj);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * DigestsObjCmd --
 *
 *	Return a list of all valid hash algorithms or message digests.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int DigestsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();


    /* Validate arg count */
    if (objc == 1) {
	return DigestList(interp);

    } else if (objc == 2) {
	return DigestInfo(interp, objv[1]);

    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * KdfList --
 *
 *	Return a list of all KDF algorithms
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int KdfList(Tcl_Interp *interp, char *select_name) {
    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }

    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("hkdf", -1));
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("pbkdf2", -1));
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("scrypt", -1));
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * KdfsObjCmd --
 *
 *	Return a list of all valid Key Derivation Function (KDF).
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int KdfsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();


    /* Validate arg count */
    if (objc == 1) {
	return KdfList(interp, NULL);

    } else if (objc == 2) {


    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * MacInfo --
 *
 *	Return a list of properties and values for macName.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int MacInfo(Tcl_Interp *interp, Tcl_Obj *nameObj) {
    Tcl_Obj *resultObj;
    int res = TCL_OK;
    char *name = Tcl_GetStringFromObj(nameObj, (Tcl_Size *) NULL);

    if (strcmp(name, "cmac") != 0 && strcmp(name, "hmac") != 0) {
	Tcl_AppendResult(interp, "Invalid MAC \"", name, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /* Get properties */
    resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }
    LAPPEND_STR(interp, resultObj, "name", name, -1);
    LAPPEND_STR(interp, resultObj, "description", "", -1);
    LAPPEND_STR(interp, resultObj, "provider", "", -1);

    Tcl_SetObjResult(interp, resultObj);
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * MacList --
 *
 *	Return a list of all MAC algorithms
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int MacList(Tcl_Interp *interp) {
    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }

    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("cmac", -1));
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("hmac", -1));
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * MacsObjCmd --
 *
 *	Return a list of all valid message authentication codes (MAC).
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int MacsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc == 1) {
	return MacList(interp);

    } else if (objc == 2) {
	return MacInfo(interp, objv[1]);

    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * PkeyInfo --
 *
 *	Return a list of properties and values for pkey.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int PkeyInfo(Tcl_Interp *interp, Tcl_Obj *nameObj) {
    Tcl_Obj *resultObj;
    int res = TCL_OK;
    char *name = Tcl_GetStringFromObj(nameObj, (Tcl_Size *) NULL);
    EVP_PKEY *pkey = NULL;

    if (pkey == NULL) {
	Tcl_AppendResult(interp, "Invalid public key method \"", name, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /* Get properties */
    resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }
    LAPPEND_STR(interp, resultObj, "name", OBJ_nid2ln(EVP_PKEY_id(pkey)), -1);
    LAPPEND_STR(interp, resultObj, "description", "", -1);
    LAPPEND_INT(interp, resultObj, "size", EVP_PKEY_size(pkey));
    LAPPEND_INT(interp, resultObj, "bits", EVP_PKEY_bits(pkey));
    LAPPEND_INT(interp, resultObj, "security_bits", EVP_PKEY_security_bits(pkey));
    LAPPEND_STR(interp, resultObj, "baseId", OBJ_nid2ln(EVP_PKEY_base_id(pkey)), -1);
    LAPPEND_STR(interp, resultObj, "provider", "", -1);
    LAPPEND_STR(interp, resultObj, "type", OBJ_nid2ln(EVP_PKEY_type(EVP_PKEY_id(pkey))), -1);

    {
	int pnid;
	if (EVP_PKEY_get_default_digest_nid(pkey, &pnid) > 0) {
	    LAPPEND_STR(interp, resultObj, "default_digest", OBJ_nid2ln(pnid), -2);
	}
    }

    Tcl_SetObjResult(interp, resultObj);
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * PkeyList --
 *
 *	Return a list of all public key methods
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int PkeyList(Tcl_Interp *interp) {
    Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }

    for (size_t i = 0; i < EVP_PKEY_meth_get_count(); i++) {
        const EVP_PKEY_METHOD *pmeth = EVP_PKEY_meth_get0(i);
        int pkey_id, pkey_flags;

        EVP_PKEY_meth_get0_info(&pkey_id, &pkey_flags, pmeth);
	/*LAPPEND_STR(interp, resultObj, "name", OBJ_nid2ln(pkey_id), -1);
	LAPPEND_STR(interp, resultObj, "type", pkey_flags & ASN1_PKEY_DYNAMIC ? "External" : "Built-in", -1);*/

	Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(OBJ_nid2ln(pkey_id), -1));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * PkeysObjCmd --
 *
 *	Return a list of all valid hash algorithms or message digests.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
int PkeysObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc == 1) {
	return PkeyList(interp);

    } else if (objc == 2) {
	return PkeyInfo(interp, objv[1]);

    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * ProtocolsObjCmd --
 *
 *	Return a list of the available or supported SSL/TLS protocols.
 *
 * Results:
 *	A standard Tcl list.
 *
 * Side effects:
 *	none
 *
 *-------------------------------------------------------------------
 */
static int
ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *resultObj;
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    /* List all protocols */
    resultObj = Tcl_NewListObj(0, NULL);
    if (resultObj == NULL) {
	return TCL_ERROR;
    }
#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(protocols[TLS_SSL2], -1));
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD)
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(protocols[TLS_SSL3], -1));
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
    Tcl_ListObjAppendElement(interp, resultObj, 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, resultObj, 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, resultObj, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1));
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1));
#endif
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * VersionObjCmd --
 *
 *	Return a string with the OpenSSL version info.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *resultObj;
    (void) clientData;

    dprintf("Called");

    /* Validate arg count */
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    resultObj = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * Tls_InfoCommands --
 *
 *	Create info commands
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_InfoCommands(Tcl_Interp *interp) {

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_ciphers();
    OpenSSL_add_all_digests();
    OpenSSL_add_all_algorithms();
#endif

    Tcl_CreateObjCommand(interp, "tls::cipher", CipherObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::digests", DigestsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::kdfs", KdfsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::macs", MacsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::pkeys", PkeysObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

Modified generic/tlsInt.h from [07c33eb860] to [d59da98e39].

33
34
35
36
37
38
39
40
41
42
43
44



45
46
47
48
49



50
51
52
53
54
55
56
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







-




+
+
+





+
+
+







#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
    #include <limits.h>
    #define TCL_SIZE_MAX INT_MAX

    #ifndef Tcl_Size
        typedef int Tcl_Size;
    #endif

    #define TCL_SIZE_MODIFIER ""
    #define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj
    #define Tcl_NewSizeIntObj     Tcl_NewIntObj
    #define Tcl_NewSizeIntFromObj Tcl_NewWideIntObj
#endif

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

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







-
+














-
+








+
+
+
+
+


+
+
+
+
+
+
+
+
+
+





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

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

	char *err;
} State;

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

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

Tcl_Obj         *Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert);
Tcl_Obj		*Tls_NewCAObj(Tcl_Interp *interp, const SSL *ssl, int peer);
void            Tls_Error(State *statePtr, char *msg);
void            Tls_Free(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, Tcl_Size *len, int max, int no_null);
unsigned char	*Util_GetKey(Tcl_Interp *interp, Tcl_Obj *keyObj, Tcl_Size *len, char *name, int max, int no_null);
unsigned char	*Util_GetSalt(Tcl_Interp *interp, Tcl_Obj *saltObj, Tcl_Size *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 */

Added generic/tlsKDF.c version [a4bcf33c6e].



































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Key Derivation Function (KDF) Module
 *
 * Provides commands to derive keys.
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <openssl/evp.h>
#include <openssl/kdf.h>

/*******************************************************************/

/* Options for KDF commands */

static const char *command_opts [] = {
    "-cipher", "-digest", "-hash", "-info", "-iterations", "-key", "-length", "-password",
    "-salt", "-size", "-N", "-n", "-r", "-p", NULL};

enum _command_opts {
    _opt_cipher, _opt_digest, _opt_hash, _opt_info, _opt_iter, _opt_key, _opt_length,
    _opt_password, _opt_salt, _opt_size, _opt_N, _opt_n, _opt_r, _opt_p
};

/*
 *-------------------------------------------------------------------
 *
 * KDF_PBKDF2 --
 *
 *	PKCS5_PBKDF2_HMAC key derivation function (KDF) specified by PKCS #5.
 *	KDFs include PBKDF2 from RFC 2898/8018 and Scrypt from RFC 7914.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to a list of key and iv values, or an error message
 *
 *-------------------------------------------------------------------
 */
static int KDF_PBKDF2(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Size fn, salt_len = 0, pass_len = 0;
    int iklen, ivlen, iter = 1;
    unsigned char *pass = NULL, *salt = NULL;
    const EVP_MD *md = NULL;
    const EVP_CIPHER *cipher = NULL;
    int buf_len = (EVP_MAX_KEY_LENGTH + EVP_MAX_IV_LENGTH)*4, dk_len = buf_len;
    unsigned char tmpkeyiv[(EVP_MAX_KEY_LENGTH + EVP_MAX_IV_LENGTH)*4];
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc < 3 || objc > 11) {
	Tcl_WrongNumArgs(interp, 1, objv, "[-cipher cipher | -size length] -digest digest ?-iterations count? ?-password string? ?-salt string?");
	return TCL_ERROR;
    }

    /* Init buffers */
    memset(tmpkeyiv, 0, buf_len);

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

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

	switch(fn) {
	case _opt_cipher:
	    if ((cipher = Util_GetCipher(interp, objv[idx], 1)) == NULL) {
		return TCL_ERROR;
	    }
	    break;
	case _opt_digest:
	case _opt_hash:
	    if ((md = Util_GetDigest(interp, objv[idx], 1)) == NULL) {
		return TCL_ERROR;
	    }
	    break;
	case _opt_iter:
	    if (Util_GetInt(interp, objv[idx], &iter, "iterations", 1, -1) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case _opt_key:
	case _opt_password:
	    pass = Util_GetKey(interp, objv[idx], &pass_len, (char *) command_opts[fn], 0, 0);
	    break;
	case _opt_salt:
	    GET_OPT_BYTE_ARRAY(objv[idx], salt, &salt_len);
	    break;
	case _opt_length:
	case _opt_size:
	    if (Util_GetInt(interp, objv[idx], &dk_len, (char *) command_opts[fn], 1, buf_len) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	}
    }

    /* Validate options */
    if (md == NULL) {
	Tcl_AppendResult(interp, "no digest", (char *) NULL);
	return TCL_ERROR;
    }

    /* Set output type sizes */
    if (cipher == NULL) {
	if (dk_len > buf_len) dk_len = buf_len;
	iklen = dk_len;
	ivlen = 0;
    } else {
	iklen = EVP_CIPHER_key_length(cipher);
	ivlen = EVP_CIPHER_iv_length(cipher);
	dk_len = iklen+ivlen;
    }

    /* Derive key */
    if (!PKCS5_PBKDF2_HMAC((const char *) pass, (int) pass_len, salt, (int) salt_len, iter, md, dk_len, tmpkeyiv)) {
	Tcl_AppendResult(interp, "Key derivation failed: ", GET_ERR_REASON(), (char *) NULL);
	return TCL_ERROR;
    }

   /* Set result to key and iv */
    if (cipher == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(tmpkeyiv, (Tcl_Size) dk_len));
    } else {
	Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL);
	LAPPEND_BARRAY(interp, resultObj, "key", tmpkeyiv, (Tcl_Size) iklen);
	LAPPEND_BARRAY(interp, resultObj, "iv", tmpkeyiv+iklen, (Tcl_Size) ivlen);
	Tcl_SetObjResult(interp, resultObj);
    }

    /* Clear data */
    memset(tmpkeyiv, 0, buf_len);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * KDF_HKDF --
 *
 *	HMAC-based Extract-and-Expand Key Derivation Function (HKDF).
 *	See RFC 5869.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to a key of specified length, or an error message
 *
 *-------------------------------------------------------------------
 */
static int KDF_HKDF(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    EVP_PKEY_CTX *pctx = NULL;
    const EVP_MD *md = NULL;
    unsigned char *salt = NULL, *key = NULL, *info = NULL, *out = NULL;
    Tcl_Size salt_len = 0, key_len = 0, info_len = 0;
    int res = TCL_OK;
    Tcl_Size fn;
    int dk_len = EVP_MAX_KEY_LENGTH + EVP_MAX_IV_LENGTH;
    size_t out_len;
    Tcl_Obj *resultObj;
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc < 5 || objc > 11) {
	Tcl_WrongNumArgs(interp, 1, objv, "-digest digest -key string ?-info string? ?-salt string? ?-size derived_length?");
	return TCL_ERROR;
    }

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

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

	switch(fn) {
	case _opt_digest:
	case _opt_hash:
	    if ((md = Util_GetDigest(interp, objv[idx], 1)) == NULL) {
		goto error;
	    }
	    break;
	case _opt_info:
	    /* Max 1024/2048 */
	    GET_OPT_BYTE_ARRAY(objv[idx], info, &info_len);
	    break;
	case _opt_key:
	case _opt_password:
	    if ((key = Util_GetKey(interp, objv[idx], &key_len, (char *) command_opts[fn], 0, 1)) == NULL) {
		goto error;
	    }
	    break;
	case _opt_salt:
	    GET_OPT_BYTE_ARRAY(objv[idx], salt, &salt_len);
	    break;
	case _opt_length:
	case _opt_size:
	    if (Util_GetInt(interp, objv[idx], &dk_len, (char *) command_opts[fn], 1, 0) != TCL_OK) {
		goto error;
	    }
	    break;
	}
    }

    if (md == NULL) {
	Tcl_AppendResult(interp, "no digest", (char *) NULL);
	goto error;
    }

    if (key == NULL) {
	Tcl_AppendResult(interp, "no key", (char *) NULL);
	goto error;
    }

    /* Create context */
    pctx = EVP_PKEY_CTX_new_id(EVP_PKEY_HKDF, NULL);
    if (pctx == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	goto error;
    }

    if (EVP_PKEY_derive_init(pctx) < 1) {
	Tcl_AppendResult(interp, "Initialize failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }

    /* Set config parameters */
    if (EVP_PKEY_CTX_set_hkdf_md(pctx, md) < 1) {
	Tcl_AppendResult(interp, "Set digest failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }
    if (EVP_PKEY_CTX_set1_hkdf_key(pctx, key, (int) key_len) < 1) {
	Tcl_AppendResult(interp, "Set key failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }
    if (salt != NULL && EVP_PKEY_CTX_set1_hkdf_salt(pctx, salt, (int) salt_len) < 1) {
	Tcl_AppendResult(interp, "Set salt failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }
    if (info != NULL && EVP_PKEY_CTX_add1_hkdf_info(pctx, info, (int) info_len) < 1) {
	Tcl_AppendResult(interp, "Set info failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }

    /* Get buffer */
    resultObj = Tcl_NewObj();
    if ((out = Tcl_SetByteArrayLength(resultObj, (Tcl_Size) dk_len)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	goto error;
    }
    out_len = (size_t) dk_len;

    /* Derive key */
    if (EVP_PKEY_derive(pctx, out, &out_len) > 0) {
	/* Shrink buffer to actual size */
	Tcl_SetByteArrayLength(resultObj, (Tcl_Size) out_len);
	Tcl_SetObjResult(interp, resultObj);
	res = TCL_OK;
	goto done;
    } else {
	Tcl_AppendResult(interp, "Key derivation failed: ", GET_ERR_REASON(), (char *) NULL);
	Tcl_DecrRefCount(resultObj);
    }

error:
    res = TCL_ERROR;
done:
    if (pctx != NULL) {
	EVP_PKEY_CTX_free(pctx);
    }
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * KDF_Scrypt --
 *
 *	HMAC-based Extract-and-Expand Key Derivation Function (HKDF).
 *	See RFC 5869 and RFC 7914.
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to a list of key and iv values, or an error message
 *
 *-------------------------------------------------------------------
 */
static int KDF_Scrypt(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    EVP_PKEY_CTX *pctx = NULL;
    unsigned char *salt = NULL, *pass = NULL, *out = NULL;
    Tcl_Size salt_len = 0, pass_len = 0;
    int dk_len = 64, res = TCL_OK;
    Tcl_Size fn;
    Tcl_WideInt N = 0, p = 0, r = 0, maxmem = 0;
    size_t out_len;
    Tcl_Obj *resultObj;
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc < 5 || objc > 13) {
	Tcl_WrongNumArgs(interp, 1, objv, "-password string -salt string ?-N costParameter? ?-r blockSize? ?-p parallelization? ?-size derived_length?");
	return TCL_ERROR;
    }

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

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

	switch(fn) {
	case _opt_key:
	case _opt_password:
	    GET_OPT_BYTE_ARRAY(objv[idx], pass, &pass_len);
	    break;
	case _opt_salt:
	    GET_OPT_BYTE_ARRAY(objv[idx], salt, &salt_len);
	    break;
	case _opt_length:
	case _opt_size:
	    if (Util_GetInt(interp, objv[idx], &dk_len, (char *) command_opts[fn], 1, 0) != TCL_OK) {
		goto error;
	    }
	    break;
	case _opt_N:
	case _opt_n:
	    GET_OPT_WIDE(objv[idx], &N);
	    break;
	case _opt_r:
	    GET_OPT_WIDE(objv[idx], &r);
	    break;
	case _opt_p:
	    GET_OPT_WIDE(objv[idx], &p);
	    break;
	}
    }

    if (pass == NULL) {
	Tcl_AppendResult(interp, "no password", (char *) NULL);
	return TCL_ERROR;
    }

    if (salt == NULL) {
	Tcl_AppendResult(interp, "no salt", (char *) NULL);
	return TCL_ERROR;
    }

    /* Create context */
    pctx = EVP_PKEY_CTX_new_id(EVP_PKEY_SCRYPT, NULL);
    if (pctx == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	goto error;
    }

    if (EVP_PKEY_derive_init(pctx) < 1) {
	Tcl_AppendResult(interp, "Initialize failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }

    /* Set config parameters */
    if (EVP_PKEY_CTX_set1_pbe_pass(pctx, (const char *) pass, (int) pass_len) < 1) {
	Tcl_AppendResult(interp, "Set key failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }
    if (EVP_PKEY_CTX_set1_scrypt_salt(pctx, salt, (int) salt_len) < 1) {
	Tcl_AppendResult(interp, "Set salt failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }
    if (N != 0 && EVP_PKEY_CTX_set_scrypt_N(pctx, (uint64_t) N) < 1) {
	Tcl_AppendResult(interp, "Set cost parameter (N) failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }
    if (r != 0 && EVP_PKEY_CTX_set_scrypt_r(pctx, (uint64_t) r) < 1) {
	Tcl_AppendResult(interp, "Set lock size parameter (r) failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
   }
    if (p != 0 && EVP_PKEY_CTX_set_scrypt_p(pctx, (uint64_t) p) < 1) {
	Tcl_AppendResult(interp, "Set Parallelization parameter (p) failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }
    if (maxmem != 0 && EVP_PKEY_CTX_set_scrypt_maxmem_bytes(pctx, maxmem) < 1) {
	Tcl_AppendResult(interp, "Set max memory failed: ", GET_ERR_REASON(), (char *) NULL);
	goto error;
    }

    /* Get buffer */
    resultObj = Tcl_NewObj();
    if ((out = Tcl_SetByteArrayLength(resultObj, (Tcl_Size) dk_len)) == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	goto error;
    }
    out_len = (size_t) dk_len;

    /* Derive key */
    if (EVP_PKEY_derive(pctx, out, &out_len) > 0) {
	/* Shrink buffer to actual size */
	Tcl_SetByteArrayLength(resultObj, (Tcl_Size) out_len);
	Tcl_SetObjResult(interp, resultObj);
	goto done;

    } else {
	Tcl_AppendResult(interp, "Key derivation failed: ", GET_ERR_REASON(), (char *) NULL);
	Tcl_DecrRefCount(resultObj);
    }

error:
    res = TCL_ERROR;

done:
    if (pctx != NULL) {
	EVP_PKEY_CTX_free(pctx);
    }
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_KeyCommands --
 *
 *	Create key commands
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_KDFCommands(Tcl_Interp *interp) {
    Tcl_CreateObjCommand(interp, "tls::hkdf", KDF_HKDF, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::pbkdf2", KDF_PBKDF2, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::scrypt", KDF_Scrypt, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

Added generic/tlsRand.c version [4b096f23cb].






















































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * Key Derivation Function (KDF) Module
 *
 * Provides commands to derive keys.
 *
 * Copyright (C) 2023 Brian O'Hagan
 *
 */

#include "tlsInt.h"
#include "tclOpts.h"
#include <openssl/rand.h>

/*******************************************************************/

/* Options for Random commands */

static const char *command_opts [] = {
    "-private", NULL};

enum _command_opts {
    _opt_private
};

/*
 *-------------------------------------------------------------------
 *
 * RAND_Random --
 *
 *	Generate random byes using a random bytes using a cryptographically
 *	secure pseudo random generator (CSPRNG).
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Sets result to the random bytes, or an error message
 *
 *-------------------------------------------------------------------
 */
static int RAND_Random(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    int out_len = 0, res;
    unsigned char *out_buf;
    Tcl_Obj *resultObj;
    (void) clientData;

    dprintf("Called");

    /* Clear errors */
    Tcl_ResetResult(interp);
    ERR_clear_error();

    /* Validate arg count */
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-private? length");
	return TCL_ERROR;
    } else if (objc == 3) {
	Tcl_Size fn;
	if (Tcl_GetIndexFromObj(interp, objv[1], command_opts, "option", 0, &fn) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /* Get length */
    if (Tcl_GetIntFromObj(interp, objv[objc - 1], &out_len) != TCL_OK) {
	return TCL_ERROR;
    }
    if (out_len < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad count \"%d\": must be integer >= 0", out_len));
	return TCL_ERROR;
    }

    /* Allocate storage for result */
    resultObj = Tcl_NewObj();
    out_buf = Tcl_SetByteArrayLength(resultObj, (Tcl_Size) out_len);
    if (resultObj == NULL || out_buf == NULL) {
	Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	Tcl_DecrRefCount(resultObj);
	return TCL_ERROR;
    }

    /* Get random bytes */
    if (objc == 2) {
	res = RAND_bytes(out_buf, out_len);
    } else {
	res = RAND_priv_bytes(out_buf, out_len);
    }
    if (!res) {
	Tcl_AppendResult(interp, "Generate failed: ", GET_ERR_REASON(), (char *) NULL);
	Tcl_DecrRefCount(resultObj);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_RandCommands --
 *
 *	Create key commands
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_RandCommands(Tcl_Interp *interp) {
    Tcl_CreateObjCommand(interp, "tls::random", RAND_Random, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

Added generic/tlsUtil.c version [b1b9224457].






































































































































































































































































































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

#include "tlsInt.h"
#include "tclOpts.h"
#include <openssl/evp.h>


/*
 *-------------------------------------------------------------------
 *
 * Util_GetCipher --
 *
 *	Get symmetric cipher from TclObj
 *
 * Returns:
 *	Pointer to type or NULL
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
EVP_CIPHER *Util_GetCipher(Tcl_Interp *interp, Tcl_Obj *cipherObj, int no_null) {
    EVP_CIPHER *cipher = NULL;
    char *name = NULL;

    if (cipherObj != NULL) {
	name = Tcl_GetStringFromObj(cipherObj, (Tcl_Size *) NULL);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
	cipher = EVP_get_cipherbyname(name);
#else
	cipher = EVP_CIPHER_fetch(NULL, name, NULL);
#endif
	if (cipher == NULL) {
	    Tcl_AppendResult(interp, "invalid cipher \"", name, "\"", (char *) NULL);
	}
    } else if (no_null) {
	Tcl_AppendResult(interp, "no cipher", (char *) NULL);
    }
    return cipher;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetDigest --
 *
 *	Get message digest (MD) or hash from TclObj
 *
 * Returns:
 *	Pointer to type or NULL
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
EVP_MD *Util_GetDigest(Tcl_Interp *interp, Tcl_Obj *digestObj, int no_null) {
    EVP_MD *md = NULL;
    char *name = NULL;

    if (digestObj != NULL) {
	name = Tcl_GetStringFromObj(digestObj, (Tcl_Size *) NULL);
#if OPENSSL_VERSION_NUMBER < 0x30000000L
	md = EVP_get_digestbyname(name);
#else
	md = EVP_MD_fetch(NULL, name, NULL);
#endif
	if (md == NULL) {
	    Tcl_AppendResult(interp, "invalid digest \"", name, "\"", (char *) NULL);
	}
    } else if (no_null) {
	Tcl_AppendResult(interp, "no digest", (char *) NULL);
    }
    return md;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetIV --
 *
 *	Get encryption initialization vector or seed from TclObj
 *
 * Returns:
 *	Pointer to type or NULL, and size
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
unsigned char *Util_GetIV(Tcl_Interp *interp, Tcl_Obj *ivObj, Tcl_Size *len, int max, int no_null) {
    unsigned char *iv = NULL;
    *len = 0;
    Tcl_Size size = 0;

    if (ivObj != NULL) {
	iv = Tcl_GetByteArrayFromObj(ivObj, &size);
	*len = (int) size;
    } else if (no_null) {
	Tcl_AppendResult(interp, "no initialization vector (IV)", (char *) NULL);
	return NULL;
    }

    if (max > 0 && *len > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("IV too long. Must be <= %d bytes", max));
	return NULL;
    }
    return iv;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetKey --
 *
 *	Get encryption key or password from TclObj
 *
 * Returns:
 *	Pointer to type or NULL, and size
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
unsigned char *Util_GetKey(Tcl_Interp *interp, Tcl_Obj *keyObj, Tcl_Size *len, char *name, int max, int no_null) {
    unsigned char *key = NULL;
    *len = 0;

    if (keyObj != NULL) {
	key = Tcl_GetByteArrayFromObj(keyObj, len);
    } else if (no_null) {
	Tcl_AppendResult(interp, "no ", name, (char *) NULL);
	return NULL;
    }

    if (max > 0 && *len > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid %s length. Must be <= %d bytes", name, max));
	return NULL;
    }
    return key;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetMAC --
 *
 *	Get Message Authentication Code (MAC) from TclObj
 *
 * Returns:
 *	Pointer to type or NULL
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
#if OPENSSL_VERSION_NUMBER >= 0x30000000L
EVP_MAC *Util_GetMAC(Tcl_Interp *interp, Tcl_Obj *MacObj, int no_null) {
    EVP_MAC *mac = NULL;
    char *name = NULL;

    if (MacObj != NULL) {
	name = Tcl_GetStringFromObj(MacObj, (Tcl_Size *) NULL);
	mac = EVP_MAC_fetch(NULL, name, NULL);
	if (mac == NULL) {
	    Tcl_AppendResult(interp, "invalid MAC \"", name, "\"", (char *) NULL);
	    return NULL;
	}
    } else if (no_null) {
	Tcl_AppendResult(interp, "no MAC", (char *) NULL);
    }
    return mac;
}
#endif

/*
 *-------------------------------------------------------------------
 *
 * Util_GetSalt --
 *
 *	Get encryption salt from TclObj
 *
 * Returns:
 *	Pointer to type or NULL, and size
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
unsigned char *Util_GetSalt(Tcl_Interp *interp, Tcl_Obj *saltObj, Tcl_Size *len, int max, int no_null) {
    unsigned char *salt = NULL;
    *len = 0;

    if (saltObj != NULL) {
	salt = Tcl_GetByteArrayFromObj(saltObj, len);
    } else if (no_null) {
	Tcl_AppendResult(interp, "no salt", (char *) NULL);
	return NULL;
    }

    if (max > 0 && *len > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Salt too long. Must be <= %d bytes", max));
	return NULL;
    }
    return salt;
}

/*******************************************************************/

/*
 *-------------------------------------------------------------------
 *
 * Util_GetBinaryArray --
 *
 *	Get binary array from TclObj
 *
 * Returns:
 *	Pointer to type or NULL, and size
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */
unsigned char *Util_GetBinaryArray(Tcl_Interp *interp, Tcl_Obj *dataObj, Tcl_Size *len,
	char *name, Tcl_Size min, Tcl_Size max, int no_null) {
    unsigned char *data = NULL;
    *len = 0;

    if (dataObj != NULL) {
	data = Tcl_GetByteArrayFromObj(dataObj, len);
    } else if (no_null) {
	Tcl_AppendResult(interp, "no ", name, (char *) NULL);
	return NULL;
    }

    if (*len < min) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid length for \"%s\": must be >= %d", name, min));
	return NULL;
    } else if (max > 0 && *len > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Invalid length for \"%s\": must be <= %d", name, max));
	return NULL;
    }
    return data;
}

/*
 *-------------------------------------------------------------------
 *
 * Util_GetInt --
 *
 *	Get integer value from TclObj
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------
 */

int Util_GetInt(Tcl_Interp *interp, Tcl_Obj *dataObj, int *value, char *name, int min, int max) {

    if (dataObj != NULL) {
	if (Tcl_GetIntFromObj(interp, dataObj, value) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /* Validate range */
    if (*value < min) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid value \"%d\" for option \"%s\": must be >= %d", *value, name, min));
	return TCL_ERROR;
    } else if (max > 0 && *value > max) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid value \"%d\" for option \"%s\": must be <= %d", *value, name, max));
	return TCL_ERROR;
    }
    return TCL_OK;
}

Modified generic/tlsX509.c from [37e1c520a1] to [051a5b0d6c].

58
59
60
61
62
63
64
65

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

81
82
83

84
85
86

87
88
89

90
91
92
93
94
95
96
58
59
60
61
62
63
64

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

80
81
82

83
84
85

86
87
88

89
90
91
92
93
94
95
96







-
+














-
+


-
+


-
+


-
+







    const STACK_OF(X509_EXTENSION) *exts;
    Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);

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

    if (exts = X509_get0_extensions(cert)) {
    if ((exts = X509_get0_extensions(cert)) != NULL) {
	for (int i=0; i < X509_get_ext_count(cert); i++) {
	    X509_EXTENSION *ex = sk_X509_EXTENSION_value(exts, i);
	    ASN1_OBJECT *obj = X509_EXTENSION_get_object(ex);
	    /* ASN1_OCTET_STRING *data = X509_EXTENSION_get_data(ex); */
	    int critical = X509_EXTENSION_get_critical(ex);
	    LAPPEND_BOOL(interp, listPtr, OBJ_nid2ln(OBJ_obj2nid(obj)), critical);
	}
    }
    return listPtr;
}

/*
 * Get Authority and Subject Key Identifiers
 */
Tcl_Obj *Tls_x509Identifier(ASN1_OCTET_STRING *astring) {
Tcl_Obj *Tls_x509Identifier(const ASN1_OCTET_STRING *astring) {
    Tcl_Obj *resultPtr = NULL;
    int len = 0;
    char buffer[1024];
    unsigned char buffer[1024];

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

/*
 * Get Key Usage
 */
Tcl_Obj *Tls_x509KeyUsage(Tcl_Interp *interp, X509 *cert, uint32_t xflags) {
199
200
201
202
203
204
205
206

207
208
209
210

211
212
213
214
215
216
217
199
200
201
202
203
204
205

206
207
208
209

210
211
212
213
214
215
216
217







-
+



-
+







    int len;
    char buffer[1024];

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

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

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

269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296
297

298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317

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

337
338
339
340
341
342

343
344
345
346
347
348
349
269
270
271
272
273
274
275

276
277
278
279
280
281
282
283
284
285
286
287

288
289
290
291
292
293
294
295
296

297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316

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

336
337
338
339
340
341

342
343
344
345
346
347
348
349







-
+











-
+








-
+



















-
+


















-
+





-
+







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

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

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

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

/*
 * Get On-line Certificate Status Protocol (OSCP) URL
 */
Tcl_Obj *Tls_x509Oscp(Tcl_Interp *interp, X509 *cert) {
    STACK_OF(OPENSSL_STRING) *ocsp;
    Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);

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

    if (ocsp = X509_get1_ocsp(cert)) {
    if ((ocsp = X509_get1_ocsp(cert)) != NULL) {
	for (int i = 0; i < sk_OPENSSL_STRING_num(ocsp); i++) {
	    LAPPEND_STR(interp, listPtr, NULL, sk_OPENSSL_STRING_value(ocsp, i), -1);
	}
	X509_email_free(ocsp);
    }
    return listPtr;
}

/*
 * Get Certificate Authority (CA) Issuers URL
 */
Tcl_Obj *Tls_x509CaIssuers(Tcl_Interp *interp, X509 *cert) {
    STACK_OF(ACCESS_DESCRIPTION) *ads;
    ACCESS_DESCRIPTION *ad;
    Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);
    unsigned char *buf;
    int len;

    if (ads = X509_get_ext_d2i(cert, NID_info_access, NULL, NULL)) {
    if ((ads = X509_get_ext_d2i(cert, NID_info_access, NULL, NULL)) != NULL) {
	for (int i = 0; i < sk_ACCESS_DESCRIPTION_num(ads); i++) {
	    ad = sk_ACCESS_DESCRIPTION_value(ads, i);
	    if (OBJ_obj2nid(ad->method) == NID_ad_ca_issuers && ad->location) {
		if (ad->location->type == GEN_URI) {
		    len = ASN1_STRING_to_UTF8(&buf, ad->location->d.uniformResourceIdentifier);
		    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buf, (Tcl_Size) len));
		    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((char *) buf, (Tcl_Size) len));
		    OPENSSL_free(buf);
		    break;
		}
	    }
	}
	/* sk_ACCESS_DESCRIPTION_pop_free(ads, ACCESS_DESCRIPTION_free); */
	AUTHORITY_INFO_ACCESS_free(ads);
371
372
373
374
375
376
377

378
379
380
381
382
383
384
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385







+







 */

Tcl_Obj*
Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert) {
    Tcl_Obj *certPtr = Tcl_NewListObj(0, NULL);
    BIO *bio = BIO_new(BIO_s_mem());
    int mdnid, pknid, bits, len;
    unsigned int ulen;
    uint32_t xflags;
    char buffer[BUFSIZ];
    unsigned char md[EVP_MAX_MD_SIZE];
    unsigned long flags = XN_FLAG_RFC2253 | ASN1_STRFLGS_UTF8_CONVERT;
    flags &= ~ASN1_STRFLGS_ESC_MSB;

    if (interp == NULL || cert == NULL || bio == NULL || certPtr == NULL) {
394
395
396
397
398
399
400
401

402
403
404
405
406
407
408
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409







-
+







	const ASN1_BIT_STRING *sig;
	int sig_nid;

	X509_get0_signature(&sig, &sig_alg, cert);
	/* sig_nid = X509_get_signature_nid(cert) */
	sig_nid = OBJ_obj2nid(sig_alg->algorithm);
	LAPPEND_STR(interp, certPtr, "signatureAlgorithm", OBJ_nid2ln(sig_nid), -1);
	len = (sig_nid != NID_undef) ? String_to_Hex(sig->data, sig->length, buffer, BUFSIZ) : 0;
	len = (sig_nid != NID_undef) ? String_to_Hex(sig->data, sig->length, (unsigned char *) buffer, BUFSIZ) : 0;
	LAPPEND_STR(interp, certPtr, "signatureValue", buffer, (Tcl_Size) len);
    }

    /* Version of the encoded certificate - RFC 5280 section 4.1.2.1 */
    LAPPEND_LONG(interp, certPtr, "version", X509_get_version(cert)+1);

    /* Unique number assigned by CA to certificate - RFC 5280 section 4.1.2.2 */
429
430
431
432
433
434
435
436
437
438



439
440
441
442
443
444



445
446
447
448
449
450
451
452
453
454
455
456
457
458

459
460
461
462
463

464
465
466
467
468
469
470

471
472
473
474
475
476
477
478
479
480
481
482
483

484
485
486
487
488
489
490
491
492
493
494

495
496
497
498

499
500
501
502
503
504
505

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

520
521
522
523
524
525
526
430
431
432
433
434
435
436



437
438
439
440
441
442



443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458

459
460
461
462
463

464
465
466
467
468
469
470

471
472
473
474
475
476
477
478
479
480
481
482
483

484
485
486
487
488
489
490
491
492
493
494

495
496
497
498

499
500
501
502
503
504
505

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

520
521
522
523
524
525
526
527







-
-
-
+
+
+



-
-
-
+
+
+













-
+




-
+






-
+












-
+










-
+



-
+






-
+













-
+








    /* 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);
    if (X509_digest(cert, EVP_sha1(), md, &ulen)) {
	len = String_to_Hex(md, len, (unsigned char *) buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha1_hash", buffer, (Tcl_Size) ulen);
    }

    /* 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);
    if (X509_digest(cert, EVP_sha256(), md, &ulen)) {
	len = String_to_Hex(md, len, (unsigned char *) buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "sha256_hash", buffer, (Tcl_Size) ulen);
    }

    /* 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;
	unsigned int n;

	LAPPEND_STR(interp, certPtr, "signingDigest", OBJ_nid2ln(mdnid), -1);
	LAPPEND_STR(interp, certPtr, "publicKeyAlgorithm", OBJ_nid2ln(pknid), -1);
	LAPPEND_INT(interp, certPtr, "bits", bits); /* Effective security bits */

	key = X509_get0_pubkey_bitstr(cert);
	len = String_to_Hex(key->data, key->length, buffer, BUFSIZ);
	len = String_to_Hex(key->data, key->length, (unsigned char *) buffer, BUFSIZ);
	LAPPEND_STR(interp, certPtr, "publicKey", buffer, (Tcl_Size) len);

	len = 0;
	if (X509_pubkey_digest(cert, EVP_get_digestbynid(pknid), md, &n)) {
	    len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
	    len = String_to_Hex(md, (int) n, (unsigned char *) buffer, BUFSIZ);
	}
	LAPPEND_STR(interp, certPtr, "publicKeyHash", buffer, (Tcl_Size) len);

	/* digest of the DER representation of the certificate */
	len = 0;
	if (X509_digest(cert, EVP_get_digestbynid(mdnid), md, &n)) {
	    len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
	    len = String_to_Hex(md, (int) n, (unsigned char *) buffer, BUFSIZ);
	}
	LAPPEND_STR(interp, certPtr, "signatureHash", buffer, (Tcl_Size) len);
    }

    /* Certificate Purpose. Call before checking for extensions. */
    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 */
    /* 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);
	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));
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((const unsigned char *)iuid->data, (Tcl_Size) iuid->length));
	} else {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
	}

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

    /* X509 v3 Extensions - RFC 5280 section 4.1.2.9 */
    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 */
584
585
586
587
588
589
590
591
592




593
594
595
596
597
598
599
585
586
587
588
589
590
591


592
593
594
595
596
597
598
599
600
601
602







-
-
+
+
+
+








    /* Subject Information Access - RFC 5280 section 4.2.2.2, NID_sinfo_access */

    /* Certificate Alias. If uses a PKCS#12 structure, alias will reflect the
	friendlyName attribute (RFC 2985). */
    {
	len = 0;
        char *string = X509_alias_get0(cert, &len);
	LAPPEND_STR(interp, certPtr, "alias", string, (Tcl_Size) len);
        unsigned char *string = X509_alias_get0(cert, &len);
	LAPPEND_STR(interp, certPtr, "alias", (char *) string, (Tcl_Size) len);
	string = X509_keyid_get0 (cert, &len);
	LAPPEND_STR(interp, certPtr, "keyId", (char *) string, (Tcl_Size) len);
    }

    /* Certificate and dump all data */
    {
	char certStr[CERT_STR_SIZE];

	/* Get certificate */

Modified tests/all.tcl from [b91d386182] to [7643c0fdf5].

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

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







-
+












-
+


-
+







-
+





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

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

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

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

#
# Run all tests in current and any sub directories with an all.tcl file.
#
set exitCode 0
set ::exitCode 0
if {[package vsatisfies [package require tcltest] 2.5-]} {
    if {[::tcltest::runAllTests] == 1} {
	set exitCode 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}]
	set ::exitCode [expr {$numTests(Total) == 0 || $numTests(Failed) > 0}]
    }
    ::tcltest::runAllTests
}

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

Modified tests/badssl.csv from [8df90efe9b] to [152d5864b6].

1
2
3

4
5
6

7
8

9
10
11

12
13
14

15
16
17
18
19
20
21
1
2

3
4
5

6
7

8



9
10
11

12
13
14
15
16
17
18
19


-
+


-
+

-
+
-
-
-
+


-
+







# 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,source [file join [file dirname [info script]] common.tcl],,,,,,,,,
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,,,,,,

Modified tests/badssl.test from [66893a8fa7] to [62a312d78a].

10
11
12
13
14
15
16
17

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

17


18
19
20
21
22
23
24







-
+
-
-








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]
source [file join [file dirname [info script]] common.tcl]
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


Deleted tests/ciphers.csv version [f4aff3652a].

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














































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
command,,,,,,,,,,
command,# Make sure path includes location of OpenSSL executable,,,,,,,,,
command,"if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] "";"" $::env(path)}",,,,,,,,,
command,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3],,,,,,,,,
command,foreach protocol $protocols {::tcltest::testConstraint $protocol 0},,,,,,,,,
command,foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1},,,,,,,,,
command,"::tcltest::testConstraint OpenSSL [string match ""OpenSSL*"" [::tls::version]]",,,,,,,,,
,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc lcompare {list1 list2} {set m """";set u """";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list ""missing"" $m ""unexpected"" $u]}",,,,,,,,,
command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,,
,,,,,,,,,,
command,# Test protocols,,,,,,,,,
Protocols,All,,,lcompare $protocols [::tls::protocols],,,missing {ssl2 ssl3} unexpected {},,,
,,,,,,,,,,
command,# Test ciphers,,,,,,,,,
CiphersAll,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2] [::tls::ciphers ssl2]",,,missing {} unexpected {},,,
CiphersAll,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3] [::tls::ciphers ssl3]",,,missing {} unexpected {},,,
CiphersAll,TLS1,tls1,,"lcompare [exec_get "":"" ciphers -tls1] [::tls::ciphers tls1]",,,missing {} unexpected {},,,
CiphersAll,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1] [::tls::ciphers tls1.1]",,,missing {} unexpected {},,,
CiphersAll,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2] [::tls::ciphers tls1.2]",,,missing {} unexpected {},,,
CiphersAll,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3] [::tls::ciphers tls1.3]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test cipher descriptions,,,,,,,,,
CiphersDesc,SSL2,ssl2,,"lcompare [exec_get ""\r\n"" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]",,,missing {} unexpected {},,,
CiphersDesc,SSL3,ssl3,,"lcompare [exec_get ""\r\n"" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]",,,missing {} unexpected {},,,
CiphersDesc,TLS1,tls1,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,,
CiphersDesc,TLS1.1,tls1.1,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,,
CiphersDesc,TLS1.2,tls1.2,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,,
CiphersDesc,TLS1.3,tls1.3,,"lcompare [exec_get ""\r\n"" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test protocol specific ciphers,,,,,,,,,
CiphersSpecific,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,TLS1,tls1,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,,
CiphersSpecific,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test version,,,,,,,,,
Version,All,,,::tls::version,,glob,*,,,
Version,OpenSSL,OpenSSL,,::tls::version,,glob,OpenSSL*,,,

Deleted tests/ciphers.test version [212c1bf055].

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Auto generated test cases for ciphers_and_protocols.csv

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

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

package require tls

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

# Constraints
set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3]
foreach protocol $protocols {::tcltest::testConstraint $protocol 0}
foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1}
::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]]
# Helper functions
proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]}
proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]}
# Test protocols


test Protocols-1.1 {All} -body {
	lcompare $protocols [::tls::protocols]
    } -result {missing {ssl2 ssl3} unexpected {}}
# Test ciphers


test CiphersAll-2.1 {SSL2} -constraints {ssl2} -body {
	lcompare [exec_get ":" ciphers -ssl2] [::tls::ciphers ssl2]
    } -result {missing {} unexpected {}}

test CiphersAll-2.2 {SSL3} -constraints {ssl3} -body {
	lcompare [exec_get ":" ciphers -ssl3] [::tls::ciphers ssl3]
    } -result {missing {} unexpected {}}

test CiphersAll-2.3 {TLS1} -constraints {tls1} -body {
	lcompare [exec_get ":" ciphers -tls1] [::tls::ciphers tls1]
    } -result {missing {} unexpected {}}

test CiphersAll-2.4 {TLS1.1} -constraints {tls1.1} -body {
	lcompare [exec_get ":" ciphers -tls1_1] [::tls::ciphers tls1.1]
    } -result {missing {} unexpected {}}

test CiphersAll-2.5 {TLS1.2} -constraints {tls1.2} -body {
	lcompare [exec_get ":" ciphers -tls1_2] [::tls::ciphers tls1.2]
    } -result {missing {} unexpected {}}

test CiphersAll-2.6 {TLS1.3} -constraints {tls1.3} -body {
	lcompare [exec_get ":" ciphers -tls1_3] [::tls::ciphers tls1.3]
    } -result {missing {} unexpected {}}
# Test cipher descriptions


test CiphersDesc-3.1 {SSL2} -constraints {ssl2} -body {
	lcompare [exec_get "\r\n" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]
    } -result {missing {} unexpected {}}

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

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

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

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

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


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

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

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

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

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

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


test Version-5.1 {All} -body {
	::tls::version
    } -match {glob} -result {*}

test Version-5.2 {OpenSSL} -constraints {OpenSSL} -body {
	::tls::version
    } -match {glob} -result {OpenSSL*}

# Cleanup
::tcltest::cleanupTests
return

Added tests/common.tcl version [019f917847].























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

# Common Constraints
package require tls

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

foreach protocol [::tls::protocols] {
    ::tcltest::testConstraint $protocol 1
    ::tcltest::testConstraint !$protocol 0
}

# OpenSSL version
::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]]

# Legacy OpenSSL v1.1.1 vs new v3.x
scan [lindex [split [::tls::version]] 1] %f version
::tcltest::testConstraint new_api [expr {$version >= 3.0}]

Added tests/digest.csv version [e953e823d3].






















































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,::tcltest::testConstraint md4 [expr {"md4" in [::tls::digests]}],,,,,,,,,
,,,,,,,,,,
command,# Helper functions - See common.tcl,,,,,,,,,
command,proc digest_read_chan {cmd filename args} {;set ch [open $filename rb];set bsize [fconfigure $ch -buffersize];set new [$cmd {*}$args -chan $ch];while {![eof $new]} {set md [read $new $bsize]};close $new;return $md},,,,,,,,,
command,proc digest_write_chan {cmd filename data args} {;set ch [open $filename wb];set new [$cmd {*}$args -chan $ch];puts -nonewline $new $data;flush $new;close $new;set ch [open $filename rb];set md [read $ch];close $ch;return $md},,,,,,,,,
command,proc digest_accumulate {string args} {;set cmd [{*}$args -command dcmd]; $cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},,,,,,,,
,,,,,,,,,,
command,"set test_data ""Example string for message digest tests.\n""",,,,,,,,,
command,"set test_file ""md_data.dat""",,,,,,,,,
command,"set test_alt_file ""md_alt_data.dat""",,,,,,,,,
command,"set test_key ""Example key""",,,,,,,,,
command,::tcltest::makeFile $test_data $test_file,,,,,,,,,
,,,,,,,,,,
command,# Test short-cut commands,,,,,,,,,
Shortcut Cmds,md4 cmd,md4,,::tls::md4 $test_data,,,793399f792eca2752c6af3234ba70858,,,
Shortcut Cmds,md5 cmd,,,::tls::md5 $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
Shortcut Cmds,sha1 cmd,,,::tls::sha1 $test_data,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
Shortcut Cmds,sha256 cmd,,,::tls::sha256 $test_data,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
Shortcut Cmds,sha512 cmd,,,::tls::sha512 $test_data,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
,,,,,,,,,,
,,,,,,,,,,
command,# Test MD command for read channel,,,,,,,,,
MD Chan Read,md4,md4,,digest_read_chan ::tls::md $test_file -digest md4,,,793399f792eca2752c6af3234ba70858,,,
MD Chan Read,md5,,,digest_read_chan ::tls::md $test_file -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Chan Read,sha1,,,digest_read_chan ::tls::md $test_file -digest sha1,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
MD Chan Read,sha256,,,digest_read_chan ::tls::md $test_file -digest sha256,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
MD Chan Read,sha512,,,digest_read_chan ::tls::md $test_file -digest sha512,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
MD Chan Read,md5 bin,,,binary encode hex [digest_read_chan ::tls::md $test_file -bin -digest md5],,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Chan Read,md5 hex,,,digest_read_chan ::tls::md $test_file -hex -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
,,,,,,,,,,
command,# Test MD command for write channel,,,,,,,,,
MD Chan Write,md4,md4,,digest_write_chan ::tls::md $test_alt_file $test_data -digest md4,,,793399f792eca2752c6af3234ba70858,,,
MD Chan Write,md5,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Chan Write,sha1,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest sha1,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
MD Chan Write,sha256,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest sha256,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
MD Chan Write,sha512,,,digest_write_chan ::tls::md $test_alt_file $test_data -digest sha512,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
MD Chan Write,md5 bin,,,binary encode hex [digest_write_chan ::tls::md $test_alt_file $test_data -bin -digest md5],,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Chan Write,md5 hex,,,digest_write_chan ::tls::md $test_alt_file $test_data -hex -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
,,,,,,,,,,
command,# Test MD command for object command,,,,,,,,,
MD Command,md4,md4,,digest_accumulate $test_data ::tls::md -digest md4,,,793399f792eca2752c6af3234ba70858,,,
MD Command,md5,,,digest_accumulate $test_data ::tls::md -digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Command,sha1,,,digest_accumulate $test_data ::tls::md -digest sha1,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
MD Command,sha256,,,digest_accumulate $test_data ::tls::md -digest sha256,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
MD Command,sha512,,,digest_accumulate $test_data ::tls::md -digest sha512,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
MD Command,md5 bin,,,binary encode hex [digest_accumulate $test_data ::tls::md -digest md5 -bin],,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Command,md5 hex,,,digest_accumulate $test_data ::tls::md -digest md5 -hex,,,962bf0803b4232ec23bd8427bb94ea09,,,
,,,,,,,,,,
command,# Test MD command for data shortcut,,,,,,,,,
MD Shortcut,md4,md4,,::tls::md md4 $test_data,,,793399f792eca2752c6af3234ba70858,,,
MD Shortcut,md5,,,::tls::md md5 $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Shortcut,sha1,,,::tls::md sha1 $test_data,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
MD Shortcut,sha256,,,::tls::md sha256 $test_data,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
MD Shortcut,sha512,,,::tls::md sha512 $test_data,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
,,,,,,,,,,
command,# Test MD command for data,,,,,,,,,
MD Data,md4,md4,,::tls::md -digest md4 -data $test_data,,,793399f792eca2752c6af3234ba70858,,,
MD Data,md5,,,::tls::md -digest md5 -data $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Data,sha1,,,::tls::md -digest sha1 -data $test_data,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
MD Data,sha256,,,::tls::md -digest sha256 -data $test_data,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
MD Data,sha512,,,::tls::md -digest sha512 -data $test_data,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
MD Data,md5 bin,,,binary encode hex [::tls::md -digest md5 -data $test_data -bin],,,962bf0803b4232ec23bd8427bb94ea09,,,
MD Data,md5 hex,,,::tls::md -digest md5 -data $test_data -hex,,,962bf0803b4232ec23bd8427bb94ea09,,,
,,,,,,,,,,
command,# Test MD command for file,,,,,,,,,
MD File,md4,md4,,::tls::md -digest md4 -file $test_file,,,793399f792eca2752c6af3234ba70858,,,
MD File,md5,,,::tls::md -digest md5 -file $test_file,,,962bf0803b4232ec23bd8427bb94ea09,,,
MD File,sha1,,,::tls::md -digest sha1 -file $test_file,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
MD File,sha256,,,::tls::md -digest sha256 -file $test_file,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
MD File,sha512,,,::tls::md -digest sha512 -file $test_file,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
MD File,md5 bin,,,binary encode hex [::tls::md -digest md5 -file $test_file -bin],,,962bf0803b4232ec23bd8427bb94ea09,,,
MD File,md5 hex,,,::tls::md -digest md5 -file $test_file -hex,,,962bf0803b4232ec23bd8427bb94ea09,,,
,,,,,,,,,,
command,# MD Error Cases,,,,,,,,,
MD Errors,Too few args,,,::tls::md,,,"wrong # args: should be ""::tls::md ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
MD Errors,Too many args,,,::tls::md too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::md ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
MD Errors,Invalid digest,,,::tls::md bogus data,,,"invalid digest ""bogus""",,,1
MD Errors,Invalid digest Arg,,,::tls::md -digest bogus -data data,,,"invalid digest ""bogus""",,,1
MD Errors,No digest,,,::tls::md -hex -data value,,,no digest,,,1
MD Errors,Invalid option,,,::tls::md -digest sha256 -bogus value,,,"bad option ""-bogus"": must be -bin, -binary, -hex, -hexadecimal, -chan, -channel, -cipher, -command, -data, -digest, -file, -filename, -hash, -key, or -mac",,,1
MD Errors,Invalid file,,,::tls::md -digest sha256 -file bogus,,,"couldn't open ""bogus"": no such file or directory",,,1
MD Errors,Invalid channel,,,::tls::md -digest sha256 -channel bogus,,,"can not find channel named ""bogus""",,,1
MD Errors,No operation,,,::tls::md -digest sha256 -bin,,,"No operation: Use -channel, -command, -data, or -file option",,,1
,,,,,,,,,,
,,,,,,,,,,
command,# Test CMAC command,,,,,,,,,
command,"set test_cipher ""aes-128-cbc""",,,,,,,,,
command,"set test_key ""Example key 1234""",,,,,,,,,
CMAC,data,,,::tls::cmac -cipher $test_cipher -key $test_key -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
CMAC,file,,,::tls::cmac -cipher $test_cipher -key $test_key -file $test_file,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
CMAC,channel,,,digest_read_chan ::tls::cmac $test_file -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
CMAC,command,,,digest_accumulate $test_data ::tls::cmac -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
CMAC,data bin,,,binary encode hex [::tls::cmac -bin -cipher $test_cipher -key $test_key -data $test_data],,,baf5c20f9973e2d606b14c7efdfe52fa,,,
,,,,,,,,,,
command,# Test MD CMAC,,,,,,,,,
MD CMAC,data,,,::tls::md -cipher $test_cipher -key $test_key -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
MD CMAC,file,,,::tls::md -cipher $test_cipher -key $test_key -file $test_file,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
MD CMAC,channel,,,digest_read_chan ::tls::md $test_file -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
MD CMAC,command,,,digest_accumulate $test_data ::tls::md -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
MD CMAC,data bin,,,binary encode hex [::tls::md -bin -cipher $test_cipher -key $test_key -data $test_data],,,baf5c20f9973e2d606b14c7efdfe52fa,,,
,,,,,,,,,,
command,# Test CMAC Shortcut,,,,,,,,,
CMAC Shortcut,data,,,::tls::cmac $test_cipher -key $test_key $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
,,,,,,,,,,
command,# CMAC Error Cases,,,,,,,,,
CMAC Errors,Too few args,,,::tls::cmac,,,"wrong # args: should be ""::tls::cmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
CMAC Errors,Too many args,,,::tls::cmac too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::cmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
CMAC Errors,No cipher,,,::tls::cmac -hex -data $test_data,,,no cipher,,,1
CMAC Errors,No key,,,::tls::cmac -cipher $test_cipher -data $test_data,,,no key,,,1
CMAC Errors,Invalid cipher,,,::tls::cmac -cipher bogus -data $test_data,,,"invalid cipher ""bogus""",,,1
,,,,,,,,,,
,,,,,,,,,,
command,# Test HMAC command,,,,,,,,,
command,set test_digest md5,,,,,,,,,
command,"set test_key ""Example key""",,,,,,,,,
HMAC,data,,,::tls::hmac -digest $test_digest -key $test_key -data $test_data,,,f98327ef3e20ab6d388f676c6a79d93d,,,
HMAC,file,,,::tls::hmac -digest $test_digest -key $test_key -file $test_file,,,f98327ef3e20ab6d388f676c6a79d93d,,,
HMAC,channel,,,digest_read_chan ::tls::hmac $test_file -digest $test_digest -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
HMAC,command,,,digest_accumulate $test_data ::tls::hmac -digest $test_digest -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
HMAC,data bin,,,binary encode hex [::tls::hmac -digest $test_digest -bin -key $test_key -data $test_data],,,f98327ef3e20ab6d388f676c6a79d93d,,,
,,,,,,,,,,
command,# Test MD HMAC,,,,,,,,,
MD HMAC,data,,,::tls::md -digest $test_digest -key $test_key -data $test_data,,,f98327ef3e20ab6d388f676c6a79d93d,,,
MD HMAC,file,,,::tls::md -digest $test_digest -key $test_key -file $test_file,,,f98327ef3e20ab6d388f676c6a79d93d,,,
MD HMAC,channel,,,digest_read_chan ::tls::md $test_file -digest $test_digest -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
MD HMAC,command,,,digest_accumulate $test_data ::tls::md -digest $test_digest -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
MD HMAC,data bin,,,binary encode hex [::tls::md -digest $test_digest -bin -key $test_key -data $test_data],,,f98327ef3e20ab6d388f676c6a79d93d,,,
,,,,,,,,,,
command,# Test HMAC Shortcut,,,,,,,,,
HMAC Shortcut,data,,,::tls::hmac $test_digest -key $test_key $test_data,,,f98327ef3e20ab6d388f676c6a79d93d,,,
,,,,,,,,,,
command,# HMAC Error Cases,,,,,,,,,
HMAC Errors,Too few args,,,::tls::hmac,,,"wrong # args: should be ""::tls::hmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
HMAC Errors,Too many args,,,::tls::hmac too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::hmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
HMAC Errors,No digest,,,::tls::hmac -hex -data $test_data,,,no digest,,,1
HMAC Errors,No key,,,::tls::hmac -digest sha256 -data $test_data,,,no key,,,1
HMAC Errors,Invalid digest,,,::tls::md -digest bogus -key $test_key -data $test_data,,,"invalid digest ""bogus""",,,1
,,,,,,,,,,
,,,,,,,,,,
command,# Test MAC command,,,,,,,,,
command,"set test_cipher ""aes-128-cbc""",,,,,,,,,
command,set test_digest sha256,,,,,,,,,
command,"set test_key ""Example key 1234""",,,,,,,,,
MAC,CMAC,,,::tls::mac -cipher $test_cipher -key $test_key -mac cmac -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
MAC,HMAC,,,::tls::mac -digest $test_digest -key $test_key -mac hmac -data $test_data,,,676daf96370d0e3c5598557da38a9a810a4fbacbb2d10c67f6dfa83f10f48e96,,,
MAC,MD-CMAC,,,::tls::md -cipher $test_cipher -key $test_key -mac cmac -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
MAC,MD-HMAC,,,::tls::md -digest $test_digest -key $test_key -mac hmac -data $test_data,,,676daf96370d0e3c5598557da38a9a810a4fbacbb2d10c67f6dfa83f10f48e96,,,
,,,,,,,,,,
command,# MAC Error Cases,,,,,,,,,
MAC Errors,Too few args,,,::tls::mac,,,"wrong # args: should be ""::tls::mac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
MAC Errors,No mac,,,::tls::mac -key $test_key -data $test_data,,,no MAC,,,1
MAC Errors,No key,,,::tls::mac -mac hmac -digest $test_digest -data $test_data,,,no key,,,1
MAC Errors,Invalid MAC,,,::tls::mac -mac bogus -key $test_key -data $test_data,,,"invalid MAC ""bogus""",,,1
MAC Errors,Too many args,,,::tls::mac too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::mac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
,,,,,,,,,,
,,,,,,,,,,
command,# RFC 1321 Message Digest 5,,,,,,,,,
RFC1321-MD5,TC1,,,"::tls::md -digest md5 -data """"",,,d41d8cd98f00b204e9800998ecf8427e,,,
RFC1321-MD5,TC2,,,"::tls::md -digest md5 -data ""a""",,,0cc175b9c0f1b6a831c399e269772661,,,
RFC1321-MD5,TC3,,,"::tls::md -digest md5 -data ""abc""",,,900150983cd24fb0d6963f7d28e17f72,,,
RFC1321-MD5,TC4,,,"::tls::md -digest md5 -data ""message digest""",,,f96b697d7cb7938d525a2f31aaf161d0,,,
RFC1321-MD5,TC5,,,"::tls::md -digest md5 -data ""abcdefghijklmnopqrstuvwxyz""",,,c3fcd3d76192e4007dfb496cca67e13b,,,
RFC1321-MD5,TC6,,,"::tls::md -digest md5 -data ""ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789""",,,d174ab98d277d9f5a5611c2c9f419d9f,,,
RFC1321-MD5,TC7,,,"::tls::md -digest md5 -data [string repeat ""1234567890"" 8]",,,57edf4a22be3c955ac49da2e2107b67a,,,
,,,,,,,,,,
command,# RFC 6234 SHA1,,,,,,,,,
RFC6234-MD-SHA1,TC1,,,"::tls::md -digest sha1 -data ""abc""",,,a9993e364706816aba3e25717850c26c9cd0d89d,,,
RFC6234-MD-SHA1,TC2_1,,,"::tls::md -digest sha1 -data ""abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq""",,,84983e441c3bd26ebaae4aa1f95129e5e54670f1,,,
RFC6234-MD-SHA1,TC3,,,"::tls::md -digest sha1 -data [string repeat ""a"" 1000000]",,,34aa973cd4c4daa4f61eeb2bdbad27316534016f,,,
RFC6234-MD-SHA1,TC4,,,"::tls::md -digest sha1 -data [string repeat ""01234567"" 80]",,,dea356a2cddd90c7a7ecedc5ebb563934f460452,,,
RFC6234-MD-SHA1,TC6,,,"::tls::md -digest sha1 -data ""\x5e""",,,5e6f80a34a9798cafc6a5db96cc57ba4c4db59c2,,,
RFC6234-MD-SHA1,TC8_1,,,"::tls::md -digest sha1 -data ""\x9a\x7d\xfd\xf1\xec\xea\xd0\x6e\xd6\x46\xaa\x55\xfe\x75\x71\x46""",,,82abff6605dbe1c17def12a394fa22a82b544a35,,,
RFC6234-MD-SHA1,TC10_1,,,"::tls::md -digest sha1 -data ""\xf7\x8f\x92\x14\x1b\xcd\x17\x0a\xe8\x9b\x4f\xba\x15\xa1\xd5\x9f\x3f\xd8\x4d\x22\x3c\x92\x51\xbd\xac\xbb\xae\x61\xd0\x5e\xd1\x15\xa0\x6a\x7c\xe1\x17\xb7\xbe\xea\xd2\x44\x21\xde\xd9\xc3\x25\x92\xbd\x57\xed\xea\xe3\x9c\x39\xfa\x1f\xe8\x94\x6a\x84\xd0\xcf\x1f\x7b\xee\xad\x17\x13\xe2\xe0\x95\x98\x97\x34\x7f\x67\xc8\x0b\x04\x00\xc2\x09\x81\x5d\x6b\x10\xa6\x83\x83\x6f\xd5\x56\x2a\x56\xca\xb1\xa2\x8e\x81\xb6\x57\x66\x54\x63\x1c\xf1\x65\x66\xb8\x6e\x3b\x33\xa1\x08\xb0\x53\x07\xc0\x0a\xff\x14\xa7\x68\xed\x73\x50\x60\x6a\x0f\x85\xe6\xa9\x1d\x39\x6f\x5b\x5c\xbe\x57\x7f\x9b\x38\x80\x7c\x7d\x52\x3d\x6d\x79\x2f\x6e\xbc\x24\xa4\xec\xf2\xb3\xa4\x27\xcd\xbb\xfb""",,,cb0082c8f197d260991ba6a460e76e202bad27b3,,,
,,,,,,,,,,
command,# RFC 6234 SHA256,,,,,,,,,
RFC6234-MD-SHA256,TC1,,,"::tls::md -digest sha256 -data ""abc""",,,ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad,,,
RFC6234-MD-SHA256,TC2_1,,,"::tls::md -digest sha256 -data ""abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq""",,,248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1,,,
RFC6234-MD-SHA256,TC3,,,"::tls::md -digest sha256 -data [string repeat ""a"" 1000000]",,,cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0,,,
RFC6234-MD-SHA256,TC4,,,"::tls::md -digest sha256 -data [string repeat ""01234567"" 80]",,,594847328451bdfa85056225462cc1d867d877fb388df0ce35f25ab5562bfbb5,,,
RFC6234-MD-SHA256,TC6,,,"::tls::md -digest sha256 -data ""\x19""",,,68aa2e2ee5dff96e3355e6c7ee373e3d6a4e17f75f9518d843709c0c9bc3e3d4,,,
RFC6234-MD-SHA256,TC8_256,,,"::tls::md -digest sha256 -data ""\xe3\xd7\x25\x70\xdc\xdd\x78\x7c\xe3\x88\x7a\xb2\xcd\x68\x46\x52""",,,175ee69b02ba9b58e2b0a5fd13819cea573f3940a94f825128cf4209beabb4e8,,,
RFC6234-MD-SHA256,TC10_256,,,"::tls::md -digest sha256 -data ""\x83\x26\x75\x4e\x22\x77\x37\x2f\x4f\xc1\x2b\x20\x52\x7a\xfe\xf0\x4d\x8a\x05\x69\x71\xb1\x1a\xd5\x71\x23\xa7\xc1\x37\x76\x00\x00\xd7\xbe\xf6\xf3\xc1\xf7\xa9\x08\x3a\xa3\x9d\x81\x0d\xb3\x10\x77\x7d\xab\x8b\x1e\x7f\x02\xb8\x4a\x26\xc7\x73\x32\x5f\x8b\x23\x74\xde\x7a\x4b\x5a\x58\xcb\x5c\x5c\xf3\x5b\xce\xe6\xfb\x94\x6e\x5b\xd6\x94\xfa\x59\x3a\x8b\xeb\x3f\x9d\x65\x92\xec\xed\xaa\x66\xca\x82\xa2\x9d\x0c\x51\xbc\xf9\x33\x62\x30\xe5\xd7\x84\xe4\xc0\xa4\x3f\x8d\x79\xa3\x0a\x16\x5c\xba\xbe\x45\x2b\x77\x4b\x9c\x71\x09\xa9\x7d\x13\x8f\x12\x92\x28\x96\x6f\x6c\x0a\xdc\x10\x6a\xad\x5a\x9f\xdd\x30\x82\x57\x69\xb2\xc6\x71\xaf\x67\x59\xdf\x28\xeb\x39\x3d\x54\xd6""",,,97dbca7df46d62c8a422c941dd7e835b8ad3361763f7e9b2d95f4f0da6e1ccbc,,,
,,,,,,,,,,
command,# RFC 4231 HMAC Examples Test Case #1,,,,,,,,,
command,"set key [binary decode hex [string repeat ""0b"" 20]]",,,,,,,,,
command,"set data ""Hi There""",,,,,,,,,
RFC4231 HMAC TC1,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,896fb1128abbdf196832107cd49df33f47b4b1169912ba4f53684b22,,,
RFC4231 HMAC TC1,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7,,,
RFC4231 HMAC TC1,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6,,,
RFC4231 HMAC TC1,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854,,,
,,,,,,,,,,
command,# RFC 4231 HMAC Examples Test Case #2 - Test with a key shorter than the length of the HMAC output.,,,,,,,,,
command,"set key ""Jefe""",,,,,,,,,
command,"set data ""what do ya want for nothing?""",,,,,,,,,
RFC4231 HMAC TC2,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44,,,
RFC4231 HMAC TC2,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843,,,
RFC4231 HMAC TC2,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649,,,
RFC4231 HMAC TC2,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737,,,
,,,,,,,,,,
command,# RFC 4231 HMAC Examples Test Case #3 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).,,,,,,,,,
command,"set key [binary decode hex [string repeat ""aa"" 20]]",,,,,,,,,
command,"set data [binary decode hex [string repeat ""dd"" 50]]",,,,,,,,,
RFC4231 HMAC TC3,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,7fb3cb3588c6c1f6ffa9694d7d6ad2649365b0c1f65d69d1ec8333ea,,,
RFC4231 HMAC TC3,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe,,,
RFC4231 HMAC TC3,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27,,,
RFC4231 HMAC TC3,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb,,,
,,,,,,,,,,
command,# RFC 4231 HMAC Examples Test Case #4 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).,,,,,,,,,
command,"set key [binary decode hex ""0102030405060708090a0b0c0d0e0f10111213141516171819""]",,,,,,,,,
command,"set data [binary decode hex [string repeat ""cd"" 50]]",,,,,,,,,
RFC4231 HMAC TC4,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,6c11506874013cac6a2abc1bb382627cec6a90d86efc012de7afec5a,,,
RFC4231 HMAC TC4,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b,,,
RFC4231 HMAC TC4,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb,,,
RFC4231 HMAC TC4,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd,,,
,,,,,,,,,,
command,# RFC 4231 HMAC Examples Test Case #5 - Test with a truncation of output to 128 bits.,,,,,,,,,
command,"set key [binary decode hex [string repeat ""0c"" 20]]",,,,,,,,,
command,"set data ""Test With Truncation""",,,,,,,,,
RFC4231 HMAC TC5,sha224,,,string range [::tls::hmac -digest sha224 -key $key -data $data] 0 31,,,0e2aea68a90c8d37c988bcdb9fca6fa8,,,
RFC4231 HMAC TC5,sha256,,,string range [::tls::hmac -digest sha256 -key $key -data $data] 0 31,,,a3b6167473100ee06e0c796c2955552b,,,
RFC4231 HMAC TC5,sha384,,,string range [::tls::hmac -digest sha384 -key $key -data $data] 0 31,,,3abf34c3503b2a23a46efc619baef897,,,
RFC4231 HMAC TC5,sha512,,,string range [::tls::hmac -digest sha512 -key $key -data $data] 0 31,,,415fad6271580a531d4179bc891d87a6,,,
,,,,,,,,,,
command,# RFC 4231 HMAC Examples Test Case #6 - Test with a key larger than 128 bytes (= block-size of SHA-384 and SHA-512).,,,,,,,,,
command,"set key [binary decode hex [string repeat ""aa"" 131]]",,,,,,,,,
command,"set data ""Test Using Larger Than Block-Size Key - Hash Key First""",,,,,,,,,
RFC4231 HMAC TC6,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,95e9a0db962095adaebe9b2d6f0dbce2d499f112f2d2b7273fa6870e,,,
RFC4231 HMAC TC6,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54,,,
RFC4231 HMAC TC6,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952,,,
RFC4231 HMAC TC6,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598,,,
,,,,,,,,,,
command,# RFC 4231 HMAC Examples Test Case #7 - Test with a key and data that is larger than 128 bytes (= block-size of SHA-384 and SHA-512).,,,,,,,,,
command,"set key [binary decode hex [string repeat ""aa"" 131]]",,,,,,,,,
command,"set data ""This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm.""",,,,,,,,,
RFC4231 HMAC TC7,sha224,,,::tls::hmac -digest sha224 -key $key -data $data,,,3a854166ac5d9f023f54d517d0b39dbd946770db9c2b95c9f6f565d1,,,
RFC4231 HMAC TC7,sha256,,,::tls::hmac -digest sha256 -key $key -data $data,,,9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2,,,
RFC4231 HMAC TC7,sha384,,,::tls::hmac -digest sha384 -key $key -data $data,,,6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e,,,
RFC4231 HMAC TC7,sha512,,,::tls::hmac -digest sha512 -key $key -data $data,,,e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58,,,
,,,,,,,,,,
command,# NIST 800-38b Recommendation for Block Cipher Modes of Operation: The CMAC Mode for Authentication,,,,,,,,,
command,# AES-128,,,,,,,,,
command,"set key [binary decode hex ""2b7e151628aed2a6abf7158809cf4f3c""]",,,,,,,,,
NIST800-38b-AES128,len=0,,,"::tls::cmac -cipher aes-128-cbc -key $key -data """"",,,bb1d6929e95937287fa37d129b756746,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172a""]",,,,,,,,,
NIST800-38b-AES128,len=128,,,::tls::cmac -cipher aes-128-cbc -key $key -data $data,,,070a16b46b4d4144f79bdd9dd04a287c,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411""]",,,,,,,,,
NIST800-38b-AES128,len=320,,,::tls::cmac -cipher aes-128-cbc -key $key -data $data,,,dfa66747de9ae63030ca32611497c827,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710""]",,,,,,,,,
NIST800-38b-AES128,len=512,,,::tls::cmac -cipher aes-128-cbc -key $key -data $data,,,51f0bebf7e3b9d92fc49741779363cfe,,,
,,,,,,,,,,
command,# AES-192,,,,,,,,,
command,"set key [binary decode hex ""8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b""]",,,,,,,,,
NIST800-38b-AES-192,len=0,,,"::tls::cmac -cipher aes-192-cbc -key $key -data """"",,,d17ddf46adaacde531cac483de7a9367,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172a""]",,,,,,,,,
NIST800-38b-AES-192,len=128,,,::tls::cmac -cipher aes-192-cbc -key $key -data $data,,,9e99a7bf31e710900662f65e617c5184,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411""]",,,,,,,,,
NIST800-38b-AES-192,len=320,,,::tls::cmac -cipher aes-192-cbc -key $key -data $data,,,8a1de5be2eb31aad089a82e6ee908b0e,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710""]",,,,,,,,,
NIST800-38b-AES-192,len=512,,,::tls::cmac -cipher aes-192-cbc -key $key -data $data,,,a1d5df0eed790f794d77589659f39a11,,,
,,,,,,,,,,
command,# AES-256,,,,,,,,,
command,"set key [binary decode hex ""603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4""]",,,,,,,,,
NIST800-38b-AES-256,len=0,,,"::tls::cmac -cipher aes-256-cbc -key $key -data """"",,,028962f61b7bf89efc6b551f4667d983,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172a""]",,,,,,,,,
NIST800-38b-AES-256,len=128,,,::tls::cmac -cipher aes-256-cbc -key $key -data $data,,,28a7023f452e8f82bd4bf28d8c37c35c,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411""]",,,,,,,,,
NIST800-38b-AES-256,len=320,,,::tls::cmac -cipher aes-256-cbc -key $key -data $data,,,aaf3d8f1de5640c232f5b169b9c911e6,,,
command,"set data [binary decode hex ""6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710""]",,,,,,,,,
NIST800-38b-AES-256,len=512,,,::tls::cmac -cipher aes-256-cbc -key $key -data $data,,,e1992190549f6ed5696a2c056c315410,,,
,,,,,,,,,,
command,# Cleanup,,,,,,,,,
command,::tcltest::removeFile $test_file,,,,,,,,,
command,::tcltest::removeFile $test_alt_file,,,,,,,,,

Added tests/digest.test version [ee7d628a1a].






















































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated test cases for digest.csv

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

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

package require tls

# Constraints
::tcltest::testConstraint md4 [expr {"md4" in [::tls::digests]}]

# Helper functions - See common.tcl
proc digest_read_chan {cmd filename args} {;set ch [open $filename rb];set bsize [fconfigure $ch -buffersize];set new [$cmd {*}$args -chan $ch];while {![eof $new]} {set md [read $new $bsize]};close $new;return $md}
proc digest_write_chan {cmd filename data args} {;set ch [open $filename wb];set new [$cmd {*}$args -chan $ch];puts -nonewline $new $data;flush $new;close $new;set ch [open $filename rb];set md [read $ch];close $ch;return $md}
proc digest_accumulate {string args} {;set cmd [{*}$args -command dcmd]; $cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]}

set test_data "Example string for message digest tests.\n"
set test_file "md_data.dat"
set test_alt_file "md_alt_data.dat"
set test_key "Example key"
::tcltest::makeFile $test_data $test_file

# Test short-cut commands


test Shortcut_Cmds-1.1 {md4 cmd} -constraints {md4} -body {
	::tls::md4 $test_data
    } -result {793399f792eca2752c6af3234ba70858}

test Shortcut_Cmds-1.2 {md5 cmd} -body {
	::tls::md5 $test_data
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test Shortcut_Cmds-1.3 {sha1 cmd} -body {
	::tls::sha1 $test_data
    } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}

test Shortcut_Cmds-1.4 {sha256 cmd} -body {
	::tls::sha256 $test_data
    } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}

test Shortcut_Cmds-1.5 {sha512 cmd} -body {
	::tls::sha512 $test_data
    } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}


# Test MD command for read channel


test MD_Chan_Read-2.1 {md4} -constraints {md4} -body {
	digest_read_chan ::tls::md $test_file -digest md4
    } -result {793399f792eca2752c6af3234ba70858}

test MD_Chan_Read-2.2 {md5} -body {
	digest_read_chan ::tls::md $test_file -digest md5
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Chan_Read-2.3 {sha1} -body {
	digest_read_chan ::tls::md $test_file -digest sha1
    } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}

test MD_Chan_Read-2.4 {sha256} -body {
	digest_read_chan ::tls::md $test_file -digest sha256
    } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}

test MD_Chan_Read-2.5 {sha512} -body {
	digest_read_chan ::tls::md $test_file -digest sha512
    } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}

test MD_Chan_Read-2.6 {md5 bin} -body {
	binary encode hex [digest_read_chan ::tls::md $test_file -bin -digest md5]
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Chan_Read-2.7 {md5 hex} -body {
	digest_read_chan ::tls::md $test_file -hex -digest md5
    } -result {962bf0803b4232ec23bd8427bb94ea09}

# Test MD command for write channel


test MD_Chan_Write-3.1 {md4} -constraints {md4} -body {
	digest_write_chan ::tls::md $test_alt_file $test_data -digest md4
    } -result {793399f792eca2752c6af3234ba70858}

test MD_Chan_Write-3.2 {md5} -body {
	digest_write_chan ::tls::md $test_alt_file $test_data -digest md5
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Chan_Write-3.3 {sha1} -body {
	digest_write_chan ::tls::md $test_alt_file $test_data -digest sha1
    } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}

test MD_Chan_Write-3.4 {sha256} -body {
	digest_write_chan ::tls::md $test_alt_file $test_data -digest sha256
    } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}

test MD_Chan_Write-3.5 {sha512} -body {
	digest_write_chan ::tls::md $test_alt_file $test_data -digest sha512
    } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}

test MD_Chan_Write-3.6 {md5 bin} -body {
	binary encode hex [digest_write_chan ::tls::md $test_alt_file $test_data -bin -digest md5]
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Chan_Write-3.7 {md5 hex} -body {
	digest_write_chan ::tls::md $test_alt_file $test_data -hex -digest md5
    } -result {962bf0803b4232ec23bd8427bb94ea09}

# Test MD command for object command


test MD_Command-4.1 {md4} -constraints {md4} -body {
	digest_accumulate $test_data ::tls::md -digest md4
    } -result {793399f792eca2752c6af3234ba70858}

test MD_Command-4.2 {md5} -body {
	digest_accumulate $test_data ::tls::md -digest md5
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Command-4.3 {sha1} -body {
	digest_accumulate $test_data ::tls::md -digest sha1
    } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}

test MD_Command-4.4 {sha256} -body {
	digest_accumulate $test_data ::tls::md -digest sha256
    } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}

test MD_Command-4.5 {sha512} -body {
	digest_accumulate $test_data ::tls::md -digest sha512
    } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}

test MD_Command-4.6 {md5 bin} -body {
	binary encode hex [digest_accumulate $test_data ::tls::md -digest md5 -bin]
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Command-4.7 {md5 hex} -body {
	digest_accumulate $test_data ::tls::md -digest md5 -hex
    } -result {962bf0803b4232ec23bd8427bb94ea09}

# Test MD command for data shortcut


test MD_Shortcut-5.1 {md4} -constraints {md4} -body {
	::tls::md md4 $test_data
    } -result {793399f792eca2752c6af3234ba70858}

test MD_Shortcut-5.2 {md5} -body {
	::tls::md md5 $test_data
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Shortcut-5.3 {sha1} -body {
	::tls::md sha1 $test_data
    } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}

test MD_Shortcut-5.4 {sha256} -body {
	::tls::md sha256 $test_data
    } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}

test MD_Shortcut-5.5 {sha512} -body {
	::tls::md sha512 $test_data
    } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}

# Test MD command for data


test MD_Data-6.1 {md4} -constraints {md4} -body {
	::tls::md -digest md4 -data $test_data
    } -result {793399f792eca2752c6af3234ba70858}

test MD_Data-6.2 {md5} -body {
	::tls::md -digest md5 -data $test_data
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Data-6.3 {sha1} -body {
	::tls::md -digest sha1 -data $test_data
    } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}

test MD_Data-6.4 {sha256} -body {
	::tls::md -digest sha256 -data $test_data
    } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}

test MD_Data-6.5 {sha512} -body {
	::tls::md -digest sha512 -data $test_data
    } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}

test MD_Data-6.6 {md5 bin} -body {
	binary encode hex [::tls::md -digest md5 -data $test_data -bin]
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_Data-6.7 {md5 hex} -body {
	::tls::md -digest md5 -data $test_data -hex
    } -result {962bf0803b4232ec23bd8427bb94ea09}

# Test MD command for file


test MD_File-7.1 {md4} -constraints {md4} -body {
	::tls::md -digest md4 -file $test_file
    } -result {793399f792eca2752c6af3234ba70858}

test MD_File-7.2 {md5} -body {
	::tls::md -digest md5 -file $test_file
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_File-7.3 {sha1} -body {
	::tls::md -digest sha1 -file $test_file
    } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}

test MD_File-7.4 {sha256} -body {
	::tls::md -digest sha256 -file $test_file
    } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}

test MD_File-7.5 {sha512} -body {
	::tls::md -digest sha512 -file $test_file
    } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}

test MD_File-7.6 {md5 bin} -body {
	binary encode hex [::tls::md -digest md5 -file $test_file -bin]
    } -result {962bf0803b4232ec23bd8427bb94ea09}

test MD_File-7.7 {md5 hex} -body {
	::tls::md -digest md5 -file $test_file -hex
    } -result {962bf0803b4232ec23bd8427bb94ea09}

# MD Error Cases


test MD_Errors-8.1 {Too few args} -body {
	::tls::md
    } -result {wrong # args: should be "::tls::md ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}

test MD_Errors-8.2 {Too many args} -body {
	::tls::md too many command line args to pass the test without an error or failing
    } -result {wrong # args: should be "::tls::md ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}

test MD_Errors-8.3 {Invalid digest} -body {
	::tls::md bogus data
    } -result {invalid digest "bogus"} -returnCodes {1}

test MD_Errors-8.4 {Invalid digest Arg} -body {
	::tls::md -digest bogus -data data
    } -result {invalid digest "bogus"} -returnCodes {1}

test MD_Errors-8.5 {No digest} -body {
	::tls::md -hex -data value
    } -result {no digest} -returnCodes {1}

test MD_Errors-8.6 {Invalid option} -body {
	::tls::md -digest sha256 -bogus value
    } -result {bad option "-bogus": must be -bin, -binary, -hex, -hexadecimal, -chan, -channel, -cipher, -command, -data, -digest, -file, -filename, -hash, -key, or -mac} -returnCodes {1}

test MD_Errors-8.7 {Invalid file} -body {
	::tls::md -digest sha256 -file bogus
    } -result {couldn't open "bogus": no such file or directory} -returnCodes {1}

test MD_Errors-8.8 {Invalid channel} -body {
	::tls::md -digest sha256 -channel bogus
    } -result {can not find channel named "bogus"} -returnCodes {1}

test MD_Errors-8.9 {No operation} -body {
	::tls::md -digest sha256 -bin
    } -result {No operation: Use -channel, -command, -data, or -file option} -returnCodes {1}


# Test CMAC command
set test_cipher "aes-128-cbc"
set test_key "Example key 1234"


test CMAC-9.1 {data} -body {
	::tls::cmac -cipher $test_cipher -key $test_key -data $test_data
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test CMAC-9.2 {file} -body {
	::tls::cmac -cipher $test_cipher -key $test_key -file $test_file
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test CMAC-9.3 {channel} -body {
	digest_read_chan ::tls::cmac $test_file -cipher $test_cipher -key $test_key
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test CMAC-9.4 {command} -body {
	digest_accumulate $test_data ::tls::cmac -cipher $test_cipher -key $test_key
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test CMAC-9.5 {data bin} -body {
	binary encode hex [::tls::cmac -bin -cipher $test_cipher -key $test_key -data $test_data]
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

# Test MD CMAC


test MD_CMAC-10.1 {data} -body {
	::tls::md -cipher $test_cipher -key $test_key -data $test_data
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test MD_CMAC-10.2 {file} -body {
	::tls::md -cipher $test_cipher -key $test_key -file $test_file
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test MD_CMAC-10.3 {channel} -body {
	digest_read_chan ::tls::md $test_file -cipher $test_cipher -key $test_key
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test MD_CMAC-10.4 {command} -body {
	digest_accumulate $test_data ::tls::md -cipher $test_cipher -key $test_key
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test MD_CMAC-10.5 {data bin} -body {
	binary encode hex [::tls::md -bin -cipher $test_cipher -key $test_key -data $test_data]
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

# Test CMAC Shortcut


test CMAC_Shortcut-11.1 {data} -body {
	::tls::cmac $test_cipher -key $test_key $test_data
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

# CMAC Error Cases


test CMAC_Errors-12.1 {Too few args} -body {
	::tls::cmac
    } -result {wrong # args: should be "::tls::cmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}

test CMAC_Errors-12.2 {Too many args} -body {
	::tls::cmac too many command line args to pass the test without an error or failing
    } -result {wrong # args: should be "::tls::cmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}

test CMAC_Errors-12.3 {No cipher} -body {
	::tls::cmac -hex -data $test_data
    } -result {no cipher} -returnCodes {1}

test CMAC_Errors-12.4 {No key} -body {
	::tls::cmac -cipher $test_cipher -data $test_data
    } -result {no key} -returnCodes {1}

test CMAC_Errors-12.5 {Invalid cipher} -body {
	::tls::cmac -cipher bogus -data $test_data
    } -result {invalid cipher "bogus"} -returnCodes {1}


# Test HMAC command
set test_digest md5
set test_key "Example key"


test HMAC-13.1 {data} -body {
	::tls::hmac -digest $test_digest -key $test_key -data $test_data
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

test HMAC-13.2 {file} -body {
	::tls::hmac -digest $test_digest -key $test_key -file $test_file
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

test HMAC-13.3 {channel} -body {
	digest_read_chan ::tls::hmac $test_file -digest $test_digest -key $test_key
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

test HMAC-13.4 {command} -body {
	digest_accumulate $test_data ::tls::hmac -digest $test_digest -key $test_key
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

test HMAC-13.5 {data bin} -body {
	binary encode hex [::tls::hmac -digest $test_digest -bin -key $test_key -data $test_data]
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

# Test MD HMAC


test MD_HMAC-14.1 {data} -body {
	::tls::md -digest $test_digest -key $test_key -data $test_data
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

test MD_HMAC-14.2 {file} -body {
	::tls::md -digest $test_digest -key $test_key -file $test_file
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

test MD_HMAC-14.3 {channel} -body {
	digest_read_chan ::tls::md $test_file -digest $test_digest -key $test_key
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

test MD_HMAC-14.4 {command} -body {
	digest_accumulate $test_data ::tls::md -digest $test_digest -key $test_key
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

test MD_HMAC-14.5 {data bin} -body {
	binary encode hex [::tls::md -digest $test_digest -bin -key $test_key -data $test_data]
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

# Test HMAC Shortcut


test HMAC_Shortcut-15.1 {data} -body {
	::tls::hmac $test_digest -key $test_key $test_data
    } -result {f98327ef3e20ab6d388f676c6a79d93d}

# HMAC Error Cases


test HMAC_Errors-16.1 {Too few args} -body {
	::tls::hmac
    } -result {wrong # args: should be "::tls::hmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}

test HMAC_Errors-16.2 {Too many args} -body {
	::tls::hmac too many command line args to pass the test without an error or failing
    } -result {wrong # args: should be "::tls::hmac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}

test HMAC_Errors-16.3 {No digest} -body {
	::tls::hmac -hex -data $test_data
    } -result {no digest} -returnCodes {1}

test HMAC_Errors-16.4 {No key} -body {
	::tls::hmac -digest sha256 -data $test_data
    } -result {no key} -returnCodes {1}

test HMAC_Errors-16.5 {Invalid digest} -body {
	::tls::md -digest bogus -key $test_key -data $test_data
    } -result {invalid digest "bogus"} -returnCodes {1}


# Test MAC command
set test_cipher "aes-128-cbc"
set test_digest sha256
set test_key "Example key 1234"


test MAC-17.1 {CMAC} -body {
	::tls::mac -cipher $test_cipher -key $test_key -mac cmac -data $test_data
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test MAC-17.2 {HMAC} -body {
	::tls::mac -digest $test_digest -key $test_key -mac hmac -data $test_data
    } -result {676daf96370d0e3c5598557da38a9a810a4fbacbb2d10c67f6dfa83f10f48e96}

test MAC-17.3 {MD-CMAC} -body {
	::tls::md -cipher $test_cipher -key $test_key -mac cmac -data $test_data
    } -result {baf5c20f9973e2d606b14c7efdfe52fa}

test MAC-17.4 {MD-HMAC} -body {
	::tls::md -digest $test_digest -key $test_key -mac hmac -data $test_data
    } -result {676daf96370d0e3c5598557da38a9a810a4fbacbb2d10c67f6dfa83f10f48e96}

# MAC Error Cases


test MAC_Errors-18.1 {Too few args} -body {
	::tls::mac
    } -result {wrong # args: should be "::tls::mac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}

test MAC_Errors-18.2 {No mac} -body {
	::tls::mac -key $test_key -data $test_data
    } -result {no MAC} -returnCodes {1}

test MAC_Errors-18.3 {No key} -body {
	::tls::mac -mac hmac -digest $test_digest -data $test_data
    } -result {no key} -returnCodes {1}

test MAC_Errors-18.4 {Invalid MAC} -body {
	::tls::mac -mac bogus -key $test_key -data $test_data
    } -result {invalid MAC "bogus"} -returnCodes {1}

test MAC_Errors-18.5 {Too many args} -body {
	::tls::mac too many command line args to pass the test without an error or failing
    } -result {wrong # args: should be "::tls::mac ?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}


# RFC 1321 Message Digest 5


test RFC1321-MD5-19.1 {TC1} -body {
	::tls::md -digest md5 -data ""
    } -result {d41d8cd98f00b204e9800998ecf8427e}

test RFC1321-MD5-19.2 {TC2} -body {
	::tls::md -digest md5 -data "a"
    } -result {0cc175b9c0f1b6a831c399e269772661}

test RFC1321-MD5-19.3 {TC3} -body {
	::tls::md -digest md5 -data "abc"
    } -result {900150983cd24fb0d6963f7d28e17f72}

test RFC1321-MD5-19.4 {TC4} -body {
	::tls::md -digest md5 -data "message digest"
    } -result {f96b697d7cb7938d525a2f31aaf161d0}

test RFC1321-MD5-19.5 {TC5} -body {
	::tls::md -digest md5 -data "abcdefghijklmnopqrstuvwxyz"
    } -result {c3fcd3d76192e4007dfb496cca67e13b}

test RFC1321-MD5-19.6 {TC6} -body {
	::tls::md -digest md5 -data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
    } -result {d174ab98d277d9f5a5611c2c9f419d9f}

test RFC1321-MD5-19.7 {TC7} -body {
	::tls::md -digest md5 -data [string repeat "1234567890" 8]
    } -result {57edf4a22be3c955ac49da2e2107b67a}

# RFC 6234 SHA1


test RFC6234-MD-SHA1-20.1 {TC1} -body {
	::tls::md -digest sha1 -data "abc"
    } -result {a9993e364706816aba3e25717850c26c9cd0d89d}

test RFC6234-MD-SHA1-20.2 {TC2_1} -body {
	::tls::md -digest sha1 -data "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
    } -result {84983e441c3bd26ebaae4aa1f95129e5e54670f1}

test RFC6234-MD-SHA1-20.3 {TC3} -body {
	::tls::md -digest sha1 -data [string repeat "a" 1000000]
    } -result {34aa973cd4c4daa4f61eeb2bdbad27316534016f}

test RFC6234-MD-SHA1-20.4 {TC4} -body {
	::tls::md -digest sha1 -data [string repeat "01234567" 80]
    } -result {dea356a2cddd90c7a7ecedc5ebb563934f460452}

test RFC6234-MD-SHA1-20.5 {TC6} -body {
	::tls::md -digest sha1 -data "\x5e"
    } -result {5e6f80a34a9798cafc6a5db96cc57ba4c4db59c2}

test RFC6234-MD-SHA1-20.6 {TC8_1} -body {
	::tls::md -digest sha1 -data "\x9a\x7d\xfd\xf1\xec\xea\xd0\x6e\xd6\x46\xaa\x55\xfe\x75\x71\x46"
    } -result {82abff6605dbe1c17def12a394fa22a82b544a35}

test RFC6234-MD-SHA1-20.7 {TC10_1} -body {
	::tls::md -digest sha1 -data "\xf7\x8f\x92\x14\x1b\xcd\x17\x0a\xe8\x9b\x4f\xba\x15\xa1\xd5\x9f\x3f\xd8\x4d\x22\x3c\x92\x51\xbd\xac\xbb\xae\x61\xd0\x5e\xd1\x15\xa0\x6a\x7c\xe1\x17\xb7\xbe\xea\xd2\x44\x21\xde\xd9\xc3\x25\x92\xbd\x57\xed\xea\xe3\x9c\x39\xfa\x1f\xe8\x94\x6a\x84\xd0\xcf\x1f\x7b\xee\xad\x17\x13\xe2\xe0\x95\x98\x97\x34\x7f\x67\xc8\x0b\x04\x00\xc2\x09\x81\x5d\x6b\x10\xa6\x83\x83\x6f\xd5\x56\x2a\x56\xca\xb1\xa2\x8e\x81\xb6\x57\x66\x54\x63\x1c\xf1\x65\x66\xb8\x6e\x3b\x33\xa1\x08\xb0\x53\x07\xc0\x0a\xff\x14\xa7\x68\xed\x73\x50\x60\x6a\x0f\x85\xe6\xa9\x1d\x39\x6f\x5b\x5c\xbe\x57\x7f\x9b\x38\x80\x7c\x7d\x52\x3d\x6d\x79\x2f\x6e\xbc\x24\xa4\xec\xf2\xb3\xa4\x27\xcd\xbb\xfb"
    } -result {cb0082c8f197d260991ba6a460e76e202bad27b3}

# RFC 6234 SHA256


test RFC6234-MD-SHA256-21.1 {TC1} -body {
	::tls::md -digest sha256 -data "abc"
    } -result {ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad}

test RFC6234-MD-SHA256-21.2 {TC2_1} -body {
	::tls::md -digest sha256 -data "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
    } -result {248d6a61d20638b8e5c026930c3e6039a33ce45964ff2167f6ecedd419db06c1}

test RFC6234-MD-SHA256-21.3 {TC3} -body {
	::tls::md -digest sha256 -data [string repeat "a" 1000000]
    } -result {cdc76e5c9914fb9281a1c7e284d73e67f1809a48a497200e046d39ccc7112cd0}

test RFC6234-MD-SHA256-21.4 {TC4} -body {
	::tls::md -digest sha256 -data [string repeat "01234567" 80]
    } -result {594847328451bdfa85056225462cc1d867d877fb388df0ce35f25ab5562bfbb5}

test RFC6234-MD-SHA256-21.5 {TC6} -body {
	::tls::md -digest sha256 -data "\x19"
    } -result {68aa2e2ee5dff96e3355e6c7ee373e3d6a4e17f75f9518d843709c0c9bc3e3d4}

test RFC6234-MD-SHA256-21.6 {TC8_256} -body {
	::tls::md -digest sha256 -data "\xe3\xd7\x25\x70\xdc\xdd\x78\x7c\xe3\x88\x7a\xb2\xcd\x68\x46\x52"
    } -result {175ee69b02ba9b58e2b0a5fd13819cea573f3940a94f825128cf4209beabb4e8}

test RFC6234-MD-SHA256-21.7 {TC10_256} -body {
	::tls::md -digest sha256 -data "\x83\x26\x75\x4e\x22\x77\x37\x2f\x4f\xc1\x2b\x20\x52\x7a\xfe\xf0\x4d\x8a\x05\x69\x71\xb1\x1a\xd5\x71\x23\xa7\xc1\x37\x76\x00\x00\xd7\xbe\xf6\xf3\xc1\xf7\xa9\x08\x3a\xa3\x9d\x81\x0d\xb3\x10\x77\x7d\xab\x8b\x1e\x7f\x02\xb8\x4a\x26\xc7\x73\x32\x5f\x8b\x23\x74\xde\x7a\x4b\x5a\x58\xcb\x5c\x5c\xf3\x5b\xce\xe6\xfb\x94\x6e\x5b\xd6\x94\xfa\x59\x3a\x8b\xeb\x3f\x9d\x65\x92\xec\xed\xaa\x66\xca\x82\xa2\x9d\x0c\x51\xbc\xf9\x33\x62\x30\xe5\xd7\x84\xe4\xc0\xa4\x3f\x8d\x79\xa3\x0a\x16\x5c\xba\xbe\x45\x2b\x77\x4b\x9c\x71\x09\xa9\x7d\x13\x8f\x12\x92\x28\x96\x6f\x6c\x0a\xdc\x10\x6a\xad\x5a\x9f\xdd\x30\x82\x57\x69\xb2\xc6\x71\xaf\x67\x59\xdf\x28\xeb\x39\x3d\x54\xd6"
    } -result {97dbca7df46d62c8a422c941dd7e835b8ad3361763f7e9b2d95f4f0da6e1ccbc}

# RFC 4231 HMAC Examples Test Case #1
set key [binary decode hex [string repeat "0b" 20]]
set data "Hi There"


test RFC4231_HMAC_TC1-22.1 {sha224} -body {
	::tls::hmac -digest sha224 -key $key -data $data
    } -result {896fb1128abbdf196832107cd49df33f47b4b1169912ba4f53684b22}

test RFC4231_HMAC_TC1-22.2 {sha256} -body {
	::tls::hmac -digest sha256 -key $key -data $data
    } -result {b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7}

test RFC4231_HMAC_TC1-22.3 {sha384} -body {
	::tls::hmac -digest sha384 -key $key -data $data
    } -result {afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6}

test RFC4231_HMAC_TC1-22.4 {sha512} -body {
	::tls::hmac -digest sha512 -key $key -data $data
    } -result {87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854}

# RFC 4231 HMAC Examples Test Case #2 - Test with a key shorter than the length of the HMAC output.
set key "Jefe"
set data "what do ya want for nothing?"


test RFC4231_HMAC_TC2-23.1 {sha224} -body {
	::tls::hmac -digest sha224 -key $key -data $data
    } -result {a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44}

test RFC4231_HMAC_TC2-23.2 {sha256} -body {
	::tls::hmac -digest sha256 -key $key -data $data
    } -result {5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843}

test RFC4231_HMAC_TC2-23.3 {sha384} -body {
	::tls::hmac -digest sha384 -key $key -data $data
    } -result {af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649}

test RFC4231_HMAC_TC2-23.4 {sha512} -body {
	::tls::hmac -digest sha512 -key $key -data $data
    } -result {164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737}

# RFC 4231 HMAC Examples Test Case #3 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).
set key [binary decode hex [string repeat "aa" 20]]
set data [binary decode hex [string repeat "dd" 50]]


test RFC4231_HMAC_TC3-24.1 {sha224} -body {
	::tls::hmac -digest sha224 -key $key -data $data
    } -result {7fb3cb3588c6c1f6ffa9694d7d6ad2649365b0c1f65d69d1ec8333ea}

test RFC4231_HMAC_TC3-24.2 {sha256} -body {
	::tls::hmac -digest sha256 -key $key -data $data
    } -result {773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe}

test RFC4231_HMAC_TC3-24.3 {sha384} -body {
	::tls::hmac -digest sha384 -key $key -data $data
    } -result {88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27}

test RFC4231_HMAC_TC3-24.4 {sha512} -body {
	::tls::hmac -digest sha512 -key $key -data $data
    } -result {fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb}

# RFC 4231 HMAC Examples Test Case #4 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).
set key [binary decode hex "0102030405060708090a0b0c0d0e0f10111213141516171819"]
set data [binary decode hex [string repeat "cd" 50]]


test RFC4231_HMAC_TC4-25.1 {sha224} -body {
	::tls::hmac -digest sha224 -key $key -data $data
    } -result {6c11506874013cac6a2abc1bb382627cec6a90d86efc012de7afec5a}

test RFC4231_HMAC_TC4-25.2 {sha256} -body {
	::tls::hmac -digest sha256 -key $key -data $data
    } -result {82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b}

test RFC4231_HMAC_TC4-25.3 {sha384} -body {
	::tls::hmac -digest sha384 -key $key -data $data
    } -result {3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb}

test RFC4231_HMAC_TC4-25.4 {sha512} -body {
	::tls::hmac -digest sha512 -key $key -data $data
    } -result {b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd}

# RFC 4231 HMAC Examples Test Case #5 - Test with a truncation of output to 128 bits.
set key [binary decode hex [string repeat "0c" 20]]
set data "Test With Truncation"


test RFC4231_HMAC_TC5-26.1 {sha224} -body {
	string range [::tls::hmac -digest sha224 -key $key -data $data] 0 31
    } -result {0e2aea68a90c8d37c988bcdb9fca6fa8}

test RFC4231_HMAC_TC5-26.2 {sha256} -body {
	string range [::tls::hmac -digest sha256 -key $key -data $data] 0 31
    } -result {a3b6167473100ee06e0c796c2955552b}

test RFC4231_HMAC_TC5-26.3 {sha384} -body {
	string range [::tls::hmac -digest sha384 -key $key -data $data] 0 31
    } -result {3abf34c3503b2a23a46efc619baef897}

test RFC4231_HMAC_TC5-26.4 {sha512} -body {
	string range [::tls::hmac -digest sha512 -key $key -data $data] 0 31
    } -result {415fad6271580a531d4179bc891d87a6}

# RFC 4231 HMAC Examples Test Case #6 - Test with a key larger than 128 bytes (= block-size of SHA-384 and SHA-512).
set key [binary decode hex [string repeat "aa" 131]]
set data "Test Using Larger Than Block-Size Key - Hash Key First"


test RFC4231_HMAC_TC6-27.1 {sha224} -body {
	::tls::hmac -digest sha224 -key $key -data $data
    } -result {95e9a0db962095adaebe9b2d6f0dbce2d499f112f2d2b7273fa6870e}

test RFC4231_HMAC_TC6-27.2 {sha256} -body {
	::tls::hmac -digest sha256 -key $key -data $data
    } -result {60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54}

test RFC4231_HMAC_TC6-27.3 {sha384} -body {
	::tls::hmac -digest sha384 -key $key -data $data
    } -result {4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952}

test RFC4231_HMAC_TC6-27.4 {sha512} -body {
	::tls::hmac -digest sha512 -key $key -data $data
    } -result {80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598}

# RFC 4231 HMAC Examples Test Case #7 - Test with a key and data that is larger than 128 bytes (= block-size of SHA-384 and SHA-512).
set key [binary decode hex [string repeat "aa" 131]]
set data "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm."


test RFC4231_HMAC_TC7-28.1 {sha224} -body {
	::tls::hmac -digest sha224 -key $key -data $data
    } -result {3a854166ac5d9f023f54d517d0b39dbd946770db9c2b95c9f6f565d1}

test RFC4231_HMAC_TC7-28.2 {sha256} -body {
	::tls::hmac -digest sha256 -key $key -data $data
    } -result {9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2}

test RFC4231_HMAC_TC7-28.3 {sha384} -body {
	::tls::hmac -digest sha384 -key $key -data $data
    } -result {6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e}

test RFC4231_HMAC_TC7-28.4 {sha512} -body {
	::tls::hmac -digest sha512 -key $key -data $data
    } -result {e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58}

# NIST 800-38b Recommendation for Block Cipher Modes of Operation: The CMAC Mode for Authentication
# AES-128
set key [binary decode hex "2b7e151628aed2a6abf7158809cf4f3c"]


test NIST800-38b-AES128-29.1 {len=0} -body {
	::tls::cmac -cipher aes-128-cbc -key $key -data ""
    } -result {bb1d6929e95937287fa37d129b756746}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172a"]

test NIST800-38b-AES128-29.2 {len=128} -body {
	::tls::cmac -cipher aes-128-cbc -key $key -data $data
    } -result {070a16b46b4d4144f79bdd9dd04a287c}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411"]

test NIST800-38b-AES128-29.3 {len=320} -body {
	::tls::cmac -cipher aes-128-cbc -key $key -data $data
    } -result {dfa66747de9ae63030ca32611497c827}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710"]

test NIST800-38b-AES128-29.4 {len=512} -body {
	::tls::cmac -cipher aes-128-cbc -key $key -data $data
    } -result {51f0bebf7e3b9d92fc49741779363cfe}

# AES-192
set key [binary decode hex "8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"]


test NIST800-38b-AES-192-30.1 {len=0} -body {
	::tls::cmac -cipher aes-192-cbc -key $key -data ""
    } -result {d17ddf46adaacde531cac483de7a9367}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172a"]

test NIST800-38b-AES-192-30.2 {len=128} -body {
	::tls::cmac -cipher aes-192-cbc -key $key -data $data
    } -result {9e99a7bf31e710900662f65e617c5184}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411"]

test NIST800-38b-AES-192-30.3 {len=320} -body {
	::tls::cmac -cipher aes-192-cbc -key $key -data $data
    } -result {8a1de5be2eb31aad089a82e6ee908b0e}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710"]

test NIST800-38b-AES-192-30.4 {len=512} -body {
	::tls::cmac -cipher aes-192-cbc -key $key -data $data
    } -result {a1d5df0eed790f794d77589659f39a11}

# AES-256
set key [binary decode hex "603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"]


test NIST800-38b-AES-256-31.1 {len=0} -body {
	::tls::cmac -cipher aes-256-cbc -key $key -data ""
    } -result {028962f61b7bf89efc6b551f4667d983}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172a"]

test NIST800-38b-AES-256-31.2 {len=128} -body {
	::tls::cmac -cipher aes-256-cbc -key $key -data $data
    } -result {28a7023f452e8f82bd4bf28d8c37c35c}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411"]

test NIST800-38b-AES-256-31.3 {len=320} -body {
	::tls::cmac -cipher aes-256-cbc -key $key -data $data
    } -result {aaf3d8f1de5640c232f5b169b9c911e6}
set data [binary decode hex "6bc1bee22e409f96e93d7e117393172aae2d8a571e03ac9c9eb76fac45af8e5130c81c46a35ce411e5fbc1191a0a52eff69f2445df4f9b17ad2b417be66c3710"]

test NIST800-38b-AES-256-31.4 {len=512} -body {
	::tls::cmac -cipher aes-256-cbc -key $key -data $data
    } -result {e1992190549f6ed5696a2c056c315410}

# Cleanup
::tcltest::removeFile $test_file
::tcltest::removeFile $test_alt_file

# Cleanup
::tcltest::cleanupTests
return

Added tests/encrypt.csv version [a8fd540f67].













































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Helper functions - See common.tcl,,,,,,,,,
command,"proc read_chan {filename args} {set ch [open $filename rb];set bsize [fconfigure $ch -buffersize];set new [{*}$args -chan $ch];set dat """";while {![eof $new]} {append dat [read $new $bsize]};close $new;return $dat}",,,,,,,,,
command,proc write_chan {filename data args} {set ch [open $filename wb];set new [{*}$args -chan $ch];puts -nonewline $new $data;flush $new;close $new;set ch [open $filename rb];set dat [read $ch];close $ch;return $dat},,,,,,,,,
command,"proc accumulate {string args} {set cmd [{*}$args -command dcmd];set ::dat """";append ::dat [$cmd update [string range $string 0 20]];append ::dat [$cmd update [string range $string 21 end]];append ::dat [$cmd finalize]}",$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},,,,,,,,
command,proc get_file_hex {filename} {set ch [open $filename rb];set data [read $ch];close $ch;return [binary encode hex $data]},,,,,,,,,
command,proc get_file_text {filename} {set ch [open $filename r];set data [read $ch];close $ch;return $data},,,,,,,,,
,,,,,,,,,,
command,"set test_data ""Example string for message digest tests.\n""",,,,,,,,,
command,"set unencrypted_file ""unencrypted_data.dat""",,,,,,,,,
command,"set encrypted_file ""encrypted_data.dat""",,,,,,,,,
command,"set alt_file ""result_data.dat""",,,,,,,,,
command,"set test_key ""Example key""",,,,,,,,,
command,"set test_iv ""Example iv""",,,,,,,,,
command,::tcltest::makeFile $test_data $unencrypted_file,,,,,,,,,
 ,,,,,,,,,,
command,# Test encrypt data,,,,,,,,,
command,set cipher aes-128-cbc,,,,,,,,,
command,"set hex_string ""3cea034398de64507abbc7bcf6acba55c7011100c9015c22b3c9c331d18479fed5e542ce02a3b89a0f750daf8e2a494e""",,,,,,,,,
Encrypt Decrypt Data,Encrypt aes-138-cbc,,,binary encode hex [set data [tls::encrypt -cipher $cipher -key $test_key -iv $test_iv -data $test_data]],,,$hex_string,,,
Encrypt Decrypt Data,Decrypt aes-128-cbc,,,tls::decrypt -cipher $cipher -key $test_key -iv $test_iv -data $data,,,$test_data,,,
 ,,,,,,,,,,
command,# Test encrypt file,,,,,,,,,
Encrypt Decrypt File,Encrypt aes-138-cbc,,,tls::encrypt -cipher $cipher -key $test_key -iv $test_iv -infile $unencrypted_file -outfile $encrypted_file;get_file_hex $encrypted_file,,,$hex_string,,,
Encrypt Decrypt File,Decrypt aes-128-cbc,,,tls::decrypt -cipher $cipher -key $test_key -iv $test_iv -infile $encrypted_file -outfile $alt_file;get_file_text $alt_file,,,$test_data,,,
 ,,,,,,,,,,
command,# Test encrypt using object command,,,,,,,,,
Encrypt Decrypt Command,Encrypt aes-138-cbc,,,accumulate $test_data tls::encrypt -cipher $cipher -key $test_key -iv $test_iv;binary encode hex $::dat,,,$hex_string,,,
Encrypt Decrypt Command,Decrypt aes-128-cbc,,,accumulate $::dat tls::decrypt -cipher $cipher -key $test_key -iv $test_iv;set ::dat,,,$test_data,,,
 ,,,,,,,,,,
command,# Test encrypt using read channel,,,,,,,,,
Encrypt Decrypt Channel Read,Encrypt aes-138-cbc,,,binary encode hex [read_chan $unencrypted_file tls::encrypt -cipher $cipher -key $test_key -iv $test_iv],,,$hex_string,,,
Encrypt Decrypt Channel Read,Decrypt aes-138-cbc,,,read_chan $encrypted_file tls::decrypt -cipher $cipher -key $test_key -iv $test_iv,,,$test_data,,,
 ,,,,,,,,,,
command,# Test encrypt using write channel,,,,,,,,,
Encrypt Decrypt Channel Write,Encrypt aes-138-cbc,,,binary encode hex [set data [write_chan $encrypted_file $test_data tls::encrypt -cipher $cipher -key $test_key -iv $test_iv]],,,$hex_string,,,
Encrypt Decrypt Channel Write,Decrypt aes-138-cbc,,,write_chan $alt_file $data tls::decrypt -cipher $cipher -key $test_key -iv $test_iv,,,$test_data,,,
,,,,,,,,,,
command,# Cleanup,,,,,,,,,
command,::tcltest::removeFile $unencrypted_file,,,,,,,,,
command,::tcltest::removeFile $encrypted_file,,,,,,,,,
command,::tcltest::removeFile $alt_file,,,,,,,,,

Added tests/encrypt.test version [30ef9b5ec2].

































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated test cases for encrypt.csv

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

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

package require tls

# Helper functions - See common.tcl
proc read_chan {filename args} {set ch [open $filename rb];set bsize [fconfigure $ch -buffersize];set new [{*}$args -chan $ch];set dat "";while {![eof $new]} {append dat [read $new $bsize]};close $new;return $dat}
proc write_chan {filename data args} {set ch [open $filename wb];set new [{*}$args -chan $ch];puts -nonewline $new $data;flush $new;close $new;set ch [open $filename rb];set dat [read $ch];close $ch;return $dat}
proc accumulate {string args} {set cmd [{*}$args -command dcmd];set ::dat "";append ::dat [$cmd update [string range $string 0 20]];append ::dat [$cmd update [string range $string 21 end]];append ::dat [$cmd finalize]}
proc get_file_hex {filename} {set ch [open $filename rb];set data [read $ch];close $ch;return [binary encode hex $data]}
proc get_file_text {filename} {set ch [open $filename r];set data [read $ch];close $ch;return $data}

set test_data "Example string for message digest tests.\n"
set unencrypted_file "unencrypted_data.dat"
set encrypted_file "encrypted_data.dat"
set alt_file "result_data.dat"
set test_key "Example key"
set test_iv "Example iv"
::tcltest::makeFile $test_data $unencrypted_file

# Test encrypt data
set cipher aes-128-cbc
set hex_string "3cea034398de64507abbc7bcf6acba55c7011100c9015c22b3c9c331d18479fed5e542ce02a3b89a0f750daf8e2a494e"


test Encrypt_Decrypt_Data-1.1 {Encrypt aes-138-cbc} -body {
	binary encode hex [set data [tls::encrypt -cipher $cipher -key $test_key -iv $test_iv -data $test_data]]
    } -result $hex_string

test Encrypt_Decrypt_Data-1.2 {Decrypt aes-128-cbc} -body {
	tls::decrypt -cipher $cipher -key $test_key -iv $test_iv -data $data
    } -result $test_data

# Test encrypt file


test Encrypt_Decrypt_File-2.1 {Encrypt aes-138-cbc} -body {
	tls::encrypt -cipher $cipher -key $test_key -iv $test_iv -infile $unencrypted_file -outfile $encrypted_file
	get_file_hex $encrypted_file
    } -result $hex_string

test Encrypt_Decrypt_File-2.2 {Decrypt aes-128-cbc} -body {
	tls::decrypt -cipher $cipher -key $test_key -iv $test_iv -infile $encrypted_file -outfile $alt_file
	get_file_text $alt_file
    } -result $test_data

# Test encrypt using object command


test Encrypt_Decrypt_Command-3.1 {Encrypt aes-138-cbc} -body {
	accumulate $test_data tls::encrypt -cipher $cipher -key $test_key -iv $test_iv
	binary encode hex $::dat
    } -result $hex_string

test Encrypt_Decrypt_Command-3.2 {Decrypt aes-128-cbc} -body {
	accumulate $::dat tls::decrypt -cipher $cipher -key $test_key -iv $test_iv
	set ::dat
    } -result $test_data

# Test encrypt using read channel


test Encrypt_Decrypt_Channel_Read-4.1 {Encrypt aes-138-cbc} -body {
	binary encode hex [read_chan $unencrypted_file tls::encrypt -cipher $cipher -key $test_key -iv $test_iv]
    } -result $hex_string

test Encrypt_Decrypt_Channel_Read-4.2 {Decrypt aes-138-cbc} -body {
	read_chan $encrypted_file tls::decrypt -cipher $cipher -key $test_key -iv $test_iv
    } -result $test_data

# Test encrypt using write channel


test Encrypt_Decrypt_Channel_Write-5.1 {Encrypt aes-138-cbc} -body {
	binary encode hex [set data [write_chan $encrypted_file $test_data tls::encrypt -cipher $cipher -key $test_key -iv $test_iv]]
    } -result $hex_string

test Encrypt_Decrypt_Channel_Write-5.2 {Decrypt aes-138-cbc} -body {
	write_chan $alt_file $data tls::decrypt -cipher $cipher -key $test_key -iv $test_iv
    } -result $test_data

# Cleanup
::tcltest::removeFile $unencrypted_file
::tcltest::removeFile $encrypted_file
::tcltest::removeFile $alt_file

# Cleanup
::tcltest::cleanupTests
return

Added tests/info.csv version [f336604239].























































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Make sure path includes location of OpenSSL executable,,,,,,,,,
command,"if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] "";"" $::env(path)]}",,,,,,,,,
,,,,,,,,,,
command,# Constraints,,,,,,,,,
command,source [file join [file dirname [info script]] common.tcl],,,,,,,,,
,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc lcompare {list1 list2} {set m """";set u """";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list ""missing"" $m ""unexpected"" $u]}",,,,,,,,,
command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,,
command,"proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data ""\n""] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}",,,,,,,,,
command,"proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data ""\n""] {foreach digest $line {if {[string match ""-*"" $digest]} {lappend list [string trimleft $digest ""-""]}}};return [lsort $list]}",,,,,,,,,
command,"proc exec_get_pkeys {} {set list [list];set data [exec openssl list -public-key-methods];foreach line [split $data ""\n""] {if {![string match ""*Type:*"" $line]} {lappend list [string trim $line]}};return $list}",,,,,,,,,
command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,,
command,proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result},,,,,,,,,
,,,,,,,,,,
command,# Test list ciphers,,,,,,,,,
Ciphers List,All,,,lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]],,,missing {rc5 rc5-cbc rc5-cfb rc5-ecb rc5-ofb} unexpected {aes-128-ccm aes-128-gcm aes-192-ccm aes-192-gcm aes-256-ccm aes-256-gcm},,,
,,,,,,,,,,
command,# Test list ciphers for protocols,,,,,,,,,
Ciphers By Protocol,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2] [::tls::ciphers ssl2]",,,missing {} unexpected {},,,
Ciphers By Protocol,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3] [::tls::ciphers ssl3]",,,missing {} unexpected {},,,
Ciphers By Protocol,TLS1.0,tls1,,"lcompare [exec_get "":"" ciphers -tls1] [::tls::ciphers tls1]",,,missing {} unexpected {},,,
Ciphers By Protocol,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1] [::tls::ciphers tls1.1]",,,missing {} unexpected {},,,
Ciphers By Protocol,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2] [::tls::ciphers tls1.2]",,,missing {} unexpected {},,,
Ciphers By Protocol,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3] [::tls::ciphers tls1.3]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test cipher descriptions,,,,,,,,,
Ciphers With Descriptions,SSL2,ssl2,,"lcompare [exec_get ""\r\n"" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,SSL3,ssl3,,"lcompare [exec_get ""\r\n"" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.0,tls1,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.1,tls1.1,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.2,tls1.2,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,,
Ciphers With Descriptions,TLS1.3,tls1.3,,"lcompare [exec_get ""\r\n"" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test protocol specific ciphers,,,,,,,,,
Ciphers Protocol Specific,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.0,tls1,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,,
Ciphers Protocol Specific,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Ciphers Error Cases,,,,,,,,,
Ciphers Errors,Too many args,,,::tls::ciphers too many args to pass,,,"wrong # args: should be ""::tls::ciphers ?protocol? ?verbose? ?supported?""",,,1
Ciphers Errors,Invalid protocol,,,::tls::ciphers bogus,,,"bad protocol ""bogus"": must be ssl2, ssl3, tls1, tls1.1, tls1.2, or tls1.3",,,1
Ciphers Errors,Invalid verbose,,,::tls::ciphers tls1.3 bogus,,,"expected boolean value but got ""bogus""",,,1
Ciphers Errors,Invalid supported,,,::tls::ciphers tls1.3 1 bogus,,,"expected boolean value but got ""bogus""",,,1
Ciphers Errors,SSL2,!ssl2,,::tls::ciphers ssl2,,,ssl2: protocol not supported,,,1
Ciphers Errors,SSL3,!ssl3,,::tls::ciphers ssl3,,,ssl3: protocol not supported,,,1
Ciphers Errors,TLS1.0,!tls1,,::tls::ciphers tls1,,,tls1: protocol not supported,,,1
Ciphers Errors,TLS1.1,!tls1.1,,::tls::ciphers tls1.1,,,tls1.0: protocol not supported,,,1
Ciphers Errors,TLS1.2,!tls1.2,,::tls::ciphers tls1.2,,,tls1.1: protocol not supported,,,1
Ciphers Errors,TLS1.3,!tls1.3,,::tls::ciphers tls1.3,,,tls1.3: protocol not supported,,,1
,,,,,,,,,,
command,# Test Cipher Info,,,,,,,,,
Cipher Info,AES-256-CCM,,,tls::cipher aes-256-ccm,,,nid aes-256-ccm name id-aes256-CCM description {} block_size 1 key_length 32 iv_length 12 type aes-256-ccm provider {} mode CCM flags {{Variable Length} 0 {Always Call Init} 1 {Custom IV} 1 {Control Init} 1 {Custom Cipher} 1 {AEAD Cipher} 1 {Custom Copy} 1 {Non FIPS Allow} 0} tag_length 16 aad_length 13,,,
,,,,,,,,,,
command,# Test list digests,,,,,,,,,
Digests List,All,,,lcompare [lsort [exec_get_digests]] [lsort [tls::digests]],,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test Digest Info,,,,,,,,,
Digest Info,md5,,,tls::digests md5,,,name MD5 description {} size 16 block_size 64 provider {} type md5 pkey_type md5WithRSAEncryption flags {One-shot 0 XOF 0 DigestAlgorithmId_NULL 0 DigestAlgorithmId_Abscent 0 DigestAlgorithmId_Custom 0 FIPS 0},,,
,,,,,,,,,,
command,# Test list MACs,,,,,,,,,
MAC List,All,,,lcompare [exec_get_macs] [tls::macs],,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test list Pkeys,,,,,,,,,
Pkey List,All,,,lcompare [exec_get_pkeys] [tls::pkeys],,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test list protocols,,,,,,,,,
Protocols,All,,,lcompare $::protocols [::tls::protocols],,,missing {ssl2 ssl3} unexpected {},,,
,,,,,,,,,,
command,# Test show version,,,,,,,,,
Version,All,,,::tls::version,,glob,*,,,
Version,OpenSSL,OpenSSL,,::tls::version,,glob,OpenSSL*,,,
,,,,,,,,,,
command,# Error Cases,,,,,,,,,
Error Cases,Cipher Too many args,,,::tls::cipher too many args,,,"wrong # args: should be ""::tls::cipher ?name?""",,,1
Error Cases,Digests Too many args,,,::tls::digests too many args,,,"wrong # args: should be ""::tls::digests ?name?""",,,1
Error Cases,MACs Too many args,,,::tls::macs too many args,,,"wrong # args: should be ""::tls::macs ?name?""",,,1
Error Cases,Pkeys Too many args,,,::tls::pkeys too many args,,,"wrong # args: should be ""::tls::pkeys ?name?""",,,1
Error Cases,Protocols Too many args,,,::tls::protocols too many args,,,"wrong # args: should be ""::tls::protocols""",,,1
Error Cases,Version Too many args,,,::tls::version too many args,,,"wrong # args: should be ""::tls::version""",,,1

Added tests/info.test version [abbefd3499].


















































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated test cases for info.csv

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

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

package require tls

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

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

# Helper functions
proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]}
proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]}
proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data "\n"] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}
proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data "\n"] {foreach digest $line {if {[string match "-*" $digest]} {lappend list [string trimleft $digest "-"]}}};return [lsort $list]}
proc exec_get_pkeys {} {set list [list];set data [exec openssl list -public-key-methods];foreach line [split $data "\n"] {if {![string match "*Type:*" $line]} {lappend list [string trim $line]}};return $list}
proc exec_get_macs {} {return [list cmac hmac]}
proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result}

# Test list ciphers


test Ciphers_List-1.1 {All} -body {
	lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]]
    } -result {missing {rc5 rc5-cbc rc5-cfb rc5-ecb rc5-ofb} unexpected {aes-128-ccm aes-128-gcm aes-192-ccm aes-192-gcm aes-256-ccm aes-256-gcm}}

# Test list ciphers for protocols


test Ciphers_By_Protocol-2.1 {SSL2} -constraints {ssl2} -body {
	lcompare [exec_get ":" ciphers -ssl2] [::tls::ciphers ssl2]
    } -result {missing {} unexpected {}}

test Ciphers_By_Protocol-2.2 {SSL3} -constraints {ssl3} -body {
	lcompare [exec_get ":" ciphers -ssl3] [::tls::ciphers ssl3]
    } -result {missing {} unexpected {}}

test Ciphers_By_Protocol-2.3 {TLS1.0} -constraints {tls1} -body {
	lcompare [exec_get ":" ciphers -tls1] [::tls::ciphers tls1]
    } -result {missing {} unexpected {}}

test Ciphers_By_Protocol-2.4 {TLS1.1} -constraints {tls1.1} -body {
	lcompare [exec_get ":" ciphers -tls1_1] [::tls::ciphers tls1.1]
    } -result {missing {} unexpected {}}

test Ciphers_By_Protocol-2.5 {TLS1.2} -constraints {tls1.2} -body {
	lcompare [exec_get ":" ciphers -tls1_2] [::tls::ciphers tls1.2]
    } -result {missing {} unexpected {}}

test Ciphers_By_Protocol-2.6 {TLS1.3} -constraints {tls1.3} -body {
	lcompare [exec_get ":" ciphers -tls1_3] [::tls::ciphers tls1.3]
    } -result {missing {} unexpected {}}

# Test cipher descriptions


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

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

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

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

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

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

# Test protocol specific ciphers


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

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

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

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

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

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

# Ciphers Error Cases


test Ciphers_Errors-5.1 {Too many args} -body {
	::tls::ciphers too many args to pass
    } -result {wrong # args: should be "::tls::ciphers ?protocol? ?verbose? ?supported?"} -returnCodes {1}

test Ciphers_Errors-5.2 {Invalid protocol} -body {
	::tls::ciphers bogus
    } -result {bad protocol "bogus": must be ssl2, ssl3, tls1, tls1.1, tls1.2, or tls1.3} -returnCodes {1}

test Ciphers_Errors-5.3 {Invalid verbose} -body {
	::tls::ciphers tls1.3 bogus
    } -result {expected boolean value but got "bogus"} -returnCodes {1}

test Ciphers_Errors-5.4 {Invalid supported} -body {
	::tls::ciphers tls1.3 1 bogus
    } -result {expected boolean value but got "bogus"} -returnCodes {1}

test Ciphers_Errors-5.5 {SSL2} -constraints {!ssl2} -body {
	::tls::ciphers ssl2
    } -result {ssl2: protocol not supported} -returnCodes {1}

test Ciphers_Errors-5.6 {SSL3} -constraints {!ssl3} -body {
	::tls::ciphers ssl3
    } -result {ssl3: protocol not supported} -returnCodes {1}

test Ciphers_Errors-5.7 {TLS1.0} -constraints {!tls1} -body {
	::tls::ciphers tls1
    } -result {tls1: protocol not supported} -returnCodes {1}

test Ciphers_Errors-5.8 {TLS1.1} -constraints {!tls1.1} -body {
	::tls::ciphers tls1.1
    } -result {tls1.0: protocol not supported} -returnCodes {1}

test Ciphers_Errors-5.9 {TLS1.2} -constraints {!tls1.2} -body {
	::tls::ciphers tls1.2
    } -result {tls1.1: protocol not supported} -returnCodes {1}

test Ciphers_Errors-5.10 {TLS1.3} -constraints {!tls1.3} -body {
	::tls::ciphers tls1.3
    } -result {tls1.3: protocol not supported} -returnCodes {1}

# Test Cipher Info


test Cipher_Info-6.1 {AES-256-CCM} -body {
	tls::cipher aes-256-ccm
    } -result {nid aes-256-ccm name id-aes256-CCM description {} block_size 1 key_length 32 iv_length 12 type aes-256-ccm provider {} mode CCM flags {{Variable Length} 0 {Always Call Init} 1 {Custom IV} 1 {Control Init} 1 {Custom Cipher} 1 {AEAD Cipher} 1 {Custom Copy} 1 {Non FIPS Allow} 0} tag_length 16 aad_length 13}

# Test list digests


test Digests_List-7.1 {All} -body {
	lcompare [lsort [exec_get_digests]] [lsort [tls::digests]]
    } -result {missing {} unexpected {}}

# Test Digest Info


test Digest_Info-8.1 {md5} -body {
	tls::digests md5
    } -result {name MD5 description {} size 16 block_size 64 provider {} type md5 pkey_type md5WithRSAEncryption flags {One-shot 0 XOF 0 DigestAlgorithmId_NULL 0 DigestAlgorithmId_Abscent 0 DigestAlgorithmId_Custom 0 FIPS 0}}

# Test list MACs


test MAC_List-9.1 {All} -body {
	lcompare [exec_get_macs] [tls::macs]
    } -result {missing {} unexpected {}}

# Test list Pkeys


test Pkey_List-10.1 {All} -body {
	lcompare [exec_get_pkeys] [tls::pkeys]
    } -result {missing {} unexpected {}}

# Test list protocols


test Protocols-11.1 {All} -body {
	lcompare $::protocols [::tls::protocols]
    } -result {missing {ssl2 ssl3} unexpected {}}

# Test show version


test Version-12.1 {All} -body {
	::tls::version
    } -match {glob} -result {*}

test Version-12.2 {OpenSSL} -constraints {OpenSSL} -body {
	::tls::version
    } -match {glob} -result {OpenSSL*}

# Error Cases


test Error_Cases-13.1 {Cipher Too many args} -body {
	::tls::cipher too many args
    } -result {wrong # args: should be "::tls::cipher ?name?"} -returnCodes {1}

test Error_Cases-13.2 {Digests Too many args} -body {
	::tls::digests too many args
    } -result {wrong # args: should be "::tls::digests ?name?"} -returnCodes {1}

test Error_Cases-13.3 {MACs Too many args} -body {
	::tls::macs too many args
    } -result {wrong # args: should be "::tls::macs ?name?"} -returnCodes {1}

test Error_Cases-13.4 {Pkeys Too many args} -body {
	::tls::pkeys too many args
    } -result {wrong # args: should be "::tls::pkeys ?name?"} -returnCodes {1}

test Error_Cases-13.5 {Protocols Too many args} -body {
	::tls::protocols too many args
    } -result {wrong # args: should be "::tls::protocols"} -returnCodes {1}

test Error_Cases-13.6 {Version Too many args} -body {
	::tls::version too many args
    } -result {wrong # args: should be "::tls::version"} -returnCodes {1}

# Cleanup
::tcltest::cleanupTests
return

Added tests/kdf.csv version [ecd5209032].

















































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# PBKDF2 Error Cases,,,,,,,,,
PBKDF2 Errors,Too few args,,,::tls::pbkdf2,,,"wrong # args: should be ""::tls::pbkdf2 [-cipher cipher | -size length] -digest digest ?-iterations count? ?-password string? ?-salt string?""",,,1
PBKDF2 Errors,Too many args,,,::tls::pbkdf2 too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::pbkdf2 [-cipher cipher | -size length] -digest digest ?-iterations count? ?-password string? ?-salt string?""",,,1
PBKDF2 Errors,Invalid cipher,,,::tls::pbkdf2 -digest sha256 -password key -cipher bogus,,,"invalid cipher ""bogus""",,,1
PBKDF2 Errors,Invalid digest,,,::tls::pbkdf2 -digest bogus -password key,,,"invalid digest ""bogus""",,,1
PBKDF2 Errors,Invalid iterations,,,::tls::pbkdf2 -digest sha256 -password key -iterations -1,,,"invalid value ""-1"" for option ""iterations"": must be >= 1",,,1
PBKDF2 Errors,No password value,,,::tls::pbkdf2 -digest sha256 -password,,,"No value for option ""-password""",,,1
PBKDF2 Errors,No salt value,,,::tls::pbkdf2 -digest sha256 -password key -salt,,,"No value for option ""-salt""",,,1
PBKDF2 Errors,Invalid size,,,::tls::pbkdf2 -digest sha256 -password key -size 0,,,"invalid value ""0"" for option ""-size"": must be >= 1",,,1
PBKDF2 Errors,Too big size,,,::tls::pbkdf2 -digest sha256 -password key -size 400,,,"invalid value ""400"" for option ""-size"": must be <= 320",,,1
,,,,,,,,,,
command,# HKDF Error Cases,,,,,,,,,
HKDF Errors,Too few args,,,::tls::hkdf,,,"wrong # args: should be ""::tls::hkdf -digest digest -key string ?-info string? ?-salt string? ?-size derived_length?""",,,1
HKDF Errors,Too many args,,,::tls::hkdf too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::hkdf -digest digest -key string ?-info string? ?-salt string? ?-size derived_length?""",,,1
HKDF Errors,No digest,,,::tls::hkdf -key key -key key,,,no digest,,,1
HKDF Errors,No key,,,::tls::hkdf -digest sha256 -digest sha256,,,no key,,,1
HKDF Errors,No info value,,,::tls::hkdf -digest sha256 -key key -info,,,"No value for option ""-info""",,,1
HKDF Errors,No salt value,,,::tls::hkdf -digest sha256 -password key -salt,,,"No value for option ""-salt""",,,1
HKDF Errors,Invalid size,,,::tls::hkdf -digest sha256 -password key -size 0,,,"invalid value ""0"" for option ""-size"": must be >= 1",,,1
HKDF Errors,Too big size,,,::tls::hkdf -digest sha256 -password key -size 8161,,,"""Key derivation failed: """,,,1
,,,,,,,,,,
command,# Scrypt Error Cases,,,,,,,,,
Scrypt Errors,Too few args,,,::tls::scrypt,,,"wrong # args: should be ""::tls::scrypt -password string -salt string ?-N costParameter? ?-r blockSize? ?-p parallelization? ?-size derived_length?""",,,1
Scrypt Errors,Too many args,,,::tls::scrypt too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::scrypt -password string -salt string ?-N costParameter? ?-r blockSize? ?-p parallelization? ?-size derived_length?""",,,1
Scrypt Errors,No password value,,,::tls::scrypt -salt salt -salt salt,,,no password,,,1
Scrypt Errors,No salt value,,,::tls::scrypt -password key -password key,,,no salt,,,1
Scrypt Errors,Invalid size,,,::tls::scrypt -password key -salt salt -size 0,,,"invalid value ""0"" for option ""-size"": must be >= 1",,,1
Scrypt Errors,Invalid N costParameter,knownIgnored,,::tls::scrypt -password key -salt salt -N 0,,,,,,1
Scrypt Errors,Invalid r blockSize,knownIgnored,,::tls::scrypt -password key -salt salt -r 0,,,,,,1
Scrypt Errors,Invalid p parallelization,knownIgnored,,::tls::scrypt -password key -salt salt -p 0,,,,,,1
,,,,,,,,,,
command,set digest sha1,,,,,,,,,
command,"set P ""password""",,,,,,,,,
command,"set S ""salt""",,,,,,,,,
command,set dkLen 20,,,,,,,,,
,,,,,,,,,,
command,# PBKDF2 RFC 6070,,,,,,,,,
PBKDF2 RFC 6070,Test Case 1,,,binary encode hex [::tls::pbkdf2 -digest $digest -password $P -salt $S -iterations 1 -size $dkLen],,,0c60c80f961f0e71f3a9b524af6012062fe037a6,,,
PBKDF2 RFC 6070,Test Case 2,,,binary encode hex [::tls::pbkdf2 -digest $digest -password $P -salt $S -iterations 2 -size $dkLen],,,ea6c014dc72d6f8ccd1ed92ace1d41f0d8de8957,,,
PBKDF2 RFC 6070,Test Case 3,,,binary encode hex [::tls::pbkdf2 -digest $digest -password $P -salt $S -iterations 4096 -size $dkLen],,,4b007901b765489abead49d926f721d065a429c1,,,
PBKDF2 RFC 6070,Test Case 4,,,binary encode hex [::tls::pbkdf2 -digest $digest -password $P -salt $S -iterations 16777216 -size $dkLen],,,eefe3d61cd4da4e4e9945b3d6ba2158c2634e984,,,
,,,,,,,,,,
command,set digest sha1,,,,,,,,,
command,set key [binary decode hex 0b0b0b0b0b0b0b0b0b0b0b],,,,,,,,,
command,set salt [binary decode hex 000102030405060708090a0b0c],,,,,,,,,
command,set info [binary decode hex f0f1f2f3f4f5f6f7f8f9],,,,,,,,,
command,set size 42,,,,,,,,,
,,,,,,,,,,
command,# HKDF RFC 6234,,,,,,,,,
HKDF RFC 6234,"A.4.  Test Case 4, Basic test case with SHA-1",,,binary encode hex [::tls::hkdf -digest $digest -password $key -salt $salt -info $info -size $size],,,085a01ea1b10f36933068b56efa5ad81a4f14b822f5b091568a9cdd4f155fda2c22e422478d305f3f896,,,
,,,,,,,,,,
command,set key [binary decode hex 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f],,,,,,,,,
command,set salt [binary decode hex 606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeaf],,,,,,,,,
command,set info [binary decode hex b0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfeff],,,,,,,,,
command,set size 82,,,,,,,,,
,,,,,,,,,,
HKDF RFC 6234,"A.5.  Test Case 5, Test with SHA-1 and longer inputs/outputs",,,binary encode hex [::tls::hkdf -digest $digest -password $key -salt $salt -info $info -size $size],,,0bd770a74d1160f7c9f12cd5912a06ebff6adcae899d92191fe4305673ba2ffe8fa3f1a4e5ad79f3f334b3b202b2173c486ea37ce3d397ed034c7f9dfeb15c5e927336d0441f4c4300e2cff0d0900b52d3b4,,,
,,,,,,,,,,
command,set key [binary decode hex 0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b],,,,,,,,,
command,"set salt """"",,,,,,,,,
command,"set info """"",,,,,,,,,
command,set size 42,,,,,,,,,
,,,,,,,,,,
HKDF RFC 6234,"A.6.  Test Case 6, Test with SHA-1 and zero-length salt/info",,,binary encode hex [::tls::hkdf -digest $digest -password $key -salt $salt -info $info -size $size],,,0ac1af7002b3d761d1e55298da9d0506b9ae52057220a306e07b6b87e8df21d0ea00033de03984d34918,,,
,,,,,,,,,,
command,set key [binary decode hex 0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c],,,,,,,,,
command,"set salt """"",,,,,,,,,
command,"set info """"",,,,,,,,,
command,set size 42,,,,,,,,,
,,,,,,,,,,
HKDF RFC 6234,"A.7.  Test Case 7, Test with SHA-1, salt not provided (defaults to HashLen zero octets), zero-length info",,,binary encode hex [::tls::hkdf -digest $digest -password $key -salt $salt -info $info -size $size],,,2c91117204d745f3500d636a62f64f0ab3bae548aa53d423b0d1f27ebba6f5e5673a081d70cce7acfc48,,,
,,,,,,,,,,
command,# Scrypt RFC 7914,,,,,,,,,
Scrypt RFC 7914,Test Case 1,,,"binary encode hex [::tls::scrypt -password """" -salt """" -N 16 -r 1 -p 1 -size 64]",,,77d6576238657b203b19ca42c18a0497f16b4844e3074ae8dfdffa3fede21442fcd0069ded0948f8326a753a0fc81f17e8d3e0fb2e0d3628cf35e20c38d18906,,,
Scrypt RFC 7914,Test Case 2,,,"binary encode hex [::tls::scrypt -password ""password"" -salt ""NaCl"" -N 1024 -r 8 -p 16 -size 64]",,,fdbabe1c9d3472007856e7190d01e9fe7c6ad7cbc8237830e77376634b3731622eaf30d92e22a3886ff109279d9830dac727afb94a83ee6d8360cbdfa2cc0640,,,
Scrypt RFC 7914,Test Case 3,,,"binary encode hex [::tls::scrypt -password ""pleaseletmein"" -salt ""SodiumChloride"" -N 16384 -r 8 -p 1 -size 64]",,,7023bdcb3afd7348461c06cd81fd38ebfda8fbba904f8e3ea9b543f6545da1f2d5432955613f0fcf62d49705242a9af9e61e85dc0d651e40dfcf017b45575887,,,
Scrypt RFC 7914,Test Case 4,,,"binary encode hex [::tls::scrypt -password ""pleaseletmein"" -salt ""SodiumChloride"" -N 1048576 -r 8 -p 1 -size 64]",,,2101cb9b6a511aaeaddbbe09cf70f881ec568d574a2ffd4dabe5ee9820adaa478e56fd8f4ba5d09ffa1c6d927c40f4c337304049e8a952fbcbf45c6fa77a41a4,,,

Added tests/kdf.test version [e9cb54f939].



















































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated test cases for kdf.csv

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

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

package require tls

# PBKDF2 Error Cases


test PBKDF2_Errors-1.1 {Too few args} -body {
	::tls::pbkdf2
    } -result {wrong # args: should be "::tls::pbkdf2 [-cipher cipher | -size length] -digest digest ?-iterations count? ?-password string? ?-salt string?"} -returnCodes {1}

test PBKDF2_Errors-1.2 {Too many args} -body {
	::tls::pbkdf2 too many command line args to pass the test without an error or failing
    } -result {wrong # args: should be "::tls::pbkdf2 [-cipher cipher | -size length] -digest digest ?-iterations count? ?-password string? ?-salt string?"} -returnCodes {1}

test PBKDF2_Errors-1.3 {Invalid cipher} -body {
	::tls::pbkdf2 -digest sha256 -password key -cipher bogus
    } -result {invalid cipher "bogus"} -returnCodes {1}

test PBKDF2_Errors-1.4 {Invalid digest} -body {
	::tls::pbkdf2 -digest bogus -password key
    } -result {invalid digest "bogus"} -returnCodes {1}

test PBKDF2_Errors-1.5 {Invalid iterations} -body {
	::tls::pbkdf2 -digest sha256 -password key -iterations -1
    } -result {invalid value "-1" for option "iterations": must be >= 1} -returnCodes {1}

test PBKDF2_Errors-1.6 {No password value} -body {
	::tls::pbkdf2 -digest sha256 -password
    } -result {No value for option "-password"} -returnCodes {1}

test PBKDF2_Errors-1.7 {No salt value} -body {
	::tls::pbkdf2 -digest sha256 -password key -salt
    } -result {No value for option "-salt"} -returnCodes {1}

test PBKDF2_Errors-1.8 {Invalid size} -body {
	::tls::pbkdf2 -digest sha256 -password key -size 0
    } -result {invalid value "0" for option "-size": must be >= 1} -returnCodes {1}

test PBKDF2_Errors-1.9 {Too big size} -body {
	::tls::pbkdf2 -digest sha256 -password key -size 400
    } -result {invalid value "400" for option "-size": must be <= 320} -returnCodes {1}

# HKDF Error Cases


test HKDF_Errors-2.1 {Too few args} -body {
	::tls::hkdf
    } -result {wrong # args: should be "::tls::hkdf -digest digest -key string ?-info string? ?-salt string? ?-size derived_length?"} -returnCodes {1}

test HKDF_Errors-2.2 {Too many args} -body {
	::tls::hkdf too many command line args to pass the test without an error or failing
    } -result {wrong # args: should be "::tls::hkdf -digest digest -key string ?-info string? ?-salt string? ?-size derived_length?"} -returnCodes {1}

test HKDF_Errors-2.3 {No digest} -body {
	::tls::hkdf -key key -key key
    } -result {no digest} -returnCodes {1}

test HKDF_Errors-2.4 {No key} -body {
	::tls::hkdf -digest sha256 -digest sha256
    } -result {no key} -returnCodes {1}

test HKDF_Errors-2.5 {No info value} -body {
	::tls::hkdf -digest sha256 -key key -info
    } -result {No value for option "-info"} -returnCodes {1}

test HKDF_Errors-2.6 {No salt value} -body {
	::tls::hkdf -digest sha256 -password key -salt
    } -result {No value for option "-salt"} -returnCodes {1}

test HKDF_Errors-2.7 {Invalid size} -body {
	::tls::hkdf -digest sha256 -password key -size 0
    } -result {invalid value "0" for option "-size": must be >= 1} -returnCodes {1}

test HKDF_Errors-2.8 {Too big size} -body {
	::tls::hkdf -digest sha256 -password key -size 8161
    } -result "Key derivation failed: " -returnCodes {1}

# Scrypt Error Cases


test Scrypt_Errors-3.1 {Too few args} -body {
	::tls::scrypt
    } -result {wrong # args: should be "::tls::scrypt -password string -salt string ?-N costParameter? ?-r blockSize? ?-p parallelization? ?-size derived_length?"} -returnCodes {1}

test Scrypt_Errors-3.2 {Too many args} -body {
	::tls::scrypt too many command line args to pass the test without an error or failing
    } -result {wrong # args: should be "::tls::scrypt -password string -salt string ?-N costParameter? ?-r blockSize? ?-p parallelization? ?-size derived_length?"} -returnCodes {1}

test Scrypt_Errors-3.3 {No password value} -body {
	::tls::scrypt -salt salt -salt salt
    } -result {no password} -returnCodes {1}

test Scrypt_Errors-3.4 {No salt value} -body {
	::tls::scrypt -password key -password key
    } -result {no salt} -returnCodes {1}

test Scrypt_Errors-3.5 {Invalid size} -body {
	::tls::scrypt -password key -salt salt -size 0
    } -result {invalid value "0" for option "-size": must be >= 1} -returnCodes {1}

test Scrypt_Errors-3.6 {Invalid N costParameter} -constraints {knownIgnored} -body {
	::tls::scrypt -password key -salt salt -N 0
    } -returnCodes {1}

test Scrypt_Errors-3.7 {Invalid r blockSize} -constraints {knownIgnored} -body {
	::tls::scrypt -password key -salt salt -r 0
    } -returnCodes {1}

test Scrypt_Errors-3.8 {Invalid p parallelization} -constraints {knownIgnored} -body {
	::tls::scrypt -password key -salt salt -p 0
    } -returnCodes {1}

set digest sha1
set P "password"
set S "salt"
set dkLen 20

# PBKDF2 RFC 6070


test PBKDF2_RFC_6070-4.1 {Test Case 1} -body {
	binary encode hex [::tls::pbkdf2 -digest $digest -password $P -salt $S -iterations 1 -size $dkLen]
    } -result {0c60c80f961f0e71f3a9b524af6012062fe037a6}

test PBKDF2_RFC_6070-4.2 {Test Case 2} -body {
	binary encode hex [::tls::pbkdf2 -digest $digest -password $P -salt $S -iterations 2 -size $dkLen]
    } -result {ea6c014dc72d6f8ccd1ed92ace1d41f0d8de8957}

test PBKDF2_RFC_6070-4.3 {Test Case 3} -body {
	binary encode hex [::tls::pbkdf2 -digest $digest -password $P -salt $S -iterations 4096 -size $dkLen]
    } -result {4b007901b765489abead49d926f721d065a429c1}

test PBKDF2_RFC_6070-4.4 {Test Case 4} -body {
	binary encode hex [::tls::pbkdf2 -digest $digest -password $P -salt $S -iterations 16777216 -size $dkLen]
    } -result {eefe3d61cd4da4e4e9945b3d6ba2158c2634e984}

set digest sha1
set key [binary decode hex 0b0b0b0b0b0b0b0b0b0b0b]
set salt [binary decode hex 000102030405060708090a0b0c]
set info [binary decode hex f0f1f2f3f4f5f6f7f8f9]
set size 42

# HKDF RFC 6234


test HKDF_RFC_6234-5.1 {A.4.  Test Case 4, Basic test case with SHA-1} -body {
	binary encode hex [::tls::hkdf -digest $digest -password $key -salt $salt -info $info -size $size]
    } -result {085a01ea1b10f36933068b56efa5ad81a4f14b822f5b091568a9cdd4f155fda2c22e422478d305f3f896}

set key [binary decode hex 000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f]
set salt [binary decode hex 606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeaf]
set info [binary decode hex b0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfeff]
set size 82


test HKDF_RFC_6234-5.2 {A.5.  Test Case 5, Test with SHA-1 and longer inputs/outputs} -body {
	binary encode hex [::tls::hkdf -digest $digest -password $key -salt $salt -info $info -size $size]
    } -result {0bd770a74d1160f7c9f12cd5912a06ebff6adcae899d92191fe4305673ba2ffe8fa3f1a4e5ad79f3f334b3b202b2173c486ea37ce3d397ed034c7f9dfeb15c5e927336d0441f4c4300e2cff0d0900b52d3b4}

set key [binary decode hex 0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b]
set salt ""
set info ""
set size 42


test HKDF_RFC_6234-5.3 {A.6.  Test Case 6, Test with SHA-1 and zero-length salt/info} -body {
	binary encode hex [::tls::hkdf -digest $digest -password $key -salt $salt -info $info -size $size]
    } -result {0ac1af7002b3d761d1e55298da9d0506b9ae52057220a306e07b6b87e8df21d0ea00033de03984d34918}

set key [binary decode hex 0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c]
set salt ""
set info ""
set size 42


test HKDF_RFC_6234-5.4 {A.7.  Test Case 7, Test with SHA-1, salt not provided (defaults to HashLen zero octets), zero-length info} -body {
	binary encode hex [::tls::hkdf -digest $digest -password $key -salt $salt -info $info -size $size]
    } -result {2c91117204d745f3500d636a62f64f0ab3bae548aa53d423b0d1f27ebba6f5e5673a081d70cce7acfc48}

# Scrypt RFC 7914


test Scrypt_RFC_7914-6.1 {Test Case 1} -body {
	binary encode hex [::tls::scrypt -password "" -salt "" -N 16 -r 1 -p 1 -size 64]
    } -result {77d6576238657b203b19ca42c18a0497f16b4844e3074ae8dfdffa3fede21442fcd0069ded0948f8326a753a0fc81f17e8d3e0fb2e0d3628cf35e20c38d18906}

test Scrypt_RFC_7914-6.2 {Test Case 2} -body {
	binary encode hex [::tls::scrypt -password "password" -salt "NaCl" -N 1024 -r 8 -p 16 -size 64]
    } -result {fdbabe1c9d3472007856e7190d01e9fe7c6ad7cbc8237830e77376634b3731622eaf30d92e22a3886ff109279d9830dac727afb94a83ee6d8360cbdfa2cc0640}

test Scrypt_RFC_7914-6.3 {Test Case 3} -body {
	binary encode hex [::tls::scrypt -password "pleaseletmein" -salt "SodiumChloride" -N 16384 -r 8 -p 1 -size 64]
    } -result {7023bdcb3afd7348461c06cd81fd38ebfda8fbba904f8e3ea9b543f6545da1f2d5432955613f0fcf62d49705242a9af9e61e85dc0d651e40dfcf017b45575887}

test Scrypt_RFC_7914-6.4 {Test Case 4} -body {
	binary encode hex [::tls::scrypt -password "pleaseletmein" -salt "SodiumChloride" -N 1048576 -r 8 -p 1 -size 64]
    } -result {2101cb9b6a511aaeaddbbe09cf70f881ec568d574a2ffd4dabe5ee9820adaa478e56fd8f4ba5d09ffa1c6d927c40f4c337304049e8a952fbcbf45c6fa77a41a4}

# Cleanup
::tcltest::cleanupTests
return

Modified tests/make_test_files.tcl from [c31b96320d] to [e265399d3c].

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
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]
		    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 \[ \" \{]} {
			    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"

Added tests/random.csv version [354daf498a].

















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
,,,,,,,,,,
command,# Random command,,,,,,,,,
Random,Min Length,,,string length [::tls::random 0],,,0,,,
Random,Example 1,,,string length [::tls::random 42],,,42,,,
Random,Example 2,,,string length [::tls::random 1000],,,1000,,,
Random,Private Option,,,string length [::tls::random -private 42],,,42,,,
,,,,,,,,,,
command,# Random command errors,,,,,,,,,
Random Errors,Too few args,,,::tls::random,,,"wrong # args: should be ""::tls::random ?-private? length""",,,1
Random Errors,Too many args,,,::tls::random too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::random ?-private? length""",,,1
Random Errors,Invalid length value,,,::tls::random bogus,,,"expected integer but got ""bogus""",,,1
Random Errors,Negative length,,,::tls::random -1,,,"bad count ""-1"": must be integer >= 0",,,1
Random Errors,Invalid option,,,::tls::random -bogus 42,,,"bad option ""-bogus"": must be -private",,,1
Random Errors,Invalid length with option,,,::tls::random -private bogus,,,"expected integer but got ""bogus""",,,1

Added tests/random.test version [13cb064c8c].






























































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated test cases for random.csv

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

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

package require tls

# Random command


test Random-1.1 {Min Length} -body {
	string length [::tls::random 0]
    } -result {0}

test Random-1.2 {Example 1} -body {
	string length [::tls::random 42]
    } -result {42}

test Random-1.3 {Example 2} -body {
	string length [::tls::random 1000]
    } -result {1000}

test Random-1.4 {Private Option} -body {
	string length [::tls::random -private 42]
    } -result {42}

# Random command errors


test Random_Errors-2.1 {Too few args} -body {
	::tls::random
    } -result {wrong # args: should be "::tls::random ?-private? length"} -returnCodes {1}

test Random_Errors-2.2 {Too many args} -body {
	::tls::random too many command line args to pass the test without an error or failing
    } -result {wrong # args: should be "::tls::random ?-private? length"} -returnCodes {1}

test Random_Errors-2.3 {Invalid length value} -body {
	::tls::random bogus
    } -result {expected integer but got "bogus"} -returnCodes {1}

test Random_Errors-2.4 {Negative length} -body {
	::tls::random -1
    } -result {bad count "-1": must be integer >= 0} -returnCodes {1}

test Random_Errors-2.5 {Invalid option} -body {
	::tls::random -bogus 42
    } -result {bad option "-bogus": must be -private} -returnCodes {1}

test Random_Errors-2.6 {Invalid length with option} -body {
	::tls::random -private bogus
    } -result {expected integer but got "bogus"} -returnCodes {1}

# Cleanup
::tcltest::cleanupTests
return

Added tests/test_vectors/Hash/BLAKE2b512.test version [8e818cab70].


























































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated from "BLAKE2b512.txt"
package require tls
package require tcltest

tcltest::testConstraint BLAKE2b512 [expr {[lsearch -nocase [tls::digests] BLAKE2b512] > -1}]

tcltest::test Hash_BLAKE2b512-1.1 {BLAKE2b512} \
	-constraints BLAKE2b512 \
	-setup {set data ""} \
	-body {tls::digest -digest BLAKE2b512 -data $data} \
	-match exact -result 786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce

tcltest::test Hash_BLAKE2b512-1.2 {BLAKE2b512} \
	-constraints BLAKE2b512 \
	-setup {set data "a"} \
	-body {tls::digest -digest BLAKE2b512 -data $data} \
	-match exact -result 333fcb4ee1aa7c115355ec66ceac917c8bfd815bf7587d325aec1864edd24e34d5abe2c6b1b5ee3face62fed78dbef802f2a85cb91d455a8f5249d330853cb3c

tcltest::test Hash_BLAKE2b512-1.3 {BLAKE2b512} \
	-constraints BLAKE2b512 \
	-setup {set data "abc"} \
	-body {tls::digest -digest BLAKE2b512 -data $data} \
	-match exact -result ba80a53f981c4d0d6a2797b69f12f6e94c212f14685ac4b74b12bb6fdbffa2d17d87c5392aab792dc252d5de4533cc9518d38aa8dbf1925ab92386edd4009923

tcltest::test Hash_BLAKE2b512-1.4 {BLAKE2b512} \
	-constraints BLAKE2b512 \
	-setup {set data "message digest"} \
	-body {tls::digest -digest BLAKE2b512 -data $data} \
	-match exact -result 3c26ce487b1c0f062363afa3c675ebdbf5f4ef9bdc022cfbef91e3111cdc283840d8331fc30a8a0906cff4bcdbcd230c61aaec60fdfad457ed96b709a382359a

tcltest::test Hash_BLAKE2b512-1.5 {BLAKE2b512} \
	-constraints BLAKE2b512 \
	-setup {set data "abcdefghijklmnopqrstuvwxyz"} \
	-body {tls::digest -digest BLAKE2b512 -data $data} \
	-match exact -result c68ede143e416eb7b4aaae0d8e48e55dd529eafed10b1df1a61416953a2b0a5666c761e7d412e6709e31ffe221b7a7a73908cb95a4d120b8b090a87d1fbedb4c

tcltest::test Hash_BLAKE2b512-1.6 {BLAKE2b512} \
	-constraints BLAKE2b512 \
	-setup {set data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"} \
	-body {tls::digest -digest BLAKE2b512 -data $data} \
	-match exact -result 99964802e5c25e703722905d3fb80046b6bca698ca9e2cc7e49b4fe1fa087c2edf0312dfbb275cf250a1e542fd5dc2edd313f9c491127c2e8c0c9b24168e2d50

tcltest::test Hash_BLAKE2b512-1.7 {BLAKE2b512} \
	-constraints BLAKE2b512 \
	-setup {set data "12345678901234567890123456789012345678901234567890123456789012345678901234567890"} \
	-body {tls::digest -digest BLAKE2b512 -data $data} \
	-match exact -result 686f41ec5afff6e87e1f076f542aa466466ff5fbde162c48481ba48a748d842799f5b30f5b67fc684771b33b994206d05cc310f31914edd7b97e41860d77d282

tcltest::test Hash_BLAKE2b512-1.8 {BLAKE2b512} \
	-constraints BLAKE2b512 \
	-setup {set data "The quick brown fox jumps over the lazy dog"} \
	-body {tls::digest -digest BLAKE2b512 -data $data} \
	-match exact -result a8add4bdddfd93e4877d2746e62817b116364a1fa7bc148d95090bc7333b3673f82401cf7aa2e4cb1ecd90296e3f14cb5413f8ed77be73045b13914cdcd6a918

# Cleanup
::tcltest::cleanupTests
return

Added tests/test_vectors/Hash/BLAKE2b512.txt version [d3c92f5aad].











































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# blake2b512
# From https://github.com/BLAKE2/BLAKE2/tree/master/testvectors

[L = 64]

Len = 0
Msg = ""
MD = 786a02f742015903c6c6fd852552d272912f4740e15847618a86e217f71f5419d25e1031afee585313896444934eb04b903a685b1448b755d56f701afe9be2ce

Len = 1
Msg = "a"
#Msg = 61
MD = 333fcb4ee1aa7c115355ec66ceac917c8bfd815bf7587d325aec1864edd24e34d5abe2c6b1b5ee3face62fed78dbef802f2a85cb91d455a8f5249d330853cb3c

Len = 3
Msg = "abc"
#Msg = 616263
MD = ba80a53f981c4d0d6a2797b69f12f6e94c212f14685ac4b74b12bb6fdbffa2d17d87c5392aab792dc252d5de4533cc9518d38aa8dbf1925ab92386edd4009923

Len = 14
Msg = "message digest"
#Msg = 6d65737361676520646967657374
MD = 3c26ce487b1c0f062363afa3c675ebdbf5f4ef9bdc022cfbef91e3111cdc283840d8331fc30a8a0906cff4bcdbcd230c61aaec60fdfad457ed96b709a382359a

Len = 26
Msg = "abcdefghijklmnopqrstuvwxyz"
#Msg = 6162636465666768696a6b6c6d6e6f707172737475767778797a
MD = c68ede143e416eb7b4aaae0d8e48e55dd529eafed10b1df1a61416953a2b0a5666c761e7d412e6709e31ffe221b7a7a73908cb95a4d120b8b090a87d1fbedb4c

Len = 62
Msg = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
#Msg = 4142434445464748494a4b4c4d4e4f505152535455565758595a6162636465666768696a6b6c6d6e6f707172737475767778797a30313233343536373839
MD = 99964802e5c25e703722905d3fb80046b6bca698ca9e2cc7e49b4fe1fa087c2edf0312dfbb275cf250a1e542fd5dc2edd313f9c491127c2e8c0c9b24168e2d50

Len = 80
Msg = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
#Msg = 3132333435363738393031323334353637383930313233343536373839303132333435363738393031323334353637383930313233343536373839303132333435363738393031323334353637383930
MD = 686f41ec5afff6e87e1f076f542aa466466ff5fbde162c48481ba48a748d842799f5b30f5b67fc684771b33b994206d05cc310f31914edd7b97e41860d77d282

Len = 43
Msg = "The quick brown fox jumps over the lazy dog"
MD = a8add4bdddfd93e4877d2746e62817b116364a1fa7bc148d95090bc7333b3673f82401cf7aa2e4cb1ecd90296e3f14cb5413f8ed77be73045b13914cdcd6a918

Added tests/test_vectors/Hash/BLAKE2s256.test version [0d1c096bbe].


























































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated from "BLAKE2s256.txt"
package require tls
package require tcltest

tcltest::testConstraint BLAKE2s256 [expr {[lsearch -nocase [tls::digests] BLAKE2s256] > -1}]

tcltest::test Hash_BLAKE2s256-1.1 {BLAKE2s256} \
	-constraints BLAKE2s256 \
	-setup {set data ""} \
	-body {tls::digest -digest BLAKE2s256 -data $data} \
	-match exact -result 69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9

tcltest::test Hash_BLAKE2s256-1.2 {BLAKE2s256} \
	-constraints BLAKE2s256 \
	-setup {set data "a"} \
	-body {tls::digest -digest BLAKE2s256 -data $data} \
	-match exact -result 4a0d129873403037c2cd9b9048203687f6233fb6738956e0349bd4320fec3e90

tcltest::test Hash_BLAKE2s256-1.3 {BLAKE2s256} \
	-constraints BLAKE2s256 \
	-setup {set data "abc"} \
	-body {tls::digest -digest BLAKE2s256 -data $data} \
	-match exact -result 508c5e8c327c14e2e1a72ba34eeb452f37458b209ed63a294d999b4c86675982

tcltest::test Hash_BLAKE2s256-1.4 {BLAKE2s256} \
	-constraints BLAKE2s256 \
	-setup {set data "message digest"} \
	-body {tls::digest -digest BLAKE2s256 -data $data} \
	-match exact -result fa10ab775acf89b7d3c8a6e823d586f6b67bdbac4ce207fe145b7d3ac25cd28c

tcltest::test Hash_BLAKE2s256-1.5 {BLAKE2s256} \
	-constraints BLAKE2s256 \
	-setup {set data "abcdefghijklmnopqrstuvwxyz"} \
	-body {tls::digest -digest BLAKE2s256 -data $data} \
	-match exact -result bdf88eb1f86a0cdf0e840ba88fa118508369df186c7355b4b16cf79fa2710a12

tcltest::test Hash_BLAKE2s256-1.6 {BLAKE2s256} \
	-constraints BLAKE2s256 \
	-setup {set data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"} \
	-body {tls::digest -digest BLAKE2s256 -data $data} \
	-match exact -result c75439ea17e1de6fa4510c335dc3d3f343e6f9e1ce2773e25b4174f1df8b119b

tcltest::test Hash_BLAKE2s256-1.7 {BLAKE2s256} \
	-constraints BLAKE2s256 \
	-setup {set data "12345678901234567890123456789012345678901234567890123456789012345678901234567890"} \
	-body {tls::digest -digest BLAKE2s256 -data $data} \
	-match exact -result fdaedb290a0d5af9870864fec2e090200989dc9cd53a3c092129e8535e8b4f66

tcltest::test Hash_BLAKE2s256-1.8 {BLAKE2s256} \
	-constraints BLAKE2s256 \
	-setup {set data "The quick brown fox jumps over the lazy dog"} \
	-body {tls::digest -digest BLAKE2s256 -data $data} \
	-match exact -result 606beeec743ccbeff6cbcdf5d5302aa855c256c29b88c8ed331ea1a6bf3c8812

# Cleanup
::tcltest::cleanupTests
return

Added tests/test_vectors/Hash/BLAKE2s256.txt version [e3f8f87e87].











































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# blake2s256
# From https://github.com/BLAKE2/BLAKE2/tree/master/testvectors

[L = 32]

Len = 0
Msg = ""
MD = 69217a3079908094e11121d042354a7c1f55b6482ca1a51e1b250dfd1ed0eef9

Len = 1
Msg = "a"
#Msg = 61
MD = 4a0d129873403037c2cd9b9048203687f6233fb6738956e0349bd4320fec3e90

Len = 3
Msg = "abc"
#Msg = 616263
MD = 508c5e8c327c14e2e1a72ba34eeb452f37458b209ed63a294d999b4c86675982

Len = 14
Msg = "message digest"
#Msg = 6d65737361676520646967657374
MD = fa10ab775acf89b7d3c8a6e823d586f6b67bdbac4ce207fe145b7d3ac25cd28c

Len = 26
Msg = "abcdefghijklmnopqrstuvwxyz"
#Msg = 6162636465666768696a6b6c6d6e6f707172737475767778797a
MD = bdf88eb1f86a0cdf0e840ba88fa118508369df186c7355b4b16cf79fa2710a12

Len = 62
Msg = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
#Msg = 4142434445464748494a4b4c4d4e4f505152535455565758595a6162636465666768696a6b6c6d6e6f707172737475767778797a30313233343536373839
MD = c75439ea17e1de6fa4510c335dc3d3f343e6f9e1ce2773e25b4174f1df8b119b

Len = 80
Msg = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
#Msg = 3132333435363738393031323334353637383930313233343536373839303132333435363738393031323334353637383930313233343536373839303132333435363738393031323334353637383930
MD = fdaedb290a0d5af9870864fec2e090200989dc9cd53a3c092129e8535e8b4f66

Len = 43
Msg = "The quick brown fox jumps over the lazy dog"
MD = 606beeec743ccbeff6cbcdf5d5302aa855c256c29b88c8ed331ea1a6bf3c8812

Added tests/test_vectors/Hash/MD2.test version [99bc7b516b].




















































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated from "MD2.txt"
package require tls
package require tcltest

tcltest::testConstraint MD2 [expr {[lsearch -nocase [tls::digests] MD2] > -1}]

tcltest::test Hash_MD2-1.1 {MD2} \
	-constraints MD2 \
	-setup {set data ""} \
	-body {tls::digest -digest MD2 -data $data} \
	-match exact -result 8350e5a3e24c153df2275c9f80692773

tcltest::test Hash_MD2-1.2 {MD2} \
	-constraints MD2 \
	-setup {set data "a"} \
	-body {tls::digest -digest MD2 -data $data} \
	-match exact -result 32ec01ec4a6dac72c0ab96fb34c0b5d1

tcltest::test Hash_MD2-1.3 {MD2} \
	-constraints MD2 \
	-setup {set data "abc"} \
	-body {tls::digest -digest MD2 -data $data} \
	-match exact -result da853b0d3f88d99b30283a69e6ded6bb

tcltest::test Hash_MD2-1.4 {MD2} \
	-constraints MD2 \
	-setup {set data "message digest"} \
	-body {tls::digest -digest MD2 -data $data} \
	-match exact -result ab4f496bfb2a530b219ff33031fe06b0

tcltest::test Hash_MD2-1.5 {MD2} \
	-constraints MD2 \
	-setup {set data "abcdefghijklmnopqrstuvwxyz"} \
	-body {tls::digest -digest MD2 -data $data} \
	-match exact -result 4e8ddff3650292ab5a4108c3aa47940b

tcltest::test Hash_MD2-1.6 {MD2} \
	-constraints MD2 \
	-setup {set data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"} \
	-body {tls::digest -digest MD2 -data $data} \
	-match exact -result da33def2a42df13975352846c30338cd

tcltest::test Hash_MD2-1.7 {MD2} \
	-constraints MD2 \
	-setup {set data "12345678901234567890123456789012345678901234567890123456789012345678901234567890"} \
	-body {tls::digest -digest MD2 -data $data} \
	-match exact -result d5976f79d83d3a0dc9806c3c66f3efd8

# Cleanup
::tcltest::cleanupTests
return

Added tests/test_vectors/Hash/MD2.txt version [72dbd4087b].































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# MD2
# From RFC 1319

Len = 0
Msg = ""
MD = 8350e5a3e24c153df2275c9f80692773

Len = 1
Msg = "a"
MD = 32ec01ec4a6dac72c0ab96fb34c0b5d1

Len = 3
Msg = "abc"
MD = da853b0d3f88d99b30283a69e6ded6bb

Len = 14
Msg = "message digest"
MD = ab4f496bfb2a530b219ff33031fe06b0

Len = 26
Msg = "abcdefghijklmnopqrstuvwxyz"
MD = 4e8ddff3650292ab5a4108c3aa47940b

Len = 62
Msg = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
MD = da33def2a42df13975352846c30338cd

Len = 80
Msg = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
MD = d5976f79d83d3a0dc9806c3c66f3efd8

Added tests/test_vectors/Hash/MD4.test version [467c08c34a].


























































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated from "MD4.txt"
package require tls
package require tcltest

tcltest::testConstraint MD4 [expr {[lsearch -nocase [tls::digests] MD4] > -1}]

tcltest::test Hash_MD4-1.1 {MD4} \
	-constraints MD4 \
	-setup {set data ""} \
	-body {tls::digest -digest MD4 -data $data} \
	-match exact -result 31d6cfe0d16ae931b73c59d7e0c089c0

tcltest::test Hash_MD4-1.2 {MD4} \
	-constraints MD4 \
	-setup {set data "a"} \
	-body {tls::digest -digest MD4 -data $data} \
	-match exact -result bde52cb31de33e46245e05fbdbd6fb24

tcltest::test Hash_MD4-1.3 {MD4} \
	-constraints MD4 \
	-setup {set data "abc"} \
	-body {tls::digest -digest MD4 -data $data} \
	-match exact -result a448017aaf21d8525fc10ae87aa6729d

tcltest::test Hash_MD4-1.4 {MD4} \
	-constraints MD4 \
	-setup {set data "message digest"} \
	-body {tls::digest -digest MD4 -data $data} \
	-match exact -result d9130a8164549fe818874806e1c7014b

tcltest::test Hash_MD4-1.5 {MD4} \
	-constraints MD4 \
	-setup {set data "abcdefghijklmnopqrstuvwxyz"} \
	-body {tls::digest -digest MD4 -data $data} \
	-match exact -result d79e1c308aa5bbcdeea8ed63df412da9

tcltest::test Hash_MD4-1.6 {MD4} \
	-constraints MD4 \
	-setup {set data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"} \
	-body {tls::digest -digest MD4 -data $data} \
	-match exact -result 043f8582f241db351ce627e153e7f0e4

tcltest::test Hash_MD4-1.7 {MD4} \
	-constraints MD4 \
	-setup {set data "12345678901234567890123456789012345678901234567890123456789012345678901234567890"} \
	-body {tls::digest -digest MD4 -data $data} \
	-match exact -result e33b4ddc9c38f2199c3e7b164fcc0536

tcltest::test Hash_MD4-1.8 {MD4} \
	-constraints MD4 \
	-setup {set data "The quick brown fox jumps over the lazy dog"} \
	-body {tls::digest -digest MD4 -data $data} \
	-match exact -result 1bee69a46ba811185c194762abaeae90

# Cleanup
::tcltest::cleanupTests
return

Added tests/test_vectors/Hash/MD4.txt version [e0a9e8ce64].



































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# MD4
# From RFC 1320

Len = 0
Msg = ""
MD = 31d6cfe0d16ae931b73c59d7e0c089c0

Len = 1
Msg = "a"
MD = bde52cb31de33e46245e05fbdbd6fb24

Len = 3
Msg = "abc"
MD = a448017aaf21d8525fc10ae87aa6729d

Len = 14
Msg = "message digest"
MD = d9130a8164549fe818874806e1c7014b

Len = 26
Msg = "abcdefghijklmnopqrstuvwxyz"
MD = d79e1c308aa5bbcdeea8ed63df412da9

Len = 62
Msg = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
MD = 043f8582f241db351ce627e153e7f0e4

Len = 80
Msg = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
MD = e33b4ddc9c38f2199c3e7b164fcc0536

Len = 43
Msg = "The quick brown fox jumps over the lazy dog"
MD = 1bee69a46ba811185c194762abaeae90

Added tests/test_vectors/Hash/MD5.test version [4a3b7c9208].


























































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated from "MD5.txt"
package require tls
package require tcltest

tcltest::testConstraint MD5 [expr {[lsearch -nocase [tls::digests] MD5] > -1}]

tcltest::test Hash_MD5-1.1 {MD5} \
	-constraints MD5 \
	-setup {set data ""} \
	-body {tls::digest -digest MD5 -data $data} \
	-match exact -result d41d8cd98f00b204e9800998ecf8427e

tcltest::test Hash_MD5-1.2 {MD5} \
	-constraints MD5 \
	-setup {set data "a"} \
	-body {tls::digest -digest MD5 -data $data} \
	-match exact -result 0cc175b9c0f1b6a831c399e269772661

tcltest::test Hash_MD5-1.3 {MD5} \
	-constraints MD5 \
	-setup {set data "abc"} \
	-body {tls::digest -digest MD5 -data $data} \
	-match exact -result 900150983cd24fb0d6963f7d28e17f72

tcltest::test Hash_MD5-1.4 {MD5} \
	-constraints MD5 \
	-setup {set data "message digest"} \
	-body {tls::digest -digest MD5 -data $data} \
	-match exact -result f96b697d7cb7938d525a2f31aaf161d0

tcltest::test Hash_MD5-1.5 {MD5} \
	-constraints MD5 \
	-setup {set data "abcdefghijklmnopqrstuvwxyz"} \
	-body {tls::digest -digest MD5 -data $data} \
	-match exact -result c3fcd3d76192e4007dfb496cca67e13b

tcltest::test Hash_MD5-1.6 {MD5} \
	-constraints MD5 \
	-setup {set data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"} \
	-body {tls::digest -digest MD5 -data $data} \
	-match exact -result d174ab98d277d9f5a5611c2c9f419d9f

tcltest::test Hash_MD5-1.7 {MD5} \
	-constraints MD5 \
	-setup {set data "12345678901234567890123456789012345678901234567890123456789012345678901234567890"} \
	-body {tls::digest -digest MD5 -data $data} \
	-match exact -result 57edf4a22be3c955ac49da2e2107b67a

tcltest::test Hash_MD5-1.8 {MD5} \
	-constraints MD5 \
	-setup {set data "The quick brown fox jumps over the lazy dog"} \
	-body {tls::digest -digest MD5 -data $data} \
	-match exact -result 9e107d9d372bb6826bd81d3542a419d6

# Cleanup
::tcltest::cleanupTests
return

Added tests/test_vectors/Hash/MD5.txt version [1f89db3968].









































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# MD5
# From RFC 1321

Len = 0
Msg = ""
MD = d41d8cd98f00b204e9800998ecf8427e

Len = 1
Msg = "a"
#Msg = 61
MD = 0cc175b9c0f1b6a831c399e269772661

Len = 3
Msg = "abc"
#Msg = 616263
MD = 900150983cd24fb0d6963f7d28e17f72

Len = 14
Msg = "message digest"
#Msg = 6d65737361676520646967657374
MD = f96b697d7cb7938d525a2f31aaf161d0

Len = 26
Msg = "abcdefghijklmnopqrstuvwxyz"
#Msg = 6162636465666768696a6b6c6d6e6f707172737475767778797a
MD = c3fcd3d76192e4007dfb496cca67e13b

Len = 62
Msg = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
#Msg = 4142434445464748494a4b4c4d4e4f505152535455565758595a6162636465666768696a6b6c6d6e6f707172737475767778797a30313233343536373839
MD = d174ab98d277d9f5a5611c2c9f419d9f

Len = 80
Msg = "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
#3132333435363738393031323334353637383930313233343536373839303132333435363738393031323334353637383930313233343536373839303132333435363738393031323334353637383930
MD = 57edf4a22be3c955ac49da2e2107b67a

Len = 43
Msg = "The quick brown fox jumps over the lazy dog"
MD = 9e107d9d372bb6826bd81d3542a419d6

Added tests/test_vectors/Hash/MDC2.test version [9cb43c6d6f].






















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated from "MDC2.txt"
package require tls
package require tcltest

tcltest::testConstraint MDC2 [expr {[lsearch -nocase [tls::digests] MDC2] > -1}]

tcltest::test Hash_MDC2-1.1 {MDC2} \
	-constraints MDC2 \
	-setup {set data ""} \
	-body {tls::digest -digest MDC2 -data $data} \
	-match exact -result 52525252525252522525252525252525

tcltest::test Hash_MDC2-1.2 {MDC2} \
	-constraints MDC2 \
	-setup {set data "The quick brown fox jumps over the lazy dog"} \
	-body {tls::digest -digest MDC2 -data $data} \
	-match exact -result 000ed54e093d61679aefbeae05bfe33a

# Cleanup
::tcltest::cleanupTests
return

Added tests/test_vectors/Hash/MDC2.txt version [c90b9728d3].











1
2
3
4
5
6
7
8
9
10
+
+
+
+
+
+
+
+
+
+
# MDC2
# From https://en.wikipedia.org/wiki/MDC-2

Len = 0
Msg = ""
MD = 52525252525252522525252525252525

Len = 43
Msg = "The quick brown fox jumps over the lazy dog"
MD = 000ed54e093d61679aefbeae05bfe33a

Added tests/test_vectors/Hash/RIPEMD128.test version [d7315ba5f4].






































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Auto generated from "RIPEMD128.txt"
package require tls
package require tcltest

tcltest::testConstraint RIPEMD128 [expr {[lsearch -nocase [tls::digests] RIPEMD128] > -1}]

tcltest::test Hash_RIPEMD128-1.1 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data ""} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result cdf26213a150dc3ecb610f18f6b38b46

tcltest::test Hash_RIPEMD128-1.2 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data "a"} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result 86be7afa339d0fc7cfc785e72f578d33

tcltest::test Hash_RIPEMD128-1.3 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data "abc"} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result c14a12199c66e4ba84636b0f69144c77

tcltest::test Hash_RIPEMD128-1.4 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data "message digest"} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result 9e327b3d6e523062afc1132d7df9d1b8

tcltest::test Hash_RIPEMD128-1.5 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data "abcdefghijklmnopqrstuvwxyz"} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result fd2aa607f71dc8f510714922b371834e

tcltest::test Hash_RIPEMD128-1.6 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result a1aa0689d0fafa2ddc22e88b49133a06

tcltest::test Hash_RIPEMD128-1.7 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result d1e959eb179c911faea4624c60c5c702

tcltest::test Hash_RIPEMD128-1.8 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data [string repeat "1234567890" 8]} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result 3f45ef194732c2dbb2c4a2c769795fa3

tcltest::test Hash_RIPEMD128-1.9 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data [string repeat "a" 1000000]} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result 4a7f5723f954eba1216c9d8f6320431f

tcltest::test Hash_RIPEMD128-1.10 {RIPEMD128} \
	-constraints RIPEMD128 \
	-setup {set data "The quick brown fox jumps over the lazy dog"} \
	-body {tls::digest -digest RIPEMD128 -data $data} \
	-match exact -result 3fa9b57f053c053fbe2735b2380db596

# Cleanup
::tcltest::cleanupTests
return

Added tests/test_vectors/Hash/RIPEMD128.txt version [8200be1de0].