Index: configure
==================================================================
--- configure
+++ configure
@@ -5394,11 +5394,11 @@
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------
- vars="tls.c tlsBIO.c tlsIO.c tlsX509.c"
+ vars="tls.c tlsBIO.c tlsDigest.c tlsInfo.c tlsIO.c tlsX509.c"
for i in $vars; do
case $i in
\$*)
# allow $-var names
PKG_SOURCES="$PKG_SOURCES $i"
Index: configure.ac
==================================================================
--- configure.ac
+++ configure.ac
@@ -69,11 +69,11 @@
# and runtime Tcl library files in TEA_ADD_TCL_SOURCES.
# This defines PKG(_STUB)_SOURCES, PKG(_STUB)_OBJECTS, PKG_HEADERS
# and PKG_TCL_SOURCES.
#-----------------------------------------------------------------------
-TEA_ADD_SOURCES([tls.c tlsBIO.c tlsIO.c tlsX509.c])
+TEA_ADD_SOURCES([tls.c tlsBIO.c tlsDigest.c 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([])
Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -29,13 +29,24 @@
<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> </dt>
- <dd><b>tls::ciphers </b> <em>protocol ?verbose? ?supported?</em></dd>
+ <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> </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>
@@ -50,11 +61,11 @@
<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>
+<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>
@@ -62,13 +73,24 @@
<a href="#tls::connection"><b>tls::connection</b> <i>channel</i></a><br>
<a href="#tls::handshake"><b>tls::handshake</b> <i>channel</i></a><br>
<a href="#tls::import"><b>tls::import</b> <i>channel ?options?</i></a><br>
<a href="#tls::unimport"><b>tls::unimport</b> <i>channel</i></a><br>
<br>
-<a href="#tls::ciphers"><b>tls::ciphers</b> <i>protocol ?verbose? ?supported?</i></a><br>
-<a href="#tls::protocols"><b>tls::protocols</b></a>
-<a href="#tls::version"><b>tls::version</b></a>
+<a href="#tls::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
@@ -413,27 +435,94 @@
<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>
+ <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
+ "<em>cmdName</em> <b>update</b> <em>data</em>", where data is
+ the data to add. When done, call "<em>cmdName</em> <b>finalize</b>"
+ 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>
Index: generic/tclOpts.h
==================================================================
--- generic/tclOpts.h
+++ generic/tclOpts.h
@@ -5,10 +5,16 @@
* 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, \
@@ -15,13 +21,15 @@
"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()
@@ -44,11 +52,11 @@
&(var)) != TCL_OK) { \
return TCL_ERROR; \
} \
OPT_POSTLOG()
-#define OPTBYTE(option, var, lvar) \
+#define OPTBYTE(option, var, lvar) \
OPT_PROLOG(option) \
var = Tcl_GetByteArrayFromObj(objv[idx], &(lvar));\
OPT_POSTLOG()
#define OPTBAD(type, list) \
Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -24,10 +24,14 @@
#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
@@ -43,11 +47,10 @@
*/
#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);
@@ -444,11 +447,11 @@
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) {
+ } 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) {
@@ -551,19 +554,19 @@
Tcl_Release((ClientData) statePtr);
/* If successful, pass back password string and truncate if too long */
if (code == TCL_OK) {
- Tcl_Size len;
+ int len;
char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
- if (len > (Tcl_Size) size-1) {
- len = (Tcl_Size) size-1;
+ if (len > size-1) {
+ len = size-1;
}
strncpy(buf, ret, (size_t) len);
buf[len] = '\0';
Tcl_Release((ClientData) interp);
- return((int) len);
+ return(len);
}
Tcl_Release((ClientData) interp);
return -1;
}
@@ -613,15 +616,15 @@
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));
+ 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, (Tcl_Size) 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)));
@@ -902,11 +905,11 @@
/* 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));
+ 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;
@@ -923,226 +926,10 @@
/********************/
/* 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 --
*
@@ -1171,11 +958,11 @@
return(TCL_ERROR);
}
ERR_clear_error();
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
+ 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 */
@@ -1249,20 +1036,19 @@
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 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;
- Tcl_Size key_len = 0;
+ int key_len = 0;
unsigned char *cert = NULL;
- Tcl_Size cert_len = 0;
+ int cert_len = 0;
char *ciphers = NULL;
char *ciphersuites = NULL;
char *CAfile = NULL;
char *CAdir = NULL;
char *DHparams = NULL;
@@ -1295,20 +1081,20 @@
return TCL_ERROR;
}
ERR_clear_error();
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
+ 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], (Tcl_Size *)NULL);
+ char *opt = Tcl_GetStringFromObj(objv[idx], NULL);
if (opt[0] != '-')
break;
OPTOBJ("-alpn", alpn);
@@ -1424,12 +1210,12 @@
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) {
+ 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;
}
}
@@ -1515,12 +1301,11 @@
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;
+ int i, len, cnt;
Tcl_Obj **list;
if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) {
Tls_Free((char *) statePtr);
return TCL_ERROR;
@@ -1533,20 +1318,20 @@
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;
+ protos_len += 1 + 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);
+ 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 */
@@ -1720,48 +1505,48 @@
const SSL_METHOD *method;
dprintf("Called");
if (!proto) {
- Tcl_AppendResult(interp, "no valid protocol selected", (char *) NULL);
+ 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", (char *) NULL);
+ 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", (char *) NULL);
+ 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", (char *) NULL);
+ 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", (char *) NULL);
+ 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", (char *) NULL);
+ 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", (char *) NULL);
+ Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", NULL);
return NULL;
}
#endif
if (proto == 0) {
/* Use full range */
@@ -1845,10 +1630,14 @@
/* 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 */
@@ -2062,11 +1851,11 @@
Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel");
return TCL_ERROR;
}
/* Get channel Id */
- channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], (Tcl_Size *) NULL);
+ channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], NULL);
chan = Tcl_GetChannel(interp, channelName, &mode);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
}
@@ -2132,11 +1921,11 @@
/* 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, "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);
@@ -2182,11 +1971,11 @@
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channel");
return(TCL_ERROR);
}
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL);
+ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL);
if (chan == (Tcl_Channel) NULL) {
return(TCL_ERROR);
}
/* Make sure to operate on the topmost channel */
@@ -2289,16 +2078,16 @@
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);
+ 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, (Tcl_Size) ulen);
+ LAPPEND_STR(interp, objPtr, "npn", (char *) proto, (int) ulen);
#endif
/* Resumable session */
LAPPEND_BOOL(interp, objPtr, "resumable", SSL_SESSION_is_resumable(session));
@@ -2308,30 +2097,30 @@
/* 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);
+ 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, (Tcl_Size) 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, (Tcl_Size) 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, (Tcl_Size) 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, (Tcl_Size) len2);
+ 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);
}
@@ -2393,38 +2182,10 @@
}
/*
*-------------------------------------------------------------------
*
- * 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.
*
@@ -2435,12 +2196,11 @@
*/
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;
+ int cmd, isStr;
char buffer[16384];
dprintf("Called");
if (objc < 2) {
@@ -2459,12 +2219,11 @@
case C_STRREQ: {
EVP_PKEY *pkey=NULL;
X509 *cert=NULL;
X509_NAME *name=NULL;
Tcl_Obj **listv;
- Tcl_Size listc;
- int i;
+ 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;
@@ -2491,11 +2250,12 @@
Tcl_SetVar(interp,keyout,"",0);
Tcl_SetVar(interp,pemout,"",0);
}
if (objc>=6) {
- if (Tcl_ListObjGetElements(interp, objv[5], &listc, &listv) != TCL_OK) {
+ 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);
@@ -2771,23 +2531,23 @@
return TCL_ERROR;
}
#endif
if (TlsLibInit(0) != TCL_OK) {
- Tcl_AppendResult(interp, "could not initialize SSL library", (char *) NULL);
+ Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
return TCL_ERROR;
}
- Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::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);
- 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);
+
+ Tls_DigestCommands(interp);
+ Tls_InfoCommands(interp);
if (interp) {
Tcl_Eval(interp, tlsTclInitScript);
}
Index: generic/tlsBIO.c
==================================================================
--- generic/tlsBIO.c
+++ generic/tlsBIO.c
@@ -6,24 +6,23 @@
#include "tlsInt.h"
static int BioWrite(BIO *bio, const char *buf, int bufLen) {
Tcl_Channel chan;
- Tcl_Size ret;
+ int ret;
int tclEofChan, tclErrno;
chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);
- ret = Tcl_WriteRaw(chan, buf, (Tcl_Size) bufLen);
+ ret = (int) Tcl_WriteRaw(chan, buf, 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());
+ 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");
@@ -53,11 +52,11 @@
dprintf("Setting should retry read flag");
BIO_set_retry_read(bio);
}
}
- return((int) ret);
+ return(ret);
}
static int BioRead(BIO *bio, char *buf, int bufLen) {
Tcl_Channel chan;
Tcl_Size ret = 0;
@@ -69,17 +68,16 @@
if (buf == NULL) {
return 0;
}
- ret = Tcl_ReadRaw(chan, buf, (Tcl_Size) bufLen);
+ ret = Tcl_ReadRaw(chan, buf, 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);
+ 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");
@@ -110,14 +108,13 @@
BIO_set_retry_write(bio);
}
}
- dprintf("BioRead(%p, <buf>, %d) [%p] returning %" TCL_SIZE_MODIFIER "d", (void *) bio,
- bufLen, (void *) chan, ret);
+ dprintf("BioRead(%p, <buf>, %d) [%p] returning %i", (void *) bio, bufLen, (void *) chan, ret);
- return((int) ret);
+ return(ret);
}
static int BioPuts(BIO *bio, const char *str) {
dprintf("BioPuts(%p, <string:%p>) called", bio, str);
ADDED generic/tlsDigest.c
Index: generic/tlsDigest.c
==================================================================
--- /dev/null
+++ generic/tlsDigest.c
@@ -0,0 +1,1294 @@
+/*
+ * Message Digests (MD) and Message Authentication Code (MAC) Module
+ *
+ * Provides commands to calculate a message digest (MD) or message
+ * authentication code (MAC) using a specified hash function and/or cipher.
+ *
+ * Copyright (C) 2023 Brian O'Hagan
+ *
+ */
+
+#include "tlsInt.h"
+#include "tclOpts.h"
+#include <tcl.h>
+#include <stdio.h>
+#include <string.h>
+#include <openssl/evp.h>
+#include <openssl/cmac.h>
+#include <openssl/hmac.h>
+
+/* Constants */
+const char *hex = "0123456789abcdef";
+
+/* Macros */
+#define BUFFER_SIZE 65536
+#define CHAN_EOF 0x10
+#define READ_DELAY 5
+
+/* Digest format and operation */
+#define BIN_FORMAT 0x01
+#define HEX_FORMAT 0x02
+#define 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 = 0, 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 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 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 do_result) {
+ 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);
+ }
+ if (!res && do_result) {
+ Tcl_AppendResult(statePtr->interp, "Update failed: ", REASON(), NULL);
+ return TCL_ERROR;
+ }
+ 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 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;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * 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, 0)) {
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("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("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, 0)) {
+ Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("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.
+ *
+ *----------------------------------------------------------------------
+ */
+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, "Memory allocation error", (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, 1)) {
+ return TCL_ERROR;
+ }
+
+ } else {
+ /* Finalize hash function and calculate message digest */
+ if (Tls_DigestFinialize(interp, statePtr) != TCL_OK) {
+ 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, "Memory allocation error", (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, Tcl_Obj *dataObj, const EVP_MD *md,
+ const EVP_CIPHER *cipher, int format, Tcl_Obj *keyObj) {
+ char *data;
+ int data_len;
+ DigestState *statePtr;
+
+ /* Get data */
+ data = Tcl_GetByteArrayFromObj(dataObj, &data_len);
+ if (data == NULL || data_len == 0) {
+ Tcl_SetResult(interp, "No data", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Create state struct */
+ if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Calc Digest */
+ if (Tls_DigestInit(interp, statePtr, md, cipher, keyObj) != TCL_OK ||
+ Tls_DigestUpdate(statePtr, data, (size_t) len, 1) == 0 ||
+ Tls_DigestFinialize(interp, statePtr) != TCL_OK) {
+ Tls_DigestFree(statePtr);
+ return TCL_ERROR;
+ }
+ Tls_DigestFree(statePtr);
+ 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;
+
+ /* Create state data struct */
+ if ((statePtr = Tls_DigestNew(interp, format)) == NULL) {
+ Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Open file channel */
+ chan = Tcl_FSOpenFileChannel(interp, filename, "rb", 0444);
+ if (chan == (Tcl_Channel) NULL) {
+ Tls_DigestFree(statePtr);
+ return TCL_ERROR;
+ }
+
+ /* Configure channel */
+ if ((res = Tcl_SetChannelOption(interp, chan, "-translation", "binary")) == TCL_ERROR) {
+ goto done;
+ }
+ Tcl_SetChannelBufferSize(chan, BUFFER_SIZE);
+
+ /* 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, 1)) {
+ 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;
+}
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * DigestMain --
+ *
+ * Return message digest or Message Authentication Code (MAC) of
+ * data using user specified hash function.
+ *
+ * Returns:
+ * TCL_OK or TCL_ERROR
+ *
+ * Side effects:
+ * Sets result to message digest or error message
+ *
+ *-------------------------------------------------------------------
+ */
+static int DigestMain(int type, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ int 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 = NULL;
+ const EVP_CIPHER *cipher = NULL;
+
+ /* Clear interp result */
+ Tcl_ResetResult(interp);
+
+ /* Validate arg count */
+ if (objc < 3 || objc > 12) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-bin|-hex? ?-cipher name? ?-digest name? ?-key key? [-channel chan | -command cmdName | -file filename | ?-data? data]");
+ return TCL_ERROR;
+ }
+
+ /* Optimal case for a digest and blob of data */
+ if (objc == 3 && type == TYPE_MD) {
+ digestName = Tcl_GetStringFromObj(objv[1],NULL);
+ if ((md = EVP_get_digestbyname(digestName)) != NULL) {
+ return Tls_DigestData(interp, objv[2], md, NULL, HEX_FORMAT | TYPE_MD, NULL);
+ } else {
+ Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /* 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);
+ OPTSTR("-digest", digestName);
+ OPTOBJ("-file", fileObj);
+ OPTOBJ("-filename", fileObj);
+ OPTOBJ("-key", keyObj);
+
+ OPTBAD("option", "-bin, -channel, -cipher, -command, -data, -digest, -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 digest */
+ if (digestName != NULL) {
+ md = EVP_get_digestbyname(digestName);
+ if (md == NULL) {
+ Tcl_AppendResult(interp, "Invalid digest \"", digestName, "\"", NULL);
+ return TCL_ERROR;
+ }
+ } else if (type == TYPE_MD || type == TYPE_HMAC) {
+ Tcl_AppendResult(interp, "No digest 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) {
+ res = Tls_DigestData(interp, dataObj, 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[]) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "data");
+ return TCL_ERROR;
+ }
+ return Tls_DigestData(interp, objv[1], EVP_md4(), NULL, HEX_FORMAT | TYPE_MD, NULL);
+}
+
+int DigestMD5Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "data");
+ return TCL_ERROR;
+ }
+ return Tls_DigestData(interp, objv[1], EVP_md5(), NULL, HEX_FORMAT | TYPE_MD, NULL);
+}
+
+int DigestSHA1Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "data");
+ return TCL_ERROR;
+ }
+ return Tls_DigestData(interp, objv[1], EVP_sha1(), NULL, HEX_FORMAT | TYPE_MD, NULL);
+}
+
+int DigestSHA256Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "data");
+ return TCL_ERROR;
+ }
+ return Tls_DigestData(interp, objv[1], EVP_sha256(), NULL, HEX_FORMAT | TYPE_MD, NULL);
+}
+
+int DigestSHA512Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "data");
+ return TCL_ERROR;
+ }
+ return Tls_DigestData(interp, objv[1], 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;
+}
+
Index: generic/tlsIO.c
==================================================================
--- generic/tlsIO.c
+++ generic/tlsIO.c
@@ -161,11 +161,11 @@
}
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()));
+ 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;
@@ -232,11 +232,11 @@
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()));
+ Tls_Error(statePtr, (char *)REASON());
statePtr->flags |= TLS_TCL_HANDSHAKE_FAILED;
*errorCodePtr = ECONNABORTED;
return(-1);
case SSL_ERROR_WANT_CONNECT:
ADDED generic/tlsInfo.c
Index: generic/tlsInfo.c
==================================================================
--- /dev/null
+++ generic/tlsInfo.c
@@ -0,0 +1,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;
+}
Index: generic/tlsInt.h
==================================================================
--- generic/tlsInt.h
+++ generic/tlsInt.h
@@ -40,15 +40,11 @@
/*
* 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 ""
+# define Tcl_Size int
#endif
#include <openssl/ssl.h>
#include <openssl/err.h>
#include <openssl/rand.h>
@@ -102,10 +98,11 @@
#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)); \
@@ -196,11 +193,13 @@
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 */
Index: generic/tlsX509.c
==================================================================
--- generic/tlsX509.c
+++ generic/tlsX509.c
@@ -18,17 +18,21 @@
/*
* Binary string to hex string
*/
-int String_to_Hex(char* input, int ilen, char *output, int olen) {
+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) {
- sprintf(output + count, "%02X", input[i] & 0xff);
+ *optr++ = hex[(*iptr>>4)&0xF];
+ *optr++ = hex[(*iptr++)&0xF];
}
- output[count] = 0;
+ *optr = 0;
return count;
}
/*
* BIO to Buffer
@@ -77,14 +81,14 @@
Tcl_Obj *resultPtr = NULL;
int len = 0;
char buffer[1024];
if (astring != NULL) {
- len = String_to_Hex((char *)ASN1_STRING_get0_data(astring),
+ len = String_to_Hex(ASN1_STRING_get0_data(astring),
ASN1_STRING_length(astring), buffer, 1024);
}
- resultPtr = Tcl_NewStringObj(buffer, (Tcl_Size) len);
+ resultPtr = Tcl_NewStringObj(buffer, len);
return resultPtr;
}
/*
* Get Key Usage
@@ -202,11 +206,11 @@
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);
+ LAPPEND_STR(interp, listPtr, NULL, buffer, len);
}
sk_GENERAL_NAME_pop_free(names, GENERAL_NAME_free);
}
return listPtr;
}
@@ -279,20 +283,20 @@
for (int j = 0; j < sk_GENERAL_NAME_num(distpoint->name.fullname); j++) {
GENERAL_NAME *gen = sk_GENERAL_NAME_value(distpoint->name.fullname, j);
int type;
ASN1_STRING *uri = GENERAL_NAME_get0_value(gen, &type);
if (type == GEN_URI) {
- LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_get0_data(uri), (Tcl_Size) ASN1_STRING_length(uri));
+ LAPPEND_STR(interp, listPtr, 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), (Tcl_Size) ASN1_STRING_length(d));
+ LAPPEND_STR(interp, listPtr, NULL, ASN1_STRING_data(d), ASN1_STRING_length(d));
}
}
}
CRL_DIST_POINTS_free(crl);
}
@@ -333,11 +337,11 @@
for (int i = 0; i < sk_ACCESS_DESCRIPTION_num(ads); i++) {
ad = sk_ACCESS_DESCRIPTION_value(ads, i);
if (OBJ_obj2nid(ad->method) == NID_ad_ca_issuers && ad->location) {
if (ad->location->type == GEN_URI) {
len = ASN1_STRING_to_UTF8(&buf, ad->location->d.uniformResourceIdentifier);
- Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buf, (Tcl_Size) len));
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buf, len));
OPENSSL_free(buf);
break;
}
}
}
@@ -393,53 +397,53 @@
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);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) 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, (Tcl_Size) 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)) {
@@ -450,24 +454,24 @@
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);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ 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));
@@ -474,11 +478,11 @@
/* Get extensions flags */
xflags = X509_get_extension_flags(cert);
LAPPEND_INT(interp, certPtr, "extFlags", xflags);
- /* Check if cert was issued by CA cert issuer or self signed */
+ /* Check if cert was issued by CA cert issuer or self signed */
LAPPEND_BOOL(interp, certPtr, "selfIssued", xflags & EXFLAG_SI);
LAPPEND_BOOL(interp, certPtr, "selfSigned", xflags & EXFLAG_SS);
LAPPEND_BOOL(interp, certPtr, "isProxyCert", xflags & EXFLAG_PROXY);
LAPPEND_BOOL(interp, certPtr, "extInvalid", xflags & EXFLAG_INVALID);
LAPPEND_BOOL(interp, certPtr, "isCACert", X509_check_ca(cert));
@@ -485,22 +489,22 @@
/* The Unique Ids are used to handle the possibility of reuse of subject
and/or issuer names over time. RFC 5280 section 4.1.2.8 */
{
const ASN1_BIT_STRING *iuid, *suid;
- X509_get0_uids(cert, &iuid, &suid);
+ X509_get0_uids(cert, &iuid, &suid);
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1));
if (iuid != NULL) {
- Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, (Tcl_Size) iuid->length));
+ Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((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, (Tcl_Size) suid->length));
+ Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)suid->data, suid->length));
} else {
Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("", -1));
}
}
@@ -510,11 +514,11 @@
/* Authority Key Identifier (AKI) is the Subject Key Identifier (SKI) of
its signer (the CA). RFC 5280 section 4.2.1.1, NID_authority_key_identifier */
LAPPEND_OBJ(interp, certPtr, "authorityKeyIdentifier",
Tls_x509Identifier(X509_get0_authority_key_id(cert)));
-
+
/* Subject Key Identifier (SKI) is used to identify certificates that contain
a particular public key. RFC 5280 section 4.2.1.2, NID_subject_key_identifier */
LAPPEND_OBJ(interp, certPtr, "subjectKeyIdentifier",
Tls_x509Identifier(X509_get0_subject_key_id(cert)));
@@ -583,24 +587,24 @@
/* 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);
+ 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, (Tcl_Size) len);
+ 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, (Tcl_Size) len);
+ LAPPEND_STR(interp, certPtr, "all", certStr, len);
}
BIO_free(bio);
return certPtr;
}
Index: tests/badssl.csv
==================================================================
--- tests/badssl.csv
+++ tests/badssl.csv
@@ -1,19 +1,17 @@
# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
command,package require tls,,,,,,,,,
-command,,,,,,,,,,
+,,,,,,,,,,
command,# Find default CA certificates directory,,,,,,,,,
command,if {[info exists ::env(SSL_CERT_FILE)]} {set ::cafile $::env(SSL_CERT_FILE)} else {set ::cafile [file normalize {C:\Users\Brian\Documents\Source\Build\SSL-1.1\certs\cacert.pem}]},,,,,,,,,
-command,,,,,,,,,,
+,,,,,,,,,,
command,# Constraints,,,,,,,,,
-command,set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3],,,,,,,,,
-command,foreach protocol $protocols {::tcltest::testConstraint $protocol 0},,,,,,,,,
-command,foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1},,,,,,,,,
-command,,,,,,,,,,
+command,source common.tcl,,,,,,,,,
+,,,,,,,,,,
command,# Helper functions,,,,,,,,,
command,"proc badssl {url} {set port 443;lassign [split $url "":""] url port;if {$port eq """"} {set port 443};set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}",,,,,,,,,
-command,,,,,,,,,,
+,,,,,,,,,,
command,# BadSSL.com Tests,,,,,,,,,
BadSSL,1000-sans,,,badssl 1000-sans.badssl.com,,,handshake failed: certificate verify failed due to: certificate has expired,,,1
BadSSL,10000-sans,,,badssl 10000-sans.badssl.com,,,handshake failed: excessive message size,,,1
BadSSL,3des,,,badssl 3des.badssl.com,,,handshake failed: sslv3 alert handshake failure,,,1
BadSSL,captive-portal,,,badssl captive-portal.badssl.com,,,handshake failed: certificate verify failed due to: Hostname mismatch,,,1
Index: tests/badssl.test
==================================================================
--- tests/badssl.test
+++ tests/badssl.test
@@ -12,13 +12,11 @@
# Find default CA certificates directory
if {[info exists ::env(SSL_CERT_FILE)]} {set ::cafile $::env(SSL_CERT_FILE)} else {set ::cafile [file normalize {C:\Users\Brian\Documents\Source\Build\SSL-1.1\certs\cacert.pem}]}
# Constraints
-set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3]
-foreach protocol $protocols {::tcltest::testConstraint $protocol 0}
-foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1}
+source common.tcl
# Helper functions
proc badssl {url} {set port 443;lassign [split $url ":"] url port;if {$port eq ""} {set port 443};set ch [tls::socket -autoservername 1 -require 1 -cafile $::cafile $url $port];if {[catch {tls::handshake $ch} err]} {close $ch;return -code error $err} else {close $ch}}
# BadSSL.com Tests
DELETED tests/ciphers.csv
Index: tests/ciphers.csv
==================================================================
--- tests/ciphers.csv
+++ /dev/null
@@ -1,46 +0,0 @@
-# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
-command,package require tls,,,,,,,,,
-command,,,,,,,,,,
-command,# Make sure path includes location of OpenSSL executable,,,,,,,,,
-command,"if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] "";"" $::env(path)}",,,,,,,,,
-command,,,,,,,,,,
-command,# Constraints,,,,,,,,,
-command,set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3],,,,,,,,,
-command,foreach protocol $protocols {::tcltest::testConstraint $protocol 0},,,,,,,,,
-command,foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1},,,,,,,,,
-command,"::tcltest::testConstraint OpenSSL [string match ""OpenSSL*"" [::tls::version]]",,,,,,,,,
-,,,,,,,,,,
-command,# Helper functions,,,,,,,,,
-command,"proc lcompare {list1 list2} {set m """";set u """";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list ""missing"" $m ""unexpected"" $u]}",,,,,,,,,
-command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,,
-,,,,,,,,,,
-command,# Test protocols,,,,,,,,,
-Protocols,All,,,lcompare $protocols [::tls::protocols],,,missing {ssl2 ssl3} unexpected {},,,
-,,,,,,,,,,
-command,# Test ciphers,,,,,,,,,
-CiphersAll,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2] [::tls::ciphers ssl2]",,,missing {} unexpected {},,,
-CiphersAll,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3] [::tls::ciphers ssl3]",,,missing {} unexpected {},,,
-CiphersAll,TLS1,tls1,,"lcompare [exec_get "":"" ciphers -tls1] [::tls::ciphers tls1]",,,missing {} unexpected {},,,
-CiphersAll,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1] [::tls::ciphers tls1.1]",,,missing {} unexpected {},,,
-CiphersAll,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2] [::tls::ciphers tls1.2]",,,missing {} unexpected {},,,
-CiphersAll,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3] [::tls::ciphers tls1.3]",,,missing {} unexpected {},,,
-,,,,,,,,,,
-command,# Test cipher descriptions,,,,,,,,,
-CiphersDesc,SSL2,ssl2,,"lcompare [exec_get ""\r\n"" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]",,,missing {} unexpected {},,,
-CiphersDesc,SSL3,ssl3,,"lcompare [exec_get ""\r\n"" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]",,,missing {} unexpected {},,,
-CiphersDesc,TLS1,tls1,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,,
-CiphersDesc,TLS1.1,tls1.1,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,,
-CiphersDesc,TLS1.2,tls1.2,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,,
-CiphersDesc,TLS1.3,tls1.3,,"lcompare [exec_get ""\r\n"" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]",,,missing {} unexpected {},,,
-,,,,,,,,,,
-command,# Test protocol specific ciphers,,,,,,,,,
-CiphersSpecific,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]",,,missing {} unexpected {},,,
-CiphersSpecific,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]",,,missing {} unexpected {},,,
-CiphersSpecific,TLS1,tls1,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,,
-CiphersSpecific,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,,
-CiphersSpecific,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,,
-CiphersSpecific,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,,
-,,,,,,,,,,
-command,# Test version,,,,,,,,,
-Version,All,,,::tls::version,,glob,*,,,
-Version,OpenSSL,OpenSSL,,::tls::version,,glob,OpenSSL*,,,
DELETED tests/ciphers.test
Index: tests/ciphers.test
==================================================================
--- tests/ciphers.test
+++ /dev/null
@@ -1,121 +0,0 @@
-# Auto generated test cases for ciphers_and_protocols.csv
-
-# Load Tcl Test package
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import ::tcltest::*
-}
-
-set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]
-
-package require tls
-
-# Make sure path includes location of OpenSSL executable
-if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] ";" $::env(path)}
-
-# Constraints
-set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3]
-foreach protocol $protocols {::tcltest::testConstraint $protocol 0}
-foreach protocol [::tls::protocols] {::tcltest::testConstraint $protocol 1}
-::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]]
-# Helper functions
-proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]}
-proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]}
-# Test protocols
-
-
-test Protocols-1.1 {All} -body {
- lcompare $protocols [::tls::protocols]
- } -result {missing {ssl2 ssl3} unexpected {}}
-# Test ciphers
-
-
-test CiphersAll-2.1 {SSL2} -constraints {ssl2} -body {
- lcompare [exec_get ":" ciphers -ssl2] [::tls::ciphers ssl2]
- } -result {missing {} unexpected {}}
-
-test CiphersAll-2.2 {SSL3} -constraints {ssl3} -body {
- lcompare [exec_get ":" ciphers -ssl3] [::tls::ciphers ssl3]
- } -result {missing {} unexpected {}}
-
-test CiphersAll-2.3 {TLS1} -constraints {tls1} -body {
- lcompare [exec_get ":" ciphers -tls1] [::tls::ciphers tls1]
- } -result {missing {} unexpected {}}
-
-test CiphersAll-2.4 {TLS1.1} -constraints {tls1.1} -body {
- lcompare [exec_get ":" ciphers -tls1_1] [::tls::ciphers tls1.1]
- } -result {missing {} unexpected {}}
-
-test CiphersAll-2.5 {TLS1.2} -constraints {tls1.2} -body {
- lcompare [exec_get ":" ciphers -tls1_2] [::tls::ciphers tls1.2]
- } -result {missing {} unexpected {}}
-
-test CiphersAll-2.6 {TLS1.3} -constraints {tls1.3} -body {
- lcompare [exec_get ":" ciphers -tls1_3] [::tls::ciphers tls1.3]
- } -result {missing {} unexpected {}}
-# Test cipher descriptions
-
-
-test CiphersDesc-3.1 {SSL2} -constraints {ssl2} -body {
- lcompare [exec_get "\r\n" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]
- } -result {missing {} unexpected {}}
-
-test CiphersDesc-3.2 {SSL3} -constraints {ssl3} -body {
- lcompare [exec_get "\r\n" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]
- } -result {missing {} unexpected {}}
-
-test CiphersDesc-3.3 {TLS1} -constraints {tls1} -body {
- lcompare [exec_get "\r\n" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]
- } -result {missing {} unexpected {}}
-
-test CiphersDesc-3.4 {TLS1.1} -constraints {tls1.1} -body {
- lcompare [exec_get "\r\n" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]
- } -result {missing {} unexpected {}}
-
-test CiphersDesc-3.5 {TLS1.2} -constraints {tls1.2} -body {
- lcompare [exec_get "\r\n" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]
- } -result {missing {} unexpected {}}
-
-test CiphersDesc-3.6 {TLS1.3} -constraints {tls1.3} -body {
- lcompare [exec_get "\r\n" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]
- } -result {missing {} unexpected {}}
-# Test protocol specific ciphers
-
-
-test CiphersSpecific-4.1 {SSL2} -constraints {ssl2} -body {
- lcompare [exec_get ":" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]
- } -result {missing {} unexpected {}}
-
-test CiphersSpecific-4.2 {SSL3} -constraints {ssl3} -body {
- lcompare [exec_get ":" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]
- } -result {missing {} unexpected {}}
-
-test CiphersSpecific-4.3 {TLS1} -constraints {tls1} -body {
- lcompare [exec_get ":" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]
- } -result {missing {} unexpected {}}
-
-test CiphersSpecific-4.4 {TLS1.1} -constraints {tls1.1} -body {
- lcompare [exec_get ":" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]
- } -result {missing {} unexpected {}}
-
-test CiphersSpecific-4.5 {TLS1.2} -constraints {tls1.2} -body {
- lcompare [exec_get ":" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]
- } -result {missing {} unexpected {}}
-
-test CiphersSpecific-4.6 {TLS1.3} -constraints {tls1.3} -body {
- lcompare [exec_get ":" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]
- } -result {missing {} unexpected {}}
-# Test version
-
-
-test Version-5.1 {All} -body {
- ::tls::version
- } -match {glob} -result {*}
-
-test Version-5.2 {OpenSSL} -constraints {OpenSSL} -body {
- ::tls::version
- } -match {glob} -result {OpenSSL*}
-
-# Cleanup
-::tcltest::cleanupTests
-return
ADDED tests/common.tcl
Index: tests/common.tcl
==================================================================
--- /dev/null
+++ tests/common.tcl
@@ -0,0 +1,22 @@
+
+# Common Constraints
+package require tls
+
+# Supported protocols
+set protocols [list ssl2 ssl3 tls1 tls1.1 tls1.2 tls1.3]
+foreach protocol $protocols {
+ ::tcltest::testConstraint $protocol 0
+ ::tcltest::testConstraint !$protocol 1
+}
+
+foreach protocol [::tls::protocols] {
+ ::tcltest::testConstraint $protocol 1
+ ::tcltest::testConstraint !$protocol 0
+}
+
+# OpenSSL version
+::tcltest::testConstraint OpenSSL [string match "OpenSSL*" [::tls::version]]
+
+# Legacy OpenSSL v1.1.1 vs new v3.x
+scan [lindex [split [::tls::version]] 1] %f version
+::tcltest::testConstraint new_api [expr {$version >= 3.0}]
ADDED tests/digest.csv
Index: tests/digest.csv
==================================================================
--- /dev/null
+++ tests/digest.csv
@@ -0,0 +1,151 @@
+# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
+command,package require tls,,,,,,,,,
+,,,,,,,,,,
+command,# Constraints,,,,,,,,,
+command,source common.tcl,,,,,,,,,
+,,,,,,,,,,
+command,# Helper functions,,,,,,,,,
+command,proc read_chan {cmd md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set bsize [fconfigure $ch -buffersize];set new [$cmd $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new $bsize]};close $new;return $result},,,,,,,,,
+command,proc accumulate {string args} {set cmd [{*}$args -command dcmd];$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]},,,,,,,,,
+,,,,,,,,,,
+command,"set test_data ""Example string for message digest tests.\n""",,,,,,,,,
+command,"set test_file ""md_data.dat""",,,,,,,,,
+command,"set test_key ""Example key""",,,,,,,,,
+command,::tcltest::makeFile $test_data $test_file,,,,,,,,,
+,,,,,,,,,,
+command,# Test digest commands,,,,,,,,,
+Digest Cmds,md4 cmd,,,::tls::md4 $test_data,,,793399f792eca2752c6af3234ba70858,,,
+Digest Cmds,md5 cmd,,,::tls::md5 $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest Cmds,sha1 cmd,,,::tls::sha1 $test_data,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+Digest Cmds,sha256 cmd,,,::tls::sha256 $test_data,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+Digest Cmds,sha512 cmd,,,::tls::sha512 $test_data,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+,,,,,,,,,,
+command,# Test digest command for channel,,,,,,,,,
+Digest Chan,md4,,,read_chan ::tls::digest md4 $test_file,,,793399f792eca2752c6af3234ba70858,,,
+Digest Chan,md5,,,read_chan ::tls::digest md5 $test_file,,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest Chan,sha1,,,read_chan ::tls::digest sha1 $test_file,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+Digest Chan,sha256,,,read_chan ::tls::digest sha256 $test_file,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+Digest Chan,sha512,,,read_chan ::tls::digest sha512 $test_file,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+Digest Chan,md5 bin,,,binary encode hex [read_chan ::tls::digest md5 $test_file -bin],,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest Chan,md5 hex,,,read_chan ::tls::digest md5 $test_file -hex,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# Test digest command for object command,,,,,,,,,
+Digest Command,md4,,,accumulate $test_data ::tls::digest md4,,,793399f792eca2752c6af3234ba70858,,,
+Digest Command,md5,,,accumulate $test_data ::tls::digest md5,,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest Command,sha1,,,accumulate $test_data ::tls::digest sha1,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+Digest Command,sha256,,,accumulate $test_data ::tls::digest sha256,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+Digest Command,sha512,,,accumulate $test_data ::tls::digest sha512,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+Digest Command,md5 bin,,,binary encode hex [accumulate $test_data ::tls::digest md5 -bin],,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest Command,md5 hex,,,accumulate $test_data ::tls::digest md5 -hex,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# Test digest command for data,,,,,,,,,
+Digest Data,md4,,,::tls::digest md4 $test_data,,,793399f792eca2752c6af3234ba70858,,,
+Digest Data,md5,,,::tls::digest md5 $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest Data,sha1,,,::tls::digest sha1 $test_data,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+Digest Data,sha256,,,::tls::digest sha256 $test_data,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+Digest Data,sha512,,,::tls::digest sha512 $test_data,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+Digest Data,md5 bin,,,binary encode hex [::tls::digest md5 -bin $test_data],,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest Data,md5 hex,,,::tls::digest md5 -hex $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest Data,md5 with arg,,,::tls::digest md5 -data $test_data,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# Test digest command for file,,,,,,,,,
+Digest File,md4,,,::tls::digest md4 -file $test_file,,,793399f792eca2752c6af3234ba70858,,,
+Digest File,md5,,,::tls::digest md5 -file $test_file,,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest File,sha1,,,::tls::digest sha1 -file $test_file,,,4fe03b7f2568551dfafb98ca6004e65c4b71aa7d,,,
+Digest File,sha256,,,::tls::digest sha256 -file $test_file,,,9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19,,,
+Digest File,sha512,,,::tls::digest sha512 -file $test_file,,,d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1,,,
+Digest File,md5 bin,,,binary encode hex [::tls::digest md5 -bin -file $test_file],,,962bf0803b4232ec23bd8427bb94ea09,,,
+Digest File,md5 hex,,,::tls::digest md5 -hex -file $test_file,,,962bf0803b4232ec23bd8427bb94ea09,,,
+,,,,,,,,,,
+command,# Test Digest HMAC,,,,,,,,,
+Digest HMAC,data,,,::tls::digest md5 -key $test_key -data $test_data,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+Digest HMAC,file,,,::tls::digest md5 -key $test_key -file $test_file,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+Digest HMAC,channel,,,read_chan ::tls::digest md5 $test_file -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+Digest HMAC,data bin,,,binary encode hex [::tls::digest md5 -bin -key $test_key -data $test_data],,,f98327ef3e20ab6d388f676c6a79d93d,,,
+,,,,,,,,,,
+command,# Test HMAC command,,,,,,,,,
+HMAC,data,,,::tls::hmac md5 -key $test_key -data $test_data,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+HMAC,file,,,::tls::hmac md5 -key $test_key -file $test_file,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+HMAC,channel,,,read_chan ::tls::hmac md5 $test_file -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+HMAC,command,,,accumulate $test_data ::tls::hmac md5 -key $test_key,,,f98327ef3e20ab6d388f676c6a79d93d,,,
+HMAC,data bin,,,binary encode hex [::tls::hmac md5 -bin -key $test_key -data $test_data],,,f98327ef3e20ab6d388f676c6a79d93d,,,
+,,,,,,,,,,
+command,# Test CMAC command,,,,,,,,,
+command,"set test_cipher ""aes-128-cbc""",,,,,,,,,
+command,"set test_key ""Example key 1234""",,,,,,,,,
+CMAC,data,,,::tls::cmac sha256 -cipher $test_cipher -key $test_key -data $test_data,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+CMAC,file,,,::tls::cmac sha256 -cipher $test_cipher -key $test_key -file $test_file,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+CMAC,channel,,,read_chan ::tls::cmac sha256 $test_file -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+CMAC,command,,,accumulate $test_data ::tls::cmac sha256 -cipher $test_cipher -key $test_key,,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+CMAC,data bin,,,binary encode hex [::tls::cmac sha256 -bin -cipher $test_cipher -key $test_key -data $test_data],,,baf5c20f9973e2d606b14c7efdfe52fa,,,
+,,,,,,,,,,
+command,# Test MAC command,,,,,,,,,
+MAC,HMAC,new_api,,::tls::mac -digest sha256 -mac hmac -key $test_key -data $test_data,,,498ef5ef71424f81da7499b2eeae1d0a348dd40b841ea27bdde494f6bc9046ff,,,
+MAC,CMAC,new_api,,::tls::mac -cipher $test_cipher -digest sha256 -mac cmac -key $test_key -data $test_data,,,498ef5ef71424f81da7499b2eeae1d0a348dd40b841ea27bdde494f6bc9046ff,,,
+,,,,,,,,,,
+command,# Digest Error Cases,,,,,,,,,
+Digest Errors,Too few args,,,::tls::digest,,,"wrong # args: should be ""::tls::digest digest ?-bin|-hex? ?-cipher name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+Digest Errors,Too many args,,,::tls::digest too many command line args to pass the test without an error or failing,,,"wrong # args: should be ""::tls::digest digest ?-bin|-hex? ?-cipher name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]""",,,1
+Digest Errors,Invalid digest,,,::tls::digest bogus data,,,"Invalid digest ""bogus""",,,1
+Digest Errors,Invalid option,,,::tls::digest sha256 -bogus value,,,"bad option ""-bogus"": must be -bin, -channel, -cipher, -command, -data, -file, -filename, -hex, -key, or -mac",,,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,# RFC 4231 HMAC Examples Test Case #1,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""0b"" 20]]",,,,,,,,,
+command,"set data ""Hi There""",,,,,,,,,
+RFC4231 TC1,sha224,,,::tls::hmac sha224 -key $key -data $data,,,896fb1128abbdf196832107cd49df33f47b4b1169912ba4f53684b22,,,
+RFC4231 TC1,sha256,,,::tls::hmac sha256 -key $key -data $data,,,b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7,,,
+RFC4231 TC1,sha384,,,::tls::hmac sha384 -key $key -data $data,,,afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6,,,
+RFC4231 TC1,sha512,,,::tls::hmac sha512 -key $key -data $data,,,87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #2 - Test with a key shorter than the length of the HMAC output.,,,,,,,,,
+command,"set key ""Jefe""",,,,,,,,,
+command,"set data ""what do ya want for nothing?""",,,,,,,,,
+RFC4231 TC2,sha224,,,::tls::hmac sha224 -key $key -data $data,,,a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44,,,
+RFC4231 TC2,sha256,,,::tls::hmac sha256 -key $key -data $data,,,5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843,,,
+RFC4231 TC2,sha384,,,::tls::hmac sha384 -key $key -data $data,,,af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649,,,
+RFC4231 TC2,sha512,,,::tls::hmac sha512 -key $key -data $data,,,164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #3 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""aa"" 20]]",,,,,,,,,
+command,"set data [binary decode hex [string repeat ""dd"" 50]]",,,,,,,,,
+RFC4231 TC3,sha224,,,::tls::hmac sha224 -key $key -data $data,,,7fb3cb3588c6c1f6ffa9694d7d6ad2649365b0c1f65d69d1ec8333ea,,,
+RFC4231 TC3,sha256,,,::tls::hmac sha256 -key $key -data $data,,,773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe,,,
+RFC4231 TC3,sha384,,,::tls::hmac sha384 -key $key -data $data,,,88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27,,,
+RFC4231 TC3,sha512,,,::tls::hmac sha512 -key $key -data $data,,,fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #4 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).,,,,,,,,,
+command,"set key [binary decode hex ""0102030405060708090a0b0c0d0e0f10111213141516171819""]",,,,,,,,,
+command,"set data [binary decode hex [string repeat ""cd"" 50]]",,,,,,,,,
+RFC4231 TC4,sha224,,,::tls::hmac sha224 -key $key -data $data,,,6c11506874013cac6a2abc1bb382627cec6a90d86efc012de7afec5a,,,
+RFC4231 TC4,sha256,,,::tls::hmac sha256 -key $key -data $data,,,82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b,,,
+RFC4231 TC4,sha384,,,::tls::hmac sha384 -key $key -data $data,,,3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb,,,
+RFC4231 TC4,sha512,,,::tls::hmac sha512 -key $key -data $data,,,b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #5 - Test with a truncation of output to 128 bits.,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""0c"" 20]]",,,,,,,,,
+command,"set data ""Test With Truncation""",,,,,,,,,
+RFC4231 TC5,sha224,,,string range [::tls::hmac sha224 -key $key -data $data] 0 31,,,0e2aea68a90c8d37c988bcdb9fca6fa8,,,
+RFC4231 TC5,sha256,,,string range [::tls::hmac sha256 -key $key -data $data] 0 31,,,a3b6167473100ee06e0c796c2955552b,,,
+RFC4231 TC5,sha384,,,string range [::tls::hmac sha384 -key $key -data $data] 0 31,,,3abf34c3503b2a23a46efc619baef897,,,
+RFC4231 TC5,sha512,,,string range [::tls::hmac sha512 -key $key -data $data] 0 31,,,415fad6271580a531d4179bc891d87a6,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #6 - Test with a key larger than 128 bytes (= block-size of SHA-384 and SHA-512).,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""aa"" 131]]",,,,,,,,,
+command,"set data ""Test Using Larger Than Block-Size Key - Hash Key First""",,,,,,,,,
+RFC4231 TC6,sha224,,,::tls::hmac sha224 -key $key -data $data,,,95e9a0db962095adaebe9b2d6f0dbce2d499f112f2d2b7273fa6870e,,,
+RFC4231 TC6,sha256,,,::tls::hmac sha256 -key $key -data $data,,,60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54,,,
+RFC4231 TC6,sha384,,,::tls::hmac sha384 -key $key -data $data,,,4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952,,,
+RFC4231 TC6,sha512,,,::tls::hmac sha512 -key $key -data $data,,,80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598,,,
+,,,,,,,,,,
+command,# RFC 4231 HMAC Examples Test Case #7 - Test with a key and data that is larger than 128 bytes (= block-size of SHA-384 and SHA-512).,,,,,,,,,
+command,"set key [binary decode hex [string repeat ""aa"" 131]]",,,,,,,,,
+command,"set data ""This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm.""",,,,,,,,,
+RFC4231 TC7,sha224,,,::tls::hmac sha224 -key $key -data $data,,,3a854166ac5d9f023f54d517d0b39dbd946770db9c2b95c9f6f565d1,,,
+RFC4231 TC7,sha256,,,::tls::hmac sha256 -key $key -data $data,,,9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2,,,
+RFC4231 TC7,sha384,,,::tls::hmac sha384 -key $key -data $data,,,6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e,,,
+RFC4231 TC7,sha512,,,::tls::hmac sha512 -key $key -data $data,,,e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58,,,
+,,,,,,,,,,
+command,# Cleanup,,,,,,,,,
+command,::tcltest::removeFile $test_file,,,,,,,,,
ADDED tests/digest.test
Index: tests/digest.test
==================================================================
--- /dev/null
+++ tests/digest.test
@@ -0,0 +1,433 @@
+# Auto generated test cases for digest.csv
+
+# Load Tcl Test package
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import ::tcltest::*
+}
+
+set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]
+
+package require tls
+
+# Constraints
+source common.tcl
+
+# Helper functions
+proc read_chan {cmd md filename args} {set ch [open $filename rb];fconfigure $ch -translation binary;set bsize [fconfigure $ch -buffersize];set new [$cmd $md {*}$args -chan $ch];while {![eof $new]} {set result [read $new $bsize]};close $new;return $result}
+proc accumulate {string args} {set cmd [{*}$args -command dcmd];$cmd update [string range $string 0 20];$cmd update [string range $string 21 end];return [$cmd finalize]}
+
+set test_data "Example string for message digest tests.\n"
+set test_file "md_data.dat"
+set test_key "Example key"
+::tcltest::makeFile $test_data $test_file
+
+# Test digest commands
+
+
+test Digest_Cmds-1.1 {md4 cmd} -body {
+ ::tls::md4 $test_data
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test Digest_Cmds-1.2 {md5 cmd} -body {
+ ::tls::md5 $test_data
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_Cmds-1.3 {sha1 cmd} -body {
+ ::tls::sha1 $test_data
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test Digest_Cmds-1.4 {sha256 cmd} -body {
+ ::tls::sha256 $test_data
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test Digest_Cmds-1.5 {sha512 cmd} -body {
+ ::tls::sha512 $test_data
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+# Test digest command for channel
+
+
+test Digest_Chan-2.1 {md4} -body {
+ read_chan ::tls::digest md4 $test_file
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test Digest_Chan-2.2 {md5} -body {
+ read_chan ::tls::digest md5 $test_file
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_Chan-2.3 {sha1} -body {
+ read_chan ::tls::digest sha1 $test_file
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test Digest_Chan-2.4 {sha256} -body {
+ read_chan ::tls::digest sha256 $test_file
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test Digest_Chan-2.5 {sha512} -body {
+ read_chan ::tls::digest sha512 $test_file
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test Digest_Chan-2.6 {md5 bin} -body {
+ binary encode hex [read_chan ::tls::digest md5 $test_file -bin]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_Chan-2.7 {md5 hex} -body {
+ read_chan ::tls::digest md5 $test_file -hex
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# Test digest command for object command
+
+
+test Digest_Command-3.1 {md4} -body {
+ accumulate $test_data ::tls::digest md4
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test Digest_Command-3.2 {md5} -body {
+ accumulate $test_data ::tls::digest md5
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_Command-3.3 {sha1} -body {
+ accumulate $test_data ::tls::digest sha1
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test Digest_Command-3.4 {sha256} -body {
+ accumulate $test_data ::tls::digest sha256
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test Digest_Command-3.5 {sha512} -body {
+ accumulate $test_data ::tls::digest sha512
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test Digest_Command-3.6 {md5 bin} -body {
+ binary encode hex [accumulate $test_data ::tls::digest md5 -bin]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_Command-3.7 {md5 hex} -body {
+ accumulate $test_data ::tls::digest md5 -hex
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# Test digest command for data
+
+
+test Digest_Data-4.1 {md4} -body {
+ ::tls::digest md4 $test_data
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test Digest_Data-4.2 {md5} -body {
+ ::tls::digest md5 $test_data
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_Data-4.3 {sha1} -body {
+ ::tls::digest sha1 $test_data
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test Digest_Data-4.4 {sha256} -body {
+ ::tls::digest sha256 $test_data
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test Digest_Data-4.5 {sha512} -body {
+ ::tls::digest sha512 $test_data
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test Digest_Data-4.6 {md5 bin} -body {
+ binary encode hex [::tls::digest md5 -bin $test_data]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_Data-4.7 {md5 hex} -body {
+ ::tls::digest md5 -hex $test_data
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_Data-4.8 {md5 with arg} -body {
+ ::tls::digest md5 -data $test_data
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# Test digest command for file
+
+
+test Digest_File-5.1 {md4} -body {
+ ::tls::digest md4 -file $test_file
+ } -result {793399f792eca2752c6af3234ba70858}
+
+test Digest_File-5.2 {md5} -body {
+ ::tls::digest md5 -file $test_file
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_File-5.3 {sha1} -body {
+ ::tls::digest sha1 -file $test_file
+ } -result {4fe03b7f2568551dfafb98ca6004e65c4b71aa7d}
+
+test Digest_File-5.4 {sha256} -body {
+ ::tls::digest sha256 -file $test_file
+ } -result {9d3578fc138205cf0ee4b4cef35fe101bb4ecac7b1614c18e6fa48b5c7f95e19}
+
+test Digest_File-5.5 {sha512} -body {
+ ::tls::digest sha512 -file $test_file
+ } -result {d178e759dc59127071588d2fad173c06238d87e800a6403c0a30daa4faaf05d0e7ce04916afaa6a58a30cbeb597dacb01c62f9fb9d89bab9da630c699e4816f1}
+
+test Digest_File-5.6 {md5 bin} -body {
+ binary encode hex [::tls::digest md5 -bin -file $test_file]
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+test Digest_File-5.7 {md5 hex} -body {
+ ::tls::digest md5 -hex -file $test_file
+ } -result {962bf0803b4232ec23bd8427bb94ea09}
+
+# Test Digest HMAC
+
+
+test Digest_HMAC-6.1 {data} -body {
+ ::tls::digest md5 -key $test_key -data $test_data
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test Digest_HMAC-6.2 {file} -body {
+ ::tls::digest md5 -key $test_key -file $test_file
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test Digest_HMAC-6.3 {channel} -body {
+ read_chan ::tls::digest md5 $test_file -key $test_key
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test Digest_HMAC-6.4 {data bin} -body {
+ binary encode hex [::tls::digest md5 -bin -key $test_key -data $test_data]
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+# Test HMAC command
+
+
+test HMAC-7.1 {data} -body {
+ ::tls::hmac md5 -key $test_key -data $test_data
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test HMAC-7.2 {file} -body {
+ ::tls::hmac md5 -key $test_key -file $test_file
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test HMAC-7.3 {channel} -body {
+ read_chan ::tls::hmac md5 $test_file -key $test_key
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test HMAC-7.4 {command} -body {
+ accumulate $test_data ::tls::hmac md5 -key $test_key
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+test HMAC-7.5 {data bin} -body {
+ binary encode hex [::tls::hmac md5 -bin -key $test_key -data $test_data]
+ } -result {f98327ef3e20ab6d388f676c6a79d93d}
+
+# Test CMAC command
+set test_cipher "aes-128-cbc"
+set test_key "Example key 1234"
+
+
+test CMAC-8.1 {data} -body {
+ ::tls::cmac sha256 -cipher $test_cipher -key $test_key -data $test_data
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test CMAC-8.2 {file} -body {
+ ::tls::cmac sha256 -cipher $test_cipher -key $test_key -file $test_file
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test CMAC-8.3 {channel} -body {
+ read_chan ::tls::cmac sha256 $test_file -cipher $test_cipher -key $test_key
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test CMAC-8.4 {command} -body {
+ accumulate $test_data ::tls::cmac sha256 -cipher $test_cipher -key $test_key
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+test CMAC-8.5 {data bin} -body {
+ binary encode hex [::tls::cmac sha256 -bin -cipher $test_cipher -key $test_key -data $test_data]
+ } -result {baf5c20f9973e2d606b14c7efdfe52fa}
+
+# Test MAC command
+
+
+test MAC-9.1 {HMAC} -constraints {new_api} -body {
+ ::tls::mac -digest sha256 -mac hmac -key $test_key -data $test_data
+ } -result {498ef5ef71424f81da7499b2eeae1d0a348dd40b841ea27bdde494f6bc9046ff}
+
+test MAC-9.2 {CMAC} -constraints {new_api} -body {
+ ::tls::mac -cipher $test_cipher -digest sha256 -mac cmac -key $test_key -data $test_data
+ } -result {498ef5ef71424f81da7499b2eeae1d0a348dd40b841ea27bdde494f6bc9046ff}
+
+# Digest Error Cases
+
+
+test Digest_Errors-10.1 {Too few args} -body {
+ ::tls::digest
+ } -result {wrong # args: should be "::tls::digest digest ?-bin|-hex? ?-cipher name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test Digest_Errors-10.2 {Too many args} -body {
+ ::tls::digest too many command line args to pass the test without an error or failing
+ } -result {wrong # args: should be "::tls::digest digest ?-bin|-hex? ?-cipher name? ?-key key? ?-mac name? [-channel chan | -command cmdName | -file filename | ?-data? data]"} -returnCodes {1}
+
+test Digest_Errors-10.3 {Invalid digest} -body {
+ ::tls::digest bogus data
+ } -result {Invalid digest "bogus"} -returnCodes {1}
+
+test Digest_Errors-10.4 {Invalid option} -body {
+ ::tls::digest sha256 -bogus value
+ } -result {bad option "-bogus": must be -bin, -channel, -cipher, -command, -data, -file, -filename, -hex, -key, or -mac} -returnCodes {1}
+
+test Digest_Errors-10.5 {Invalid file} -body {
+ ::tls::digest sha256 -file bogus
+ } -result {couldn't open "bogus": no such file or directory} -returnCodes {1}
+
+test Digest_Errors-10.6 {Invalid channel} -body {
+ ::tls::digest sha256 -channel bogus
+ } -result {can not find channel named "bogus"} -returnCodes {1}
+
+# RFC 4231 HMAC Examples Test Case #1
+set key [binary decode hex [string repeat "0b" 20]]
+set data "Hi There"
+
+
+test RFC4231_TC1-11.1 {sha224} -body {
+ ::tls::hmac sha224 -key $key -data $data
+ } -result {896fb1128abbdf196832107cd49df33f47b4b1169912ba4f53684b22}
+
+test RFC4231_TC1-11.2 {sha256} -body {
+ ::tls::hmac sha256 -key $key -data $data
+ } -result {b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7}
+
+test RFC4231_TC1-11.3 {sha384} -body {
+ ::tls::hmac sha384 -key $key -data $data
+ } -result {afd03944d84895626b0825f4ab46907f15f9dadbe4101ec682aa034c7cebc59cfaea9ea9076ede7f4af152e8b2fa9cb6}
+
+test RFC4231_TC1-11.4 {sha512} -body {
+ ::tls::hmac sha512 -key $key -data $data
+ } -result {87aa7cdea5ef619d4ff0b4241a1d6cb02379f4e2ce4ec2787ad0b30545e17cdedaa833b7d6b8a702038b274eaea3f4e4be9d914eeb61f1702e696c203a126854}
+
+# RFC 4231 HMAC Examples Test Case #2 - Test with a key shorter than the length of the HMAC output.
+set key "Jefe"
+set data "what do ya want for nothing?"
+
+
+test RFC4231_TC2-12.1 {sha224} -body {
+ ::tls::hmac sha224 -key $key -data $data
+ } -result {a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44}
+
+test RFC4231_TC2-12.2 {sha256} -body {
+ ::tls::hmac sha256 -key $key -data $data
+ } -result {5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843}
+
+test RFC4231_TC2-12.3 {sha384} -body {
+ ::tls::hmac sha384 -key $key -data $data
+ } -result {af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649}
+
+test RFC4231_TC2-12.4 {sha512} -body {
+ ::tls::hmac sha512 -key $key -data $data
+ } -result {164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737}
+
+# RFC 4231 HMAC Examples Test Case #3 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).
+set key [binary decode hex [string repeat "aa" 20]]
+set data [binary decode hex [string repeat "dd" 50]]
+
+
+test RFC4231_TC3-13.1 {sha224} -body {
+ ::tls::hmac sha224 -key $key -data $data
+ } -result {7fb3cb3588c6c1f6ffa9694d7d6ad2649365b0c1f65d69d1ec8333ea}
+
+test RFC4231_TC3-13.2 {sha256} -body {
+ ::tls::hmac sha256 -key $key -data $data
+ } -result {773ea91e36800e46854db8ebd09181a72959098b3ef8c122d9635514ced565fe}
+
+test RFC4231_TC3-13.3 {sha384} -body {
+ ::tls::hmac sha384 -key $key -data $data
+ } -result {88062608d3e6ad8a0aa2ace014c8a86f0aa635d947ac9febe83ef4e55966144b2a5ab39dc13814b94e3ab6e101a34f27}
+
+test RFC4231_TC3-13.4 {sha512} -body {
+ ::tls::hmac sha512 -key $key -data $data
+ } -result {fa73b0089d56a284efb0f0756c890be9b1b5dbdd8ee81a3655f83e33b2279d39bf3e848279a722c806b485a47e67c807b946a337bee8942674278859e13292fb}
+
+# RFC 4231 HMAC Examples Test Case #4 - Test with a combined length of key and data that is larger than 64 bytes (= block-size of SHA-224 and SHA-256).
+set key [binary decode hex "0102030405060708090a0b0c0d0e0f10111213141516171819"]
+set data [binary decode hex [string repeat "cd" 50]]
+
+
+test RFC4231_TC4-14.1 {sha224} -body {
+ ::tls::hmac sha224 -key $key -data $data
+ } -result {6c11506874013cac6a2abc1bb382627cec6a90d86efc012de7afec5a}
+
+test RFC4231_TC4-14.2 {sha256} -body {
+ ::tls::hmac sha256 -key $key -data $data
+ } -result {82558a389a443c0ea4cc819899f2083a85f0faa3e578f8077a2e3ff46729665b}
+
+test RFC4231_TC4-14.3 {sha384} -body {
+ ::tls::hmac sha384 -key $key -data $data
+ } -result {3e8a69b7783c25851933ab6290af6ca77a9981480850009cc5577c6e1f573b4e6801dd23c4a7d679ccf8a386c674cffb}
+
+test RFC4231_TC4-14.4 {sha512} -body {
+ ::tls::hmac sha512 -key $key -data $data
+ } -result {b0ba465637458c6990e5a8c5f61d4af7e576d97ff94b872de76f8050361ee3dba91ca5c11aa25eb4d679275cc5788063a5f19741120c4f2de2adebeb10a298dd}
+
+# RFC 4231 HMAC Examples Test Case #5 - Test with a truncation of output to 128 bits.
+set key [binary decode hex [string repeat "0c" 20]]
+set data "Test With Truncation"
+
+
+test RFC4231_TC5-15.1 {sha224} -body {
+ string range [::tls::hmac sha224 -key $key -data $data] 0 31
+ } -result {0e2aea68a90c8d37c988bcdb9fca6fa8}
+
+test RFC4231_TC5-15.2 {sha256} -body {
+ string range [::tls::hmac sha256 -key $key -data $data] 0 31
+ } -result {a3b6167473100ee06e0c796c2955552b}
+
+test RFC4231_TC5-15.3 {sha384} -body {
+ string range [::tls::hmac sha384 -key $key -data $data] 0 31
+ } -result {3abf34c3503b2a23a46efc619baef897}
+
+test RFC4231_TC5-15.4 {sha512} -body {
+ string range [::tls::hmac sha512 -key $key -data $data] 0 31
+ } -result {415fad6271580a531d4179bc891d87a6}
+
+# RFC 4231 HMAC Examples Test Case #6 - Test with a key larger than 128 bytes (= block-size of SHA-384 and SHA-512).
+set key [binary decode hex [string repeat "aa" 131]]
+set data "Test Using Larger Than Block-Size Key - Hash Key First"
+
+
+test RFC4231_TC6-16.1 {sha224} -body {
+ ::tls::hmac sha224 -key $key -data $data
+ } -result {95e9a0db962095adaebe9b2d6f0dbce2d499f112f2d2b7273fa6870e}
+
+test RFC4231_TC6-16.2 {sha256} -body {
+ ::tls::hmac sha256 -key $key -data $data
+ } -result {60e431591ee0b67f0d8a26aacbf5b77f8e0bc6213728c5140546040f0ee37f54}
+
+test RFC4231_TC6-16.3 {sha384} -body {
+ ::tls::hmac sha384 -key $key -data $data
+ } -result {4ece084485813e9088d2c63a041bc5b44f9ef1012a2b588f3cd11f05033ac4c60c2ef6ab4030fe8296248df163f44952}
+
+test RFC4231_TC6-16.4 {sha512} -body {
+ ::tls::hmac sha512 -key $key -data $data
+ } -result {80b24263c7c1a3ebb71493c1dd7be8b49b46d1f41b4aeec1121b013783f8f3526b56d037e05f2598bd0fd2215d6a1e5295e64f73f63f0aec8b915a985d786598}
+
+# RFC 4231 HMAC Examples Test Case #7 - Test with a key and data that is larger than 128 bytes (= block-size of SHA-384 and SHA-512).
+set key [binary decode hex [string repeat "aa" 131]]
+set data "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm."
+
+
+test RFC4231_TC7-17.1 {sha224} -body {
+ ::tls::hmac sha224 -key $key -data $data
+ } -result {3a854166ac5d9f023f54d517d0b39dbd946770db9c2b95c9f6f565d1}
+
+test RFC4231_TC7-17.2 {sha256} -body {
+ ::tls::hmac sha256 -key $key -data $data
+ } -result {9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2}
+
+test RFC4231_TC7-17.3 {sha384} -body {
+ ::tls::hmac sha384 -key $key -data $data
+ } -result {6617178e941f020d351e2f254e8fd32c602420feb0b8fb9adccebb82461e99c5a678cc31e799176d3860e6110c46523e}
+
+test RFC4231_TC7-17.4 {sha512} -body {
+ ::tls::hmac sha512 -key $key -data $data
+ } -result {e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58}
+
+# Cleanup
+::tcltest::removeFile $test_file
+
+# Cleanup
+::tcltest::cleanupTests
+return
ADDED tests/info.csv
Index: tests/info.csv
==================================================================
--- /dev/null
+++ tests/info.csv
@@ -0,0 +1,74 @@
+# Group,Name,Constraints,Setup,Body,Cleanup,Match,Result,Output,Error Output,Return Codes
+command,package require tls,,,,,,,,,
+,,,,,,,,,,
+command,# Make sure path includes location of OpenSSL executable,,,,,,,,,
+command,"if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] "";"" $::env(path)]}",,,,,,,,,
+,,,,,,,,,,
+command,# Constraints,,,,,,,,,
+command,source common.tcl,,,,,,,,,
+,,,,,,,,,,
+command,# Helper functions,,,,,,,,,
+command,"proc lcompare {list1 list2} {set m """";set u """";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list ""missing"" $m ""unexpected"" $u]}",,,,,,,,,
+command,proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]},,,,,,,,,
+command,"proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data ""\n""] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}",,,,,,,,,
+command,"proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data ""\n""] {foreach digest $line {if {[string match ""-*"" $digest]} {lappend list [string trimleft $digest ""-""]}}};return [lsort $list]}",,,,,,,,,
+command,proc exec_get_macs {} {return [list cmac hmac]},,,,,,,,,
+command,proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result},,,,,,,,,
+,,,,,,,,,,
+command,# Test list ciphers,,,,,,,,,
+Ciphers List,All,,,lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]],,,missing {rc5 rc5-cbc rc5-cfb rc5-ecb rc5-ofb} unexpected {aes-128-ccm aes-128-gcm aes-192-ccm aes-192-gcm aes-256-ccm aes-256-gcm},,,
+,,,,,,,,,,
+command,# Test list ciphers for protocols,,,,,,,,,
+Ciphers By Protocol,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2] [::tls::ciphers ssl2]",,,missing {} unexpected {},,,
+Ciphers By Protocol,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3] [::tls::ciphers ssl3]",,,missing {} unexpected {},,,
+Ciphers By Protocol,TLS1.0,tls1,,"lcompare [exec_get "":"" ciphers -tls1] [::tls::ciphers tls1]",,,missing {} unexpected {},,,
+Ciphers By Protocol,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1] [::tls::ciphers tls1.1]",,,missing {} unexpected {},,,
+Ciphers By Protocol,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2] [::tls::ciphers tls1.2]",,,missing {} unexpected {},,,
+Ciphers By Protocol,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3] [::tls::ciphers tls1.3]",,,missing {} unexpected {},,,
+,,,,,,,,,,
+command,# Test cipher descriptions,,,,,,,,,
+Ciphers With Descriptions,SSL2,ssl2,,"lcompare [exec_get ""\r\n"" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,SSL3,ssl3,,"lcompare [exec_get ""\r\n"" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,TLS1.0,tls1,,"lcompare [exec_get ""\r\n"" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,TLS1.1,tls1.1,,"lcompare [exec_get ""\r\n"" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,TLS1.2,tls1.2,,"lcompare [exec_get ""\r\n"" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]",,,missing {} unexpected {},,,
+Ciphers With Descriptions,TLS1.3,tls1.3,,"lcompare [exec_get ""\r\n"" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]",,,missing {} unexpected {},,,
+,,,,,,,,,,
+command,# Test protocol specific ciphers,,,,,,,,,
+Ciphers Protocol Specific,SSL2,ssl2,,"lcompare [exec_get "":"" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,SSL3,ssl3,,"lcompare [exec_get "":"" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,TLS1.0,tls1,,"lcompare [exec_get "":"" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,TLS1.1,tls1.1,,"lcompare [exec_get "":"" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,TLS1.2,tls1.2,,"lcompare [exec_get "":"" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]",,,missing {} unexpected {},,,
+Ciphers Protocol Specific,TLS1.3,tls1.3,,"lcompare [exec_get "":"" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]",,,missing {} unexpected {},,,
+,,,,,,,,,,
+command,# Ciphers Error Cases,,,,,,,,,
+Ciphers Errors,Too many args,,,::tls::ciphers too many args to pass,,,"wrong # args: should be ""::tls::ciphers ?protocol? ?verbose? ?supported?""",,,1
+Ciphers Errors,Invalid protocol,,,::tls::ciphers bogus,,,"bad protocol ""bogus"": must be ssl2, ssl3, tls1, tls1.1, tls1.2, or tls1.3",,,1
+Ciphers Errors,Invalid verbose,,,::tls::ciphers tls1.3 bogus,,,"expected boolean value but got ""bogus""",,,1
+Ciphers Errors,Invalid supported,,,::tls::ciphers tls1.3 1 bogus,,,"expected boolean value but got ""bogus""",,,1
+Ciphers Errors,SSL2,!ssl2,,::tls::ciphers ssl2,,,ssl2: protocol not supported,,,1
+Ciphers Errors,SSL3,!ssl3,,::tls::ciphers ssl3,,,ssl3: protocol not supported,,,1
+Ciphers Errors,TLS1.0,!tls1,,::tls::ciphers tls1,,,tls1: protocol not supported,,,1
+Ciphers Errors,TLS1.1,!tls1.1,,::tls::ciphers tls1.1,,,tls1.0: protocol not supported,,,1
+Ciphers Errors,TLS1.2,!tls1.2,,::tls::ciphers tls1.2,,,tls1.1: protocol not supported,,,1
+Ciphers Errors,TLS1.3,!tls1.3,,::tls::ciphers tls1.3,,,tls1.3: protocol not supported,,,1
+,,,,,,,,,,
+command,# Test list digests,,,,,,,,,
+Digests List,All,,,lcompare [lsort [exec_get_digests]] [lsort [tls::digests]],,,missing {} unexpected {},,,
+,,,,,,,,,,
+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
ADDED tests/info.test
Index: tests/info.test
==================================================================
--- /dev/null
+++ tests/info.test
@@ -0,0 +1,212 @@
+# Auto generated test cases for info.csv
+
+# Load Tcl Test package
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import ::tcltest::*
+}
+
+set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]
+
+package require tls
+
+# Make sure path includes location of OpenSSL executable
+if {[info exists ::env(OPENSSL)]} {set ::env(path) [string cat [file join $::env(OPENSSL) bin] ";" $::env(path)]}
+
+# Constraints
+source common.tcl
+
+# Helper functions
+proc lcompare {list1 list2} {set m "";set u "";foreach i $list1 {if {$i ni $list2} {lappend m $i}};foreach i $list2 {if {$i ni $list1} {lappend u $i}};return [list "missing" $m "unexpected" $u]}
+proc exec_get {delim args} {return [split [exec openssl {*}$args] $delim]}
+proc exec_get_ciphers {} {set list [list];set data [exec openssl list -cipher-algorithms];foreach line [split $data "\n"] {foreach {cipher null alias} [split [string trim $line]] {lappend list [string tolower $cipher]}};return [lsort -unique $list]}
+proc exec_get_digests {} {set list [list];set data [exec openssl dgst -list];foreach line [split $data "\n"] {foreach digest $line {if {[string match "-*" $digest]} {lappend list [string trimleft $digest "-"]}}};return [lsort $list]}
+proc exec_get_macs {} {return [list cmac hmac]}
+proc list_tolower {list} {set result [list];foreach element $list {lappend result [string tolower $element]};return $result}
+
+
+# Test list ciphers
+
+
+test Ciphers_List-1.1 {All} -body {
+ lcompare [lsort [exec_get_ciphers]] [list_tolower [lsort [::tls::ciphers]]]
+ } -result {missing {rc5 rc5-cbc rc5-cfb rc5-ecb rc5-ofb} unexpected {aes-128-ccm aes-128-gcm aes-192-ccm aes-192-gcm aes-256-ccm aes-256-gcm}}
+
+# Test list ciphers for protocols
+
+
+test Ciphers_By_Protocol-2.1 {SSL2} -constraints {ssl2} -body {
+ lcompare [exec_get ":" ciphers -ssl2] [::tls::ciphers ssl2]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.2 {SSL3} -constraints {ssl3} -body {
+ lcompare [exec_get ":" ciphers -ssl3] [::tls::ciphers ssl3]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.3 {TLS1.0} -constraints {tls1} -body {
+ lcompare [exec_get ":" ciphers -tls1] [::tls::ciphers tls1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.4 {TLS1.1} -constraints {tls1.1} -body {
+ lcompare [exec_get ":" ciphers -tls1_1] [::tls::ciphers tls1.1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.5 {TLS1.2} -constraints {tls1.2} -body {
+ lcompare [exec_get ":" ciphers -tls1_2] [::tls::ciphers tls1.2]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_By_Protocol-2.6 {TLS1.3} -constraints {tls1.3} -body {
+ lcompare [exec_get ":" ciphers -tls1_3] [::tls::ciphers tls1.3]
+ } -result {missing {} unexpected {}}
+
+# Test cipher descriptions
+
+
+test Ciphers_With_Descriptions-3.1 {SSL2} -constraints {ssl2} -body {
+ lcompare [exec_get "\r\n" ciphers -ssl2 -v] [split [string trim [::tls::ciphers ssl2 1]] \n]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_With_Descriptions-3.2 {SSL3} -constraints {ssl3} -body {
+ lcompare [exec_get "\r\n" ciphers -ssl3 -v] [split [string trim [::tls::ciphers ssl3 1]] \n]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_With_Descriptions-3.3 {TLS1.0} -constraints {tls1} -body {
+ lcompare [exec_get "\r\n" ciphers -tls1 -v] [split [string trim [::tls::ciphers tls1 1]] \n]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_With_Descriptions-3.4 {TLS1.1} -constraints {tls1.1} -body {
+ lcompare [exec_get "\r\n" ciphers -tls1_1 -v] [split [string trim [::tls::ciphers tls1.1 1]] \n]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_With_Descriptions-3.5 {TLS1.2} -constraints {tls1.2} -body {
+ lcompare [exec_get "\r\n" ciphers -tls1_2 -v] [split [string trim [::tls::ciphers tls1.2 1]] \n]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_With_Descriptions-3.6 {TLS1.3} -constraints {tls1.3} -body {
+ lcompare [exec_get "\r\n" ciphers -tls1_3 -v] [split [string trim [::tls::ciphers tls1.3 1]] \n]
+ } -result {missing {} unexpected {}}
+
+# Test protocol specific ciphers
+
+
+test Ciphers_Protocol_Specific-4.1 {SSL2} -constraints {ssl2} -body {
+ lcompare [exec_get ":" ciphers -ssl2 -s] [::tls::ciphers ssl2 0 1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_Protocol_Specific-4.2 {SSL3} -constraints {ssl3} -body {
+ lcompare [exec_get ":" ciphers -ssl3 -s] [::tls::ciphers ssl3 0 1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_Protocol_Specific-4.3 {TLS1.0} -constraints {tls1} -body {
+ lcompare [exec_get ":" ciphers -tls1 -s] [::tls::ciphers tls1 0 1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_Protocol_Specific-4.4 {TLS1.1} -constraints {tls1.1} -body {
+ lcompare [exec_get ":" ciphers -tls1_1 -s] [::tls::ciphers tls1.1 0 1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_Protocol_Specific-4.5 {TLS1.2} -constraints {tls1.2} -body {
+ lcompare [exec_get ":" ciphers -tls1_2 -s] [::tls::ciphers tls1.2 0 1]
+ } -result {missing {} unexpected {}}
+
+test Ciphers_Protocol_Specific-4.6 {TLS1.3} -constraints {tls1.3} -body {
+ lcompare [exec_get ":" ciphers -tls1_3 -s] [::tls::ciphers tls1.3 0 1]
+ } -result {missing {} unexpected {}}
+
+# Ciphers Error Cases
+
+
+test Ciphers_Errors-5.1 {Too many args} -body {
+ ::tls::ciphers too many args to pass
+ } -result {wrong # args: should be "::tls::ciphers ?protocol? ?verbose? ?supported?"} -returnCodes {1}
+
+test Ciphers_Errors-5.2 {Invalid protocol} -body {
+ ::tls::ciphers bogus
+ } -result {bad protocol "bogus": must be ssl2, ssl3, tls1, tls1.1, tls1.2, or tls1.3} -returnCodes {1}
+
+test Ciphers_Errors-5.3 {Invalid verbose} -body {
+ ::tls::ciphers tls1.3 bogus
+ } -result {expected boolean value but got "bogus"} -returnCodes {1}
+
+test Ciphers_Errors-5.4 {Invalid supported} -body {
+ ::tls::ciphers tls1.3 1 bogus
+ } -result {expected boolean value but got "bogus"} -returnCodes {1}
+
+test Ciphers_Errors-5.5 {SSL2} -constraints {!ssl2} -body {
+ ::tls::ciphers ssl2
+ } -result {ssl2: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.6 {SSL3} -constraints {!ssl3} -body {
+ ::tls::ciphers ssl3
+ } -result {ssl3: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.7 {TLS1.0} -constraints {!tls1} -body {
+ ::tls::ciphers tls1
+ } -result {tls1: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.8 {TLS1.1} -constraints {!tls1.1} -body {
+ ::tls::ciphers tls1.1
+ } -result {tls1.0: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.9 {TLS1.2} -constraints {!tls1.2} -body {
+ ::tls::ciphers tls1.2
+ } -result {tls1.1: protocol not supported} -returnCodes {1}
+
+test Ciphers_Errors-5.10 {TLS1.3} -constraints {!tls1.3} -body {
+ ::tls::ciphers tls1.3
+ } -result {tls1.3: protocol not supported} -returnCodes {1}
+
+# Test list digests
+
+
+test Digests_List-6.1 {All} -body {
+ lcompare [lsort [exec_get_digests]] [lsort [tls::digests]]
+ } -result {missing {} unexpected {}}
+
+# Test list MACs
+
+
+test MAC_List-7.1 {All} -body {
+ lcompare [exec_get_macs] [tls::macs]
+ } -result {missing {} unexpected {}}
+
+# Test list protocols
+
+
+test Protocols-8.1 {All} -body {
+ lcompare $::protocols [::tls::protocols]
+ } -result {missing {ssl2 ssl3} unexpected {}}
+
+# Test show version
+
+
+test Version-9.1 {All} -body {
+ ::tls::version
+ } -match {glob} -result {*}
+
+test Version-9.2 {OpenSSL} -constraints {OpenSSL} -body {
+ ::tls::version
+ } -match {glob} -result {OpenSSL*}
+
+# Error Cases
+
+
+test Error_Cases-10.1 {Digests Too many args} -body {
+ ::tls::digests too many args
+ } -result {wrong # args: should be "::tls::digests"} -returnCodes {1}
+
+test Error_Cases-10.2 {MACs Too many args} -body {
+ ::tls::macs too many args
+ } -result {wrong # args: should be "::tls::macs"} -returnCodes {1}
+
+test Error_Cases-10.3 {Protocols Too many args} -body {
+ ::tls::protocols too many args
+ } -result {wrong # args: should be "::tls::protocols"} -returnCodes {1}
+
+test Error_Cases-10.4 {Version Too many args} -body {
+ ::tls::version too many args
+ } -result {wrong # args: should be "::tls::version"} -returnCodes {1}
+
+# Cleanup
+::tcltest::cleanupTests
+return
Index: tests/make_test_files.tcl
==================================================================
--- tests/make_test_files.tcl
+++ tests/make_test_files.tcl
@@ -101,10 +101,11 @@
}
puts $out $buffer
} else {
# Empty line
+ puts $out ""
}
break
}
}
Index: win/makefile.vc
==================================================================
--- win/makefile.vc
+++ win/makefile.vc
@@ -25,20 +25,23 @@
# 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
@@ -53,10 +56,14 @@
# 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