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 * - * 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, , %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, , %d) [%p] returning %" TCL_SIZE_MODIFIER "d", (void *) bio, - bufLen, (void *) chan, ret); + dprintf("BioRead(%p, , %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, ) 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 /* * 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;