Changes On Branch fc183cdaa1cc064b

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

This is equivalent to a diff from 914ac6b2a4 to fc183cdaa1

2023-11-22
22:18
Fix to IO test missing set blocking value. See https://core.tcl-lang.org/tcltls/tktview/bb7085cfdc check-in: 104e43c85e user: bohagan tags: trunk
2023-11-13
02:26
Corrected test cases check-in: 1d173cfaca user: bohagan tags: crypto
2023-11-12
05:23
Added cmac and hmac commands to documentation check-in: fc183cdaa1 user: bohagan tags: crypto
2023-11-10
22:23
Added cmac and hmac convenience commands check-in: 992cc75b71 user: bohagan tags: crypto
2023-10-28
17:30
Merged in changes from master check-in: 1de7e0ec74 user: bohagan tags: crypto
17:20
Optimized TLS channel type definition check-in: 914ac6b2a4 user: bohagan tags: trunk
2023-10-09
19:08
Updated to latest TEA and Tcl Config check-in: ec0cc9fbdf user: bohagan tags: trunk

Modified configure from [4c56eae107] to [285f813da9].

5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------


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







|







5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------


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

Modified configure.ac from [ac9d3aa5eb] to [48f68fd73a].

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

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








|







67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
# public headers that need to be installed in TEA_ADD_HEADERS,
# stub library C source files to compile in TEA_ADD_STUB_SOURCES,
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------

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

Modified doc/tls.html from [9494c1c42e] to [cf50cb73f4].

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
	    <dd><b>tls::socket</b> <em> ?-server command? ?options? port</em></dd>
	    <dd><b>tls::handshake</b> <em> channel</em></dd>
	    <dd><b>tls::status </b> <em>?-local? channel</em></dd>
	    <dd><b>tls::connection </b> <em>channel</em></dd>
	    <dd><b>tls::import</b> <em>channel ?options?</em></dd>
	    <dd><b>tls::unimport</b> <em>channel</em></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::ciphers </b> <em>protocol ?verbose? ?supported?</em></dd>


	    <dd><b>tls::protocols</b></dd>
	    <dd><b>tls::version</b></dd>









	</dl>
    </dd>
    <dd><a href="#COMMANDS">COMMANDS</a></dd>
    <dd><a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a></dd>
    <dd><a href="#HTTPS EXAMPLE">HTTPS EXAMPLE</a></dd>
    <dd><a href="#SEE ALSO">SPECIAL CONSIDERATIONS</a></dd>
    <dd><a href="#SEE ALSO">SEE ALSO</a></dd>
</dl>

<hr>

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

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

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

<p><b>package require Tcl 8.4</b><br>
<b>package require tls</b><br>
<br>
<a href="#tls::init"><b>tls::init</b> <i>?options?</i></a><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?options? host port</i><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?-server command? ?options? port</i></a><br>
<a href="#tls::status"><b>tls::status</b> <i>?-local? channel</i></a><br>
<a href="#tls::connection"><b>tls::connection</b> <i>channel</i></a><br>
<a href="#tls::handshake"><b>tls::handshake</b> <i>channel</i></a><br>
<a href="#tls::import"><b>tls::import</b> <i>channel ?options?</i></a><br>
<a href="#tls::unimport"><b>tls::unimport</b> <i>channel</i></a><br>
<br>
<a href="#tls::ciphers"><b>tls::ciphers</b> <i>protocol ?verbose? ?supported?</i></a><br>


<a href="#tls::protocols"><b>tls::protocols</b></a>
<a href="#tls::version"><b>tls::version</b></a>









</p>

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

<p>This extension provides a generic binding to <a
href="http://www.openssl.org/">OpenSSL</a>, utilizing the
<strong>Tcl_StackChannel</strong>







|
>
>


>
>
>
>
>
>
>
>
>


















|











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







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
	    <dd><b>tls::socket</b> <em> ?-server command? ?options? port</em></dd>
	    <dd><b>tls::handshake</b> <em> channel</em></dd>
	    <dd><b>tls::status </b> <em>?-local? channel</em></dd>
	    <dd><b>tls::connection </b> <em>channel</em></dd>
	    <dd><b>tls::import</b> <em>channel ?options?</em></dd>
	    <dd><b>tls::unimport</b> <em>channel</em></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::ciphers</b> <em>?protocol? ?verbose? ?supported?</em></dd>
	    <dd><b>tls::digests</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::digest</b> <em>type ?options?</em></dd>
	    <dd><b>tls::cmac</b> <em>type</em> <b>-cipher</b> <em>name ?options?</em></dd>
	    <dd><b>tls::hmac</b> <em>type</em> <b>-key</b> <em>key ?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>
	</dl>
    </dd>
    <dd><a href="#COMMANDS">COMMANDS</a></dd>
    <dd><a href="#CALLBACK OPTIONS">CALLBACK OPTIONS</a></dd>
    <dd><a href="#HTTPS EXAMPLE">HTTPS EXAMPLE</a></dd>
    <dd><a href="#SEE ALSO">SPECIAL CONSIDERATIONS</a></dd>
    <dd><a href="#SEE ALSO">SEE ALSO</a></dd>
</dl>

<hr>

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

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

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

<p><b>package require Tcl 8.5</b><br>
<b>package require tls</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::digests"><b>tls::digests</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::digest"><b>tls::digest</b> <i>type ?options?</i></a><br>
<a href="#tls::cmac"><b>tls::cmac</b> <i>type</i> <b>-cipher</b> <i>name ?options?</i></a><br>
<a href="#tls::hmac"><b>tls::hmac</b> <i>type</i> <b>-key</b> <i>key ?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>
</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>
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
	<dd>Unique session master key.</dd>
	<dt><strong>session_cache_mode</strong> <em>mode</em></dt>
	<dd>Server cache mode (client, server, or both).</dd>
    </dl>
</blockquote>

    <dt><a name="tls::ciphers"><strong>tls::ciphers</strong>
    <em>protocol ?verbose? ?supported?</em></a></dt>
    <dd>Returns a list of supported ciphers available for <em>protocol</em>,

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








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

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



























































</dl>

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

<p>
As indicated above, individual channels can be given their own callbacks
to handle intermediate processing by the OpenSSL library, using the







|
|
>
|
|
|
|


>
>
>
>
>
>
>









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







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
	<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>Without any args, returns a list of all ciphers. With
	<em>protocol</em>, only the ciphers supported for that protocol
	are returned where <em>protocol</em> 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::digests"><strong>tls::digests</strong></a></dt>
    <dd>Returns a list of the hash algorithms for <b>tls::digest</b> command.</dd>

    <dt><a name="tls::macs"><strong>tls::macs</strong></a></dt>
    <dd>Returns a list of the available Message Authentication Codes (MAC) for
	the <b>tls::digest</b> command.</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>
    <dt><a name="tls::digest"><strong>tls::digest</strong> <em>digest ?-bin|-hex?
	[-file filename | -command cmdName | -chan channelId | ?-data? data]</em></a></dt>
    <dd>Calculate the message digest for data using <em>digest</em> hash
	function. Returns value as a hex string (default) or as a binary value
	with <b>-bin</b> option. Argument <em>digest</em> can be any OpenSSL
	supported hash function including: <b>md4</b>, <b>md5</b>, <b>sha1</b>,
	<b>sha256</b>, <b>sha512</b>, <b>sha3-256</b>, etc. See
	<b>tls::digests</b> command for a full list.
	<br>
	Using the <b>-data</b> option will immediately return the message
	digest for <em>data</em> in the specified format.
	<br>
	Using the <b>-file</b> option will open file <em>filename</em>, read
	the file data, close the file, and return the message digest in the
	specified format. This uses the TCL APIs, so VFS files are supported.
	<br>
	Using the <b>-chan</b> option, a stacked channel is created for
	<em>channelId</em> and data read from the channel is used to calculate
	a message digest with the result returned with the last read operation
	before EOF. Channel is automatically set to binary mode.
	<br>
	Using the <b>-command</b> option, a new command <em>cmdName</em> is
	created and returned. To add data to the hash function, call
	&quot;<em>cmdName</em> <b>update</b> <em>data</em>&quot;, where data is
	the data to add. When done, call &quot;<em>cmdName</em> <b>finalize</b>&quot;
	to return the message digest.
	</dd>

    <dt><a name="tls::cmac"><strong>tls::cmac</strong> <em>digest</em>
	<strong>-cipher</strong> <em>name</em> ?-bin|-hex? [-file filename |
	-command cmdName | -chan channelId | ?-data? data]</em></a></dt>
    <dd>Calculate the Cipher-based Message Authentication Code (CMAC). Same arguments
	as <b>tls::digest</b> with additional option <b>-cipher</b> to specify the
	cipher to use and for certain ciphers, <b>-key</b> to specify the key.</dd>

    <dt><a name="tls::hmac"><strong>tls::hmac</strong> <em>digest</em>
	<strong>-key</strong> <em>key</em> ?-bin|-hex? [-file filename |
	-command cmdName | -chan channelId | ?-data? data]</em></a></dt>
    <dd>Calculate the Hashed Message Authentication Code (HMAC). Same arguments
	as <b>tls::digest</b> with additional option <b>-key</b> to specify the
	key to use. To salt a password, append or prepend the salt
	data to the password. </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>
</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

Modified generic/tclOpts.h from [fee5089a30] to [c197957f96].

1
2
3
4
5
6
7
8
9






10
11
12
13
14
15
16
17
18
19

20
21
22

23
24
25
26
27
28
29
/*
 *  Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Stylized option processing - requires consistent
 * external vars: opt, idx, objc, objv
 */

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H







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

#define OPT_POSTLOG()				\
	continue;				\
    }

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

#define OPTSTR(option, var)			\
    OPT_PROLOG(option)				\









>
>
>
>
>
>










>



>







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

#ifndef _TCL_OPTS_H
#define _TCL_OPTS_H

#define OPTFLAG(option, var, val)		\
    if (strcmp(opt, (option)) == 0) {		\
	var = val;				\
	continue;				\
    }

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

#define OPT_POSTLOG()				\
	continue;				\
    }

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

#define OPTSTR(option, var)			\
    OPT_PROLOG(option)				\
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

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

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

#endif /* _TCL_OPTS_H */







|










50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
    OPT_PROLOG(option)				\
    if (Tcl_GetBooleanFromObj(interp, objv[idx],\
	    &(var)) != TCL_OK) {		\
	    return TCL_ERROR;			\
    }						\
    OPT_POSTLOG()

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

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

#endif /* _TCL_OPTS_H */

Modified generic/tls.c from [f4a59d7949] to [2858ec05c6].

22
23
24
25
26
27
28




29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 *
 */

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




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

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

