@@ -36,13 +36,10 @@ /* Min OpenSSL version */ #if OPENSSL_VERSION_NUMBER < 0x10101000L #error "Only OpenSSL v1.1.1 or later is supported" #endif -/* - * External functions - */ /* * Forward declarations */ @@ -344,11 +341,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. @@ -424,11 +421,11 @@ /* *------------------------------------------------------------------- * * 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 * @@ -499,13 +496,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: @@ -520,19 +517,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; } } @@ -559,11 +561,10 @@ Tcl_Release((ClientData) 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); @@ -635,10 +636,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; } /* *------------------------------------------------------------------- @@ -1418,11 +1421,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((char *) statePtr); ckfree(protos); @@ -1752,10 +1755,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; @@ -1764,11 +1768,10 @@ { DH* dh; if (DHparams != NULL) { BIO *bio; - Tcl_DStringInit(&ds); 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); @@ -1800,11 +1803,10 @@ /* set our certificate */ load_private_key = 0; if (certfile != NULL) { load_private_key = 1; - Tcl_DStringInit(&ds); 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); SSL_CTX_free(ctx); @@ -1844,11 +1846,10 @@ /* get the private key associated with this certificate */ if (keyfile == NULL) { keyfile = certfile; } - Tcl_DStringInit(&ds); 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, " ", @@ -1887,11 +1888,10 @@ /* Overrides for the CA verify path and file */ { #if OPENSSL_VERSION_NUMBER < 0x30000000L if (CApath != NULL || CAfile != NULL) { Tcl_DString ds1; - Tcl_DStringInit(&ds); Tcl_DStringInit(&ds1); if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CApath, &ds1))) { abort++; } @@ -1899,35 +1899,31 @@ Tcl_DStringFree(&ds1); /* Set list of CAs to send to client when requesting a client certificate */ /* https://sourceforge.net/p/tls/bugs/57/ */ /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */ - Tcl_DStringInit(&ds); STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds)); if (certNames != NULL) { SSL_CTX_set_client_CA_list(ctx, certNames); } Tcl_DStringFree(&ds); } #else if (CApath != NULL) { - Tcl_DStringInit(&ds); if (!SSL_CTX_load_verify_dir(ctx, F2N(CApath, &ds))) { abort++; } Tcl_DStringFree(&ds); } if (CAfile != NULL) { - Tcl_DStringInit(&ds); if (!SSL_CTX_load_verify_file(ctx, F2N(CAfile, &ds))) { abort++; } Tcl_DStringFree(&ds); /* Set list of CAs to send to client when requesting a client certificate */ - Tcl_DStringInit(&ds); STACK_OF(X509_NAME) *certNames = SSL_load_client_CA_file(F2N(CAfile, &ds)); if (certNames != NULL) { SSL_CTX_set_client_CA_list(ctx, certNames); } Tcl_DStringFree(&ds);