@@ -93,15 +93,15 @@ static int locksCount = 0; static Tcl_Mutex init_mx; #endif /* OPENSSL_THREADS */ #endif /* TCL_THREADS */ + /********************/ /* Callbacks */ /********************/ - /* *------------------------------------------------------------------- * * Eval Callback Command -- * @@ -156,10 +156,11 @@ * Results: * None * * Side effects: * Calls callback (if defined) + * *------------------------------------------------------------------- */ static void InfoCallback(const SSL *ssl, int where, int ret) { State *statePtr = (State*)SSL_get_app_data((SSL *)ssl); @@ -199,11 +200,11 @@ else if (where & SSL_CB_LOOP) minor = "loop"; else if (where & SSL_CB_EXIT) minor = "exit"; else minor = "unknown"; } - /* Create command to eval from callback */ + /* Create command to eval */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(major, -1)); @@ -255,10 +256,11 @@ * empty string - no change to certificate validation * * Side effects: * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason + * *------------------------------------------------------------------- */ static int VerifyCallback(int ok, X509_STORE_CTX *ctx) { Tcl_Obj *cmdPtr; @@ -277,11 +279,11 @@ } else { return 1; } } - /* Create command to eval from callback */ + /* Create command to eval */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(depth)); @@ -296,11 +298,11 @@ Tcl_IncrRefCount(cmdPtr); ok = EvalCallback(interp, statePtr, cmdPtr); Tcl_DecrRefCount(cmdPtr); statePtr->flags &= ~(TLS_TCL_CALLBACK); - return(ok); /* By default, leave verification unchanged. */ + return(ok); /* By default, leave verification unchanged. */ } /* *------------------------------------------------------------------- * @@ -310,10 +312,11 @@ * what to do with errors. * * Side effects: * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason + * *------------------------------------------------------------------- */ void Tls_Error(State *statePtr, char *msg) { Tcl_Interp *interp = statePtr->interp; @@ -351,10 +354,11 @@ * * Write received key data to log file. * * Side effects: * none + * *------------------------------------------------------------------- */ void KeyLogCallback(const SSL *ssl, const char *line) { char *str = getenv(SSLKEYLOGFILE); FILE *fd; @@ -371,10 +375,11 @@ * Password Callback -- * * Called when a password is needed to unpack RSA and PEM keys. * Evals any bound password script and returns the result as * the password string. + * *------------------------------------------------------------------- */ static int PasswordCallback(char *buf, int size, int verify, void *udata) { State *statePtr = (State *) udata; @@ -392,11 +397,11 @@ } else { return -1; } } - /* Create command to eval from callback */ + /* Create command to eval */ cmdPtr = Tcl_DuplicateObj(statePtr->password); Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); @@ -465,11 +470,11 @@ return SSL_TLSEXT_ERR_OK; } else if (ssl == NULL) { return SSL_TLSEXT_ERR_NOACK; } - /* Create command to eval from callback */ + /* Create command to eval */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1)); /* Session id */ session_id = SSL_SESSION_get_id(session, &ulen); @@ -540,11 +545,11 @@ if (statePtr->vcmd == (Tcl_Obj*)NULL) { return res; } - /* Create command to eval from callback */ + /* Create command to eval */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(*out, -1)); /* Eval callback command */ @@ -606,12 +611,12 @@ /* *------------------------------------------------------------------- * * SNI Callback for Servers -- * - * Perform server-side SNI hostname selection after receiving SNI header. - * Called after hello callback but before ALPN callback. + * Perform server-side SNI hostname selection after receiving SNI extension + * in Client Hello. Called after hello callback but before ALPN callback. * * Results: * None * * Side effects: @@ -640,20 +645,21 @@ if (ssl == NULL || arg == NULL) { return SSL_TLSEXT_ERR_NOACK; } + /* Only works for TLS 1.2 and earlier */ servername = SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name); if (!servername || servername[0] == '\0') { - return SSL_TLSEXT_ERR_NOACK; + return SSL_TLSEXT_ERR_NOACK; } if (statePtr->vcmd == (Tcl_Obj*)NULL) { return SSL_TLSEXT_ERR_OK; } - /* Create command to eval from callback */ + /* Create command to eval */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("sni", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername , -1)); /* Eval callback command */ @@ -716,44 +722,44 @@ } /* Get names */ if (!SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining) || remaining <= 2) { *alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER; - return SSL_CLIENT_HELLO_ERROR; + return SSL_CLIENT_HELLO_ERROR; } /* Extract the length of the supplied list of names. */ len = (*(p++) << 8); len += *(p++); if (len + 2 != remaining) { *alert = SSL_R_SSLV3_ALERT_ILLEGAL_PARAMETER; - return SSL_CLIENT_HELLO_ERROR; + return SSL_CLIENT_HELLO_ERROR; } remaining = len; /* The list in practice only has a single element, so we only consider the first one. */ if (remaining == 0 || *p++ != TLSEXT_NAMETYPE_host_name) { *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR; - return SSL_CLIENT_HELLO_ERROR; + return SSL_CLIENT_HELLO_ERROR; } remaining--; /* Now we can finally pull out the byte array with the actual hostname. */ if (remaining <= 2) { *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR; - return SSL_CLIENT_HELLO_ERROR; + return SSL_CLIENT_HELLO_ERROR; } len = (*(p++) << 8); len += *(p++); if (len + 2 > remaining) { *alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR; - return SSL_CLIENT_HELLO_ERROR; + return SSL_CLIENT_HELLO_ERROR; } remaining = len; servername = (const char *)p; - /* Create command to eval from callback */ + /* Create command to eval */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (int) len)); /* Eval callback command */ @@ -865,11 +871,11 @@ #if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); return TCL_ERROR; #else ctx = SSL_CTX_new(TLS_method()); - SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION); + SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION); SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION); break; #endif default: break; @@ -962,20 +968,20 @@ 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) +#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) +#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1], -1)); #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) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_1], -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) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1)); #endif #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1)); #endif @@ -1150,22 +1156,24 @@ break; OPTOBJ("-alpn", alpn); OPTSTR("-cadir", CAdir); OPTSTR("-cafile", CAfile); + OPTBYTE("-cert", cert, cert_len); OPTSTR("-certfile", certfile); OPTSTR("-cipher", ciphers); OPTSTR("-ciphers", ciphers); OPTSTR("-ciphersuites", ciphersuites); OPTOBJ("-command", script); OPTSTR("-dhparams", DHparams); + OPTBYTE("-key", key, key_len); OPTSTR("-keyfile", keyfile); OPTSTR("-model", model); OPTOBJ("-password", password); OPTBOOL("-post_handshake", post_handshake); - OPTBOOL("-require", require); OPTBOOL("-request", request); + OPTBOOL("-require", require); OPTINT("-securitylevel", level); OPTBOOL("-server", server); OPTSTR("-servername", servername); OPTSTR("-session_id", session_id); OPTBOOL("-ssl2", ssl2); @@ -1174,21 +1182,19 @@ OPTBOOL("-tls1.1", tls1_1); OPTBOOL("-tls1.2", tls1_2); OPTBOOL("-tls1.3", tls1_3); OPTOBJ("-validatecommand", vcmd); OPTOBJ("-vcmd", vcmd); - OPTBYTE("-cert", cert, cert_len); - OPTBYTE("-key", key, key_len); - OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -securitylevel, -server, -servername, -session_id, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, -tls1.3, or -validatecommand"); + OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -post_handshake, -request, -require, -securitylevel, -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 && post_handshake) verify |= SSL_VERIFY_POST_HANDSHAKE; - if (verify == 0) verify = SSL_VERIFY_NONE; + 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; 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); @@ -1316,22 +1322,23 @@ } /* Set host server name */ if (servername) { /* Sets the server name indication (SNI) in ClientHello extension */ + /* Per RFC 6066, hostname is a ASCII encoded string. */ if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) { Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *) NULL); - Tls_Free((char *) statePtr); - return TCL_ERROR; - } + Tls_Free((char *) statePtr); + return TCL_ERROR; + } /* Configure server host name checks in the SSL client. Set DNS hostname to name for peer certificate checks. SSL_set1_host has limitations. */ if (!SSL_add1_host(statePtr->ssl, servername)) { Tcl_AppendResult(interp, "setting DNS host name failed", (char *) NULL); - Tls_Free((char *) statePtr); - return TCL_ERROR; + Tls_Free((char *) statePtr); + return TCL_ERROR; } } /* Resume session id */ if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) { @@ -1410,37 +1417,44 @@ SSL_CTX_set_tlsext_servername_callback(statePtr->ctx, SNICallback); SSL_CTX_set_client_hello_cb(statePtr->ctx, HelloCallback, (void *)statePtr); if (statePtr->protos != NULL) { SSL_CTX_set_alpn_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr); #ifdef USE_NPN - SSL_CTX_set_next_protos_advertised_cb(statePtr->ctx, NPNCallback, (void *)statePtr); + if (tls1_2 == 0 && tls1_3 == 0) { + SSL_CTX_set_next_protos_advertised_cb(statePtr->ctx, NPNCallback, (void *)statePtr); + } #endif } /* Enable server to send cert request after handshake (TLS 1.3 only) */ + /* A write operation must take place for the Certificate Request to be + sent to the client, this can be done with SSL_do_handshake(). */ if (request && post_handshake) { SSL_verify_client_post_handshake(statePtr->ssl); } + /* Set server mode */ statePtr->flags |= TLS_TCL_SERVER; SSL_set_accept_state(statePtr->ssl); } else { /* Client callbacks */ - if (statePtr->protos != NULL) { #ifdef USE_NPN + if (statePtr->protos != NULL && tls1_2 == 0 && tls1_3 == 0) { SSL_CTX_set_next_proto_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr); -#endif } +#endif + /* Session caching */ SSL_CTX_set_session_cache_mode(statePtr->ctx, SSL_SESS_CACHE_CLIENT | SSL_SESS_CACHE_NO_INTERNAL_STORE); SSL_CTX_sess_set_new_cb(statePtr->ctx, SessionCallback); /* Enable post handshake Authentication extension. TLS 1.3 only, not http/2. */ if (request && post_handshake) { SSL_set_post_handshake_auth(statePtr->ssl, 1); } + /* Set client mode */ SSL_set_connect_state(statePtr->ssl); } SSL_set_bio(statePtr->ssl, statePtr->p_bio, statePtr->p_bio); BIO_set_ssl(statePtr->bio, statePtr->ssl, BIO_NOCLOSE); @@ -1627,12 +1641,12 @@ #endif break; } ERR_clear_error(); + ctx = SSL_CTX_new(method); - if (!ctx) { return(NULL); } if (getenv(SSLKEYLOGFILE)) { @@ -1659,18 +1673,18 @@ #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); - SSL_CTX_free(ctx); - return 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); - SSL_CTX_free(ctx); - return NULL; + Tcl_AppendResult(interp, "Set cipher suites failed: No valid ciphers", (char *) NULL); + SSL_CTX_free(ctx); + return NULL; } /* Set security level */ if (level > -1 && level < 6) { /* SSL_set_security_level */ @@ -1883,10 +1897,12 @@ Tcl_AppendResult(interp, "bad channel \"", Tcl_GetChannelName(chan), "\": not a TLS channel", NULL); return TCL_ERROR; } statePtr = (State *) Tcl_GetChannelInstanceData(chan); + + /* Get certificate for peer or self */ if (objc == 2) { peer = SSL_get_peer_certificate(statePtr->ssl); } else { peer = SSL_get_certificate(statePtr->ssl); } @@ -2036,11 +2052,11 @@ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("bits", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(bits)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("secret_bits", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(alg_bits)); /* alg_bits is actual key secret bits. If use bits and secret (algorithm) bits differ, - the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) */ + the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) */ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("min_version", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_CIPHER_get_version(cipher), -1)); /* Get OpenSSL-specific ID, not IANA ID */ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("id", -1)); @@ -2588,39 +2604,39 @@ #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) size_t num_locks; #endif if (uninitialize) { - if (!initialized) { - dprintf("Asked to uninitialize, but we are not initialized"); - - return(TCL_OK); - } - - dprintf("Asked to uninitialize"); - -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - Tcl_MutexLock(&init_mx); - - if (locks) { - free(locks); - locks = NULL; - locksCount = 0; - } -#endif - initialized = 0; - -#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - Tcl_MutexUnlock(&init_mx); -#endif - - return(TCL_OK); + if (!initialized) { + dprintf("Asked to uninitialize, but we are not initialized"); + + return(TCL_OK); + } + + dprintf("Asked to uninitialize"); + +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) + Tcl_MutexLock(&init_mx); + + if (locks) { + free(locks); + locks = NULL; + locksCount = 0; + } +#endif + initialized = 0; + +#if defined(OPENSSL_THREADS) && defined(TCL_THREADS) + Tcl_MutexUnlock(&init_mx); +#endif + + return(TCL_OK); } if (initialized) { - dprintf("Called, but using cached value"); - return(status); + dprintf("Called, but using cached value"); + return(status); } dprintf("Called"); #if defined(OPENSSL_THREADS) && defined(TCL_THREADS)