@@ -50,11 +50,11 @@ (((key) == NULL) ? (char *) NULL : \ Tcl_TranslateFileName(interp, (key), (dsp))) static SSL_CTX *CTX_Init(State *statePtr, int isServer, int proto, char *key, char *certfile, unsigned char *key_asn1, unsigned char *cert_asn1, - int key_asn1_len, int cert_asn1_len, char *CAdir, char *CAfile, + int key_asn1_len, int cert_asn1_len, char *CApath, char *CAfile, char *ciphers, char *ciphersuites, int level, char *DHparams); static int TlsLibInit(int uninitialize); #define TLS_PROTO_SSL2 0x01 @@ -190,11 +190,11 @@ else if (where & SSL_CB_LOOP) minor = "loop"; else if (where & SSL_CB_EXIT) minor = "exit"; else minor = "unknown"; } - /* Create command to eval */ + /* Create command to eval with fn, chan, major, minor, message, and type args */ 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)); @@ -316,11 +316,11 @@ buffer[n] = 0; (void)BIO_flush(bio); BIO_free(bio); } - /* Create command to eval */ + /* Create command to eval with fn, chan, direction, version, type, and message args */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("message", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(write_p ? "Sent" : "Received", -1)); @@ -394,11 +394,11 @@ return 0; } dprintf("VerifyCallback: eval callback"); - /* Create command to eval */ + /* Create command to eval with fn, chan, depth, cert info list, status, and error args */ 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)); @@ -444,11 +444,11 @@ dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return; - /* Create command to eval */ + /* Create command to eval with fn, chan, and message args */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); if (msg != NULL) { @@ -534,11 +534,11 @@ } else { return -1; } } - /* Create command to eval */ + /* Create command to eval with fn, rwflag, and size args */ 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)); @@ -613,11 +613,11 @@ return SSL_TLSEXT_ERR_OK; } else if (ssl == NULL) { return SSL_TLSEXT_ERR_NOACK; } - /* Create command to eval */ + /* Create command to eval with fn, chan, session id, session ticket, and lifetime args */ cmdPtr = Tcl_DuplicateObj(statePtr->callback); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); @@ -690,11 +690,11 @@ if (statePtr->vcmd == (Tcl_Obj*)NULL) { return res; } - /* Create command to eval */ + /* Create command to eval with fn, chan, depth, cert info list, status, and error args */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj((const char *) *out, -1)); @@ -803,11 +803,11 @@ if (statePtr->vcmd == (Tcl_Obj*)NULL) { return SSL_TLSEXT_ERR_OK; } - /* Create command to eval */ + /* Create command to eval with fn, chan, and server name args */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("sni", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername , -1)); @@ -905,11 +905,11 @@ return SSL_CLIENT_HELLO_ERROR; } remaining = len; servername = (const char *)p; - /* Create command to eval */ + /* Create command to eval with fn, chan, and server name args */ cmdPtr = Tcl_DuplicateObj(statePtr->vcmd); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (Tcl_Size) len)); @@ -987,19 +987,23 @@ if (ret < 0 && ((statePtr->flags & TLS_TCL_ASYNC) && (err == EAGAIN))) { dprintf("Async set and err = EAGAIN"); ret = 0; } else if (ret < 0) { + long result; errStr = statePtr->err; Tcl_ResetResult(interp); Tcl_SetErrno(err); if (!errStr || (*errStr == 0)) { errStr = Tcl_PosixError(interp); } Tcl_AppendResult(interp, "handshake failed: ", errStr, (char *) NULL); + 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); } else { if (err != 0) { @@ -1046,34 +1050,34 @@ */ static int ImportObjCmd(ClientData clientData, 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 *cmdObj = NULL; - Tcl_Obj *passwdObj = NULL; - Tcl_Obj *vcmd = NULL; + SSL_CTX *ctx = NULL; + Tcl_Obj *cmdObj = NULL; + Tcl_Obj *passwdObj = NULL; + Tcl_Obj *vcmd = NULL; Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar; int idx; Tcl_Size fn, len; - int flags = TLS_TCL_INIT; - int server = 0; /* is connection incoming or outgoing? */ - char *keyfile = NULL; - char *certfile = NULL; - unsigned char *key = NULL; - Tcl_Size key_len = 0; - unsigned char *cert = NULL; - Tcl_Size cert_len = 0; - char *ciphers = NULL; - char *ciphersuites = NULL; - char *CAfile = NULL; - char *CAdir = NULL; - char *DHparams = NULL; - char *model = NULL; - char *servername = NULL; /* hostname for Server Name Indication */ + int flags = TLS_TCL_INIT; + int server = 0; /* is connection incoming or outgoing? */ + char *keyfile = NULL; + char *certfile = NULL; + unsigned char *key = NULL; + Tcl_Size key_len = 0; + unsigned char *cert = NULL; + Tcl_Size cert_len = 0; + char *ciphers = NULL; + char *ciphersuites = NULL; + char *CAfile = NULL; + char *CApath = NULL; + char *DHparams = NULL; + char *model = NULL; + char *servername = NULL; /* hostname for Server Name Indication */ const unsigned char *session_id = NULL; - Tcl_Size sess_len = 0; + Tcl_Size sess_len = 0; Tcl_Obj *alpnObj = 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; @@ -1123,11 +1127,11 @@ switch(fn) { case _opt_alpn: alpnObj = objv[idx]; break; case _opt_cadir: - GET_OPT_STRING(objv[idx], CAdir, NULL); + GET_OPT_STRING(objv[idx], CApath, NULL); break; case _opt_cafile: GET_OPT_STRING(objv[idx], CAfile, NULL); break; case _opt_cert: @@ -1225,11 +1229,11 @@ if (certfile && !*certfile) certfile = NULL; if (keyfile && !*keyfile) keyfile = NULL; if (ciphers && !*ciphers) ciphers = NULL; if (ciphersuites && !*ciphersuites) ciphersuites = NULL; if (CAfile && !*CAfile) CAfile = NULL; - if (CAdir && !*CAdir) CAdir = NULL; + if (CApath && !*CApath) CApath = NULL; if (DHparams && !*DHparams) DHparams = NULL; /* new SSL state */ statePtr = (State *) ckalloc((unsigned) sizeof(State)); memset(statePtr, 0, sizeof(State)); @@ -1287,11 +1291,11 @@ 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, CAdir, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) { + (int) cert_len, CApath, CAfile, ciphers, ciphersuites, level, DHparams)) == NULL) { Tls_Free((char *) statePtr); return TCL_ERROR; } } @@ -1327,10 +1331,14 @@ Tcl_SetChannelOption(interp, statePtr->self, "-translation", Tcl_DStringValue(&upperChannelTranslation)); Tcl_SetChannelOption(interp, statePtr->self, "-encoding", Tcl_DStringValue(&upperChannelEncoding)); Tcl_SetChannelOption(interp, statePtr->self, "-eofchar", Tcl_DStringValue(&upperChannelEOFChar)); Tcl_SetChannelOption(interp, statePtr->self, "-blocking", Tcl_DStringValue(&upperChannelBlocking)); + Tcl_DStringFree(&upperChannelTranslation); + Tcl_DStringFree(&upperChannelEncoding); + Tcl_DStringFree(&upperChannelEOFChar); + Tcl_DStringFree(&upperChannelBlocking); /* * SSL Initialization */ statePtr->ssl = SSL_new(statePtr->ctx); @@ -1570,17 +1578,16 @@ * *------------------------------------------------------------------- */ static SSL_CTX * CTX_Init(State *statePtr, int isServer, int proto, char *keyfile, char *certfile, - unsigned char *key, unsigned char *cert, int key_len, int cert_len, char *CAdir, + 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; + int off = 0, abort = 0; int load_private_key; const SSL_METHOD *method; dprintf("Called"); @@ -1756,11 +1763,10 @@ #else { 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); @@ -1792,34 +1798,33 @@ /* 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); return NULL; } + Tcl_DStringFree(&ds); + } else if (cert != NULL) { load_private_key = 1; if (SSL_CTX_use_certificate_ASN1(ctx, cert_len, cert) <= 0) { - Tcl_DStringFree(&ds); Tcl_AppendResult(interp, "unable to set certificate: ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; } + } else { certfile = (char*)X509_get_default_cert_file(); if (SSL_CTX_use_certificate_file(ctx, certfile, SSL_FILETYPE_PEM) <= 0) { #if 0 - Tcl_DStringFree(&ds); Tcl_AppendResult(interp, "unable to use default certificate file ", certfile, ": ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; #endif @@ -1849,11 +1854,10 @@ } Tcl_DStringFree(&ds); } else if (key != NULL) { if (SSL_CTX_use_PrivateKey_ASN1(EVP_PKEY_RSA, ctx, key,key_len) <= 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: ", GET_ERR_REASON(), (char *) NULL); SSL_CTX_free(ctx); return NULL; @@ -1867,42 +1871,61 @@ SSL_CTX_free(ctx); return NULL; } } - /* Set verification CAs */ - Tcl_DStringInit(&ds); - Tcl_DStringInit(&ds1); - /* There is one default directory, one default file, and one default store. - The default CA certificates directory (and default store) is in the OpenSSL - certs directory. It can be overridden by the SSL_CERT_DIR env var. The - default CA certificates file is called cert.pem in the default OpenSSL - directory. It can be overridden by the SSL_CERT_FILE env var. */ - /* int SSL_CTX_set_default_verify_dir(SSL_CTX *ctx) and int SSL_CTX_set_default_verify_file(SSL_CTX *ctx) */ - if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CAdir, &ds1)) || - !SSL_CTX_set_default_verify_paths(ctx)) { -#if 0 - Tcl_DStringFree(&ds); - Tcl_DStringFree(&ds1); - /* Don't currently care if this fails */ - Tcl_AppendResult(interp, "SSL default verify paths: ", GET_ERR_REASON(), (char *) NULL); - SSL_CTX_free(ctx); - return NULL; + /* Set to use default location and file for Certificate Authority (CA) certificates. The + * verify path and store can be overridden by the SSL_CERT_DIR env var. The verify file can + * be overridden by the SSL_CERT_FILE env var. */ + if (!SSL_CTX_set_default_verify_paths(ctx)) { + abort++; + } + + /* Overrides for the CA verify path and file */ + { +#if OPENSSL_VERSION_NUMBER < 0x30000000L + if (CApath != NULL || CAfile != NULL) { + Tcl_DString ds1; + if (!SSL_CTX_load_verify_locations(ctx, F2N(CAfile, &ds), F2N(CApath, &ds1))) { + abort++; + } + Tcl_DStringFree(&ds); + 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 */ + 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) { + if (!SSL_CTX_load_verify_dir(ctx, F2N(CApath, &ds))) { + abort++; + } + Tcl_DStringFree(&ds); + } + if (CAfile != NULL) { + 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 */ + 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); + } #endif } - /* https://sourceforge.net/p/tls/bugs/57/ */ - /* XXX:TODO: Let the user supply values here instead of something that exists on the filesystem */ - if (CAfile != NULL) { - 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); - Tcl_DStringFree(&ds1); return ctx; } /* *-------------------------------------------------------------------