Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -41,11 +41,11 @@
/*
* Forward declarations
*/
#define F2N(key, dsp) \
- (((key) == NULL) ? (char *) NULL : \
+ (((key) == NULL) ? (char *)NULL : \
Tcl_TranslateFileName(interp, (key), (dsp)))
static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key,
char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1,
int key_asn1_len, int cert_asn1_len, char *CApath, char *CAfile,
@@ -244,15 +244,10 @@
if (statePtr->callback == (Tcl_Obj*)NULL)
return;
switch(version) {
-#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
- case SSL2_VERSION:
- ver = "SSLv2";
- break;
-#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3)
case SSL3_VERSION:
ver = "SSLv3";
break;
#endif
@@ -945,11 +940,11 @@
* constructs and destroys SSL context (CTX)
*
*-------------------------------------------------------------------
*/
static const char *protocols[] = {
- "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL
+ "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
};
@@ -986,69 +981,65 @@
}
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:
+ case TLS_SSL2:
+ Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
+ return TCL_ERROR;
+ case TLS_SSL3:
#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
- Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
- return TCL_ERROR;
+ Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL);
+ return TCL_ERROR;
#else
- method = SSLv3_method(); break;
+ method = SSLv3_method(); break;
#endif
- case TLS_TLS1:
+ 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;
+ Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
+ return TCL_ERROR;
#else
- method = TLSv1_method(); break;
+ method = TLSv1_method(); break;
#endif
- case TLS_TLS1_1:
+ 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;
+ Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
+ return TCL_ERROR;
#else
- method = TLSv1_1_method(); break;
+ method = TLSv1_1_method(); break;
#endif
- case TLS_TLS1_2:
+ 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;
+ Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL);
+ return TCL_ERROR;
#else
- method = TLSv1_2_method(); break;
+ method = TLSv1_2_method(); break;
#endif
- case TLS_TLS1_3:
+ 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;
+ Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)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;
+ 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;
+ default:
+ method = TLS_method();
+ break;
}
ctx = SSL_CTX_new(method);
if (ctx == NULL) {
- Tcl_AppendResult(interp, GET_ERR_REASON(), NULL);
+ Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
return TCL_ERROR;
}
ssl = SSL_new(ctx);
if (ssl == NULL) {
- Tcl_AppendResult(interp, GET_ERR_REASON(), NULL);
+ Tcl_AppendResult(interp, GET_ERR_REASON(), (char *)NULL);
SSL_CTX_free(ctx);
return TCL_ERROR;
}
/* Use list and order as would be sent in a ClientHello or all available ciphers */
@@ -1110,10 +1101,11 @@
* Side effects:
* none
*
*-------------------------------------------------------------------
*/
+
static int
ProtocolsObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
@@ -1129,13 +1121,10 @@
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));
@@ -1168,10 +1157,11 @@
* Side effects:
* May force SSL negotiation to take place.
*
*-------------------------------------------------------------------
*/
+
static int HandshakeObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -1189,21 +1179,21 @@
return(TCL_ERROR);
}
ERR_clear_error();
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *) NULL), NULL);
+ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
if (chan == (Tcl_Channel) NULL) {
return(TCL_ERROR);
}
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
- "\": not a TLS channel", NULL);
- Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "CHANNEL", "INVALID", (char *) NULL);
+ "\": not a TLS channel", (char *)NULL);
+ Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "CHANNEL", "INVALID", (char *)NULL);
return(TCL_ERROR);
}
statePtr = (State *)Tcl_GetChannelInstanceData(chan);
dprintf("Calling Tls_WaitForConnect");
@@ -1221,15 +1211,15 @@
if (!errStr || (*errStr == 0)) {
errStr = Tcl_PosixError(interp);
}
- Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL);
+ Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *)NULL);
if ((result = SSL_get_verify_result(statePtr->ssl)) != X509_V_OK) {
- Tcl_AppendResult(interp, " due to \"", X509_verify_cert_error_string(result), "\"", (char *) NULL);
+ Tcl_AppendResult(interp, " due to \"", X509_verify_cert_error_string(result), "\"", (char *)NULL);
}
- Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "FAILED", (char *) NULL);
+ Tcl_SetErrorCode(interp, "TLS", "HANDSHAKE", "FAILED", (char *)NULL);
dprintf("Returning TCL_ERROR with handshake failed: %s", errStr);
return(TCL_ERROR);
} else {
if (err != 0) {
dprintf("Got an error with a completed handshake: err = %i", err);
@@ -1257,10 +1247,11 @@
* Side effects:
* May modify the behavior of an IO channel.
*
*-------------------------------------------------------------------
*/
+
static int
ImportObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
@@ -1367,14 +1358,14 @@
OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -post_handshake, -request, -require, -security_level, -server, -servername, -session_id, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, -tls1.3, or -validatecommand");
return TCL_ERROR;
}
- if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
- if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
+ if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
+ if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
if (request && post_handshake) verify |= SSL_VERIFY_POST_HANDSHAKE;
- if (verify == 0) verify = SSL_VERIFY_NONE;
+ if (verify == 0) verify = SSL_VERIFY_NONE;
proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);
proto |= (tls1 ? TLS_PROTO_TLS1 : 0);
proto |= (tls1_1 ? TLS_PROTO_TLS1_1 : 0);
@@ -1441,20 +1432,20 @@
* Make sure to operate on the topmost channel
*/
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
- "\": not a TLS channel", NULL);
- Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL);
- Tls_Free((void *) statePtr);
+ "\": not a TLS channel", (char *)NULL);
+ Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *)NULL);
+ Tls_Free((void *)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, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) {
- Tls_Free((void *) statePtr);
+ Tls_Free((void *)statePtr);
return TCL_ERROR;
}
}
statePtr->ctx = ctx;
@@ -1496,46 +1487,47 @@
Tcl_DStringFree(&upperChannelBlocking);
/*
* SSL Initialization
*/
+
statePtr->ssl = SSL_new(statePtr->ctx);
if (!statePtr->ssl) {
/* SSL library error */
- Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *) NULL);
- Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *) NULL);
+ Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *)NULL);
+ Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *)NULL);
Tls_Free((void *)statePtr);
return TCL_ERROR;
}
/* Set host server name */
if (servername) {
/* Sets the server name indication (SNI) in ClientHello extension */
/* Per RFC 6066, hostname is a ASCII encoded string, though RFC 4366 says UTF-8. */
if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
- Tcl_AppendResult(interp, "Set SNI extension failed: ", GET_ERR_REASON(), (char *) NULL);
- Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SNI", "FAILED", (char *) NULL);
+ Tcl_AppendResult(interp, "Set SNI extension failed: ", GET_ERR_REASON(), (char *)NULL);
+ Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SNI", "FAILED", (char *)NULL);
Tls_Free((void *)statePtr);
return TCL_ERROR;
}
/* Set hostname for peer certificate hostname verification in clients.
Don't use SSL_set1_host since it has limitations. */
if (!SSL_add1_host(statePtr->ssl, servername)) {
- Tcl_AppendResult(interp, "Set DNS hostname failed: ", GET_ERR_REASON(), (char *) NULL);
- Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *) NULL);
+ Tcl_AppendResult(interp, "Set DNS hostname failed: ", GET_ERR_REASON(), (char *)NULL);
+ Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *)NULL);
Tls_Free((void *)statePtr);
return TCL_ERROR;
}
}
/* Resume session id */
if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) {
/* SSL_set_session() */
if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) strlen(session_id))) {
- Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *) NULL);
- Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *) NULL);
+ Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *)NULL);
+ Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *)NULL);
Tls_Free((void *)statePtr);
return TCL_ERROR;
}
}
@@ -1556,12 +1548,12 @@
/* Determine the memory required for the protocol-list */
for (i = 0; i < cnt; i++) {
Tcl_GetStringFromObj(list[i], &len);
if (len > 255) {
- Tcl_AppendResult(interp, "ALPN protocol names too long", (char *) NULL);
- Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL);
+ Tcl_AppendResult(interp, "ALPN protocol names too long", (char *)NULL);
+ Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
Tls_Free((void *)statePtr);
return TCL_ERROR;
}
protos_len += 1 + (int) len;
}
@@ -1577,12 +1569,12 @@
}
/* SSL_set_alpn_protos makes a copy of the protocol-list */
/* Note: This functions reverses the return value convention */
if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) {
- Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *) NULL);
- Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *) NULL);
+ Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *)NULL);
+ Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL);
Tls_Free((void *)statePtr);
ckfree(protos);
return TCL_ERROR;
}
@@ -1666,11 +1658,10 @@
/*
* End of SSL Init
*/
dprintf("Returning %s", Tcl_GetChannelName(statePtr->self));
Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE);
-
return TCL_OK;
}
/*
*-------------------------------------------------------------------
@@ -1685,10 +1676,11 @@
* Side effects:
* May modify the behavior of an IO channel.
*
*-------------------------------------------------------------------
*/
+
static int
UnimportObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp,
int objc,
@@ -1714,11 +1706,11 @@
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
"\": not a TLS channel", (char *)NULL);
- Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL);
+ Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *)NULL);
return TCL_ERROR;
}
if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) {
return TCL_ERROR;
@@ -1738,14 +1730,29 @@
* Side effects:
* constructs SSL context (CTX)
*
*-------------------------------------------------------------------
*/
+
static SSL_CTX *
-CTX_Init(State *statePtr, int isServer, int proto, char *keyfile, char *certfile,
- unsigned char *key, unsigned char *cert, int key_len, int cert_len, char *CApath,
- char *CAfile, char *ciphers, char *ciphersuites, int level, char *DHparams) {
+CTX_Init(
+ State *statePtr,
+ int isServer,
+ int proto,
+ char *keyfile,
+ char *certfile,
+ unsigned char *key,
+ unsigned char *cert,
+ int key_len,
+ int cert_len,
+ char *CApath,
+ char *CAfile,
+ char *ciphers,
+ char *ciphersuites,
+ int level,
+ char *DHparams)
+{
Tcl_Interp *interp = statePtr->interp;
SSL_CTX *ctx = NULL;
Tcl_DString ds;
int off = 0, abort = 0;
int load_private_key;
@@ -1752,48 +1759,46 @@
const SSL_METHOD *method;
dprintf("Called");
if (!proto) {
- Tcl_AppendResult(interp, "no valid protocol selected", (char *) NULL);
+ Tcl_AppendResult(interp, "no valid protocol selected", (char *)NULL);
return NULL;
}
/* create SSL context */
-#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2)
- if (ENABLED(proto, TLS_PROTO_SSL2)) {
- Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *) NULL);
- return NULL;
- }
-#endif
-#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3)
- if (ENABLED(proto, TLS_PROTO_SSL3)) {
- Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *) NULL);
- return NULL;
- }
-#endif
-#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1)
- if (ENABLED(proto, TLS_PROTO_TLS1)) {
- Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *) NULL);
- return NULL;
- }
-#endif
-#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1)
- if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
- Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *) NULL);
- return NULL;
- }
-#endif
-#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2)
- if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
- Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *) NULL);
- return NULL;
- }
-#endif
-#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3)
- if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
- Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *) NULL);
+ if (ENABLED(proto, TLS_PROTO_SSL2)) {
+ Tcl_AppendResult(interp, "SSL2 protocol not supported", (char *)NULL);
+ return NULL;
+ }
+#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD)
+ if (ENABLED(proto, TLS_PROTO_SSL3)) {
+ Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *)NULL);
+ return NULL;
+ }
+#endif
+#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD)
+ if (ENABLED(proto, TLS_PROTO_TLS1)) {
+ Tcl_AppendResult(interp, "TLS 1.0 protocol not supported", (char *)NULL);
+ return NULL;
+ }
+#endif
+#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD)
+ if (ENABLED(proto, TLS_PROTO_TLS1_1)) {
+ Tcl_AppendResult(interp, "TLS 1.1 protocol not supported", (char *)NULL);
+ return NULL;
+ }
+#endif
+#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD)
+ if (ENABLED(proto, TLS_PROTO_TLS1_2)) {
+ Tcl_AppendResult(interp, "TLS 1.2 protocol not supported", (char *)NULL);
+ return NULL;
+ }
+#endif
+#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3_METHOD)
+ if (ENABLED(proto, TLS_PROTO_TLS1_3)) {
+ Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *)NULL);
return NULL;
}
#endif
if (proto == 0) {
/* Use full range */
@@ -1800,15 +1805,10 @@
SSL_CTX_set_min_proto_version(ctx, 0);
SSL_CTX_set_max_proto_version(ctx, 0);
}
switch (proto) {
-#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
- case TLS_PROTO_SSL2:
- method = isServer ? SSLv2_server_method() : SSLv2_client_method();
- break;
-#endif
#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD)
case TLS_PROTO_SSL3:
method = isServer ? SSLv3_server_method() : SSLv3_client_method();
break;
#endif
@@ -1834,26 +1834,23 @@
break;
#endif
default:
/* Negotiate highest available SSL/TLS version */
method = isServer ? TLS_server_method() : TLS_client_method();
-#if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2)
- off |= (ENABLED(proto, TLS_PROTO_SSL2) ? 0 : SSL_OP_NO_SSLv2);
-#endif
-#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3)
+#if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD)
off |= (ENABLED(proto, TLS_PROTO_SSL3) ? 0 : SSL_OP_NO_SSLv3);
#endif
-#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1)
+#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD)
off |= (ENABLED(proto, TLS_PROTO_TLS1) ? 0 : SSL_OP_NO_TLSv1);
#endif
-#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1)
+#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD)
off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1);
#endif
-#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2)
+#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD)
off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2);
#endif
-#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3)
+#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3_METHOD)
off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3);
#endif
break;
}
@@ -1878,31 +1875,24 @@
/* Force cipher selection order by server */
if (!isServer) {
SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
}
-#if OPENSSL_VERSION_NUMBER < 0x10100000L
- OpenSSL_add_all_algorithms(); /* Load ciphers and digests */
-#endif
-
SSL_CTX_set_app_data(ctx, (void*)interp); /* remember the interpreter */
SSL_CTX_set_options(ctx, SSL_OP_ALL); /* all SSL bug workarounds */
SSL_CTX_set_options(ctx, SSL_OP_NO_COMPRESSION); /* disable compression even if supported */
SSL_CTX_set_options(ctx, off); /* disable protocol versions */
-#if OPENSSL_VERSION_NUMBER < 0x10101000L
- SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY); /* handle new handshakes in background. On by default in OpenSSL 1.1.1. */
-#endif
SSL_CTX_sess_set_cache_size(ctx, 128);
/* Set user defined ciphers, cipher suites, and security level */
if ((ciphers != NULL) && !SSL_CTX_set_cipher_list(ctx, ciphers)) {
- Tcl_AppendResult(interp, "Set ciphers failed: No valid ciphers", (char *) NULL);
+ Tcl_AppendResult(interp, "Set ciphers failed: No valid ciphers", (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
if ((ciphersuites != NULL) && !SSL_CTX_set_ciphersuites(ctx, ciphersuites)) {
- Tcl_AppendResult(interp, "Set cipher suites failed: No valid ciphers", (char *) NULL);
+ Tcl_AppendResult(interp, "Set cipher suites failed: No valid ciphers", (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
/* Set security level */
@@ -1916,11 +1906,11 @@
SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr);
/* read a Diffie-Hellman parameters file, or use the built-in one */
#ifdef OPENSSL_NO_DH
if (DHparams != NULL) {
- Tcl_AppendResult(interp, "DH parameter support not available", (char *) NULL);
+ Tcl_AppendResult(interp, "DH parameter support not available", (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
#else
{
@@ -1928,30 +1918,30 @@
if (DHparams != NULL) {
BIO *bio;
bio = BIO_new_file(F2N(DHparams, &ds), "r");
if (!bio) {
Tcl_DStringFree(&ds);
- Tcl_AppendResult(interp, "Could not find DH parameters file", (char *) NULL);
+ Tcl_AppendResult(interp, "Could not find DH parameters file", (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
dh = PEM_read_bio_DHparams(bio, NULL, NULL, NULL);
BIO_free(bio);
Tcl_DStringFree(&ds);
if (!dh) {
- Tcl_AppendResult(interp, "Could not read DH parameters from file", (char *) NULL);
+ Tcl_AppendResult(interp, "Could not read DH parameters from file", (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
SSL_CTX_set_tmp_dh(ctx, dh);
DH_free(dh);
} else {
/* Use well known DH parameters that have built-in support in OpenSSL */
if (!SSL_CTX_set_dh_auto(ctx, 1)) {
- Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "Could not enable set DH auto: ", GET_ERR_REASON(), (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
}
}
@@ -1963,31 +1953,31 @@
load_private_key = 1;
if (SSL_CTX_use_certificate_file(ctx, F2N(certfile, &ds), SSL_FILETYPE_PEM) <= 0) {
Tcl_DStringFree(&ds);
Tcl_AppendResult(interp, "unable to set certificate file ", certfile, ": ",
- GET_ERR_REASON(), (char *) NULL);
+ GET_ERR_REASON(), (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
Tcl_DStringFree(&ds);
} else if (cert != NULL) {
load_private_key = 1;
if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) {
Tcl_AppendResult(interp, "unable to set certificate: ",
- GET_ERR_REASON(), (char *) NULL);
+ GET_ERR_REASON(), (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
} else {
certfile = (char*)X509_get_default_cert_file();
if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) {
#if 0
Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ",
- GET_ERR_REASON(), (char *) NULL);
+ GET_ERR_REASON(), (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
#endif
}
}
@@ -2007,30 +1997,30 @@
if (SSL_CTX_use_PrivateKey_file(ctx, F2N(keyfile, &ds), SSL_FILETYPE_PEM) <= 0) {
Tcl_DStringFree(&ds);
/* flush the passphrase which might be left in the result */
Tcl_SetResult(interp, NULL, TCL_STATIC);
Tcl_AppendResult(interp, "unable to set public key file ", keyfile, " ",
- GET_ERR_REASON(), (char *) NULL);
+ GET_ERR_REASON(), (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
Tcl_DStringFree(&ds);
-
} else if (key != NULL) {
if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 0) {
/* flush the passphrase which might be left in the result */
Tcl_SetResult(interp, NULL, TCL_STATIC);
- Tcl_AppendResult(interp, "unable to set public key: ", GET_ERR_REASON(), (char *) NULL);
+ Tcl_AppendResult(interp, "unable to set public key: ", GET_ERR_REASON(), (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
}
/* Now we know that a key and cert have been set against
* the SSL context */
if (!SSL_CTX_check_private_key(ctx)) {
- Tcl_AppendResult(interp, "private key does not match the certificate public key",
- (char *) NULL);
+ Tcl_AppendResult(interp,
+ "private key does not match the certificate public key",
+ (char *)NULL);
SSL_CTX_free(ctx);
return NULL;
}
}
@@ -2135,11 +2125,11 @@
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
"\": not a TLS channel", NULL);
- Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *) NULL);
+ Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *)NULL);
return TCL_ERROR;
}
statePtr = (State *) Tcl_GetChannelInstanceData(chan);
/* Get certificate for peer or self */
@@ -2258,11 +2248,11 @@
/* Make sure to operate on the topmost channel */
chan = Tcl_GetTopChannel(chan);
if (Tcl_GetChannelType(chan) != Tls_ChannelType()) {
Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan),
"\": not a TLS channel", NULL);
- Tcl_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *) NULL);
+ Tcl_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *)NULL);
return(TCL_ERROR);
}
objPtr = Tcl_NewListObj(0, NULL);
@@ -2656,17 +2646,17 @@
X509_gmtime_adj(X509_getm_notAfter(cert),(long)60*60*24*days);
X509_set_pubkey(cert,pkey);
name=X509_get_subject_name(cert);
- X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (const unsigned char *) k_C, -1, -1, 0);
- X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (const unsigned char *) k_ST, -1, -1, 0);
- X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (const unsigned char *) k_L, -1, -1, 0);
- X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (const unsigned char *) k_O, -1, -1, 0);
- X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (const unsigned char *) k_OU, -1, -1, 0);
- X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, (const unsigned char *) k_CN, -1, -1, 0);
- X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, (const unsigned char *) k_Email, -1, -1, 0);
+ X509_NAME_add_entry_by_txt(name,"C", MBSTRING_ASC, (unsigned char *) k_C, -1, -1, 0);
+ X509_NAME_add_entry_by_txt(name,"ST", MBSTRING_ASC, (unsigned char *) k_ST, -1, -1, 0);
+ X509_NAME_add_entry_by_txt(name,"L", MBSTRING_ASC, (unsigned char *) k_L, -1, -1, 0);
+ X509_NAME_add_entry_by_txt(name,"O", MBSTRING_ASC, (unsigned char *) k_O, -1, -1, 0);
+ X509_NAME_add_entry_by_txt(name,"OU", MBSTRING_ASC, (unsigned char *) k_OU, -1, -1, 0);
+ X509_NAME_add_entry_by_txt(name,"CN", MBSTRING_ASC, (unsigned char *) k_CN, -1, -1, 0);
+ X509_NAME_add_entry_by_txt(name,"Email", MBSTRING_ASC, (unsigned char *) k_Email, -1, -1, 0);
X509_set_subject_name(cert,name);
if (!X509_sign(cert,pkey,EVP_sha256())) {
X509_free(cert);
@@ -2706,14 +2696,10 @@
break;
}
return TCL_OK;
}
-/********************/
-/* Init */
-/********************/
-
/*
*-------------------------------------------------------------------
*
* Tls_Free --
*
@@ -2805,16 +2791,10 @@
}
dprintf("Returning");
}
-#if TCL_MAJOR_VERSION > 8
-#define MIN_VERSION "9.0"
-#else
-#define MIN_VERSION "8.5"
-#endif
-
/*
*-------------------------------------------------------------------
*
* Tls_Init --
*
@@ -2826,41 +2806,39 @@
* Side effects:
* create the ssl command, initialize ssl context
*
*-------------------------------------------------------------------
*/
-DLLEXPORT int Tls_Init(Tcl_Interp *interp) {
+
+DLLEXPORT int Tls_Init(
+ Tcl_Interp *interp)
+{
const char tlsTclInitScript[] = {
#include "tls.tcl.h"
0x00
};
dprintf("Called");
-#ifdef USE_TCL_STUBS
- if (Tcl_InitStubs(interp, MIN_VERSION, 0) == NULL) {
- return TCL_ERROR;
- }
-#endif
- if (Tcl_PkgRequire(interp, "Tcl", MIN_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
return TCL_ERROR;
}
if (TlsLibInit(0) != TCL_OK) {
- Tcl_AppendResult(interp, "could not initialize SSL library", (char *) NULL);
+ Tcl_AppendResult(interp, "could not initialize SSL library", (char *)NULL);
return TCL_ERROR;
}
- Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (void *) NULL, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, NULL, 0);
+ Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, NULL, 0);
+ Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, NULL, 0);
+ Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, NULL, 0);
+ Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, NULL, 0);
+ Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, NULL, 0);
+ Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, NULL, 0);
+ Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, NULL, 0);
+ Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, NULL, 0);
if (interp) {
Tcl_Eval(interp, tlsTclInitScript);
}
@@ -2965,36 +2943,11 @@
OPENSSL_init_ssl(OPENSSL_INIT_LOAD_SSL_STRINGS | OPENSSL_INIT_LOAD_CRYPTO_STRINGS
| OPENSSL_INIT_ADD_ALL_CIPHERS | OPENSSL_INIT_ADD_ALL_DIGESTS, NULL);
BIO_new_tcl(NULL, 0);
-#if 0
- /*
- * XXX:TODO: Remove this code and replace it with a check
- * for enough entropy and do not try to create our own
- * terrible entropy
- */
- /*
- * Seed the random number generator in the SSL library,
- * using the do/while construct because of the bug note in the
- * OpenSSL FAQ at http://www.openssl.org/support/faq.html#USER1
- *
- * The crux of the problem is that Solaris 7 does not have a
- * /dev/random or /dev/urandom device so it cannot gather enough
- * entropy from the RAND_seed() when TLS initializes and refuses
- * to go further. Earlier versions of OpenSSL carried on regardless.
- */
- srand((unsigned int) time((time_t *) NULL));
- do {
- for (i = 0; i < 16; i++) {
- rnd_seed[i] = 1 + (char) (255.0 * rand()/(RAND_MAX+1.0));
- }
- RAND_seed(rnd_seed, sizeof(rnd_seed));
- } while (RAND_status() != 1);
-#endif
-
#if defined(OPENSSL_THREADS) && defined(TCL_THREADS)
Tcl_MutexUnlock(&init_mx);
#endif
return(status);
}
Index: generic/tlsBIO.c
==================================================================
--- generic/tlsBIO.c
+++ generic/tlsBIO.c
@@ -1,9 +1,9 @@
/*
* Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
*
- * Provides BIO layer to interface OpenSSL to TCL.
+ * Provides BIO layer to interface OpenSSL to Tcl.
*/
#include "tlsInt.h"
/* Called by SSL_write() */
@@ -14,39 +14,36 @@
chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
dprintf("[chan=%p] BioWrite(%p, <buf>, %d)", (void *)chan, (void *) bio, bufLen);
- ret = Tcl_WriteRaw(chan, buf, (Tcl_Size) bufLen);
+ ret = Tcl_WriteRaw(chan, buf, (Tcl_Size)bufLen);
tclEofChan = Tcl_Eof(chan);
tclErrno = Tcl_GetErrno();
dprintf("[chan=%p] BioWrite(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
- (void *) chan, bufLen, ret, tclEofChan, tclErrno);
+ (void *) chan, bufLen, ret, tclEofChan, tclErrno);
BIO_clear_flags(bio, BIO_FLAGS_WRITE | BIO_FLAGS_SHOULD_RETRY);
if (tclEofChan && ret <= 0) {
dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
Tcl_SetErrno(ECONNRESET);
ret = 0;
-
} else if (ret == 0) {
dprintf("Got 0 from Tcl_WriteRaw, and EOF is not set; ret = 0");
dprintf("Setting retry read flag");
BIO_set_retry_read(bio);
-
} else if (ret < 0) {
dprintf("We got some kind of I/O error");
if (tclErrno == EAGAIN) {
dprintf("It's EAGAIN");
} else {
dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
}
-
} else {
dprintf("Successfully wrote %" TCL_SIZE_MODIFIER "d bytes of data", ret);
}
if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
@@ -71,39 +68,36 @@
if (buf == NULL) {
return 0;
}
- ret = Tcl_ReadRaw(chan, buf, (Tcl_Size) bufLen);
+ ret = Tcl_ReadRaw(chan, buf, (Tcl_Size)bufLen);
tclEofChan = Tcl_Eof(chan);
tclErrno = Tcl_GetErrno();
dprintf("[chan=%p] BioRead(%d) -> %" TCL_SIZE_MODIFIER "d [tclEof=%d; tclErrno=%d]",
- (void *) chan, bufLen, ret, tclEofChan, tclErrno);
+ (void *) chan, bufLen, ret, tclEofChan, tclErrno);
BIO_clear_flags(bio, BIO_FLAGS_READ | BIO_FLAGS_SHOULD_RETRY);
if (tclEofChan && ret <= 0) {
dprintf("Got EOF while reading, returning a Connection Reset error which maps to Soft EOF");
Tcl_SetErrno(ECONNRESET);
ret = 0;
-
} else if (ret == 0) {
dprintf("Got 0 from Tcl_Read or Tcl_ReadRaw, and EOF is not set; ret = 0");
dprintf("Setting retry read flag");
BIO_set_retry_read(bio);
-
} else if (ret < 0) {
dprintf("We got some kind of I/O error");
if (tclErrno == EAGAIN) {
dprintf("It's EAGAIN");
} else {
dprintf("It's an unexpected error: %s/%i", Tcl_ErrnoMsg(tclErrno), tclErrno);
}
-
} else {
dprintf("Successfully read %" TCL_SIZE_MODIFIER "d bytes of data", ret);
}
if (ret != -1 || (ret == -1 && tclErrno == EAGAIN)) {
@@ -112,34 +106,33 @@
BIO_set_retry_write(bio);
}
}
- dprintf("BioRead(%p, <buf>, %d) [%p] returning %" TCL_SIZE_MODIFIER "d", (void *) bio,
- bufLen, (void *) chan, ret);
+ dprintf("BioRead(%p, <buf>, %d) [%p] returning %" TCL_SIZE_MODIFIER "d",
+ (void *)bio, bufLen, (void *) chan, ret);
- return((int) ret);
+ return (int)ret;
}
static int BioPuts(BIO *bio, const char *str) {
dprintf("BioPuts(%p, <string:%p>) called", bio, str);
- return(BioWrite(bio, str, (int) strlen(str)));
+ return BioWrite(bio, str, (int) strlen(str));
}
static long BioCtrl(BIO *bio, int cmd, long num, void *ptr) {
Tcl_Channel chan;
long ret = 1;
chan = Tls_GetParent((State *) BIO_get_data(bio), 0);
- dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", (void *) bio, cmd, num, ptr);
+ dprintf("BioCtrl(%p, 0x%x, 0x%lx, %p)", bio, cmd, num, ptr);
switch (cmd) {
case BIO_CTRL_RESET:
dprintf("Got BIO_CTRL_RESET");
- num = 0;
ret = 0;
break;
case BIO_C_FILE_SEEK:
dprintf("Got BIO_C_FILE_SEEK");
ret = 0;
@@ -217,23 +210,23 @@
ret = 0;
break;
#endif
default:
dprintf("Got unknown control command (%i)", cmd);
- ret = 0;
+ ret = -2;
break;
}
- return(ret);
+ return ret;
}
static int BioNew(BIO *bio) {
dprintf("BioNew(%p) called", bio);
BIO_set_init(bio, 0);
BIO_set_data(bio, NULL);
BIO_clear_flags(bio, -1);
- return(1);
+ return 1;
}
static int BioFree(BIO *bio) {
if (bio == NULL) {
return(0);
@@ -248,11 +241,11 @@
}
BIO_set_init(bio, 0);
BIO_clear_flags(bio, -1);
}
- return(1);
+ return 1;
}
BIO *BIO_new_tcl(State *statePtr, int flags) {
BIO *bio;
static BIO_METHOD *BioMethods = NULL;
Index: generic/tlsIO.c
==================================================================
--- generic/tlsIO.c
+++ generic/tlsIO.c
@@ -21,11 +21,11 @@
#include <errno.h>
/*
* Forward declarations
*/
-static void TlsChannelHandlerTimer(ClientData clientData);
+static void TlsChannelHandlerTimer(void *clientData);
/*
*-------------------------------------------------------------------
*
* TlsBlockModeProc --
@@ -39,11 +39,11 @@
* Side effects:
* Sets the device into blocking or nonblocking mode.
*
*-------------------------------------------------------------------
*/
-static int TlsBlockModeProc(ClientData instanceData, int mode) {
+static int TlsBlockModeProc(void *instanceData, int mode) {
State *statePtr = (State *) instanceData;
if (mode == TCL_MODE_NONBLOCKING) {
statePtr->flags |= TLS_TCL_ASYNC;
} else {
@@ -69,29 +69,31 @@
* Side effects:
* Closes the socket of the channel.
*
*-------------------------------------------------------------------
*/
-static int TlsCloseProc(ClientData instanceData, Tcl_Interp *interp) {
- State *statePtr = (State *) instanceData;
+static int TlsCloseProc(
+ void *instanceData,
+ TCL_UNUSED(Tcl_Interp *))
+{
+ State *statePtr = (State *)instanceData;
- dprintf("TlsCloseProc(%p)", (void *) statePtr);
+ dprintf("TlsCloseProc(%p)", statePtr);
Tls_Clean(statePtr);
- Tcl_EventuallyFree((ClientData)statePtr, Tls_Free);
- return(0);
+ Tcl_EventuallyFree(statePtr, Tls_Free);
+ return TCL_OK;
}
-static int TlsClose2Proc(ClientData instanceData, /* The socket state. */
+static int TlsClose2Proc(
+ void *instanceData, /* The socket state. */
Tcl_Interp *interp, /* For errors - can be NULL. */
int flags) /* Flags to close read and/or write side of channel */
{
- State *statePtr = (State *) instanceData;
+ dprintf("TlsClose2Proc(%p)", instanceData);
- dprintf("TlsClose2Proc(%p)", (void *) statePtr);
-
- if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
+ if (!(flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE))) {
return TlsCloseProc(instanceData, interp);
}
return EINVAL;
}
@@ -112,11 +114,11 @@
unsigned long backingError;
int err, rc;
int bioShouldRetry;
*errorCodePtr = 0;
- dprintf("WaitForConnect(%p)", (void *) statePtr);
+ dprintf("WaitForConnect(%p)", statePtr);
dprintFlags(statePtr);
if (!(statePtr->flags & TLS_TCL_INIT)) {
dprintf("Tls_WaitForConnect called on already initialized channel -- returning with immediate success");
return(0);
@@ -143,11 +145,10 @@
/* Not initialized yet! Also calls SSL_do_handshake. */
if (statePtr->flags & TLS_TCL_SERVER) {
dprintf("Calling SSL_accept()");
err = SSL_accept(statePtr->ssl);
-
} else {
dprintf("Calling SSL_connect()");
err = SSL_connect(statePtr->ssl);
}
@@ -278,11 +279,11 @@
dprintf("Removing the \"TLS_TCL_INIT\" flag since we have completed the handshake");
statePtr->flags &= ~TLS_TCL_INIT;
dprintf("Returning in success");
*errorCodePtr = 0;
- return(0);
+ return 0;
}
/*
*-------------------------------------------------------------------
*
@@ -298,11 +299,17 @@
* Side effects:
* Reads input from the input device of the channel.
*
*-------------------------------------------------------------------
*/
-static int TlsInputProc(ClientData instanceData, char *buf, int bufSize, int *errorCodePtr) {
+
+static int TlsInputProc(
+ void *instanceData,
+ char *buf,
+ int bufSize,
+ int *errorCodePtr)
+{
unsigned long backingError;
State *statePtr = (State *) instanceData;
int bytesRead;
int tlsConnect;
int err;
@@ -434,11 +441,11 @@
Tls_Error(statePtr, "Unknown error");
break;
}
dprintf("Input(%d) -> %d [%d]", bufSize, bytesRead, *errorCodePtr);
- return(bytesRead);
+ return bytesRead;
}
/*
*-------------------------------------------------------------------
*
@@ -454,11 +461,17 @@
* Side effects:
* Writes output on the output device of the channel.
*
*-------------------------------------------------------------------
*/
-static int TlsOutputProc(ClientData instanceData, const char *buf, int toWrite, int *errorCodePtr) {
+
+static int TlsOutputProc(
+ void *instanceData,
+ const char *buf,
+ int toWrite,
+ int *errorCodePtr)
+{
unsigned long backingError;
State *statePtr = (State *) instanceData;
int written, err;
int tlsConnect;
@@ -523,42 +536,36 @@
written = BIO_write(statePtr->bio, buf, toWrite);
dprintf("BIO_write(%p, %d) -> [%d]", (void *) statePtr, toWrite, written);
err = SSL_get_error(statePtr->ssl, written);
backingError = ERR_get_error();
-
switch (err) {
case SSL_ERROR_NONE:
if (written < 0) {
written = 0;
}
break;
-
case SSL_ERROR_WANT_WRITE:
dprintf("Got SSL_ERROR_WANT_WRITE, mapping it to EAGAIN");
*errorCodePtr = EAGAIN;
written = -1;
Tls_Error(statePtr, "SSL_ERROR_WANT_WRITE");
break;
-
case SSL_ERROR_WANT_READ:
dprintf(" write R BLOCK");
Tls_Error(statePtr, "SSL_ERROR_WANT_READ");
break;
-
case SSL_ERROR_WANT_X509_LOOKUP:
dprintf(" write X BLOCK");
Tls_Error(statePtr, "SSL_ERROR_WANT_X509_LOOKUP");
break;
-
case SSL_ERROR_ZERO_RETURN:
dprintf(" closed");
written = 0;
*errorCodePtr = 0;
Tls_Error(statePtr, "Peer has closed the connection for writing by sending the close_notify alert");
break;
-
case SSL_ERROR_SYSCALL:
/* Some non-recoverable, fatal I/O error occurred */
if (backingError == 0 && written == 0) {
dprintf("EOF reached")
@@ -591,11 +598,10 @@
Tls_Error(statePtr, "Unknown SSL error");
}
*errorCodePtr = ECONNABORTED;
written = -1;
break;
-
default:
dprintf("unknown error: %d", err);
Tls_Error(statePtr, "Unknown error");
break;
}
@@ -619,11 +625,11 @@
* Updates channel option to new value.
*
*-------------------------------------------------------------------
*/
static int
-TlsSetOptionProc(ClientData instanceData, /* Socket state. */
+TlsSetOptionProc(void *instanceData, /* Socket state. */
Tcl_Interp *interp, /* For errors - can be NULL. */
const char *optionName, /* Name of the option to set the value for, or
* NULL to get all options and their values. */
const char *optionValue) /* Value for option. */
{
@@ -664,11 +670,12 @@
* None.
*
*-------------------------------------------------------------------
*/
static int
-TlsGetOptionProc(ClientData instanceData, /* Socket state. */
+TlsGetOptionProc(
+ void *instanceData, /* Socket state. */
Tcl_Interp *interp, /* For errors - can be NULL. */
const char *optionName, /* Name of the option to retrieve the value for, or
* NULL to get all options and their values. */
Tcl_DString *optionValue) /* Where to store the computed value initialized by caller. */
{
@@ -706,12 +713,14 @@
* Sets up the notifier so that a future event on the channel
* will be seen by Tcl.
*
*-------------------------------------------------------------------
*/
+
static void
-TlsWatchProc(ClientData instanceData, /* The socket state. */
+TlsWatchProc(
+ void *instanceData, /* The socket state. */
int mask) /* Events of interest; an OR-ed combination of
* TCL_READABLE, TCL_WRITABLE and TCL_EXCEPTION. */
{
Tcl_Channel downChan;
State *statePtr = (State *) instanceData;
@@ -768,11 +777,11 @@
/*
* There is interest in readable events and we actually have
* data waiting, so generate a timer to flush that.
*/
dprintf("Creating a new timer since data appears to be waiting");
- statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, (ClientData) statePtr);
+ statePtr->timer = Tcl_CreateTimerHandler(TLS_TCL_DELAY, TlsChannelHandlerTimer, statePtr);
}
}
/*
*-------------------------------------------------------------------
@@ -788,15 +797,16 @@
* Side effects:
* None.
*
*-------------------------------------------------------------------
*/
-static int TlsGetHandleProc(ClientData instanceData, /* Socket state. */
+static int TlsGetHandleProc(
+ void *instanceData, /* Socket state. */
int direction, /* TCL_READABLE or TCL_WRITABLE */
- ClientData *handlePtr) /* Handle associated with the channel */
+ void **handlePtr) /* Handle associated with the channel */
{
- State *statePtr = (State *) instanceData;
+ State *statePtr = (State *)instanceData;
return(Tcl_GetChannelHandle(Tls_GetParent(statePtr, TLS_TCL_FASTPATH), direction, handlePtr));
}
/*
@@ -813,15 +823,17 @@
* Side effects:
* May process the incoming event by itself.
*
*-------------------------------------------------------------------
*/
-static int TlsNotifyProc(ClientData instanceData, /* Socket state. */
+
+static int TlsNotifyProc(
+ void *instanceData, /* Socket state. */
int mask) /* type of event that occurred:
* OR-ed combination of TCL_READABLE or TCL_WRITABLE */
{
- State *statePtr = (State *) instanceData;
+ State *statePtr = (State *)instanceData;
int errorCode;
/*
* An event occurred in the underlying channel. This
* transformation doesn't process such events thus returns the
@@ -878,11 +890,11 @@
* Result:
* None.
*
*------------------------------------------------------*
*/
-static void TlsChannelHandlerTimer(ClientData clientData) {
+static void TlsChannelHandlerTimer(void *clientData) {
State *statePtr = (State *) clientData;
int mask = 0;
dprintf("Called");
@@ -937,22 +949,22 @@
"tls", /* Type name */
TCL_CHANNEL_VERSION_5, /* v5 channel */
TlsCloseProc, /* Close proc */
TlsInputProc, /* Input proc */
TlsOutputProc, /* Output proc */
- NULL, /* Seek proc */
+ 0, /* Seek proc */
TlsSetOptionProc, /* Set option proc */
TlsGetOptionProc, /* Get option proc */
TlsWatchProc, /* Initialize notifier */
TlsGetHandleProc, /* Get OS handles out of channel */
TlsClose2Proc, /* close2proc */
TlsBlockModeProc, /* Set blocking/nonblocking mode*/
- NULL, /* Flush proc */
+ 0, /* Flush proc */
TlsNotifyProc, /* Handling of events bubbling up */
- NULL, /* Wide seek proc */
+ 0, /* Wide seek proc */
NULL, /* Thread action */
NULL /* Truncate */
};
const Tcl_ChannelType *Tls_ChannelType(void) {
return &tlsChannelType;
}
Index: generic/tlsInt.h
==================================================================
--- generic/tlsInt.h
+++ generic/tlsInt.h
@@ -164,11 +164,11 @@
BIO *p_bio; /* Parent BIO (that is layered on Tcl_Channel) */
unsigned char *protos; /* List of supported protocols in protocol format */
unsigned int protos_len; /* Length of protos */
- char *err;
+ const char *err;
} State;
#ifdef USE_TCL_STUBS
#ifndef Tcl_StackChannel
#error "Unable to compile on this version of Tcl"
Index: generic/tlsX509.c
==================================================================
--- generic/tlsX509.c
+++ generic/tlsX509.c
@@ -369,11 +369,14 @@
*
*------------------------------------------------------*
*/
Tcl_Obj*
-Tls_NewX509Obj(Tcl_Interp *interp, X509 *cert) {
+Tls_NewX509Obj(
+ Tcl_Interp *interp,
+ X509 *cert)
+{
Tcl_Obj *certPtr = Tcl_NewListObj(0, NULL);
BIO *bio = BIO_new(BIO_s_mem());
int mdnid, pknid, bits, len;
unsigned int ulen;
uint32_t xflags;