Index: doc/tls.html ================================================================== --- doc/tls.html +++ doc/tls.html @@ -29,13 +29,20 @@
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::protocols
tls::version
+
 
+
tls::digest type data
+
tls::digests
+
tls::md4 data
+
tls::md5 data
+
tls::sha1 data
+
tls::sha256 data
COMMANDS
CALLBACK OPTIONS
HTTPS EXAMPLE
@@ -50,11 +57,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 +69,20 @@ 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::protocols
+tls::version
+
+tls::digest type data
+tls::digests
+tls::md4 data
+tls::md5 data
+tls::sha1 data
+tls::sha256 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 supportted 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::protocols
Returns a list of supported protocols. Valid values are: @@ -430,10 +445,33 @@ and tls1.3. Exact list depends on OpenSSL version and compile time flags.
tls::version
Returns the OpenSSL version string.
+ +
+
tls::digest type data
+
Calculate the message digest for data using type + hash algorithm. Returns value as a hex string. Type can be any + OpenSSL supported hash algorithm including: md4, md5, + sha1, sha256, sha512, sha3-256, etc. + See digests command for a full list.
+ +
tls::digests
+
Returns a list of the valid hash algorithms used to create message digests.
+ +
tls::md4 data
+
Return the MD4 message-digest for data.
+ +
tls::md5 data
+
Return the MD5 message-digest for data.
+ +
tls::sha1 data
+
Return the SHA1 secure hash algorithm digest for data.
+ +
tls::sha256 data
+
Return the SHA-2 SHA256 secure hash algorithm digest for data.

