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 @@
tls::status ?-local? channel
tls::connection channel
tls::import channel ?options?
tls::unimport channel
 
-
tls::ciphers protocol ?verbose? ?supported?
+
tls::ciphers ?protocol? ?verbose? ?supported?
+
tls::digests
+
tls::macs
tls::protocols
tls::version
+
 
+
tls::digest type ?options?
+
tls::cmac type -cipher name ?options?
+
tls::hmac type -key key ?options?
+
tls::md4 data
+
tls::md5 data
+
tls::sha1 data
+
tls::sha256 data
+
tls::sha512 data
COMMANDS
CALLBACK OPTIONS
HTTPS EXAMPLE
@@ -50,11 +61,11 @@

tls - binding to OpenSSL toolkit.

SYNOPSIS

-

package require Tcl 8.4
+

package require Tcl 8.5
package require tls

tls::init ?options?
tls::socket ?options? host port
tls::socket ?-server command? ?options? port
@@ -62,13 +73,24 @@ tls::connection channel
tls::handshake channel
tls::import channel ?options?
tls::unimport channel

-tls::ciphers protocol ?verbose? ?supported?
-tls::protocols -tls::version +tls::ciphers ?protocol? ?verbose? ?supported?
+tls::digests
+tls::macs
+tls::protocols
+tls::version
+
+tls::digest type ?options?
+tls::cmac type -cipher name ?options?
+tls::hmac type -key key ?options?
+tls::md4 data
+tls::md5 data
+tls::sha1 data
+tls::sha256 data
+tls::sha512 data

DESCRIPTION

This extension provides a generic binding to Server cache mode (client, server, or both).

tls::ciphers - protocol ?verbose? ?supported?
-
Returns a list of supported ciphers available for protocol, - where protocol must be one of ssl2, ssl3, tls1, tls1.1, - tls1.2, or tls1.3. If verbose is specified as - true then a verbose, human readable list is returned with - additional information on the cipher. If supported + ?protocol? ?verbose? ?supported? +
Without any args, returns a list of all ciphers. With + protocol, only the ciphers supported for that protocol + are returned where protocol must be one of ssl2, ssl3, + tls1, tls1.1, tls1.2, or tls1.3. If verbose is + specified as true then a verbose, human readable list is returned + with additional information on the cipher. If supported is specified as true, then only the ciphers supported for protocol will be listed.
+ +
tls::digests
+
Returns a list of the hash algorithms for tls::digest command.
+ +
tls::macs
+
Returns a list of the available Message Authentication Codes (MAC) for + the tls::digest command.
tls::protocols
Returns a list of supported protocols. Valid values are: ssl2, ssl3, tls1, tls1.1, tls1.2, and tls1.3. Exact list depends on OpenSSL version and compile time flags.
tls::version
Returns the OpenSSL version string.
+ +
+
tls::digest digest ?-bin|-hex? + [-file filename | -command cmdName | -chan channelId | ?-data? data]
+
Calculate the message digest for data using digest hash + function. Returns value as a hex string (default) or as a binary value + with -bin option. Argument digest can be any OpenSSL + supported hash function including: md4, md5, sha1, + sha256, sha512, sha3-256, etc. See + tls::digests command for a full list. +
+ Using the -data option will immediately return the message + digest for data in the specified format. +
+ Using the -file option will open file filename, 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. +
+ Using the -chan option, a stacked channel is created for + channelId 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. +
+ Using the -command option, a new command cmdName is + created and returned. To add data to the hash function, call + "cmdName update data", where data is + the data to add. When done, call "cmdName finalize" + to return the message digest. +
+ +
tls::cmac digest + -cipher name ?-bin|-hex? [-file filename | + -command cmdName | -chan channelId | ?-data? data]
+
Calculate the Cipher-based Message Authentication Code (CMAC). Same arguments + as tls::digest with additional option -cipher to specify the + cipher to use and for certain ciphers, -key to specify the key.
+ +
tls::hmac digest + -key key ?-bin|-hex? [-file filename | + -command cmdName | -chan channelId | ?-data? data]
+
Calculate the Hashed Message Authentication Code (HMAC). Same arguments + as tls::digest with additional option -key to specify the + key to use. To salt a password, append or prepend the salt + data to the password.
+ +
tls::md4 data
+
Returns the MD4 message-digest for data as a hex string.
+ +
tls::md5 data
+
Returns the MD5 message-digest for data as a hex string.
+ +
tls::sha1 data
+
Returns the SHA1 secure hash algorithm digest for data as a hex string.
+ +
tls::sha256 data
+
Returns the SHA-2 SHA256 secure hash algorithm digest for data as a hex string.
+ +
tls::sha512 data
+
Returns the SHA-2 SHA512 secure hash algorithm digest for data as a hex string.