/*
 * External functions
 */

/*
 * Forward declarations
 */

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

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

static int	TlsLibInit(int uninitialize);







>
>
>
>



















<







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

52
53
54
55
56
57
58
 *
 */

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

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

/*
 * External functions
 */

/*
 * Forward declarations
 */

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


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

static int	TlsLibInit(int uninitialize);
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    if (msg != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), (Tcl_Size *)NULL)) != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else {
	listPtr = Tcl_NewListObj(0, NULL);
	while ((err = ERR_get_error()) != 0) {
	    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(ERR_reason_error_string(err), -1));
	}







|







445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    if (msg != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else if ((msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL)) != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

    } else {
	listPtr = Tcl_NewListObj(0, NULL);
	while ((err = ERR_get_error()) != 0) {
	    Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(ERR_reason_error_string(err), -1));
	}
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);

    /* If successful, pass back password string and truncate if too long */
    if (code == TCL_OK) {
	Tcl_Size len;
	char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
	if (len > (Tcl_Size) size-1) {
	    len = (Tcl_Size) size-1;
	}
	strncpy(buf, ret, (size_t) len);
	buf[len] = '\0';
	Tcl_Release((ClientData) interp);
	return((int) len);
    }
    Tcl_Release((ClientData) interp);
    return -1;
}

/*
 *-------------------------------------------------------------------







|

|
|




|







552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
    }
    Tcl_DecrRefCount(cmdPtr);

    Tcl_Release((ClientData) statePtr);

    /* If successful, pass back password string and truncate if too long */
    if (code == TCL_OK) {
	int len;
	char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
	if (len > size-1) {
	    len = size-1;
	}
	strncpy(buf, ret, (size_t) len);
	buf[len] = '\0';
	Tcl_Release((ClientData) interp);
	return(len);
    }
    Tcl_Release((ClientData) interp);
    return -1;
}

/*
 *-------------------------------------------------------------------
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    /* Session id */
    session_id = SSL_SESSION_get_id(session, &ulen);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (Tcl_Size) ulen));

    /* Session ticket */
    SSL_SESSION_get0_ticket(session, &ticket, &len2);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(ticket, (Tcl_Size) len2));

    /* Lifetime - number of seconds */
    Tcl_ListObjAppendElement(interp, cmdPtr,
	Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session)));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);







|



|







614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    /* Session id */
    session_id = SSL_SESSION_get_id(session, &ulen);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(session_id, (int) ulen));

    /* Session ticket */
    SSL_SESSION_get0_ticket(session, &ticket, &len2);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewByteArrayObj(ticket, (int) len2));

    /* Lifetime - number of seconds */
    Tcl_ListObjAppendElement(interp, cmdPtr,
	Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session)));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
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
    servername = (const char *)p;

    /* Create command to eval */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (Tcl_Size) len));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
    if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) {
	res = SSL_CLIENT_HELLO_RETRY;
	*alert = SSL_R_TLSV1_ALERT_USER_CANCELLED;
    } else if (code == 1) {
	res = SSL_CLIENT_HELLO_SUCCESS;
    } else {
	res = SSL_CLIENT_HELLO_ERROR;
	*alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
    }
    Tcl_DecrRefCount(cmdPtr);
    return res;
}

/********************/
/* Commands         */
/********************/

/*
 *-------------------------------------------------------------------
 *
 * CiphersObjCmd -- list available ciphers
 *
 *	This procedure is invoked to process the "tls::ciphers" command
 *	to list available ciphers, based upon protocol selected.
 *
 * Results:
 *	A standard Tcl result list.
 *
 * Side effects:
 *	constructs and destroys SSL context (CTX)
 *
 *-------------------------------------------------------------------
 */
static const char *protocols[] = {
	"ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL
};
enum protocol {
    TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE
};

static int
CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr = NULL;
    SSL_CTX *ctx = NULL;
    SSL *ssl = NULL;
    STACK_OF(SSL_CIPHER) *sk;
    char *cp, buf[BUFSIZ];
    int index, verbose = 0, use_supported = 0;
    const SSL_METHOD *method;

    dprintf("Called");

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((objc > 3) && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK) {
	return TCL_ERROR;
    }

    ERR_clear_error();

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

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

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

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

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

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

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

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

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

    dprintf("Called");

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

    ERR_clear_error();

    objPtr = Tcl_NewListObj(0, NULL);

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

    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * HandshakeObjCmd --
 *
 *	This command is used to verify whether the handshake is complete
 *	or not.







|




















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







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
    servername = (const char *)p;

    /* Create command to eval */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (int) len));

    /* Eval callback command */
    Tcl_IncrRefCount(cmdPtr);
    if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) {
	res = SSL_CLIENT_HELLO_RETRY;
	*alert = SSL_R_TLSV1_ALERT_USER_CANCELLED;
    } else if (code == 1) {
	res = SSL_CLIENT_HELLO_SUCCESS;
    } else {
	res = SSL_CLIENT_HELLO_ERROR;
	*alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
    }
    Tcl_DecrRefCount(cmdPtr);
    return res;
}

/********************/
/* Commands         */
/********************/

























































































































































































































/*
 *-------------------------------------------------------------------
 *
 * HandshakeObjCmd --
 *
 *	This command is used to verify whether the handshake is complete
 *	or not.
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return(TCL_ERROR);
    }

    ERR_clear_error();

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

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {







|







956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return(TCL_ERROR);
    }

    ERR_clear_error();

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

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
    Tcl_Channel chan;		/* The channel to set a mode on. */
    State *statePtr;		/* client state for ssl socket */
    SSL_CTX *ctx	        = NULL;
    Tcl_Obj *script	        = NULL;
    Tcl_Obj *password	        = NULL;
    Tcl_Obj *vcmd	        = NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx;
    Tcl_Size len;
    int flags		        = TLS_TCL_INIT;
    int server		        = 0;	/* is connection incoming or outgoing? */
    char *keyfile	        = NULL;
    char *certfile	        = NULL;
    unsigned char *key  	= NULL;
    Tcl_Size key_len                 = 0;
    unsigned char *cert         = NULL;
    Tcl_Size cert_len                = 0;
    char *ciphers	        = NULL;
    char *ciphersuites	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
    char *servername	        = NULL;	/* hostname for Server Name Indication */







|
<





|

|







1034
1035
1036
1037
1038
1039
1040
1041

1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
    Tcl_Channel chan;		/* The channel to set a mode on. */
    State *statePtr;		/* client state for ssl socket */
    SSL_CTX *ctx	        = NULL;
    Tcl_Obj *script	        = NULL;
    Tcl_Obj *password	        = NULL;
    Tcl_Obj *vcmd	        = NULL;
    Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar;
    int idx, len;

    int flags		        = TLS_TCL_INIT;
    int server		        = 0;	/* is connection incoming or outgoing? */
    char *keyfile	        = NULL;
    char *certfile	        = NULL;
    unsigned char *key  	= NULL;
    int key_len                 = 0;
    unsigned char *cert         = NULL;
    int cert_len                = 0;
    char *ciphers	        = NULL;
    char *ciphersuites	        = NULL;
    char *CAfile	        = NULL;
    char *CAdir		        = NULL;
    char *DHparams	        = NULL;
    char *model		        = NULL;
    char *servername	        = NULL;	/* hostname for Server Name Indication */
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
	return TCL_ERROR;
    }

    ERR_clear_error();

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

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

    for (idx = 2; idx < objc; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL);

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

	OPTOBJ("-alpn", alpn);
	OPTSTR("-cadir", CAdir);
	OPTSTR("-cafile", CAfile);







|








|







1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel ?options?");
	return TCL_ERROR;
    }

    ERR_clear_error();

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

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

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

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

	OPTOBJ("-alpn", alpn);
	OPTSTR("-cadir", CAdir);
	OPTSTR("-cafile", CAfile);
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
		"\": not a TLS channel", NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, (int) key_len,
	    (int) cert_len, CAdir, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;








|
|







1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
		"\": not a TLS channel", NULL);
	    Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL);
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
	ctx = ((State *)Tcl_GetChannelInstanceData(chan))->ctx;
    } else {
	if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, key_len,
	    cert_len, CAdir, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
	    Tls_Free((char *) statePtr);
	    return TCL_ERROR;
	}
    }

    statePtr->ctx = ctx;

1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554

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

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

	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);
	    if (len > 255) {
		Tcl_AppendResult(interp, "ALPN protocol name too long", (char *) NULL);
		Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL);
		Tls_Free((char *) statePtr);
		return TCL_ERROR;
	    }
	    protos_len += 1 + (int) len;
	}

	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (j = 0, p = protos; j < cnt; j++) {
	    char *str = Tcl_GetStringFromObj(list[j], &len);
	    *p++ = (unsigned char) len;
	    memcpy(p, str, (size_t) len);
	    p += len;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* Note: This functions reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "failed to set ALPN protocols", (char *) NULL);







<
|
















|





|
|
|
|







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

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

	int i, len, cnt;
	Tcl_Obj **list;

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

	/* Determine the memory required for the protocol-list */
	for (i = 0; i < cnt; i++) {
	    Tcl_GetStringFromObj(list[i], &len);
	    if (len > 255) {
		Tcl_AppendResult(interp, "ALPN protocol name too long", (char *) NULL);
		Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL);
		Tls_Free((char *) statePtr);
		return TCL_ERROR;
	    }
	    protos_len += 1 + len;
	}

	/* Build the complete protocol-list */
	protos = ckalloc(protos_len);
	/* protocol-lists consist of 8-bit length-prefixed, byte strings */
	for (i = 0, p = protos; i < cnt; i++) {
	    char *str = Tcl_GetStringFromObj(list[i], &len);
	    *p++ = len;
	    memcpy(p, str, len);
	    p += len;
	}

	/* SSL_set_alpn_protos makes a copy of the protocol-list */
	/* Note: This functions reverses the return value convention */
	if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
	    Tcl_AppendResult(interp, "failed to set ALPN protocols", (char *) NULL);
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
    int off = 0;
    int load_private_key;
    const SSL_METHOD *method;

    dprintf("Called");

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

    /* create SSL context */
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
    if (ENABLED(proto, TLS_PROTO_SSL2)) {
	Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
	Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
    if (ENABLED(proto, TLS_PROTO_TLS1)) {
	Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
	Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
	Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
	Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *) NULL);
	return NULL;
    }