CALLBACK OPTIONS

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 @@ -444,11 +448,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 +555,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 +617,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 +906,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; @@ -926,10 +930,179 @@ /********************/ /* *------------------------------------------------------------------- * + * Hash Calc -- + * + * Calculate message digest of data using type hash algorithm. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------- + */ +int +HashCalc(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const EVP_MD *type) { + char *data; + int len; + unsigned int mdlen; + unsigned char mdbuf[EVP_MAX_MD_SIZE]; + unsigned char hashbuf[EVP_MAX_MD_SIZE*2+1]; + const char *hex = "0123456789ABCDEF"; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "data"); + return TCL_ERROR; + } + + data = Tcl_GetByteArrayFromObj(objv[1], &len); + if (data == NULL) { + return TCL_ERROR; + } + + /* Calc hash, convert to hex string, and write to result */ + if (EVP_Digest(data, (size_t) len, mdbuf, &mdlen, type, NULL)) { + unsigned char *mptr = mdbuf; + unsigned char *hptr = &hashbuf[0]; + + for (unsigned int i = 0; i < mdlen; i++) { + *hptr++ = hex[(*mptr>>4)&0xF]; + *hptr++ = hex[(*mptr++)&0xF]; + } + *hptr = 0; + Tcl_SetObjResult(interp, Tcl_NewStringObj(hashbuf, mdlen*2)); + } else { + Tcl_SetResult(interp, "Hash calculation error", NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *------------------------------------------------------------------- + * + * Hash Commands -- + * + * Return the digest as a hex string for data using type message digest. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------- + */ +DigestCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + int len; + const char *name; + const EVP_MD *type; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "type data"); + return TCL_ERROR; + } + + name = Tcl_GetStringFromObj(objv[1],&len); + if (name == NULL || (type = EVP_get_digestbyname(name)) == NULL) { + Tcl_AppendResult(interp, "Invalid digest type \"", name, "\"", NULL); + return TCL_ERROR; + } + objc--; + objv++; + return HashCalc(interp, objc, objv, type); +} + +/* + * Command to Calculate MD4 Message Digest + */ +int +DigestMD4Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + return HashCalc(interp, objc, objv, EVP_md4()); +} + +/* + * Command to Calculate MD5 Message Digest + */ +int +DigestMD5Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + return HashCalc(interp, objc, objv, EVP_md5()); +} + +/* + * Command to Calculate SHA-1 Hash + */ +int +DigestSHA1Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + return HashCalc(interp, objc, objv, EVP_sha1()); +} + +/* + * Command to Calculate SHA2 SHA-256 Hash + */ +int +DigestSHA256Cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + return HashCalc(interp, objc, objv, EVP_sha256()); +} + +/* + *------------------------------------------------------------------- + * + * Hash List Command -- + * + * Return a list of all valid hash algorithms or message digests. + * + * Results: + * A standard Tcl result list. + * + * Side effects: + * None. + * + *------------------------------------------------------------------- + */ +void ListCallback(const OBJ_NAME *obj, void *arg) { + Tcl_Obj *objPtr = (Tcl_Obj *) arg; + if (1 || !obj->alias) { + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(obj->name,-1)); + } +} + +int +DigestListCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL); + +#if OPENSSL_VERSION_NUMBER < 0x10100000L + OpenSSL_add_all_digests(); /* Make sure they're loaded */ +#endif + + OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, ListCallback, (void *) objPtr); + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, objPtr); + + return TCL_OK; + clientData = clientData; + objc = objc; + objv = objv; +} + +/* + * 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 +}; + +/* + *------------------------------------------------------------------- + * * CiphersObjCmd -- list available ciphers * * This procedure is invoked to process the "tls::ciphers" command * to list available ciphers, based upon protocol selected. * @@ -939,16 +1112,10 @@ * 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; @@ -958,15 +1125,28 @@ 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?"); + if ((objc < 1) || (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) { + if (objc == 1) { + /* List all ciphers */ + Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL); + +#if OPENSSL_VERSION_NUMBER < 0x10100000L + OpenSSL_add_all_ciphers(); /* Make sure they're loaded */ +#endif + + OBJ_NAME_do_all(OBJ_NAME_TYPE_CIPHER_METH, ListCallback, (void *) objPtr); + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, objPtr); + return TCL_OK; + + } else 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; } @@ -1079,10 +1259,11 @@ } } SSL_free(ssl); SSL_CTX_free(ctx); + Tcl_ResetResult(interp); Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; } @@ -1142,10 +1323,38 @@ } /* *------------------------------------------------------------------- * + * 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; +} + +/* + *------------------------------------------------------------------- + * * HandshakeObjCmd -- * * This command is used to verify whether the handshake is complete * or not. * @@ -1171,11 +1380,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 +1458,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 +1503,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 +1632,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 +1723,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 +1740,20 @@ Tcl_AppendResult(interp, "ALPN protocol name too long", (char *) NULL); Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL); Tls_Free((char *) statePtr); return TCL_ERROR; } - protos_len += 1 + (int) len; + protos_len += 1 + len; } /* Build the complete protocol-list */ protos = ckalloc(protos_len); /* protocol-lists consist of 8-bit length-prefixed, byte strings */ - for (j = 0, p = protos; j < cnt; j++) { - char *str = Tcl_GetStringFromObj(list[j], &len); - *p++ = (unsigned char) len; - memcpy(p, str, (size_t) len); + for (i = 0, p = protos; i < cnt; i++) { + char *str = Tcl_GetStringFromObj(list[i], &len); + *p++ = len; + memcpy(p, str, len); p += len; } /* SSL_set_alpn_protos makes a copy of the protocol-list */ /* Note: This functions reverses the return value convention */ @@ -1720,48 +1927,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 +2052,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 +2273,11 @@ Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel"); return TCL_ERROR; } /* Get channel Id */ - channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], (Tcl_Size *) NULL); + channelName = Tcl_GetStringFromObj(objv[(objc == 2 ? 1 : 2)], NULL); chan = Tcl_GetChannel(interp, channelName, &mode); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } @@ -2132,11 +2343,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 +2393,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 +2500,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 +2519,30 @@ /* Timeout value - SSL_CTX_get_timeout (in seconds) */ LAPPEND_LONG(interp, objPtr, "timeout", SSL_SESSION_get_timeout(session)); /* Session id - TLSv1.2 and below only */ session_id = SSL_SESSION_get_id(session, &ulen); - LAPPEND_BARRAY(interp, objPtr, "session_id", session_id, (Tcl_Size) ulen); + LAPPEND_BARRAY(interp, objPtr, "session_id", session_id, (int) ulen); /* Session context */ session_id = SSL_SESSION_get0_id_context(session, &ulen); - LAPPEND_BARRAY(interp, objPtr, "session_context", session_id, (Tcl_Size) ulen); + LAPPEND_BARRAY(interp, objPtr, "session_context", session_id, (int) ulen); /* Session ticket - client only */ SSL_SESSION_get0_ticket(session, &ticket, &len2); - LAPPEND_BARRAY(interp, objPtr, "session_ticket", ticket, (Tcl_Size) len2); + LAPPEND_BARRAY(interp, objPtr, "session_ticket", ticket, (int) len2); /* Session ticket lifetime hint (in seconds) */ LAPPEND_LONG(interp, objPtr, "lifetime", SSL_SESSION_get_ticket_lifetime_hint(session)); /* Ticket app data */ SSL_SESSION_get0_ticket_appdata(session, &ticket, &len2); - LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (Tcl_Size) len2); + LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (int) len2); /* Get master key */ len2 = SSL_SESSION_get_master_key(session, buffer, SSL_MAX_MASTER_KEY_LENGTH); - LAPPEND_BARRAY(interp, objPtr, "master_key", buffer, (Tcl_Size) len2); + LAPPEND_BARRAY(interp, objPtr, "master_key", buffer, (int) len2); /* Compression id */ unsigned int id = SSL_SESSION_get_compress_id(session); LAPPEND_STR(interp, objPtr, "compression_id", id == 1 ? "zlib" : "none", -1); } @@ -2393,38 +2604,10 @@ } /* *------------------------------------------------------------------- * - * VersionObjCmd -- return version string from OpenSSL. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *------------------------------------------------------------------- - */ -static int -VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr; - - dprintf("Called"); - - objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); - Tcl_SetObjResult(interp, objPtr); - - return TCL_OK; - clientData = clientData; - objc = objc; - objv = objv; -} - -/* - *------------------------------------------------------------------- - * * MiscObjCmd -- misc commands * * Results: * A standard Tcl result. * @@ -2435,12 +2618,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 +2641,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 +2672,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 +2953,31 @@ 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::ciphers", CiphersObjCmd, (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); + + Tcl_CreateObjCommand(interp, "tls::digest", DigestCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::digests", DigestListCmd, (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); 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); 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 Index: generic/tlsX509.c ================================================================== --- generic/tlsX509.c +++ generic/tlsX509.c @@ -80,11 +80,11 @@ if (astring != NULL) { len = String_to_Hex((char *)ASN1_STRING_get0_data(astring), ASN1_STRING_length(astring), buffer, 1024); } - resultPtr = Tcl_NewStringObj(buffer, (Tcl_Size) len); + resultPtr = Tcl_NewStringObj(buffer, len); return resultPtr; } /* * Get Key Usage @@ -202,11 +202,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 +279,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 +333,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 +393,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); + 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); + 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 +450,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)); @@ -489,18 +489,18 @@ const ASN1_BIT_STRING *iuid, *suid; X509_get0_uids(cert, &iuid, &suid); Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewStringObj("issuerUniqueId", -1)); if (iuid != NULL) { - Tcl_ListObjAppendElement(interp, certPtr, Tcl_NewByteArrayObj((char *)iuid->data, (Tcl_Size) iuid->length)); + 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)); } } @@ -583,24 +583,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; }