@@ -33,13 +33,10 @@ /* Min OpenSSL version */ #if OPENSSL_VERSION_NUMBER < 0x10101000L #error "Only OpenSSL v1.1.1 or later is supported" #endif -/* - * External functions - */ /* * Forward declarations */ @@ -332,11 +329,11 @@ * behavior when the SSL_VERIFY_PEER flag is set. This is called * whenever a certificate is inspected or decided invalid. Called for * each certificate in the cert chain. * * Checks: - * certificate chain is checked starting with the deepest nesting level + * The certificate chain is checked starting with the deepest nesting level * (the root CA certificate) and worked upward to the peer's certificate. * All signatures are valid, current time is within first and last validity time. * Check that the certificate is issued by the issuer certificate issuer. * Check the revocation status for each certificate. * Check the validity of the given CRL and the cert revocation status. @@ -404,19 +401,19 @@ Tcl_DecrRefCount(cmdPtr); dprintf("VerifyCallback: command result = %d", ok); /* statePtr->flags &= ~(TLS_TCL_CALLBACK); */ - return(ok); /* By default, leave verification unchanged. */ + return ok; /* By default, leave verification unchanged. */ } /* *------------------------------------------------------------------- * * Tls_Error -- * - * Calls callback with list of errors. + * Calls callback with error message. * * Side effects: * The err field of the currently operative State is set * to a string describing the SSL negotiation failure reason * @@ -487,13 +484,13 @@ /* *------------------------------------------------------------------- * * Password Callback -- * - * Called when a password for a private key loading/storing a PEM - * certificate with encryption. Evals callback script and returns - * the result as the password string in buf. + * Called when a password is needed for a private key when loading + * or storing a PEM certificate with encryption. Evals callback + * script and returns the result as the password string in buf. * * Results: * None * * Side effects: @@ -508,19 +505,24 @@ PasswordCallback(char *buf, int size, int rwflag, void *udata) { State *statePtr = (State *) udata; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int code; + Tcl_Size len; dprintf("Called"); /* If no callback, use default callback */ if (statePtr->password == NULL) { if (Tcl_EvalEx(interp, "tls::password", -1, TCL_EVAL_GLOBAL) == TCL_OK) { - char *ret = (char *) Tcl_GetStringResult(interp); - strncpy(buf, ret, (size_t) size); - return (int)strlen(ret); + 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'; + return (int) len; } else { return -1; } } @@ -547,19 +549,18 @@ 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); if (len > (Tcl_Size) size-1) { len = (Tcl_Size) size-1; } strncpy(buf, ret, (size_t) len); buf[len] = '\0'; Tcl_Release((void *) interp); - return((int) len); + return (int) len; } Tcl_Release((void *) interp); return -1; } @@ -623,10 +624,12 @@ /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); EvalCallback(interp, statePtr, cmdPtr); Tcl_DecrRefCount(cmdPtr); + + /* Return 0 for now until session handling is complete */ return 0; } /* *------------------------------------------------------------------- @@ -915,10 +918,14 @@ } Tcl_DecrRefCount(cmdPtr); return res; } +/********************/ +/* Commands */ +/********************/ + /* *------------------------------------------------------------------- * * CiphersObjCmd -- list available ciphers * @@ -1013,15 +1020,17 @@ #endif default: method = TLS_method(); break; } + ctx = SSL_CTX_new(method); if (ctx == 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); SSL_CTX_free(ctx); return TCL_ERROR; @@ -1157,27 +1166,27 @@ dprintf("Called"); if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); - return(TCL_ERROR); + return TCL_ERROR; } ERR_clear_error(); chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { - return(TCL_ERROR); + 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", "HANDSHAKE", "CHANNEL", "INVALID", (char *)NULL); - return(TCL_ERROR); + return TCL_ERROR; } statePtr = (State *)Tcl_GetChannelInstanceData(chan); dprintf("Calling Tls_WaitForConnect"); ret = Tls_WaitForConnect(statePtr, &err, 1); @@ -1200,21 +1209,21 @@ 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_SetErrorCode(interp, "TLS", "HANDSHAKE", "FAILED", (char *)NULL); dprintf("Returning TCL_ERROR with handshake failed: %s", errStr); - return(TCL_ERROR); + return TCL_ERROR; } else { if (err != 0) { dprintf("Got an error with a completed handshake: err = %i", err); } ret = 1; } dprintf("Returning TCL_OK with data \"%i\"", ret); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); - return(TCL_OK); + return TCL_OK; } /* *------------------------------------------------------------------- * @@ -1296,13 +1305,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); for (idx = 2; idx < objc; idx++) { char *opt = Tcl_GetString(objv[idx]); @@ -1470,11 +1477,10 @@ 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); @@ -1551,11 +1557,11 @@ memcpy(p, str, (size_t) len); p += len; } /* SSL_set_alpn_protos makes a copy of the protocol-list */ - /* Note: This functions reverses the return value convention */ + /* 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((void *)statePtr); ckfree(protos); @@ -1682,13 +1688,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", (char *)NULL); @@ -1756,29 +1760,29 @@ } if (ENABLED(proto, TLS_PROTO_SSL3)) { Tcl_AppendResult(interp, "SSL3 protocol not supported", (char *)NULL); return NULL; } -#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD) +#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) || defined(OPENSSL_NO_TLS1_1_METHOD) +#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) || defined(OPENSSL_NO_TLS1_2_METHOD) +#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) || defined(OPENSSL_NO_TLS1_3_METHOD) +#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); return NULL; } #endif @@ -1802,39 +1806,39 @@ #if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD) case TLS_PROTO_TLS1_2: method = isServer ? TLSv1_2_server_method() : TLSv1_2_client_method(); break; #endif -#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3_METHOD) +#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) case TLS_PROTO_TLS1_3: /* Use the generic method and constraint range after context is created */ method = isServer ? TLS_server_method() : TLS_client_method(); break; #endif default: /* Negotiate highest available SSL/TLS version */ method = isServer ? TLS_server_method() : TLS_client_method(); -#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD) +#if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) off |= (ENABLED(proto, TLS_PROTO_TLS1) ? 0 : SSL_OP_NO_TLSv1); #endif -#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1_METHOD) +#if !defined(NO_TLS1_1) && !defined(OPENSSL_NO_TLS1_1) off |= (ENABLED(proto, TLS_PROTO_TLS1_1) ? 0 : SSL_OP_NO_TLSv1_1); #endif -#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2_METHOD) +#if !defined(NO_TLS1_2) && !defined(OPENSSL_NO_TLS1_2) off |= (ENABLED(proto, TLS_PROTO_TLS1_2) ? 0 : SSL_OP_NO_TLSv1_2); #endif -#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3_METHOD) +#if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) off |= (ENABLED(proto, TLS_PROTO_TLS1_3) ? 0 : SSL_OP_NO_TLSv1_3); #endif break; } ERR_clear_error(); ctx = SSL_CTX_new(method); if (!ctx) { - return(NULL); + return NULL; } if (getenv(SSLKEYLOGFILE)) { SSL_CTX_set_keylog_callback(ctx, KeyLogCallback); } @@ -1878,10 +1882,11 @@ /* set some callbacks */ SSL_CTX_set_default_passwd_cb(ctx, PasswordCallback); SSL_CTX_set_default_passwd_cb_userdata(ctx, (void *)statePtr); /* 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); SSL_CTX_free(ctx); return NULL; @@ -1889,10 +1894,11 @@ #else { DH* dh; 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); SSL_CTX_free(ctx); @@ -1987,13 +1993,12 @@ } } /* 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; } } @@ -2007,10 +2012,12 @@ /* Overrides for the CA verify path and file */ { #if OPENSSL_VERSION_NUMBER < 0x30000000L if (CApath != NULL || CAfile != NULL) { Tcl_DString ds1; + Tcl_DStringInit(&ds1); + if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CApath, &ds1))) { abort++; } Tcl_DStringFree(&ds); Tcl_DStringFree(&ds1); @@ -2086,18 +2093,18 @@ if (objc < 2 || objc > 3 || (objc == 3 && !strcmp(Tcl_GetString(objv[1]), "-local"))) { Tcl_WrongNumArgs(interp, 1, objv, "?-local? channel"); return TCL_ERROR; } + /* Get channel Id */ channelName = Tcl_GetString(objv[(objc == 2 ? 1 : 2)]); 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", (char *)NULL); Tcl_SetErrorCode(interp, "TLS", "STATUS", "CHANNEL", "INVALID", (char *)NULL); @@ -2208,25 +2215,25 @@ const SSL_SESSION *session; const EVP_MD *md; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); - return(TCL_ERROR); + return TCL_ERROR; } chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL); if (chan == (Tcl_Channel) NULL) { - return(TCL_ERROR); + 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); + "\": not a TLS channel", (char *)NULL); Tcl_SetErrorCode(interp, "TLS", "CONNECTION", "CHANNEL", "INVALID", (char *)NULL); - return(TCL_ERROR); + return TCL_ERROR; } objPtr = Tcl_NewListObj(0, NULL); /* Connection info */ @@ -2482,12 +2489,11 @@ 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(); @@ -2608,11 +2614,11 @@ Tcl_SetResult(interp,"Error generating certificate request",NULL); EVP_PKEY_free(pkey); #if OPENSSL_VERSION_NUMBER < 0x30000000L BN_free(bne); #endif - return(TCL_ERROR); + return TCL_ERROR; } X509_set_version(cert,2); ASN1_INTEGER_set(X509_get_serialNumber(cert),serial); X509_gmtime_adj(X509_getm_notBefore(cert),0); @@ -2619,17 +2625,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, (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_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_set_subject_name(cert,name); if (!X509_sign(cert,pkey,EVP_sha256())) { X509_free(cert); @@ -2907,11 +2913,11 @@ *------------------------------------------------------* */ DLLEXPORT int Tls_SafeInit(Tcl_Interp *interp) { dprintf("Called"); - return(Tls_Init(interp)); + return Tls_Init(interp); } /* *------------------------------------------------------* * @@ -2938,11 +2944,11 @@ if (uninitialize) { if (!initialized) { dprintf("Asked to uninitialize, but we are not initialized"); - return(TCL_OK); + return TCL_OK; } dprintf("Asked to uninitialize"); #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) @@ -2958,16 +2964,16 @@ #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) Tcl_MutexUnlock(&init_mx); #endif - return(TCL_OK); + return TCL_OK; } if (initialized) { dprintf("Called, but using cached value"); - return(status); + return status; } dprintf("Called"); #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) @@ -2990,7 +2996,7 @@ #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) Tcl_MutexUnlock(&init_mx); #endif - return(status); + return status; }