Index: generic/tls.c ================================================================== --- generic/tls.c +++ generic/tls.c @@ -39,11 +39,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, @@ -109,12 +109,12 @@ EvalCallback(Tcl_Interp *interp, State *statePtr, Tcl_Obj *cmdPtr) { int code, ok = 0; dprintf("Called"); - Tcl_Preserve((ClientData) interp); - Tcl_Preserve((ClientData) statePtr); + Tcl_Preserve((void *) interp); + Tcl_Preserve((void *) statePtr); /* Eval callback with success for ok or return value 1, fail for error or return value 0 */ Tcl_ResetResult(interp); code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); dprintf("EvalCallback: %d", code); @@ -133,12 +133,12 @@ #else Tcl_BackgroundException(interp, code); #endif } - Tcl_Release((ClientData) statePtr); - Tcl_Release((ClientData) interp); + Tcl_Release((void *) statePtr); + Tcl_Release((void *) interp); return ok; } /* *------------------------------------------------------------------- @@ -154,15 +154,16 @@ * Calls callback (if defined) * *------------------------------------------------------------------- */ static void -InfoCallback(const SSL *ssl, int where, int ret) { +InfoCallback(const SSL *ssl, int where, int ret) +{ State *statePtr = (State*)SSL_get_app_data((SSL *)ssl); Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; - char *major; char *minor; + const char *major, *minor; dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return; @@ -363,11 +364,12 @@ * to a string describing the SSL negotiation failure reason * *------------------------------------------------------------------- */ static int -VerifyCallback(int ok, X509_STORE_CTX *ctx) { +VerifyCallback(int ok, X509_STORE_CTX *ctx) +{ Tcl_Obj *cmdPtr; SSL *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx()); X509 *cert = X509_STORE_CTX_get_current_cert(ctx); State *statePtr = (State*)SSL_get_app_data(ssl); Tcl_Interp *interp = statePtr->interp; @@ -539,12 +541,12 @@ cmdPtr = Tcl_DuplicateObj(statePtr->password); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("password", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(rwflag)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(size)); - Tcl_Preserve((ClientData) interp); - Tcl_Preserve((ClientData) statePtr); + Tcl_Preserve((void *) interp); + Tcl_Preserve((void *) statePtr); /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { @@ -554,24 +556,24 @@ Tcl_BackgroundException(interp, code); #endif } Tcl_DecrRefCount(cmdPtr); - Tcl_Release((ClientData) statePtr); + Tcl_Release((void *) statePtr); /* If successful, pass back password string and truncate if too long */ if (code == TCL_OK) { char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len); if (len > (Tcl_Size) size-1) { len = (Tcl_Size) size-1; } strncpy(buf, ret, (size_t) len); buf[len] = '\0'; - Tcl_Release((ClientData) interp); + Tcl_Release((void *) interp); return (int) len; } - Tcl_Release((ClientData) interp); + Tcl_Release((void *) interp); return -1; } /* *------------------------------------------------------------------- @@ -948,26 +950,30 @@ * 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 }; static int -CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +CiphersObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ Tcl_Obj *objPtr = NULL; SSL_CTX *ctx = NULL; SSL *ssl = NULL; STACK_OF(SSL_CIPHER) *sk; char buf[BUFSIZ]; int index, verbose = 0, use_supported = 0; const SSL_METHOD *method; - (void) clientData; dprintf("Called"); if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?"); @@ -984,69 +990,69 @@ } ERR_clear_error(); switch ((enum protocol)index) { - case TLS_SSL2: + case TLS_SSL2: #if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)NULL); + return TCL_ERROR; #else - method = SSLv2_method(); break; + method = SSLv2_method(); break; #endif - case TLS_SSL3: + case TLS_SSL3: #if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *)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", (char *) 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", (char *) 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", (char *) 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", (char *) 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(), (char *) 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(), (char *) 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 */ @@ -1065,11 +1071,11 @@ if (c == NULL) continue; /* cipher name or (NONE) */ cp = SSL_CIPHER_get_name(c); if (cp == NULL) break; - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *) cp, -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1)); } } else { objPtr = Tcl_NewStringObj("",0); for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) { @@ -1109,14 +1115,18 @@ * Side effects: * none * *------------------------------------------------------------------- */ + static int -ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +ProtocolsObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) { Tcl_Obj *objPtr; - (void) clientData; dprintf("Called"); if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); @@ -1164,17 +1174,22 @@ * Side effects: * May force SSL negotiation to take place. * *------------------------------------------------------------------- */ -static int HandshakeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { + +static int HandshakeObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ Tcl_Channel chan; /* The channel to set a mode on. */ State *statePtr; /* client state for ssl socket */ const char *errStr = NULL; int ret = 1; int err = 0; - (void) clientData; dprintf("Called"); if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); @@ -1190,12 +1205,12 @@ /* 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", (char *) 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"); @@ -1213,15 +1228,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); @@ -1249,12 +1264,18 @@ * Side effects: * May modify the behavior of an IO channel. * *------------------------------------------------------------------- */ + static int -ImportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +ImportObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ Tcl_Channel chan; /* The channel to set a mode on. */ State *statePtr; /* client state for ssl socket */ SSL_CTX *ctx = NULL; Tcl_Obj *script = NULL; Tcl_Obj *password = NULL; @@ -1281,11 +1302,10 @@ Tcl_Obj *alpn = NULL; int ssl2 = 0, ssl3 = 0; int tls1 = 1, tls1_1 = 1, tls1_2 = 1, tls1_3 = 1; int proto = 0, level = -1; int verify = 0, require = 0, request = 1, post_handshake = 0; - (void) clientData; dprintf("Called"); #if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) tls1 = 0; @@ -1353,14 +1373,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); @@ -1417,30 +1437,30 @@ if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel(interp, model, &mode); if (chan == (Tcl_Channel) NULL) { - Tls_Free((tls_free_type *) statePtr); + Tls_Free((tls_free_type *)statePtr); 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", (char *) NULL); - Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *) NULL); - Tls_Free((tls_free_type *) statePtr); + "\": not a TLS channel", (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "IMPORT", "CHANNEL", "INVALID", (char *)NULL); + Tls_Free((tls_free_type *)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((tls_free_type *) statePtr); + if ((ctx = CTX_Init(statePtr, server, proto, keyfile, certfile, key, cert, key_len, + cert_len, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) { + Tls_Free((tls_free_type *)statePtr); return TCL_ERROR; } } statePtr->ctx = ctx; @@ -1460,18 +1480,17 @@ Tcl_GetChannelOption(interp, chan, "-translation", &upperChannelTranslation); Tcl_GetChannelOption(interp, chan, "-blocking", &upperChannelBlocking); Tcl_SetChannelOption(interp, chan, "-translation", "binary"); Tcl_SetChannelOption(interp, chan, "-blocking", "true"); dprintf("Consuming Tcl channel %s", Tcl_GetChannelName(chan)); - statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), (ClientData) statePtr, - (TCL_READABLE | TCL_WRITABLE), chan); + statePtr->self = Tcl_StackChannel(interp, Tls_ChannelType(), statePtr, (TCL_READABLE | TCL_WRITABLE), chan); dprintf("Created channel named %s", Tcl_GetChannelName(statePtr->self)); if (statePtr->self == (Tcl_Channel) NULL) { /* * No use of Tcl_EventuallyFree because no possible Tcl_Preserve. */ - Tls_Free((tls_free_type *) statePtr); + Tls_Free((tls_free_type *)statePtr); return TCL_ERROR; } Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation)); Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding)); @@ -1486,45 +1505,45 @@ * 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); - Tls_Free((tls_free_type *) statePtr); + Tcl_AppendResult(interp, "couldn't construct ssl session: ", GET_ERR_REASON(), (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "IMPORT", "INIT", "FAILED", (char *)NULL); + Tls_Free((tls_free_type *)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); - Tls_Free((tls_free_type *) statePtr); + Tcl_AppendResult(interp, "Set SNI extension failed: ", GET_ERR_REASON(), (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SNI", "FAILED", (char *)NULL); + Tls_Free((tls_free_type *)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); - Tls_Free((tls_free_type *) statePtr); + Tcl_AppendResult(interp, "Set DNS hostname failed: ", GET_ERR_REASON(), (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "IMPORT", "HOSTNAME", "FAILED", (char *)NULL); + Tls_Free((tls_free_type *)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), (const unsigned char *) 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); - Tls_Free((tls_free_type *) statePtr); + Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *)NULL); + Tls_Free((tls_free_type *)statePtr); return TCL_ERROR; } } /* Enable Application-Layer Protocol Negotiation. Examples are: http/1.0, @@ -1536,21 +1555,21 @@ Tcl_Size cnt, i; int j; Tcl_Obj **list; if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) { - Tls_Free((tls_free_type *) statePtr); + Tls_Free((tls_free_type *)statePtr); return TCL_ERROR; } /* 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); - Tls_Free((tls_free_type *) statePtr); + Tcl_AppendResult(interp, "ALPN protocol names too long", (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL); + Tls_Free((tls_free_type *)statePtr); return TCL_ERROR; } protos_len += 1 + (int) len; } @@ -1565,13 +1584,13 @@ } /* SSL_set_alpn_protos makes a copy of the protocol-list */ /* Note: This function 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); - Tls_Free((tls_free_type *) statePtr); + Tcl_AppendResult(interp, "Set ALPN protocols failed: ", GET_ERR_REASON(), (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "IMPORT", "ALPN", "FAILED", (char *)NULL); + Tls_Free((tls_free_type *)statePtr); ckfree(protos); return TCL_ERROR; } /* Store protocols list */ @@ -1653,12 +1672,11 @@ /* * End of SSL Init */ dprintf("Returning %s", Tcl_GetChannelName(statePtr->self)); - Tcl_SetResult(interp, (char *) Tcl_GetChannelName(statePtr->self), TCL_VOLATILE); - + Tcl_SetResult(interp, (char *)Tcl_GetChannelName(statePtr->self), TCL_VOLATILE); return TCL_OK; } /* *------------------------------------------------------------------- @@ -1673,14 +1691,19 @@ * Side effects: * May modify the behavior of an IO channel. * *------------------------------------------------------------------- */ + static int -UnimportObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +UnimportObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ Tcl_Channel chan; /* The channel to set a mode on. */ - (void) clientData; dprintf("Called"); if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); @@ -1695,12 +1718,12 @@ /* 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", (char *) NULL); - Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *) NULL); + "\": not a TLS channel", (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "UNIMPORT", "CHANNEL", "INVALID", (char *)NULL); return TCL_ERROR; } if (Tcl_UnstackChannel(interp, chan) == TCL_ERROR) { return TCL_ERROR; @@ -1720,14 +1743,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; @@ -1734,48 +1772,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", (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); + 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); + 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); + 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); + 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); + 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); + Tcl_AppendResult(interp, "TLS 1.3 protocol not supported", (char *)NULL); return NULL; } #endif if (proto == 0) { /* Use full range */ @@ -1864,11 +1902,11 @@ #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_app_data(ctx, 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. */ @@ -1875,16 +1913,16 @@ #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 */ @@ -1899,11 +1937,11 @@ /* read a Diffie-Hellman parameters file, or use the built-in one */ Tcl_DStringInit(&ds); #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 { @@ -1912,30 +1950,29 @@ 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; } } } @@ -1947,31 +1984,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 } } @@ -1991,30 +2028,29 @@ 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); + (char *)NULL); SSL_CTX_free(ctx); return NULL; } } @@ -2086,21 +2122,25 @@ * None. * *------------------------------------------------------------------- */ static int -StatusObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +StatusObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ State *statePtr; X509 *peer; Tcl_Obj *objPtr; Tcl_Channel chan; char *channelName, *ciphers; int mode; const unsigned char *proto; unsigned int len; int nid, res; - (void) clientData; dprintf("Called"); if (objc < 2 || objc > 3 || (objc == 3 && !strcmp(Tcl_GetString(objv[1]), "-local"))) { Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel"); @@ -2116,12 +2156,12 @@ /* 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", (char *) NULL); - Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *) NULL); + "\": not a TLS channel", (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 */ @@ -2211,19 +2251,23 @@ * A list of connection info * *------------------------------------------------------------------- */ -static int ConnectionInfoObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +static int ConnectionInfoObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ Tcl_Channel chan; /* The channel to set a mode on */ State *statePtr; /* client state for ssl socket */ Tcl_Obj *objPtr, *listPtr; const SSL *ssl; const SSL_CIPHER *cipher; const SSL_SESSION *session; const EVP_MD *md; - (void) clientData; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return TCL_ERROR; } @@ -2235,12 +2279,12 @@ /* 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", (char *) NULL); - Tcl_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *) NULL); + "\": not a TLS channel", (char *)NULL); + Tcl_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *)NULL); return TCL_ERROR; } objPtr = Tcl_NewListObj(0, NULL); @@ -2449,21 +2493,23 @@ * None. * *------------------------------------------------------------------- */ static int -VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +VersionObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, + TCL_UNUSED(int) /* objc */, + TCL_UNUSED(Tcl_Obj *const *) /* objv */) +{ Tcl_Obj *objPtr; - (void) clientData; - (void) objc; - (void) objv; dprintf("Called"); objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); - Tcl_SetObjResult(interp, objPtr); + Tcl_SetObjResult(interp, objPtr); return TCL_OK; } /* *------------------------------------------------------------------- @@ -2477,17 +2523,21 @@ * None. * *------------------------------------------------------------------- */ static int -MiscObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { +MiscObjCmd( + TCL_UNUSED(void *), + 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; char buffer[16384]; - (void) clientData; dprintf("Called"); if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?args?"); @@ -2505,16 +2555,15 @@ case C_STRREQ: { EVP_PKEY *pkey=NULL; X509 *cert=NULL; X509_NAME *name=NULL; Tcl_Obj **listv; - Tcl_Size listc; - int i; + Tcl_Size listc,i; BIO *out=NULL; - char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email=""; + const char *k_C="",*k_ST="",*k_L="",*k_O="",*k_OU="",*k_CN="",*k_Email=""; char *keyout,*pemout,*str; int keysize,serial=0,days=365; #if OPENSSL_VERSION_NUMBER < 0x30000000L BIGNUM *bne = NULL; @@ -2584,11 +2633,11 @@ !RSA_generate_key_ex(rsa, keysize, bne, NULL) || !EVP_PKEY_assign_RSA(pkey, rsa)) { EVP_PKEY_free(pkey); /* RSA_free(rsa); freed by EVP_PKEY_free */ BN_free(bne); #else - pkey = EVP_RSA_gen((unsigned int) keysize); + pkey = EVP_RSA_gen((unsigned int)keysize); ctx = EVP_PKEY_CTX_new(pkey,NULL); if (pkey == NULL || ctx == NULL || !EVP_PKEY_keygen_init(ctx) || !EVP_PKEY_CTX_set_rsa_keygen_bits(ctx, keysize) || !EVP_PKEY_keygen(ctx, &pkey)) { EVP_PKEY_free(pkey); EVP_PKEY_CTX_free(ctx); @@ -2896,23 +2945,23 @@ if (Tcl_PkgRequire(interp, "Tcl", MIN_VERSION, 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, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "::tls::connection", ConnectionInfoObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "::tls::handshake", HandshakeObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "::tls::import", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "::tls::unimport", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "::tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "::tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "::tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "::tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + 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); BuildInfoCommand(interp); if (interp && Tcl_Eval(interp, tlsTclInitScript) != TCL_OK) { return TCL_ERROR; @@ -2937,10 +2986,11 @@ * Result: * A standard Tcl error code. * *------------------------------------------------------* */ + DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) { dprintf("Called"); return Tls_Init(interp); } @@ -3044,10 +3094,10 @@ RAND_seed(rnd_seed, sizeof(rnd_seed)); } while (RAND_status() != 1); #endif #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - Tcl_MutexUnlock(&init_mx); + Tcl_MutexUnlock(&init_mx); #endif return status; } Index: generic/tlsInt.h ================================================================== --- generic/tlsInt.h +++ generic/tlsInt.h @@ -36,17 +36,10 @@ # else # define CONST86 # endif #endif -/* - * Backwards compatibility for size type change - */ -#if TCL_MAJOR_VERSION < 9 && TCL_MINOR_VERSION < 7 - #define TCL_SIZE_MODIFIER "" -#endif - #include #include #include #include @@ -171,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" @@ -185,10 +178,29 @@ #if TCL_MAJOR_VERSION < 9 typedef char tls_free_type; #else typedef void tls_free_type; #endif + +#ifndef JOIN +# define JOIN(a,b) JOIN1(a,b) +# define JOIN1(a,b) a##b +#endif + +#ifndef TCL_UNUSED +# if defined(__cplusplus) +# define TCL_UNUSED(T) T +# elif defined(__GNUC__) && (__GNUC__ > 2) +# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused)) +# else +# define TCL_UNUSED(T) T JOIN(dummy, __LINE__) +# endif +#endif + +#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7) && !defined(TCL_SIZE_MODIFIER) +# define TCL_SIZE_MODIFIER "" +#endif /* * Forward declarations */ const Tcl_ChannelType *Tls_ChannelType(void);