#endif
    if (proto == 0) {
	/* Use full range */
	SSL_CTX_set_min_proto_version(ctx, 0);
	SSL_CTX_set_max_proto_version(ctx, 0);







|






|





|





|





|





|





|







1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
    int off = 0;
    int load_private_key;
    const SSL_METHOD *method;

    dprintf("Called");

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

    /* create SSL context */
#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
    if (ENABLED(proto, TLS_PROTO_SSL2)) {
	Tcl_AppendResult(interp, "SSL2 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
    if (ENABLED(proto, TLS_PROTO_SSL3)) {
	Tcl_AppendResult(interp, "SSL3 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
    if (ENABLED(proto, TLS_PROTO_TLS1)) {
	Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
    if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
	Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
    if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
	Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", NULL);
	return NULL;
    }
#endif
#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
    if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
	Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", NULL);
	return NULL;
    }
#endif
    if (proto == 0) {
	/* Use full range */
	SSL_CTX_set_min_proto_version(ctx, 0);
	SSL_CTX_set_max_proto_version(ctx, 0);
1843
1844
1845
1846
1847
1848
1849




1850
1851
1852
1853
1854
1855
1856
    }
#endif

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





    SSL_CTX_set_app_data(ctx, (void*)interp);	/* remember the interpreter */
    SSL_CTX_set_options(ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options(ctx, SSL_OP_NO_COMPRESSION);	/* disable compression even if supported */
    SSL_CTX_set_options(ctx, off);		/* disable protocol versions */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
    SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY);	/* handle new handshakes in background. On by default in OpenSSL 1.1.1. */







>
>
>
>







1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
    }
#endif

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

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

    SSL_CTX_set_app_data(ctx, (void*)interp);	/* remember the interpreter */
    SSL_CTX_set_options(ctx, SSL_OP_ALL);	/* all SSL bug workarounds */
    SSL_CTX_set_options(ctx, SSL_OP_NO_COMPRESSION);	/* disable compression even if supported */
    SSL_CTX_set_options(ctx, off);		/* disable protocol versions */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
    SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY);	/* handle new handshakes in background. On by default in OpenSSL 1.1.1. */
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074

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

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

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







|







1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863

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

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

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
    }

    /* Verify mode depth */
    LAPPEND_INT(interp, objPtr, "verifyDepth", SSL_get_verify_depth(statePtr->ssl));

    /* Report the selected protocol as a result of the negotiation */
    SSL_get0_alpn_selected(statePtr->ssl, &proto, &len);
    LAPPEND_STR(interp, objPtr, "alpn", (char *)proto, (Tcl_Size) len);
    LAPPEND_STR(interp, objPtr, "protocol", SSL_get_version(statePtr->ssl), -1);

    /* Valid for non-RSA signature and TLS 1.3 */
    if (objc == 2) {
	res = SSL_get_peer_signature_nid(statePtr->ssl, &nid);
    } else {
	res = SSL_get_signature_nid(statePtr->ssl, &nid);







|







1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
    }

    /* Verify mode depth */
    LAPPEND_INT(interp, objPtr, "verifyDepth", SSL_get_verify_depth(statePtr->ssl));

    /* Report the selected protocol as a result of the negotiation */
    SSL_get0_alpn_selected(statePtr->ssl, &proto, &len);
    LAPPEND_STR(interp, objPtr, "alpn", (char *)proto, (int) len);
    LAPPEND_STR(interp, objPtr, "protocol", SSL_get_version(statePtr->ssl), -1);

    /* Valid for non-RSA signature and TLS 1.3 */
    if (objc == 2) {
	res = SSL_get_peer_signature_nid(statePtr->ssl, &nid);
    } else {
	res = SSL_get_signature_nid(statePtr->ssl, &nid);
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
    const EVP_MD *md;

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

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

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {







|







1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
    const EVP_MD *md;

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

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

    /* Make sure to operate on the topmost channel */
    chan = Tcl_GetTopChannel(chan);
    if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
	size_t len2;
	unsigned int ulen;
	const unsigned char *session_id, *proto;
	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
	SSL_get0_next_proto_negotiated(ssl, &proto, &ulen);
	LAPPEND_STR(interp, objPtr, "npn", (char *) proto, (Tcl_Size) ulen);
#endif

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

	/* Session start time (seconds since epoch) */
	LAPPEND_LONG(interp, objPtr, "start_time", SSL_SESSION_get_time(session));

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

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

	/* Session context */
	session_id = SSL_SESSION_get0_id_context(session, &ulen);
	LAPPEND_BARRAY(interp, objPtr, "session_context", session_id, (Tcl_Size) ulen);

	/* Session ticket - client only */
	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 */
	SSL_SESSION_get0_ticket_appdata(session, &ticket, &len2);
	LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (Tcl_Size) len2);

	/* 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);
	LAPPEND_STR(interp, objPtr, "compression_id", id == 1 ? "zlib" : "none", -1);
    }

    /* Compression info */







|




|













|



|



|






|



|







2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
	size_t len2;
	unsigned int ulen;
	const unsigned char *session_id, *proto;
	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, (int) len2);

	/* Report the selected protocol as a result of the NPN negotiation */
#ifdef USE_NPN
	SSL_get0_next_proto_negotiated(ssl, &proto, &ulen);
	LAPPEND_STR(interp, objPtr, "npn", (char *) proto, (int) ulen);
#endif

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

	/* Session start time (seconds since epoch) */
	LAPPEND_LONG(interp, objPtr, "start_time", SSL_SESSION_get_time(session));

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

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

	/* Session context */
	session_id = SSL_SESSION_get0_id_context(session, &ulen);
	LAPPEND_BARRAY(interp, objPtr, "session_context", session_id, (int) ulen);

	/* Session ticket - client only */
	SSL_SESSION_get0_ticket(session, &ticket, &len2);
	LAPPEND_BARRAY(interp, objPtr, "session_ticket", ticket, (int) len2);

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

	/* Ticket app data */
	SSL_SESSION_get0_ticket_appdata(session, &ticket, &len2);
	LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (int) len2);

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

	/* Compression id */
	unsigned int id = SSL_SESSION_get_compress_id(session);
	LAPPEND_STR(interp, objPtr, "compression_id", id == 1 ? "zlib" : "none", -1);
    }

    /* Compression info */
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
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * VersionObjCmd -- return version string from OpenSSL.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    Tcl_Obj *objPtr;

    dprintf("Called");

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

    return TCL_OK;
	clientData = clientData;
	objc = objc;
	objv = objv;
}

/*
 *-------------------------------------------------------------------
 *
 * MiscObjCmd -- misc commands
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
MiscObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    static const char *commands [] = { "req", "strreq", NULL };
    enum command { C_REQ, C_STRREQ, C_DUMMY };
    Tcl_Size cmd;
    int isStr;
    char buffer[16384];

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
	return TCL_ERROR;







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














<
|







2180
2181
2182
2183
2184
2185
2186




























2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200

2201
2202
2203
2204
2205
2206
2207
2208
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *




























 * MiscObjCmd -- misc commands
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
MiscObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    static const char *commands [] = { "req", "strreq", NULL };
    enum command { C_REQ, C_STRREQ, C_DUMMY };

    int cmd, isStr;
    char buffer[16384];

    dprintf("Called");

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?");
	return TCL_ERROR;
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
    switch ((enum command) cmd) {
	case C_REQ:
	case C_STRREQ: {
	    EVP_PKEY *pkey=NULL;
	    X509 *cert=NULL;
	    X509_NAME *name=NULL;
	    Tcl_Obj **listv;
	    Tcl_Size listc;
	    int i;

	    BIO *out=NULL;

	    char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
	    char *keyout,*pemout,*str;
	    int keysize,serial=0,days=365;








|
<







2217
2218
2219
2220
2221
2222
2223
2224

2225
2226
2227
2228
2229
2230
2231
    switch ((enum command) cmd) {
	case C_REQ:
	case C_STRREQ: {
	    EVP_PKEY *pkey=NULL;
	    X509 *cert=NULL;
	    X509_NAME *name=NULL;
	    Tcl_Obj **listv;
	    int listc,i;


	    BIO *out=NULL;

	    char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email="";
	    char *keyout,*pemout,*str;
	    int keysize,serial=0,days=365;

2489
2490
2491
2492
2493
2494
2495
2496

2497
2498
2499
2500
2501
2502
2503
	    pemout=Tcl_GetString(objv[4]);
	    if (isStr) {
		Tcl_SetVar(interp,keyout,"",0);
		Tcl_SetVar(interp,pemout,"",0);
	    }

	    if (objc>=6) {
		if (Tcl_ListObjGetElements(interp, objv[5], &listc, &listv) != TCL_OK) {

		    return TCL_ERROR;
		}

		if ((listc%2) != 0) {
		    Tcl_SetResult(interp,"Information list must have even number of arguments",NULL);
		    return TCL_ERROR;
		}







|
>







2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
	    pemout=Tcl_GetString(objv[4]);
	    if (isStr) {
		Tcl_SetVar(interp,keyout,"",0);
		Tcl_SetVar(interp,pemout,"",0);
	    }

	    if (objc>=6) {
		if (Tcl_ListObjGetElements(interp, objv[5],
			&listc, &listv) != TCL_OK) {
		    return TCL_ERROR;
		}

		if ((listc%2) != 0) {
		    Tcl_SetResult(interp,"Information list must have even number of arguments",NULL);
		    return TCL_ERROR;
		}
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783

2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
#endif
    if (Tcl_PkgRequire(interp, "Tcl", "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
#endif

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

    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

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

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}







|



<



>


|
|
|







2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539

2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
#endif
    if (Tcl_PkgRequire(interp, "Tcl", "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
#endif

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


    Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);

    Tls_DigestCommands(interp);
    Tls_InfoCommands(interp);

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

    return Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
}

Modified generic/tlsBIO.c from [904acc3cbd] to [3977ec0a04].

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

#include "tlsInt.h"

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

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

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

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

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

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

    BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;










|






|




<
|







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

23
24
25
26
27
28
29
30
/*
 * Copyright (C) 1997-2000 Matt Newman <[email protected]>
 *
 * Provides BIO layer to interface openssl to Tcl.
 */

#include "tlsInt.h"

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

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

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

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

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


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

    BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;
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
    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_read(bio)) {
	    dprintf("Setting should retry read flag");

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

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

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

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

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

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

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

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

    BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;







|















|




<
|







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
    if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
	if (BIO_should_read(bio)) {
	    dprintf("Setting should retry read flag");

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

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

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

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

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

    ret = Tcl_ReadRaw(chan, buf, bufLen);

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


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

    BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);

    if (tclEofChan && ret <= 0) {
	dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
	Tcl_SetErrno(ECONNRESET);
	ret = 0;
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
	if (BIO_should_write(bio)) {
	    dprintf("Setting should retry write flag");

	    BIO_set_retry_write(bio);
	}
    }

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

    return((int) ret);
}

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

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







|
<

|