CALLBACK OPTIONS

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 #include +#include +#include +#include +#include #include #include /* 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 */ @@ -1568,10 +1353,11 @@ /* * SSL Callbacks */ SSL_set_app_data(statePtr->ssl, (void *)statePtr); /* point back to us */ + SSL_set_verify(statePtr->ssl, verify, VerifyCallback); SSL_set_info_callback(statePtr->ssl, InfoCallback); /* Callback for observing protocol messages */ #ifndef OPENSSL_NO_SSL_TRACE @@ -1720,48 +1506,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 +1631,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 +1852,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; } @@ -2084,10 +1874,11 @@ if (objc == 2) { peer = SSL_get_peer_certificate(statePtr->ssl); } else { peer = SSL_get_certificate(statePtr->ssl); } + /* Get X509 certificate info */ if (peer) { objPtr = Tls_NewX509Obj(interp, peer); if (objc == 2) { X509_free(peer); @@ -2132,11 +1923,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 +1973,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 +2080,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 +2099,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); } @@ -2374,10 +2165,11 @@ /* IF not a server, same as SSL_get0_peer_CA_list. If server same as SSL_CTX_get_client_CA_list */ listPtr = Tcl_NewListObj(0, NULL); STACK_OF(X509_NAME) *ca_list; if ((ca_list = SSL_get_client_CA_list(ssl)) != NULL) { char buffer[BUFSIZ]; + for (int i = 0; i < sk_X509_NAME_num(ca_list); i++) { X509_NAME *name = sk_X509_NAME_value(ca_list, i); if (name) { X509_NAME_oneline(name, buffer, BUFSIZ); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1)); @@ -2385,41 +2177,14 @@ } } LAPPEND_OBJ(interp, objPtr, "caList", listPtr); LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list)); - Tcl_SetObjResult(interp, objPtr); - return TCL_OK; - clientData = clientData; -} - -/* - *------------------------------------------------------------------- - * - * VersionObjCmd -- return version string from OpenSSL. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *------------------------------------------------------------------- - */ -static int -VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr; - - dprintf("Called"); - - objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); - Tcl_SetObjResult(interp, objPtr); - - return TCL_OK; - clientData = clientData; - objc = objc; - objv = objv; + + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + clientData = clientData; } /* *------------------------------------------------------------------- * @@ -2435,12 +2200,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 +2223,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 +2254,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 +2535,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, , %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, , %d) [%p] returning %" TCL_SIZE_MODIFIER "d", (void *) bio, - bufLen, (void *) chan, ret); + dprintf("BioRead(%p, , %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, ) called", bio, str); ADDED generic/tlsDigest.c Index: generic/tlsDigest.c ================================================================== --- /dev/null +++ generic/tlsDigest.c @@ -0,0 +1,1297 @@ +/* + * Message Digest (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 +#include +#include +#include +#include +#include + +/* 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 per-instance state data 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 deletes a digest state structure + * + * Returns: + * Nothing + * + * Side effects: + * Removes structure + * + *------------------------------------------------------------------- + */ +void Tls_DigestFree(DigestState *statePtr) { + if (statePtr == (DigestState *) NULL) { + return; + } + + /* Remove pending timer */ + if (statePtr->timer != (Tcl_TimerToken) NULL) { + Tcl_DeleteTimerHandler(statePtr->timer); + } + + /* Free context structures */ + if (statePtr->ctx != (EVP_MD_CTX *) NULL) { + EVP_MD_CTX_free(statePtr->ctx); + } + if (statePtr->hctx != (HMAC_CTX *) NULL) { + HMAC_CTX_free(statePtr->hctx); + } + if (statePtr->cctx != (CMAC_CTX *) NULL) { + CMAC_CTX_free(statePtr->cctx); + } + ckfree(statePtr); +} + +/*******************************************************************/ + +/* + *------------------------------------------------------------------- + * + * 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 = NULL; + + /* 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; + } + + /* Get key */ + if (keyObj != NULL) { + key = Tcl_GetByteArrayFromObj(keyObj, &key_len); + } + + /* Initialize hash function */ + if (statePtr->format & TYPE_MD) { + res = EVP_DigestInit_ex(statePtr->ctx, md, NULL); + } else if (statePtr->format & TYPE_HMAC) { + res = HMAC_Init_ex(statePtr->hctx, (const void *) key, key_len, md, NULL); + } else if (statePtr->format & TYPE_CMAC) { + 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 with data + * + * Returns: + * 1 if successful or 0 for failure + * + * Side effects: + * Adds buf data to hash function or sets result to error message + * + *------------------------------------------------------------------- + */ +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 return the message digest + * + * Returns: + * TCL_OK if successful or TCL_ERROR for failure with result set + * to error message. + * + * Side effects: + * Sets result to message digest or an error message. + * + *------------------------------------------------------------------- + */ +int Tls_DigestFinialize(Tcl_Interp *interp, DigestState *statePtr, Tcl_Obj **resultObj) { + 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) { + if (resultObj == NULL) { + 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) { + if (resultObj == NULL) { + Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(md_buf, md_len)); + } else { + *resultObj = Tcl_NewByteArrayObj(md_buf, md_len); + Tcl_IncrRefCount(*resultObj); + } + + } else { + Tcl_Obj *newObj = Tcl_NewObj(); + unsigned char *ptr = Tcl_SetByteArrayLength(newObj, 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]; + } + + if (resultObj == NULL) { + Tcl_SetObjResult(interp, newObj); + } else { + *resultObj = newObj; + Tcl_IncrRefCount(*resultObj); + } + } + return TCL_OK; +} + +/*******************************************************************/ + +/* + *------------------------------------------------------------------- + * + * DigestBlockModeProc -- + * + * This function is invoked by the generic IO level + * to set blocking and nonblocking modes. + * + * Returns: + * 0 if successful or POSIX error code if failed. + * + * Side effects: + * Sets the device into blocking or nonblocking mode. + * Can call Tcl_SetChannelError. + * + *------------------------------------------------------------------- + */ +static int DigestBlockModeProc(ClientData clientData, int mode) { + DigestState *statePtr = (DigestState *) clientData; + + if (mode == TCL_MODE_NONBLOCKING) { + statePtr->flags |= TLS_TCL_ASYNC; + } else { + statePtr->flags &= ~(TLS_TCL_ASYNC); + } + return 0; +} + +/* + *------------------------------------------------------------------- + * + * DigestCloseProc -- + * + * This function is invoked by the generic IO level to perform + * channel-type specific cleanup when the channel is closed. All + * queued output is flushed prior to calling this function. + * + * Returns: + * 0 if successful or POSIX error code if failed. + * + * Side effects: + * Deletes stored state data. + * + *------------------------------------------------------------------- + */ +int DigestCloseProc(ClientData clientData, Tcl_Interp *interp) { + DigestState *statePtr = (DigestState *) clientData; + + /* Cancel active timer, if any */ + if (statePtr->timer != (Tcl_TimerToken) NULL) { + Tcl_DeleteTimerHandler(statePtr->timer); + statePtr->timer = (Tcl_TimerToken) NULL; + } + + /* Output message digest if not already done */ + if (!(statePtr->flags & CHAN_EOF)) { + Tcl_Channel parent = Tcl_GetStackedChannel(statePtr->self); + Tcl_Obj *resultObj; + int written; + + if (Digest_Finalize(statePtr->interp, statePtr, &resultObj) == TCL_OK) { + unsigned char *data = Tcl_GetByteArrayFromObj(resultObj, &written); + Tcl_WriteRaw(parent, data, written); + Tcl_DecrRefCount(resultObj); + } + statePtr->flags |= CHAN_EOF; + } + + /* 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. Transform gets data from the underlying channel. + * + * Returns: + * Total bytes read or -1 for an error along with a POSIX error + * code in errorCodePtr. Use EAGAIN for nonblocking and no data. + * + * Side effects: + * Read data from transform and write to buf + * + *---------------------------------------------------------------------- + */ +int DigestInputProc(ClientData clientData, char *buf, int toRead, int *errorCodePtr) { + DigestState *statePtr = (DigestState *) clientData; + Tcl_Channel parent; + int read; + *errorCodePtr = 0; + + /* Abort if nothing to process */ + if (toRead <= 0 || statePtr->self == (Tcl_Channel) NULL) { + return 0; + } + + /* Get bytes from underlying channel */ + parent = Tcl_GetStackedChannel(statePtr->self); + read = Tcl_ReadRaw(parent, buf, toRead); + + /* Update hash function */ + if (read > 0) { + /* Have data */ + if (!Tls_DigestUpdate(statePtr, buf, (size_t) read, 0)) { + Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON())); + *errorCodePtr = EINVAL; + return 0; + } + /* This is correct */ + read = -1; + *errorCodePtr = EAGAIN; + + } else if (read < 0) { + /* Error */ + *errorCodePtr = Tcl_GetErrno(); + + } else if (!(statePtr->flags & CHAN_EOF)) { + /* EOF */ + Tcl_Obj *resultObj; + if (Tls_DigestFinialize(statePtr->interp, statePtr, &resultObj) == TCL_OK) { + unsigned char *data = Tcl_GetByteArrayFromObj(resultObj, &read); + memcpy(buf, data, read); + Tcl_DecrRefCount(resultObj); + + } else { + Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Finalize failed: %s", REASON())); + *errorCodePtr = EINVAL; + read = 0; + } + statePtr->flags |= CHAN_EOF; + } + return read; +} + +/* + *---------------------------------------------------------------------- + * + * DigestOutputProc -- + * + * Called by the generic IO system to write data in buf to transform. + * The transform writes the result to the underlying channel. + * + * Returns: + * Total bytes written or -1 for an error along with a POSIX error + * code in errorCodePtr. Use EAGAIN for nonblocking and can't write data. + * + * Side effects: + * Get data from buf and update digest + * + *---------------------------------------------------------------------- + */ + int DigestOutputProc(ClientData clientData, const char *buf, int toWrite, int *errorCodePtr) { + DigestState *statePtr = (DigestState *) clientData; + *errorCodePtr = 0; + + /* Abort if nothing to process */ + if (toWrite <= 0 || statePtr->self == (Tcl_Channel) NULL) { + return 0; + } + + /* Update hash function */ + if (toWrite > 0 && !Tls_DigestUpdate(statePtr, buf, (size_t) toWrite, 0)) { + Tcl_SetChannelError(statePtr->self, Tcl_ObjPrintf("Update failed: %s", REASON())); + *errorCodePtr = EINVAL; + return 0; + } + return toWrite; +} + +/* + *---------------------------------------------------------------------- + * + * DigestSetOptionProc -- + * + * Called by the generic IO system to set channel option name to value. + * + * Returns: + * TCL_OK if successful or TCL_ERROR if failed along with an error + * message in interp and Tcl_SetErrno. + * + * Side effects: + * Updates channel option to new value. + * + *---------------------------------------------------------------------- + */ +static int DigestSetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName, + const char *optionValue) { + DigestState *statePtr = (DigestState *) clientData; + Tcl_Channel parent; + Tcl_DriverSetOptionProc *setOptionProc; + + /* Abort if no channel */ + if (statePtr->self == (Tcl_Channel) NULL) { + return TCL_ERROR; + } + + /* Delegate options downstream */ + parent = Tcl_GetStackedChannel(statePtr->self); + setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent)); + if (setOptionProc != NULL) { + return (*setOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue); + } else { + Tcl_SetErrno(EINVAL); + return Tcl_BadChannelOption(interp, optionName, NULL); + } +} + +/* + *---------------------------------------------------------------------- + * + * DigestGetOptionProc -- + * + * Called by the generic IO system to get channel option name's value. + * + * Returns: + * TCL_OK if successful or TCL_ERROR if failed along with an error + * message in interp and Tcl_SetErrno. + * + * Side effects: + * Sets result to option's value + * + *---------------------------------------------------------------------- + */ +static int DigestGetOptionProc(ClientData clientData, Tcl_Interp *interp, const char *optionName, + Tcl_DString *optionValue) { + DigestState *statePtr = (DigestState *) clientData; + Tcl_Channel parent; + Tcl_DriverGetOptionProc *getOptionProc; + + /* Abort if no channel */ + if (statePtr->self == (Tcl_Channel) NULL) { + return TCL_ERROR; + } + + /* Delegate options downstream */ + parent = Tcl_GetStackedChannel(statePtr->self); + getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(parent)); + if (getOptionProc != NULL) { + return (*getOptionProc)(Tcl_GetChannelInstanceData(parent), interp, optionName, optionValue); + } else if (optionName == (char*) NULL) { + /* Request is query for all options, this is ok. */ + return TCL_OK; + } else { + Tcl_SetErrno(EINVAL); + return Tcl_BadChannelOption(interp, optionName, NULL); + } +} + +/* + *---------------------------------------------------------------------- + * + * DigestTimerHandler -- + * + * Called by the notifier via timer to flush out pending input data. + * + * Returns: + * Nothing + * + * Side effects: + * May call Tcl_NotifyChannel + * + *---------------------------------------------------------------------- + */ +static void DigestTimerHandler(ClientData clientData) { + DigestState *statePtr = (DigestState *) clientData; + + /* Abort if no channel */ + if (statePtr->self == (Tcl_Channel) NULL) { + return; + } + + /* Clear timer token */ + statePtr->timer = (Tcl_TimerToken) NULL; + + /* Fire event if there is pending data, skip otherwise */ + if ((statePtr->watchMask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) { + Tcl_NotifyChannel(statePtr->self, TCL_READABLE); + } +} + +/* + *---------------------------------------------------------------------- + * + * DigestWatchProc -- + * + * Initialize the notifier to watch for events from this channel. + * + * Returns: + * Nothing (can't return error messages) + * + * Side effects: + * Configure notifier so future events on the channel will be seen by Tcl. + * + *---------------------------------------------------------------------- + */ +void DigestWatchProc(ClientData clientData, int mask) { + DigestState *statePtr = (DigestState *) clientData; + Tcl_Channel parent; + Tcl_DriverWatchProc *watchProc; + + /* Abort if no channel */ + if (statePtr->self == (Tcl_Channel) NULL) { + return; + } + + /* Store OR-ed combination of TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION */ + statePtr->watchMask = mask; + + /* Propagate mask info to parent channel */ + parent = Tcl_GetStackedChannel(statePtr->self); + watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(parent)); + watchProc(Tcl_GetChannelInstanceData(parent), mask); + + /* Remove pending timer */ + if (statePtr->timer != (Tcl_TimerToken) NULL) { + Tcl_DeleteTimerHandler(statePtr->timer); + statePtr->timer = (Tcl_TimerToken) NULL; + } + + /* If there is data pending, set new timer to call Tcl_NotifyChannel */ + if ((mask & TCL_READABLE) && (Tcl_InputBuffered(statePtr->self) > 0)) { + statePtr->timer = Tcl_CreateTimerHandler(READ_DELAY, DigestTimerHandler, (ClientData) statePtr); + } +} + +/* + *---------------------------------------------------------------------- + * + * DigestGetHandleProc -- + * + * Called from Tcl_GetChannelHandle to retrieve OS specific file handle + * from inside this channel. Not used for transformations? + * + * Returns: + * TCL_OK for success or TCL_ERROR for error or if not supported. If + * direction is TCL_READABLE, sets handlePtr to the handle used for + * input, or if TCL_WRITABLE sets to the handle used for output. + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ +int DigestGetHandleProc(ClientData clientData, int direction, ClientData *handlePtr) { + DigestState *statePtr = (DigestState *) clientData; + Tcl_Channel parent; + + /* Abort if no channel */ + if (statePtr->self == (Tcl_Channel) NULL) { + return TCL_ERROR; + } + + parent = Tcl_GetStackedChannel(statePtr->self); + return Tcl_GetChannelHandle(parent, direction, handlePtr); +} + +/* + *---------------------------------------------------------------------- + * + * DigestNotifyProc -- + * + * Called by Tcl to inform us of activity on the underlying channel. + * + * Returns: + * Unchanged interestMask which is an OR-ed combination of TCL_READABLE or TCL_WRITABLE + * + * Side effects: + * Cancels any pending timer. + * + *---------------------------------------------------------------------- + */ +int DigestNotifyProc(ClientData clientData, int interestMask) { + DigestState *statePtr = (DigestState *) clientData; + + /* Skip timer event as redundant */ + if (statePtr->timer != (Tcl_TimerToken) NULL) { + Tcl_DeleteTimerHandler(statePtr->timer); + statePtr->timer = (Tcl_TimerToken) NULL; + } + return interestMask; +} + +/* + * + * Channel type structure definition for digest transformations. + * + */ +static const Tcl_ChannelType digestChannelType = { + "digest", /* Type name */ + TCL_CHANNEL_VERSION_5, /* v5 channel */ + DigestCloseProc, /* Close proc */ + DigestInputProc, /* Input proc */ + DigestOutputProc, /* Output proc */ + NULL, /* Seek proc */ + DigestSetOptionProc, /* Set option proc */ + DigestGetOptionProc, /* Get option proc */ + DigestWatchProc, /* Initialize notifier */ + DigestGetHandleProc, /* Get OS handles out of channel */ + DigestClose2Proc, /* close2proc */ + DigestBlockModeProc, /* Set blocking/nonblocking mode*/ + NULL, /* Flush proc */ + DigestNotifyProc, /* Handling of events bubbling up */ + NULL, /* Wide seek proc */ + NULL, /* Thread action */ + NULL /* Truncate */ +}; + +/* + *---------------------------------------------------------------------- + * + * 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 structure */ + 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, abort for error */ + 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, NULL) != 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 structure */ + 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 data structure */ + if ((statePtr = Tls_DigestNew(interp, format)) == NULL) { + Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL); + return TCL_ERROR; + } + + /* Calc Digest, abort for error */ + if (Tls_DigestInit(interp, statePtr, md, cipher, keyObj) != TCL_OK || + Tls_DigestUpdate(statePtr, data, (size_t) data_len, 1) == 0 || + Tls_DigestFinialize(interp, statePtr, NULL) != TCL_OK) { + Tls_DigestFree(statePtr); + return TCL_ERROR; + } + + /* Clean-up */ + 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 structure */ + if ((statePtr = Tls_DigestNew(interp, format)) == NULL) { + Tcl_AppendResult(interp, "Memory allocation error", (char *) NULL); + return TCL_ERROR; + } + + /* Open file channel, abort for error */ + 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, NULL); + +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, 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 = 1; idx < objc; 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; + } + + /* 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 + * + *------------------------------------------------------------------- + */ + #define validate_argc(objc, objv) { \ + if (objc != 2) { \ + Tcl_WrongNumArgs(interp, 1, objv, "data"); \ + return TCL_ERROR; \ + } \ +} + +int DigestMD4Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + validate_argc(objc, objv); + 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[]) { + validate_argc(objc, objv); + 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[]) { + validate_argc(objc, objv); + 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[]) { + validate_argc(objc, objv); + 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[]) { + validate_argc(objc, objv); + 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 +#include +#include + +/* + * 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 #include #include @@ -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