@@ -111,12 +111,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); @@ -135,12 +135,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; } /* *------------------------------------------------------------------- @@ -156,15 +156,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; @@ -536,12 +537,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) { @@ -551,11 +552,11 @@ 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) { Tcl_Size len; char *ret = (char *) Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len); @@ -562,14 +563,14 @@ 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; } /* *------------------------------------------------------------------- @@ -951,19 +952,24 @@ 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 *cp, buf[BUFSIZ]; + const char *cp; + 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?"); @@ -1105,13 +1111,16 @@ * 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, ""); @@ -1159,17 +1168,21 @@ * 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"); @@ -1245,11 +1258,16 @@ * 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; @@ -1276,11 +1294,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; @@ -1300,20 +1317,22 @@ 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 */ + /* + * Make sure to operate on the topmost channel + */ chan = Tcl_GetTopChannel(chan); for (idx = 2; idx < objc; idx++) { - char *opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL); + char *opt = Tcl_GetString(objv[idx]); if (opt[0] != '-') break; OPTOBJ("-alpn", alpn); @@ -1412,11 +1431,11 @@ if (model != NULL) { int mode; /* Get the "model" context */ chan = Tcl_GetChannel(interp, model, &mode); if (chan == (Tcl_Channel) NULL) { - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } /* * Make sure to operate on the topmost channel @@ -1424,18 +1443,18 @@ 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((char *) statePtr); + 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((char *) statePtr); + Tls_Free((void *) statePtr); return TCL_ERROR; } } statePtr->ctx = ctx; @@ -1455,18 +1474,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((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation)); Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding)); @@ -1483,11 +1501,11 @@ 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((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } /* Set host server name */ if (servername) { @@ -1494,20 +1512,20 @@ /* 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((char *) statePtr); + 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); - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } } /* Resume session id */ @@ -1514,11 +1532,11 @@ 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); - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } } /* Enable Application-Layer Protocol Negotiation. Examples are: http/1.0, @@ -1530,21 +1548,21 @@ Tcl_Size cnt, i; int j; Tcl_Obj **list; if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) { - Tls_Free((char *) statePtr); + Tls_Free((void *)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((char *) statePtr); + Tls_Free((void *)statePtr); return TCL_ERROR; } protos_len += 1 + (int) len; } @@ -1561,11 +1579,11 @@ /* 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); - Tls_Free((char *) statePtr); + Tls_Free((void *)statePtr); ckfree(protos); return TCL_ERROR; } /* Store protocols list */ @@ -1668,13 +1686,17 @@ * 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"); @@ -1684,16 +1706,18 @@ 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 */ + /* + * 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); + "\": 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) { @@ -1721,11 +1745,10 @@ 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; - Tcl_DString ds1; int off = 0, abort = 0; int load_private_key; const SSL_METHOD *method; dprintf("Called"); @@ -2077,21 +2100,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"); @@ -2202,19 +2229,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); } @@ -2440,21 +2471,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; } /* *------------------------------------------------------------------- @@ -2468,25 +2501,30 @@ * 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?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0, &cmd) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], commands, + "command", 0,&cmd) != TCL_OK) { return TCL_ERROR; } ERR_clear_error(); @@ -2496,16 +2534,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; @@ -2690,11 +2727,16 @@ * Frees all the state * *------------------------------------------------------------------- */ void -Tls_Free(char *blockPtr) { +#if TCL_MAJOR_VERSION > 8 +Tls_Free( void *blockPtr ) +#else +Tls_Free( char *blockPtr ) +#endif +{ State *statePtr = (State *)blockPtr; dprintf("Called"); Tls_Clean(statePtr); @@ -2806,19 +2848,19 @@ if (TlsLibInit(0) != TCL_OK) { 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); if (interp) { Tcl_Eval(interp, tlsTclInitScript); } @@ -2841,10 +2883,11 @@ * Result: * A standard Tcl error code. * *------------------------------------------------------* */ + DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) { dprintf("Called"); return(Tls_Init(interp)); } @@ -2948,10 +2991,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); }