106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
121
122
	if (BIO_should_write(bio)) {
	    dprintf("Setting should retry write flag");

	    BIO_set_retry_write(bio);
	}
    }

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


    return(ret);
}

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

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

Added generic/tlsDigest.c version [71e9e504fd].





















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
/*
 * Message Digests Module
 *
 * Provides commands to calculate a message digest using a specified hash function.
 *
 * 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

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

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

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestNew --
 *
 *	This function creates a digest state structure
 *
 * Returns:
 *	Digest structure pointer
 *
 * Side effects:
 *	Creates structure
 *
 *-------------------------------------------------------------------
 */
DigestState *Tls_DigestNew(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;
}

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

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

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

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestInit --
 *
 *	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 Tls_DigestInit(Tcl_Interp *interp, DigestState *statePtr, const EVP_MD *md,
	const EVP_CIPHER *cipher, Tcl_Obj *keyObj) {
    int key_len, res = 0;
    const unsigned char *key;

    /* Create message digest context */
    if (statePtr->format & TYPE_MD) {
	statePtr->ctx = EVP_MD_CTX_new();
	res = (statePtr->ctx != NULL);
    } else if (statePtr->format & TYPE_HMAC) {
	statePtr->hctx = HMAC_CTX_new();
	res = (statePtr->hctx != NULL);
    } else if (statePtr->format & TYPE_CMAC) {
	statePtr->cctx = CMAC_CTX_new();
	res = (statePtr->cctx != NULL);
    }
    if (!res) {
	Tcl_AppendResult(interp, "Create digest context failed: ", REASON(), NULL);
	return TCL_ERROR;
    }

    /* Initialize hash function */
    if (statePtr->format & TYPE_MD) {
	res = EVP_DigestInit_ex(statePtr->ctx, md, NULL);
    } else if (statePtr->format & TYPE_HMAC) {
	key = Tcl_GetByteArrayFromObj(keyObj, &key_len);
	res = HMAC_Init_ex(statePtr->hctx, (const void *) key, key_len, md, NULL);
    } else if (statePtr->format & TYPE_CMAC) {
	key = Tcl_GetByteArrayFromObj(keyObj, &key_len);
	res = CMAC_Init(statePtr->cctx, (const void *) key, key_len, cipher, NULL);
    }
    if (!res) {
	Tcl_AppendResult(interp, "Initialize digest failed: ", REASON(), NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestUpdate --
 *
 *	Update a hash function
 *
 * Returns:
 *	1 if successful or 0 for failure
 *
 * Side effects:
 *	Adds buf to hash function
 *
 *-------------------------------------------------------------------
 */
int Tls_DigestUpdate(DigestState *statePtr, char *buf, size_t read) {
    int res = 0;

    if (statePtr->format & TYPE_MD) {
	res = EVP_DigestUpdate(statePtr->ctx, buf, read);
    } else if (statePtr->format & TYPE_HMAC) {
	res = HMAC_Update(statePtr->hctx, buf, read);
    } else if (statePtr->format & TYPE_CMAC) {
	res = CMAC_Update(statePtr->cctx, buf, read);
    }
    return res;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestFinialize --
 *
 *	Finalize a hash function and generate a 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 for hash function or an error message.
 *
 *-------------------------------------------------------------------
 */

int Tls_DigestFinialize(Tcl_Interp *interp, DigestState *statePtr) {
    unsigned char md_buf[EVP_MAX_MD_SIZE];
    unsigned int md_len;
    int res = 0;

    /* Finalize hash function and calculate message digest */
    if (statePtr->format & TYPE_MD) {
	res = EVP_DigestFinal_ex(statePtr->ctx, md_buf, &md_len);
    } else if (statePtr->format & TYPE_HMAC) {
	res = HMAC_Final(statePtr->hctx, md_buf, &md_len);
    } else if (statePtr->format & TYPE_CMAC) {
	size_t len;
	res = CMAC_Final(statePtr->cctx, md_buf, &len);
	md_len = (unsigned int) len;
    }
    if (!res) {
	Tcl_AppendResult(interp, "Finalize digest failed: ", REASON(), NULL);
	return TCL_ERROR;
    }

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

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

	for (unsigned int i = 0; i < md_len; i++) {
	    *ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
	    *ptr++ = hex[md_buf[i] & 0x0F];
	}
	Tcl_SetObjResult(interp, resultObj);
    }
    return TCL_OK;
}

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

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestFile --
 *
 *	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 Tls_DigestFile(Tcl_Interp *interp, Tcl_Obj *filename, const EVP_MD *md,
	const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj) {
    DigestState *statePtr;
    Tcl_Channel chan = NULL;
    unsigned char buf[BUFFER_SIZE];
    int res = TCL_OK, len;

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

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

    /* Create state data struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	res = TCL_ERROR;
	goto done;
    }

    /* Initialize hash function */
    if ((res = Tls_DigestInit(interp, statePtr, md, cipher, keyObj)) != TCL_OK) {
	goto done;
    }

    /* Read file data and update hash function */
    while (!Tcl_Eof(chan)) {
	len = Tcl_ReadRaw(chan, (char *) buf, BUFFER_SIZE);
	if (len > 0) {
	    if (!Tls_DigestUpdate(statePtr, &buf[0], (size_t) len)) {
		Tcl_AppendResult(interp, "Update digest failed: ", REASON(), NULL);
		res = TCL_ERROR;
		goto done;
	    }
	}
    }

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

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

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

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

/*
 *-------------------------------------------------------------------
 *
 * 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 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:
 *	Writes digest to output and closes the channel. Stores error
 *	messages in interp result using Tcl_GetChannelErrorInterp.
 *
 *-------------------------------------------------------------------
 */
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;
    }

    /* Clean-up */
    Tls_DigestFree(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.
 *
 * 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;
    int read, res = 0;
    *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, toRead);

    /* Update hash function */
    if (read > 0) {
	if (!Tls_DigestUpdate(statePtr, buf, (size_t) read)) {
	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest update failed: %s", REASON()));
	    *errorCodePtr = EINVAL;
	    return -1;
	}
	/* This is correct */
	read = -1;
	*errorCodePtr = EAGAIN;
	    
    } else if (read < 0) {
	/* Error */
	*errorCodePtr = Tcl_GetErrno();

    } else if (!(statePtr->flags & CHAN_EOF)) {
	/* EOF */
	unsigned char md_buf[EVP_MAX_MD_SIZE];
	unsigned int md_len = 0;

	/* Finalize hash function and calculate message digest */
	if (statePtr->format & TYPE_MD) {
	    res = EVP_DigestFinal_ex(statePtr->ctx, md_buf, &md_len);
	} else if (statePtr->format & TYPE_HMAC) {
	    res = HMAC_Final(statePtr->hctx, md_buf, &md_len);
	} else if (statePtr->format & TYPE_CMAC) {
	    size_t len;
	    res = CMAC_Final(statePtr->cctx, md_buf, &len);
	    md_len = (unsigned int) len;
	}
	if (!res) {
	    Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest finalize failed: %s", REASON()));
	    *errorCodePtr = EINVAL;

	/* Write message digest to output channel as byte array or hex string */
	} else if (md_len > 0) {
	    if ((statePtr->format & BIN_FORMAT) && toRead >= (int) md_len) {
		read = md_len;
		memcpy(buf, md_buf, read);

	    } else if((statePtr->format & HEX_FORMAT) && toRead >= (int) (md_len*2)) {
		unsigned char hex_buf[EVP_MAX_MD_SIZE*2];
		unsigned char *ptr = hex_buf;

		for (unsigned int i = 0; i < md_len; i++) {
		    *ptr++ = hex[(md_buf[i] >> 4) & 0x0F];
		    *ptr++ = hex[md_buf[i] & 0x0F];
		}
		read = md_len*2;
		memcpy(buf, hex_buf, read);
	    }
	}
	statePtr->flags |= CHAN_EOF;
    }
    return read;
}

/*
 *----------------------------------------------------------------------
 *
 * DigestOutputProc --
 *
 *	Called by the generic IO system to write data in buf to transform.
 *
 * 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 (toWrite > 0 && !Tls_DigestUpdate(statePtr, buf, (size_t) toWrite)) {
	Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Digest update failed: %s", REASON()));
	*errorCodePtr = EINVAL;
	return -1;
    }
    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.
 *
 *----------------------------------------------------------------------
 */
#define READ_DELAY	5
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 */
};

/*
 *----------------------------------------------------------------------
 *
 * Tls_DigestChannel --
 *
 *	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
Tls_DigestChannel(Tcl_Interp *interp, const char *channel, const EVP_MD *md,
	const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj) {
    int mode; /* OR-ed combination of TCL_READABLE and TCL_WRITABLE */
    Tcl_Channel chan;
    DigestState *statePtr;

    /* Validate args */
    if (channel == (const 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);

    /* Create state data struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Initialize digest error: memory allocation failure", (char *) NULL);
	return TCL_ERROR;
    }
    statePtr->self = chan;
    statePtr->mode = mode;

    /* Initialize hash function */
    if (Tls_DigestInit(interp, statePtr, md, cipher, keyObj) != TCL_OK) {
	return TCL_ERROR;
    }

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

    /* Stack channel */
    statePtr->self = Tcl_StackChannel(interp, &digestChannelType, (ClientData) statePtr, mode, chan);
    if (statePtr->self == (Tcl_Channel) NULL) {
	Tls_DigestFree(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
UnstackObjCmd(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  */

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

    /* Get channel */
    chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], 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);
    	clientData = clientData;
}

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

static const char *instance_fns [] = { "finalize", "update", NULL };

/*
 *-------------------------------------------------------------------
 *
 * InstanceObjCmd --
 *
 *	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 InstanceObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    DigestState *statePtr = (DigestState *) clientData;
    int fn, len = 0;
    char *buf = NULL;

    /* 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) {
	    buf = Tcl_GetByteArrayFromObj(objv[2], &len);
	} else {
	    Tcl_WrongNumArgs(interp, 1, objv, "update data");
	    return TCL_ERROR;
	}

	/* Update hash function */
	if (!Tls_DigestUpdate(statePtr, buf, (size_t) len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Digest update failed: %s", REASON()));
	    return TCL_ERROR;
	}

    } else {
	/* Finalize hash function and calculate message digest */
	if (Tls_DigestFinialize(interp, statePtr) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("Digest finalize failed: %s", REASON()));
	    return TCL_ERROR;
	}

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

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

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

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestInstance --
 *
 *	 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 Tls_DigestInstance(Tcl_Interp *interp, Tcl_Obj *cmdObj, const EVP_MD *md,
	const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj) {
    DigestState *statePtr;
    char *cmdName = Tcl_GetStringFromObj(cmdObj, NULL);

    /* Create state data struct */
    if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	Tcl_AppendResult(interp, "Initialize digest error: memory allocation failure", (char *) NULL);
	return TCL_ERROR;
    }

    /* Initialize hash function */
    if (Tls_DigestInit(interp, statePtr, md, cipher, keyObj) != TCL_OK) {
	return TCL_ERROR;
    }

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

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


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

/*
 *-------------------------------------------------------------------
 *
 * Tls_DigestData --
 *
 *	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
Tls_DigestData(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	const EVP_MD *md, const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj) {
    char *data;
    int len, res;
    unsigned int md_len;
    unsigned char md_buf[EVP_MAX_MD_SIZE];

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

    /* Get data */
    data = Tcl_GetByteArrayFromObj(objv[1], &len);
    if (data == NULL || len == 0) {
	Tcl_SetResult(interp, "No data", NULL);
	return TCL_ERROR;
    }

    /* Calculate digest based on hash function */
    if (format & TYPE_MD) {
	res = EVP_Digest(data, (size_t) len, md_buf, &md_len, md, NULL);

    } else if (format & TYPE_HMAC) {
	unsigned char *key, *hmac = NULL;
	int key_len;

	key = Tcl_GetByteArrayFromObj(keyObj, &key_len);
	hmac = HMAC(md, (const void *) key, key_len, (const unsigned char *) data,
	    (size_t) len, md_buf, &md_len);
	res = (hmac != NULL);

    } else if (format & TYPE_CMAC) {
	DigestState *statePtr;

	if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
	    Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
	    return TCL_ERROR;
	}
	if (Tls_DigestInit(interp, statePtr, md, cipher, keyObj) != TCL_OK ||
	    Tls_DigestUpdate(statePtr, data, (size_t) len) == 0 ||
	    Tls_DigestFinialize(interp, statePtr) != TCL_OK) {
	    Tls_DigestFree(statePtr);
	    return TCL_ERROR;
	}
	Tls_DigestFree(statePtr);
	return TCL_OK;
    }

    /* Output digest to result per format (bin or hex) */
    if (res) {
	if (format & BIN_FORMAT) {
	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(md_buf, md_len));

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

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

    } else {
	Tcl_AppendResult(interp, "Hash calculation error:", REASON(), (char *) NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}


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

/*
 *-------------------------------------------------------------------
 *
 * DigestObjCmd --
 *
 *	Return message digest 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 idx, len, format = HEX_FORMAT, res = TCL_OK, flags = 0;
    const char *digestName, *channel = NULL;
    Tcl_Obj *cmdObj = NULL, *dataObj = NULL, *fileObj = NULL, *keyObj = NULL;
    unsigned char *cipherName = NULL;
    const EVP_MD *md;
    const EVP_CIPHER *cipher = NULL;

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

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

    /* Get digest */
    digestName = Tcl_GetStringFromObj(objv[1], &len);
    if (digestName == NULL || (md = EVP_get_digestbyname(digestName)) == NULL) {
	Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
	return TCL_ERROR;
    }

    /* Optimal case for blob of data */
    if (objc == 3 && type == TYPE_MD) {
	return Tls_DigestData(interp, --objc, ++objv, md, NULL, HEX_FORMAT | TYPE_MD, NULL);
    }

    /* Get options */
    for (idx = 2; idx < objc-1; idx++) {
	char *opt = Tcl_GetStringFromObj(objv[idx], NULL);

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

	OPTFLAG("-bin", format, BIN_FORMAT);
	OPTFLAG("-binary", format, BIN_FORMAT);
	OPTFLAG("-hex", format, HEX_FORMAT);
	OPTFLAG("-hexadecimal", format, HEX_FORMAT);
	OPTSTR("-chan", channel);
	OPTSTR("-channel", channel);
	OPTSTR("-cipher", cipherName);
	OPTOBJ("-command", cmdObj);
	OPTOBJ("-data", dataObj);
	OPTOBJ("-file", fileObj);
	OPTOBJ("-filename", fileObj);
	OPTOBJ("-key", keyObj);

	OPTBAD("option", "-bin, -channel, -cipher, -command, -data, -file, -filename, -hex, or -key");
	return TCL_ERROR;
    }

    /* If no option for last arg, then its the data */
    if (idx < objc) {
	dataObj = objv[idx];
    }

    /* Get cipher */
    if (cipherName != NULL) {
	cipher = EVP_get_cipherbyname(cipherName);
	type = TYPE_CMAC;
	if (cipher == NULL) {
	    Tcl_AppendResult(interp, "Invalid cipher \"", cipherName, "\"", NULL);
	    return TCL_ERROR;
	}

    } else if (type == TYPE_CMAC) {
	Tcl_AppendResult(interp, "No cipher specified", NULL);
	return TCL_ERROR;
    }

    /* Get key */
    if (keyObj != NULL) {
	if (type == TYPE_MD) {
	    type = TYPE_HMAC;
	}
    } else if (type != TYPE_MD) {
	Tcl_AppendResult(interp, "No key specified", NULL);
	return TCL_ERROR;
    }

    /* Calc digest on file, stacked channel, using instance command, or data blob */
    if (fileObj != NULL) {
	res = Tls_DigestFile(interp, fileObj, md, cipher, format | type, keyObj);
    } else if (channel != NULL) {
	res = Tls_DigestChannel(interp, channel, md, cipher, format | type, keyObj);
    } else if (cmdObj != NULL) {
	res = Tls_DigestInstance(interp, cmdObj, md, cipher, format | type, keyObj);
    } else if (dataObj != NULL) {
	Tcl_Obj *objs[2];
	objs[0] = NULL;
	objs[1] = dataObj;
	res = Tls_DigestData(interp, 2, objs, md, cipher, format | type, keyObj);
    }
    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 DigestObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestMain(TYPE_MD, interp, objc, objv);
}

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

static int HMACObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return DigestMain(TYPE_HMAC, 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 DigestMD4Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return Tls_DigestData(interp, objc, objv, EVP_md4(), NULL, HEX_FORMAT | TYPE_MD, NULL);
}

int DigestMD5Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return Tls_DigestData(interp, objc, objv, EVP_md5(), NULL, HEX_FORMAT | TYPE_MD, NULL);
}

