@@ -93,10 +93,14 @@ static int locksCount = 0; static Tcl_Mutex init_mx; #endif /* OPENSSL_THREADS */ #endif /* TCL_THREADS */ +/********************/ +/* Callbacks */ +/********************/ + /* *------------------------------------------------------------------- * * InfoCallback -- @@ -111,10 +115,11 @@ *------------------------------------------------------------------- */ static void 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; dprintf("Called"); @@ -149,36 +154,36 @@ else if (where & SSL_CB_LOOP) minor = "loop"; else if (where & SSL_CB_EXIT) minor = "exit"; else minor = "unknown"; } - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj("info", -1)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(major, -1)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(minor, -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(major, -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(minor, -1)); if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) { - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(SSL_state_string_long(ssl), -1)); } else if (where & SSL_CB_ALERT) { const char *cp = (char *) SSL_alert_desc_string_long(ret); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(cp, -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(cp, -1)); } else { - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(SSL_state_string_long(ssl), -1)); } - Tcl_Preserve((ClientData) statePtr->interp); + Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); Tcl_IncrRefCount(cmdPtr); - (void) Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL); + (void) Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) statePtr); - Tcl_Release((ClientData) statePtr->interp); + Tcl_Release((ClientData) interp); } /* *------------------------------------------------------------------- * @@ -205,10 +210,11 @@ char *errStr, *string; int length; 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; int depth = X509_STORE_CTX_get_error_depth(ctx); int err = X509_STORE_CTX_get_error(ctx); int code; dprintf("Verify: %d", ok); @@ -226,44 +232,44 @@ return 1; } } cmdPtr = Tcl_DuplicateObj(statePtr->callback); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj("verify", -1)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewIntObj(depth)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tls_NewX509Obj(statePtr->interp, cert)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewIntObj(ok)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, Tcl_NewStringObj(errStr ? errStr : "", -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(depth)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tls_NewX509Obj(interp, cert)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(ok)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(errStr ? errStr : "", -1)); - Tcl_Preserve((ClientData) statePtr->interp); + Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); statePtr->flags |= TLS_TCL_CALLBACK; Tcl_IncrRefCount(cmdPtr); - code = Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL); + code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { /* It got an error - reject the certificate. */ #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) - Tcl_BackgroundError(statePtr->interp); + Tcl_BackgroundError(interp); #else - Tcl_BackgroundException(statePtr->interp, code); + Tcl_BackgroundException(interp, code); #endif ok = 0; } else { - result = Tcl_GetObjResult(statePtr->interp); + result = Tcl_GetObjResult(interp); string = Tcl_GetStringFromObj(result, &length); /* An empty result leaves verification unchanged. */ if (string != NULL && length > 0) { - code = Tcl_GetIntFromObj(statePtr->interp, result, &ok); + code = Tcl_GetIntFromObj(interp, result, &ok); if (code != TCL_OK) { #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) - Tcl_BackgroundError(statePtr->interp); + Tcl_BackgroundError(interp); #else - Tcl_BackgroundException(statePtr->interp, code); + Tcl_BackgroundException(interp, code); #endif ok = 0; } } } @@ -270,11 +276,11 @@ Tcl_DecrRefCount(cmdPtr); statePtr->flags &= ~(TLS_TCL_CALLBACK); Tcl_Release((ClientData) statePtr); - Tcl_Release((ClientData) statePtr->interp); + Tcl_Release((ClientData) interp); return(ok); /* By default, leave verification unchanged. */ } /* *------------------------------------------------------------------- @@ -289,62 +295,70 @@ * to a string describing the SSL negotiation failure reason *------------------------------------------------------------------- */ void Tls_Error(State *statePtr, char *msg) { + Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int code; dprintf("Called"); if (msg && *msg) { - Tcl_SetErrorCode(statePtr->interp, "SSL", msg, (char *)NULL); + Tcl_SetErrorCode(interp, "SSL", msg, (char *)NULL); } else { - msg = Tcl_GetStringFromObj(Tcl_GetObjResult(statePtr->interp), NULL); + msg = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), NULL); } statePtr->err = msg; if (statePtr->callback == (Tcl_Obj*)NULL) { char buf[BUFSIZ]; sprintf(buf, "SSL channel \"%s\": error: %s", Tcl_GetChannelName(statePtr->self), msg); - Tcl_SetResult(statePtr->interp, buf, TCL_VOLATILE); + Tcl_SetResult(interp, buf, TCL_VOLATILE); #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) - Tcl_BackgroundError(statePtr->interp); + Tcl_BackgroundError(interp); #else - Tcl_BackgroundException(statePtr->interp, TCL_ERROR); + Tcl_BackgroundException(interp, TCL_ERROR); #endif return; } cmdPtr = Tcl_DuplicateObj(statePtr->callback); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, - Tcl_NewStringObj("error", -1)); - - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1)); - Tcl_ListObjAppendElement(statePtr->interp, cmdPtr, - Tcl_NewStringObj(msg, -1)); - - Tcl_Preserve((ClientData) statePtr->interp); + Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); Tcl_IncrRefCount(cmdPtr); - code = Tcl_EvalObjEx(statePtr->interp, cmdPtr, TCL_EVAL_GLOBAL); + code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) - Tcl_BackgroundError(statePtr->interp); + Tcl_BackgroundError(interp); #else - Tcl_BackgroundException(statePtr->interp, code); + Tcl_BackgroundException(interp, code); #endif } Tcl_DecrRefCount(cmdPtr); Tcl_Release((ClientData) statePtr); - Tcl_Release((ClientData) statePtr->interp); + Tcl_Release((ClientData) interp); } +/* + *------------------------------------------------------------------- + * + * KeyLogCallback -- + * + * Write received key data to log file. + * + * Side effects: + * none + *------------------------------------------------------------------- + */ void KeyLogCallback(const SSL *ssl, const char *line) { char *str = getenv(SSLKEYLOGFILE); FILE *fd; if (str) { fd = fopen(str, "a"); @@ -448,11 +462,10 @@ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "session", -1)); /* Session id */ - session = SSL_get_session(statePtr->ssl); session_id = SSL_SESSION_get0_id_context(session, &len); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(session_id, len)); /* Session ticket */ SSL_SESSION_get0_ticket(session, &ticket, &len2); @@ -479,10 +492,14 @@ Tcl_Release((ClientData) statePtr); Tcl_Release((ClientData) interp); return 1; } +/********************/ +/* Commands */ +/********************/ + /* *------------------------------------------------------------------- * * CiphersObjCmd -- list available ciphers * @@ -722,13 +739,11 @@ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return(TCL_ERROR); } - /* - * Make sure to operate on the topmost channel - */ + /* 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); return(TCL_ERROR); } @@ -843,13 +858,11 @@ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } - /* - * Make sure to operate on the topmost channel - */ + /* Make sure to operate on the topmost channel */ chan = Tcl_GetTopChannel(chan); for (idx = 2; idx < objc; idx++) { char *opt = Tcl_GetStringFromObj(objv[idx], NULL); @@ -1128,13 +1141,11 @@ 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); @@ -1519,13 +1530,11 @@ chan = Tcl_GetChannel(interp, channelName, &mode); 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); return TCL_ERROR; @@ -1606,46 +1615,60 @@ chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL), NULL); if (chan == (Tcl_Channel) NULL) { return(TCL_ERROR); } - /* - * Make sure to operate on the topmost channel - */ + /* 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); return(TCL_ERROR); } objPtr = Tcl_NewListObj(0, NULL); - /* Get connection state */ + /* Connection info */ statePtr = (State *)Tcl_GetChannelInstanceData(chan); ssl = statePtr->ssl; - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("state", -1)); - if (SSL_is_init_finished(ssl)) { - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("established", -1)); - } else if (SSL_in_init(ssl)) { - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("handshake", -1)); - } else { - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("initializing", -1)); - } - - /* Get server name */ - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("servername", -1)); - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1)); - - /* Get protocol */ - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1)); - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1)); - - /* Get security level */ - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("securitylevel", -1)); - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_security_level(ssl))); - - /* Get cipher */ + if (ssl != NULL) { + const char *state; + + /* connection state */ + if (SSL_is_init_finished(ssl)) { + state = "established"; + } else if (SSL_in_init(ssl)) { + state = "handshake"; + } else { + state = "initializing"; + } + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("state", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(state, -1)); + + /* Get server name */ + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("servername", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name), -1)); + + /* Get protocol */ + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("protocol", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_version(ssl), -1)); + + /* Renegotiation allowed */ + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj( + SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1)); + + /* Report the selected protocol as a result of the ALPN negotiation */ + SSL_get0_alpn_selected(ssl, &proto, &len); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len)); + + /* Get security level */ + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("securitylevel", -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_get_security_level(ssl))); + } + + /* Cipher info */ cipher = SSL_get_current_cipher(ssl); if (cipher != NULL) { char buf[BUFSIZ] = {0}; int bits, alg_bits; @@ -1668,19 +1691,10 @@ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("description", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(buf, -1)); } } - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1)); - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj( - SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1)); - - /* Report the selected protocol as a result of the negotiation */ - SSL_get0_alpn_selected(ssl, &proto, &len); - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1)); - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len)); - /* Session info */ session = SSL_get_session(ssl); if (session != NULL) { const unsigned char *ticket; size_t len2; @@ -1715,15 +1729,15 @@ #if defined(HAVE_SSL_COMPRESSION) /* Compression info */ comp = SSL_get_current_compression(ssl); if (comp != NULL) { - expansion = SSL_get_current_expansion(ssl); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("compression", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1)); + comp = SSL_get_current_expansion(ssl); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("expansion", -1)); - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(expansion), -1)); + Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_COMP_get_name(comp), -1)); } #endif Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -1968,10 +1982,14 @@ } return TCL_OK; clientData = clientData; } +/********************/ +/* Init */ +/********************/ + /* *------------------------------------------------------------------- * * Tls_Free -- *