int DigestSHA1Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return Tls_DigestData(interp, objc, objv, EVP_sha1(), NULL, HEX_FORMAT | TYPE_MD, NULL);
}

int DigestSHA256Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return Tls_DigestData(interp, objc, objv, EVP_sha256(), NULL, HEX_FORMAT | TYPE_MD, NULL);
}

int DigestSHA512Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    return Tls_DigestData(interp, objc, objv, EVP_sha512(), NULL, HEX_FORMAT | TYPE_MD, NULL);
}

/*
 *-------------------------------------------------------------------
 *
 * 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", DigestObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::cmac", CMACObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::hmac", HMACObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::md4", DigestMD4Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::md5", DigestMD5Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::sha1", DigestSHA1Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::sha256", DigestSHA256Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::sha512", DigestSHA512Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::unstack", UnstackObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

Modified generic/tlsIO.c from [fb8d969c33] to [0b06e53585].

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	}

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

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

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







|







159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
		dprintf("Flushing the lower layers failed, this will probably terminate this session");
	    }
	}

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

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

	bioShouldRetry = 0;
	if (err <= 0) {
	    if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
		bioShouldRetry = 1;
	    } else if (BIO_should_retry(statePtr->bio)) {
		bioShouldRetry = 1;
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
	    }

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

	case SSL_ERROR_SSL:
	    dprintf("Got permanent fatal SSL error, aborting immediately");
	    Tls_Error(statePtr, (char *)ERR_reason_error_string(ERR_get_error()));
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return(-1);

	case SSL_ERROR_WANT_CONNECT:
	case SSL_ERROR_WANT_ACCEPT:
	case SSL_ERROR_WANT_X509_LOOKUP:







|







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

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

	case SSL_ERROR_SSL:
	    dprintf("Got permanent fatal SSL error, aborting immediately");
	    Tls_Error(statePtr, (char *)REASON());
	    statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
	    *errorCodePtr = ECONNABORTED;
	    return(-1);

	case SSL_ERROR_WANT_CONNECT:
	case SSL_ERROR_WANT_ACCEPT:
	case SSL_ERROR_WANT_X509_LOOKUP:

Added generic/tlsInfo.c version [bed510f6e3].































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
/*
 * 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 "tclOpts.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 *objPtr = (Tcl_Obj *) arg;

    /* Fields: (int) type and alias, (const char*) name and data */
    if (1 || !obj->alias) {
	/* Filter out signed digests (a.k.a signature algorithms) */
	if (strstr(obj->name, "rsa") == NULL && strstr(obj->name, "RSA") == NULL) {
	    Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(obj->name,-1));
	}
    }
}

/*
 *-------------------------------------------------------------------
 *
 * 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;
    int index, verbose = 0, use_supported = 0;
    int min_version, max_version;

    dprintf("Called");

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_ciphers(); /* Make sure they're loaded */
#endif

    /* 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) {
	Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);

	OBJ_NAME_do_all(OBJ_NAME_TYPE_CIPHER_METH, NamesCallback, (void *) objPtr);
	Tcl_SetObjResult(interp, objPtr);
	return TCL_OK;

    }

    /* 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", 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", 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", 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", 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", 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", 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, REASON(), 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, 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);
	/*sk = SSL_CTX_get_ciphers(ctx);*/
    }

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

	if (!verbose) {
	    char *cp;
	    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 {
	    char buf[BUFSIZ];
	    objPtr = Tcl_NewStringObj("",0);

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

		/* Get OpenSSL-specific ID, not IANA ID */
		/*id = SSL_CIPHER_get_id(c);*/

		/* TLS protocol two-byte id */
		/*id = SSL_CIPHER_get_protocol_id(c);*/

		/* Standard RFC name of cipher or (NONE) */
		/*const char *nm = SSL_CIPHER_standard_name(c);
		if (nm == NULL) {nm = "UNKNOWN";}*/

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

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

    SSL_free(ssl);
    SSL_CTX_free(ctx);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * 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[]) {
    Tcl_Obj *objPtr;

    dprintf("Called");

#if OPENSSL_VERSION_NUMBER < 0x10100000L
    OpenSSL_add_all_digests(); /* Make sure they're loaded */
#endif

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

    /* List all digests */
    objPtr = Tcl_NewListObj(0, NULL);
    OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) objPtr);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * 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[]) {
    Tcl_Obj *objPtr;

    dprintf("Called");

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

    /* List all MACs */
    objPtr = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cmac", -1));
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("hmac", -1));
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * 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 *objPtr;

    dprintf("Called");

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

    /* List all MACs */
    objPtr = Tcl_NewListObj(0, NULL);
#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL2], -1));
#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1));
#endif
#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1));
#endif
#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -1));
#endif
#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1));
#endif
#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
    Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1));
#endif
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * 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 *objPtr;

    dprintf("Called");

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

    objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
	clientData = clientData;
}

/*
 *-------------------------------------------------------------------
 *
 * Tls_InfoCommands --
 *
 *	Create info commands
 *
 * Returns:
 *	TCL_OK or TCL_ERROR
 *
 * Side effects:
 *	Creates commands
 *
 *-------------------------------------------------------------------
 */
int Tls_InfoCommands(Tcl_Interp *interp) {
    Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::digests", DigestsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::macs", MacsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

Modified generic/tlsInt.h from [0103fefac9] to [f793362aa1].

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
#   endif
#endif

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

    #define TCL_SIZE_MODIFIER ""
#endif

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








|
<
<
<
<







38
39
40
41
42
43
44
45




46
47
48
49
50
51
52
#   endif
#endif

/*
 * Backwards compatibility for size type change
 */
#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7
#   define Tcl_Size int




#endif

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

100
101
102
103
104
105
106

107
108
109
110
111
112
113
#else
#define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); }
#define dprintBuffer(bufferName, bufferLength) /**/
#define dprintFlags(statePtr) /**/
#endif

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


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







>







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
#else
#define dprintf(...) if (0) { fprintf(stderr, __VA_ARGS__); }
#define dprintBuffer(bufferName, bufferLength) /**/
#define dprintFlags(statePtr) /**/
#endif

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

/* Common list append macros */
#define LAPPEND_BARRAY(interp, obj, text, value, size) {\
    if (text != NULL) Tcl_ListObjAppendElement(interp, obj, Tcl_NewStringObj(text, -1)); \
    Tcl_ListObjAppendElement(interp, obj, Tcl_NewByteArrayObj(value, size)); \
}
#define LAPPEND_STR(interp, obj, text, value, size) {\
194
195
196
197
198
199
200


201
202
203
204
205
206

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



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

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

#endif /* _TLSINT_H */







>
>






191
192
193
194
195
196
197
198
199
200
201
202
203
204
205

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

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

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

#endif /* _TLSINT_H */

Modified generic/tlsX509.c from [a931d05109] to [135215c951].

16
17
18
19
20
21
22
23
24



25
26
27


28
29
30
31
32
33
34
35
36
/* Define maximum certificate size. Max PEM size 100kB and DER size is 24kB. */
#define CERT_STR_SIZE 32768


/*
 * Binary string to hex string
 */
int String_to_Hex(char* input, int ilen, char *output, int olen) {
    int count = 0;




    for (int i = 0; i < ilen && count < olen - 1; i++, count += 2) {
	sprintf(output + count, "%02X", input[i] & 0xff);


    }
    output[count] = 0;
    return count;
}

/*
 * BIO to Buffer
 */
int BIO_to_Buffer(int result, BIO *bio, void *buffer, int size) {







|

>
>
>


<
>
>

|







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
/* Define maximum certificate size. Max PEM size 100kB and DER size is 24kB. */
#define CERT_STR_SIZE 32768


/*
 * Binary string to hex string
 */
int String_to_Hex(unsigned char* input, int ilen, unsigned char *output, int olen) {
    int count = 0;
    unsigned char *iptr = input;
    unsigned char *optr = &output[0];
    const char *hex = "0123456789ABCDEF";

    for (int i = 0; i < ilen && count < olen - 1; i++, count += 2) {

        *optr++ = hex[(*iptr>>4)&0xF];
        *optr++ = hex[(*iptr++)&0xF];
    }
    *optr = 0;
    return count;
}

/*
 * BIO to Buffer
 */
int BIO_to_Buffer(int result, BIO *bio, void *buffer, int size) {
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
 */
Tcl_Obj *Tls_x509Identifier(ASN1_OCTET_STRING *astring) {
    Tcl_Obj *resultPtr = NULL;
    int len = 0;
    char buffer[1024];

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

/*
 * Get Key Usage
 */
Tcl_Obj *Tls_x509KeyUsage(Tcl_Interp *interp, X509 *cert, uint32_t xflags) {







|


|







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

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

/*
 * Get Key Usage
 */
Tcl_Obj *Tls_x509KeyUsage(Tcl_Interp *interp, X509 *cert, uint32_t xflags) {
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    }

    if (names = X509_get_ext_d2i(cert, nid, 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);
	    LAPPEND_STR(interp, listPtr, NULL, buffer, (Tcl_Size) len);
	}
	sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);
    }
    return listPtr;
}

/*







|







204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
    }

    if (names = X509_get_ext_d2i(cert, nid, 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);
	    LAPPEND_STR(interp, listPtr, NULL, buffer, len);
	}
	sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);
    }
    return listPtr;
}

/*
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
	    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));
		    }
		}
	    } 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));
		}
	    }
	}
	CRL_DIST_POINTS_free(crl);
    }
    return listPtr;
}







|








|







281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
	    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), 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), ASN1_STRING_length(d));
		}
	    }
	}
	CRL_DIST_POINTS_free(crl);
    }
    return listPtr;
}
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345

    if (ads = X509_get_ext_d2i(cert, NID_info_access, 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));
		    OPENSSL_free(buf);
		    break;
		}
	    }
	}
	/* sk_ACCESS_DESCRIPTION_pop_free(ads, ACCESS_DESCRIPTION_free); */
	AUTHORITY_INFO_ACCESS_free(ads);







|







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

    if (ads = X509_get_ext_d2i(cert, NID_info_access, 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, len));
		    OPENSSL_free(buf);
		    break;
		}
	    }
	}
	/* sk_ACCESS_DESCRIPTION_pop_free(ads, ACCESS_DESCRIPTION_free); */
	AUTHORITY_INFO_ACCESS_free(ads);
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
	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;
	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 */
    len = BIO_to_Buffer(i2a_ASN1_INTEGER(bio, X509_get0_serialNumber(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "serialNumber", buffer, (Tcl_Size) len);

    /* Signature algorithm used by the CA to sign the certificate. Must match
	signatureAlgorithm. RFC 5280 section 4.1.2.3 */
    LAPPEND_STR(interp, certPtr, "signature", OBJ_nid2ln(X509_get_signature_nid(cert)), -1);

    /* Issuer identifies the entity that signed and issued the cert. RFC 5280 section 4.1.2.4 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "issuer", buffer, (Tcl_Size) len);

    /* Certificate validity period is the interval the CA warrants that it will
	maintain info on the status of the certificate. RFC 5280 section 4.1.2.5 */
    /* Get Validity - Not Before */
    len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notBefore(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "notBefore", buffer, (Tcl_Size) len);

    /* Get Validity - Not After */
    len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notAfter(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "notAfter", buffer, (Tcl_Size) len);

    /* Subject identifies the entity associated with the public key stored in
	the subject public key field. RFC 5280 section 4.1.2.6 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_subject_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "subject", buffer, (Tcl_Size) len);

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

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

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







|







|







|





|



|




|




|





|














|





|






|







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
	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;
	LAPPEND_STR(interp, certPtr, "signatureValue", buffer, 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 */
    len = BIO_to_Buffer(i2a_ASN1_INTEGER(bio, X509_get0_serialNumber(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "serialNumber", buffer, len);

    /* Signature algorithm used by the CA to sign the certificate. Must match
	signatureAlgorithm. RFC 5280 section 4.1.2.3 */
    LAPPEND_STR(interp, certPtr, "signature", OBJ_nid2ln(X509_get_signature_nid(cert)), -1);

    /* Issuer identifies the entity that signed and issued the cert. RFC 5280 section 4.1.2.4 */
    len = BIO_to_Buffer(X509_NAME_print_ex(bio, X509_get_issuer_name(cert), 0, flags), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "issuer", buffer, len);

    /* Certificate validity period is the interval the CA warrants that it will
	maintain info on the status of the certificate. RFC 5280 section 4.1.2.5 */
    /* Get Validity - Not Before */
    len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notBefore(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "notBefore", buffer, len);

    /* Get Validity - Not After */
    len = BIO_to_Buffer(ASN1_TIME_print(bio, X509_get0_notAfter(cert)), bio, buffer, BUFSIZ);
    LAPPEND_STR(interp, certPtr, "notAfter", buffer, len);

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

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

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

	len = 0;
	if (X509_pubkey_digest(cert, EVP_get_digestbynid(pknid), md, &n)) {
	    len = String_to_Hex(md, (int)n, buffer, BUFSIZ);
	}
	LAPPEND_STR(interp, certPtr, "publicKeyHash", buffer, 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);
	}
	LAPPEND_STR(interp, certPtr, "signatureHash", buffer, 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 */
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
	and/or issuer names over time. RFC 5280 section 4.1.2.8 */
    {
	const ASN1_BIT_STRING *iuid, *suid;
        X509_get0_uids(cert, &iuid, &suid);

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

	Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("subjectUniqueId", -1));
	if (suid != NULL) {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((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));







|






|







491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
	and/or issuer names over time. RFC 5280 section 4.1.2.8 */
    {
	const ASN1_BIT_STRING *iuid, *suid;
        X509_get0_uids(cert, &iuid, &suid);

	Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1));
	if (iuid != NULL) {
	    Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, 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, 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));
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
    /* 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);
    }

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

	/* Get certificate */
	len = BIO_to_Buffer(PEM_write_bio_X509(bio, cert), bio, certStr, CERT_STR_SIZE);
	LAPPEND_STR(interp, certPtr, "certificate", certStr, (Tcl_Size) len);

	/* Get all cert info */
	len = BIO_to_Buffer(X509_print_ex(bio, cert, flags, 0), bio, certStr, CERT_STR_SIZE);
	LAPPEND_STR(interp, certPtr, "all", certStr, (Tcl_Size) len);
    }

    BIO_free(bio);
    return certPtr;
}







|








|



|





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

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

	/* Get certificate */
	len = BIO_to_Buffer(PEM_write_bio_X509(bio, cert), bio, certStr, CERT_STR_SIZE);
	LAPPEND_STR(interp, certPtr, "certificate", certStr, len);

	/* Get all cert info */
	len = BIO_to_Buffer(X509_print_ex(bio, cert, flags, 0), bio, certStr, CERT_STR_SIZE);
	LAPPEND_STR(interp, certPtr, "all", certStr, len);
    }

    BIO_free(bio);
    return certPtr;
}

Modified tests/ciphers.csv from [f4aff3652a] to [bf3d4dd21f].

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










|










>
>
>
>
>
>

|
|

|
|
|
|
|
|
|


|
|
|
|
|
|


|
|
|
|
|
|

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


>
>
>
>
>
>
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
# 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,"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_macs {} {return [list cmac hmac]},,,,,,,,,
command,proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result},,,,,,,,,
command,proc read_chan {md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set bsize [fconfigure $ch -buffersize];set new [tls::digest $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new $bsize]};close $new;return $result},,,,,,,,,
command,proc accumulate {md string args} {set cmd [tls::digest $md {*}$args -command dcmd];$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},,,,,,,,,
,,,,,,,,,,
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,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,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,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 [concat [exec_get "":"" ciphers -tls1_3 -s] [exec_get "":"" ciphers -tls1_2 -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
,,,,,,,,,,
command,# Test list digests,,,,,,,,,
Digests List,All,,,lcompare [lsort [exec_get_digests]] [lsort [tls::digests]],,,missing {} unexpected {},,,
,,,,,,,,,,
command,# Test digest commands,,,,,,,,,
Digest Cmds,md4 cmd,,,"tls::md4 ""Example string for message digest tests.""",,,181CDCF9DB9B6FA8FC0A3BF9C34E29D9,,,
Digest Cmds,md5 cmd,,,"tls::md5 ""Example string for message digest tests.""",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest Cmds,sha1 cmd,,,"tls::sha1 ""Example string for message digest tests.""",,,3AEFE840CA492C387E903F15ED6019E7AD833B47,,,
Digest Cmds,sha256 cmd,,,"tls::sha256 ""Example string for message digest tests.""",,,B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491,,,
Digest Cmds,sha512 cmd,,,"tls::sha512 ""Example string for message digest tests.""",,,B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F,,,
,,,,,,,,,,
command,# Test digest command for data,,,,,,,,,
Digest Data,md4,,,"tls::digest md4 ""Example string for message digest tests.""",,,181CDCF9DB9B6FA8FC0A3BF9C34E29D9,,,
Digest Data,md5,,,"tls::digest md5 ""Example string for message digest tests.""",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest Data,sha1,,,"tls::digest sha1 ""Example string for message digest tests.""",,,3AEFE840CA492C387E903F15ED6019E7AD833B47,,,
Digest Data,sha256,,,"tls::digest sha256 ""Example string for message digest tests.""",,,B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491,,,
Digest Data,sha512,,,"tls::digest sha512 ""Example string for message digest tests.""",,,B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F,,,
Digest Data,md5 bin,,,"string toupper [binary encode hex [tls::digest md5 -bin ""Example string for message digest tests.""]]",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest Data,md5 hex,,,"tls::digest md5 -hex ""Example string for message digest tests.""",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest Data,md5 with arg,,,"tls::digest md5 -data ""Example string for message digest tests.""",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
,,,,,,,,,,
command,# Test digest command for files,,,,,,,,,
Digest File,md4,,,tls::digest md4 -file md_data.dat,,,181CDCF9DB9B6FA8FC0A3BF9C34E29D9,,,
Digest File,md5,,,tls::digest md5 -file md_data.dat,,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest File,sha1,,,tls::digest sha1 -file md_data.dat,,,3AEFE840CA492C387E903F15ED6019E7AD833B47,,,
Digest File,sha256,,,tls::digest sha256 -file md_data.dat,,,B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491,,,
Digest File,sha512,,,tls::digest sha512 -file md_data.dat,,,B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F,,,
Digest File,md5 bin,,,string toupper [binary encode hex [tls::digest md5 -bin -file md_data.dat]],,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest File,md5 hex,,,tls::digest md5 -hex -file md_data.dat,,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
,,,,,,,,,,
command,# Test digest command for channel,,,,,,,,,
Digest Chan,md4,,,read_chan md4 md_data.dat,,,181CDCF9DB9B6FA8FC0A3BF9C34E29D9,,,
Digest Chan,md5,,,read_chan md5 md_data.dat,,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest Chan,sha1,,,read_chan sha1 md_data.dat,,,3AEFE840CA492C387E903F15ED6019E7AD833B47,,,
Digest Chan,sha256,,,read_chan sha256 md_data.dat,,,B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491,,,
Digest Chan,sha512,,,read_chan sha512 md_data.dat,,,B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F,,,
Digest Chan,md5 bin,,,string toupper [binary encode hex [read_chan md5 md_data.dat -bin]],,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest Chan,md5 hex,,,read_chan md5 md_data.dat -hex,,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
,,,,,,,,,,
command,# Test digest command for accumulator command,,,,,,,,,
Digest Command,md4,,,"accumulate md4 ""Example string for message digest tests.""",,,181CDCF9DB9B6FA8FC0A3BF9C34E29D9,,,
Digest Command,md5,,,"accumulate md5 ""Example string for message digest tests.""",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest Command,sha1,,,"accumulate sha1 ""Example string for message digest tests.""",,,3AEFE840CA492C387E903F15ED6019E7AD833B47,,,
Digest Command,sha256,,,"accumulate sha256 ""Example string for message digest tests.""",,,B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491,,,
Digest Command,sha512,,,"accumulate sha512 ""Example string for message digest tests.""",,,B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F,,,
Digest Command,md5 bin,,,"string toupper [binary encode hex [accumulate md5 ""Example string for message digest tests."" -bin]]",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
Digest Command,md5 hex,,,"accumulate md5 ""Example string for message digest tests."" -hex",,,CCB1BE2E11D8183E843FF73DA8C6D206,,,
,,,,,,,,,,
command,# Test HMAC,,,,,,,,,
Digest HMAC,data,,,"tls::digest md5 -key ""Example key"" -data ""Example string for message digest tests.""",,,901DA6E6976A71650C77443C37FF9C7F,,,
Digest HMAC,file,,,"tls::digest md5 -key ""Example key"" -file md_data.dat",,,901DA6E6976A71650C77443C37FF9C7F,,,
Digest HMAC,channel,,,"read_chan md5 md_data.dat -key ""Example key""",,,901DA6E6976A71650C77443C37FF9C7F,,,
Digest HMAC,data bin,,,"string toupper [binary encode hex [tls::digest md5 -bin -key ""Example key"" -data ""Example string for message digest tests.""]]",,,901DA6E6976A71650C77443C37FF9C7F,,,
,,,,,,,,,,
command,# Digest Error Cases,,,,,,,,,
Digest Errors,Too few args,,,::tls::digest,,,"wrong # args: should be ""::tls::digest type ?-bin|-hex? ?-key hmac_key? [-channel chan | -file filename | ?-data? data]""",,,1
Digest Errors,Too many args,,,::tls::digest too many args to pass the test without an error,,,"wrong # args: should be ""::tls::digest type ?-bin|-hex? ?-key hmac_key? [-channel chan | -file filename | ?-data? data]""",,,1
Digest Errors,Invalid digest,,,::tls::digest bogus data,,,"Invalid digest type ""bogus""",,,1
Digest Errors,Invalid option,,,::tls::digest sha256 -bogus value,,,"bad option ""-bogus"": must be -bin, -data, -file, -filename, -hex, or -key",,,1
Digest Errors,Invalid file,,,::tls::digest sha256 -file bogus,,,"couldn't open ""bogus"": no such file or directory",,,1
Digest Errors,Invalid channel,,,::tls::digest sha256 -channel bogus,,,"can not find channel named ""bogus""",,,1
,,,,,,,,,,
command,# Test list MACs,,,,,,,,,
MAC List,All,,,lcompare [exec_get_macs] [tls::macs],,,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,Digests Too many args,,,::tls::digests too many args,,,"wrong # args: should be ""::tls::digests""",,,1
Error Cases,MACs Too many args,,,::tls::macs too many args,,,"wrong # args: should be ""::tls::macs""",,,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

Modified tests/ciphers.test from [212c1bf055] to [3d7c03c49d].

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
|












|









>
>
>
>
>
|


|
|
|
|


|



|



|



|



|



|





|



|



|



|



|



|





|



|



|



|



|



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

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


|



|


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




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
# Auto generated test cases for ciphers.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]}
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]}
command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,,
proc read_chan {md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set bsize [fconfigure $ch -buffersize];set new [tls::digest $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new $bsize]};close $new;return $result}
proc accumulate {md string args} {set cmd [tls::digest $md {*}$args -command dcmd];$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]}
# 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} -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} -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} -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 [concat [exec_get ":" ciphers -tls1_3 -s] [exec_get ":" ciphers -tls1_2 -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 list digests


test Digests_List-6.1 {All} -body {
	lcompare [lsort [exec_get_digests]] [lsort [tls::digests]]
    } -result {missing {} unexpected {}}
# Test digest commands


test Digest_Cmds-7.1 {md4 cmd} -body {
	tls::md4 "Example string for message digest tests."
    } -result {181CDCF9DB9B6FA8FC0A3BF9C34E29D9}

test Digest_Cmds-7.2 {md5 cmd} -body {
	tls::md5 "Example string for message digest tests."
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_Cmds-7.3 {sha1 cmd} -body {
	tls::sha1 "Example string for message digest tests."
    } -result {3AEFE840CA492C387E903F15ED6019E7AD833B47}

test Digest_Cmds-7.4 {sha256 cmd} -body {
	tls::sha256 "Example string for message digest tests."
    } -result {B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491}

test Digest_Cmds-7.5 {sha512 cmd} -body {
	tls::sha512 "Example string for message digest tests."
    } -result {B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F}
# Test digest command for data


test Digest_Data-8.1 {md4} -body {
	tls::digest md4 "Example string for message digest tests."
    } -result {181CDCF9DB9B6FA8FC0A3BF9C34E29D9}

test Digest_Data-8.2 {md5} -body {
	tls::digest md5 "Example string for message digest tests."
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_Data-8.3 {sha1} -body {
	tls::digest sha1 "Example string for message digest tests."
    } -result {3AEFE840CA492C387E903F15ED6019E7AD833B47}

test Digest_Data-8.4 {sha256} -body {
	tls::digest sha256 "Example string for message digest tests."
    } -result {B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491}

test Digest_Data-8.5 {sha512} -body {
	tls::digest sha512 "Example string for message digest tests."
    } -result {B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F}

test Digest_Data-8.6 {md5 bin} -body {
	string toupper [binary encode hex [tls::digest md5 -bin "Example string for message digest tests."]]
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_Data-8.7 {md5 hex} -body {
	tls::digest md5 -hex "Example string for message digest tests."
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_Data-8.8 {md5 with arg} -body {
	tls::digest md5 -data "Example string for message digest tests."
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}
# Test digest command for files


test Digest_File-9.1 {md4} -body {
	tls::digest md4 -file md_data.dat
    } -result {181CDCF9DB9B6FA8FC0A3BF9C34E29D9}

test Digest_File-9.2 {md5} -body {
	tls::digest md5 -file md_data.dat
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_File-9.3 {sha1} -body {
	tls::digest sha1 -file md_data.dat
    } -result {3AEFE840CA492C387E903F15ED6019E7AD833B47}

test Digest_File-9.4 {sha256} -body {
	tls::digest sha256 -file md_data.dat
    } -result {B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491}

test Digest_File-9.5 {sha512} -body {
	tls::digest sha512 -file md_data.dat
    } -result {B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F}

test Digest_File-9.6 {md5 bin} -body {
	string toupper [binary encode hex [tls::digest md5 -bin -file md_data.dat]]
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_File-9.7 {md5 hex} -body {
	tls::digest md5 -hex -file md_data.dat
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}
# Test digest command for channel


test Digest_Chan-10.1 {md4} -body {
	read_chan md4 md_data.dat
    } -result {181CDCF9DB9B6FA8FC0A3BF9C34E29D9}

test Digest_Chan-10.2 {md5} -body {
	read_chan md5 md_data.dat
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_Chan-10.3 {sha1} -body {
	read_chan sha1 md_data.dat
    } -result {3AEFE840CA492C387E903F15ED6019E7AD833B47}

test Digest_Chan-10.4 {sha256} -body {
	read_chan sha256 md_data.dat
    } -result {B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491}

test Digest_Chan-10.5 {sha512} -body {
	read_chan sha512 md_data.dat
    } -result {B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F}

test Digest_Chan-10.6 {md5 bin} -body {
	string toupper [binary encode hex [read_chan md5 md_data.dat -bin]]
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_Chan-10.7 {md5 hex} -body {
	read_chan md5 md_data.dat -hex
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}
# Test digest command for accumulator command


test Digest_Command-11.1 {md4} -body {
	accumulate md4 "Example string for message digest tests."
    } -result {181CDCF9DB9B6FA8FC0A3BF9C34E29D9}

test Digest_Command-11.2 {md5} -body {
	accumulate md5 "Example string for message digest tests."
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_Command-11.3 {sha1} -body {
	accumulate sha1 "Example string for message digest tests."
    } -result {3AEFE840CA492C387E903F15ED6019E7AD833B47}

test Digest_Command-11.4 {sha256} -body {
	accumulate sha256 "Example string for message digest tests."
    } -result {B7DFDDEB0314A74FF56A8AC1E3DC57DF09BB52A96DA50F6549EB62CA61A0A491}

test Digest_Command-11.5 {sha512} -body {
	accumulate sha512 "Example string for message digest tests."
    } -result {B56EC55E33193E17B61D669FB7B04AD2483DE93FE847C411BBEAE6440ECEA6C7CFDD2E6F35A06CB189FC62D799E785CDB7A23178323789D001BC8E44A0B5907F}

test Digest_Command-11.6 {md5 bin} -body {
	string toupper [binary encode hex [accumulate md5 "Example string for message digest tests." -bin]]
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}

test Digest_Command-11.7 {md5 hex} -body {
	accumulate md5 "Example string for message digest tests." -hex
    } -result {CCB1BE2E11D8183E843FF73DA8C6D206}
# Test HMAC


test Digest_HMAC-12.1 {data} -body {
	tls::digest md5 -key "Example key" -data "Example string for message digest tests."
    } -result {901DA6E6976A71650C77443C37FF9C7F}

test Digest_HMAC-12.2 {file} -body {
	tls::digest md5 -key "Example key" -file md_data.dat
    } -result {901DA6E6976A71650C77443C37FF9C7F}

test Digest_HMAC-12.3 {channel} -body {
	read_chan md5 md_data.dat -key "Example key"
    } -result {901DA6E6976A71650C77443C37FF9C7F}

test Digest_HMAC-12.4 {data bin} -body {
	string toupper [binary encode hex [tls::digest md5 -bin -key "Example key" -data "Example string for message digest tests."]]
    } -result {901DA6E6976A71650C77443C37FF9C7F}
# Digest Error Cases


test Digest_Errors-13.1 {Too few args} -body {
	::tls::digest
    } -result {wrong # args: should be "::tls::digest type ?-bin|-hex? ?-key hmac_key? [-channel chan | -file filename | ?-data? data]"} -returnCodes {1}

test Digest_Errors-13.2 {Too many args} -body {
	::tls::digest too many args to pass the test without an error
    } -result {wrong # args: should be "::tls::digest type ?-bin|-hex? ?-key hmac_key? [-channel chan | -file filename | ?-data? data]"} -returnCodes {1}

test Digest_Errors-13.3 {Invalid digest} -body {
	::tls::digest bogus data
    } -result {Invalid digest type "bogus"} -returnCodes {1}

test Digest_Errors-13.4 {Invalid option} -body {
	::tls::digest sha256 -bogus value
    } -result {bad option "-bogus": must be -bin, -data, -file, -filename, -hex, or -key} -returnCodes {1}

test Digest_Errors-13.5 {Invalid file} -body {
	::tls::digest sha256 -file bogus
    } -result {couldn't open "bogus": no such file or directory} -returnCodes {1}

test Digest_Errors-13.6 {Invalid channel} -body {
	::tls::digest sha256 -channel bogus
    } -result {can not find channel named "bogus"} -returnCodes {1}
# Test list MACs


test MAC_List-14.1 {All} -body {
	lcompare [exec_get_macs] [tls::macs]
    } -result {missing {} unexpected {}}
# Test list protocols


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


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

test Version-16.2 {OpenSSL} -constraints {OpenSSL} -body {
	::tls::version
    } -match {glob} -result {OpenSSL*}
# Error Cases


test Error_Cases-17.1 {Digests Too many args} -body {
	::tls::digests too many args
    } -result {wrong # args: should be "::tls::digests"} -returnCodes {1}

test Error_Cases-17.2 {MACs Too many args} -body {
	::tls::macs too many args
    } -result {wrong # args: should be "::tls::macs"} -returnCodes {1}

test Error_Cases-17.3 {Protocols Too many args} -body {
	::tls::protocols too many args
    } -result {wrong # args: should be "::tls::protocols"} -returnCodes {1}

test Error_Cases-17.4 {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/md_data.dat version [b1f2301c2f].



>
1
Example string for message digest tests.

Modified win/makefile.vc from [11d5b7bf2c] to [f23472ab04].

23
24
25
26
27
28
29


30
31
32
33
34
35
36
37
38
39

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




58
59
60
61
62
63
64
65
66
67
68
69
70

# Define the object files and resource file that make up the extension.
# Note the resource file does not makes sense if doing a static library build
# hence it is under that condition. TMP_DIR is the output directory
# defined by rules for object files.
PRJ_OBJS = $(TMP_DIR)\tls.obj \
	$(TMP_DIR)\tlsBIO.obj \


	$(TMP_DIR)\tlsIO.obj \
	$(TMP_DIR)\tlsX509.obj

# Define any additional project include flags
# SSL_INSTALL_FOLDER = with the OpenSSL installation folder following.
PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -I"$(OPENSSL_INSTALL_DIR)\include"

# Define any additional compiler flags that might be required for the project
PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS
 

# SSL Libs:
#    1. ${LIBCRYPTO}.dll
#    2. ${LIBSSL}.dll
# Where LIBCRYPTO (#1.) and LIBSSL (#2.) are defined as follows:
#    v1.1: libcrypto-1.1-x64.dll and libssl-1.1-x64.dll
#    v3: libcrypto-3-x64.dll and libssl-3-x64.dll
# On *nix libcrypto.so.* and libssl.so.* (where suffix is a version indicator).
#
PRJ_LIBS = \
	"$(SSL_INSTALL_FOLDER)\lib\libssl.lib" \
	"$(SSL_INSTALL_FOLDER)\lib\libcrypto.lib" \
	WS2_32.LIB GDI32.LIB ADVAPI32.LIB CRYPT32.LIB USER32.LIB

# Define the standard targets
!include "targets.vc"

# Project specific targets





# We must define a pkgindex target that will create a pkgIndex.tcl
# file in the $(OUT_DIR) directory. We can just redirect to the
# default-pkgindex target for our sample extension.
pkgindex: default-pkgindex

# The default install target only installs binaries and scripts so add
# an additional target for our documentation. Note this *adds* a target
# since no commands are listed after it. The original targets for
# install (from targets.vc) will remain.
install: default-pkgindex-tea default-install default-install-docs-html

# Test package
test: default-test







>
>









|
>


















>
>
>
>













23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

# Define the object files and resource file that make up the extension.
# Note the resource file does not makes sense if doing a static library build
# hence it is under that condition. TMP_DIR is the output directory
# defined by rules for object files.
PRJ_OBJS = $(TMP_DIR)\tls.obj \
	$(TMP_DIR)\tlsBIO.obj \
	$(TMP_DIR)\tlsDigest.obj \
	$(TMP_DIR)\tlsInfo.obj \
	$(TMP_DIR)\tlsIO.obj \
	$(TMP_DIR)\tlsX509.obj

# Define any additional project include flags
# SSL_INSTALL_FOLDER = with the OpenSSL installation folder following.
PRJ_INCLUDES = -I"$(SSL_INSTALL_FOLDER)\include" -I"$(OPENSSL_INSTALL_DIR)\include"

# Define any additional compiler flags that might be required for the project
PRJ_DEFINES = -D NO_SSL2 -D NO_SSL3 -D _CRT_SECURE_NO_WARNINGS

#
# SSL Libs:
#    1. ${LIBCRYPTO}.dll
#    2. ${LIBSSL}.dll
# Where LIBCRYPTO (#1.) and LIBSSL (#2.) are defined as follows:
#    v1.1: libcrypto-1.1-x64.dll and libssl-1.1-x64.dll
#    v3: libcrypto-3-x64.dll and libssl-3-x64.dll
# On *nix libcrypto.so.* and libssl.so.* (where suffix is a version indicator).
#
PRJ_LIBS = \
	"$(SSL_INSTALL_FOLDER)\lib\libssl.lib" \
	"$(SSL_INSTALL_FOLDER)\lib\libcrypto.lib" \
	WS2_32.LIB GDI32.LIB ADVAPI32.LIB CRYPT32.LIB USER32.LIB

# Define the standard targets
!include "targets.vc"

# Project specific targets

all:

clean: default-clean

# We must define a pkgindex target that will create a pkgIndex.tcl
# file in the $(OUT_DIR) directory. We can just redirect to the
# default-pkgindex target for our sample extension.
pkgindex: default-pkgindex

# The default install target only installs binaries and scripts so add
# an additional target for our documentation. Note this *adds* a target
# since no commands are listed after it. The original targets for
# install (from targets.vc) will remain.
install: default-pkgindex-tea default-install default-install-docs-html

# Test package
test: default-test