@@ -24,10 +24,14 @@ #include "tlsInt.h" #include "tclOpts.h" #include #include +#include +#include +#include +#include #include #include /* Min OpenSSL version */ #if OPENSSL_VERSION_NUMBER < 0x10101000L @@ -234,11 +238,11 @@ State *statePtr = (State*)arg; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; char *ver, *type; BIO *bio; - char buffer[15000]; + char buffer[30000]; buffer[0] = 0; dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) @@ -292,22 +296,24 @@ type = "Handshake"; break; case SSL3_RT_APPLICATION_DATA: type = "App Data"; break; +#if OPENSSL_VERSION_NUMBER < 0x30000000L case DTLS1_RT_HEARTBEAT: type = "Heartbeat"; break; +#endif default: type = "unknown"; } /* Needs compile time option "enable-ssl-trace". */ if ((bio = BIO_new(BIO_s_mem())) != NULL) { int n; SSL_trace(write_p, version, content_type, buf, len, ssl, (void *)bio); - n = BIO_read(bio, buffer, min(BIO_pending(bio), 14999)); + n = BIO_read(bio, buffer, BIO_pending(bio) < 15000 ? BIO_pending(bio) : 14999); n = (n<0) ? 0 : n; buffer[n] = 0; (void)BIO_flush(bio); BIO_free(bio); } @@ -365,11 +371,11 @@ *------------------------------------------------------------------- */ static int VerifyCallback(int ok, X509_STORE_CTX *ctx) { Tcl_Obj *cmdPtr; - SSL *ssl = (SSL*)X509_STORE_CTX_get_ex_data(ctx, SSL_get_ex_data_X509_STORE_CTX_idx()); + 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); @@ -590,11 +596,11 @@ * 1 = success where app retains session in session cache, and must call SSL_SESSION_free() when done. * *------------------------------------------------------------------- */ static int -SessionCallback(const SSL *ssl, SSL_SESSION *session) { +SessionCallback(SSL *ssl, SSL_SESSION *session) { State *statePtr = (State*)SSL_get_app_data((SSL *)ssl); Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; const unsigned char *ticket; const unsigned char *session_id; @@ -657,11 +663,11 @@ * protocols are configured for this connection. The connection continues. * *------------------------------------------------------------------- */ static int -ALPNCallback(const SSL *ssl, const unsigned char **out, unsigned char *outlen, +ALPNCallback(SSL *ssl, const unsigned char **out, unsigned char *outlen, const unsigned char *in, unsigned int inlen, void *arg) { State *statePtr = (State*)arg; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int code, res; @@ -671,11 +677,11 @@ if (ssl == NULL || arg == NULL) { return SSL_TLSEXT_ERR_NOACK; } /* Select protocol */ - if (SSL_select_next_proto(out, outlen, statePtr->protos, statePtr->protos_len, + if (SSL_select_next_proto((unsigned char **) out, outlen, statePtr->protos, statePtr->protos_len, in, inlen) == OPENSSL_NPN_NEGOTIATED) { /* Match found */ res = SSL_TLSEXT_ERR_OK; } else { /* OPENSSL_NPN_NO_OVERLAP = No overlap, so use first item from client protocol list */ @@ -689,11 +695,11 @@ /* Create command to eval */ 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(*out, -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj((const char *) *out, -1)); Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewBooleanObj(res == SSL_TLSEXT_ERR_OK)); /* Eval callback command */ Tcl_IncrRefCount(cmdPtr); if ((code = EvalCallback(interp, statePtr, cmdPtr)) > 1) { @@ -779,11 +785,11 @@ SNICallback(const SSL *ssl, int *alert, void *arg) { State *statePtr = (State*)arg; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int code, res; - char *servername = NULL; + const char *servername = NULL; dprintf("Called"); if (ssl == NULL || arg == NULL) { return SSL_TLSEXT_ERR_NOACK; @@ -846,11 +852,11 @@ * SSL_CLIENT_HELLO_SUCCESS: success * *------------------------------------------------------------------- */ static int -HelloCallback(const SSL *ssl, int *alert, void *arg) { +HelloCallback(SSL *ssl, int *alert, void *arg) { State *statePtr = (State*)arg; Tcl_Interp *interp = statePtr->interp; Tcl_Obj *cmdPtr; int code, res; const char *servername; @@ -928,226 +934,10 @@ /********************/ /* *------------------------------------------------------------------- * - * CiphersObjCmd -- list available ciphers - * - * This procedure is invoked to process the "tls::ciphers" command - * to list available ciphers, based upon protocol selected. - * - * Results: - * A standard Tcl result list. - * - * Side effects: - * constructs and destroys SSL context (CTX) - * - *------------------------------------------------------------------- - */ -static const char *protocols[] = { - "ssl2", "ssl3", "tls1", "tls1.1", "tls1.2", "tls1.3", NULL -}; -enum protocol { - TLS_SSL2, TLS_SSL3, TLS_TLS1, TLS_TLS1_1, TLS_TLS1_2, TLS_TLS1_3, TLS_NONE -}; - -static int -CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr = NULL; - SSL_CTX *ctx = NULL; - SSL *ssl = NULL; - STACK_OF(SSL_CIPHER) *sk; - char *cp, buf[BUFSIZ]; - int index, verbose = 0, use_supported = 0; - const SSL_METHOD *method; - (void) clientData; - - dprintf("Called"); - - if ((objc < 2) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK) { - return TCL_ERROR; - } - if ((objc > 2) && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) { - return TCL_ERROR; - } - if ((objc > 3) && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != TCL_OK) { - return TCL_ERROR; - } - - ERR_clear_error(); - - switch ((enum protocol)index) { - case TLS_SSL2: -#if OPENSSL_VERSION_NUMBER >= 0x10100000L || defined(NO_SSL2) || defined(OPENSSL_NO_SSL2) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; -#else - method = SSLv2_method(); break; -#endif - case TLS_SSL3: -#if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; -#else - method = SSLv3_method(); break; -#endif - case TLS_TLS1: -#if defined(NO_TLS1) || defined(OPENSSL_NO_TLS1) || defined(OPENSSL_NO_TLS1_METHOD) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; -#else - method = TLSv1_method(); break; -#endif - case TLS_TLS1_1: -#if defined(NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1) || defined(OPENSSL_NO_TLS1_1_METHOD) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; -#else - method = TLSv1_1_method(); break; -#endif - case TLS_TLS1_2: -#if defined(NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2) || defined(OPENSSL_NO_TLS1_2_METHOD) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; -#else - method = TLSv1_2_method(); break; -#endif - case TLS_TLS1_3: -#if defined(NO_TLS1_3) || defined(OPENSSL_NO_TLS1_3) - Tcl_AppendResult(interp, protocols[index], ": protocol not supported", NULL); - return TCL_ERROR; -#else - method = TLS_method(); - SSL_CTX_set_min_proto_version(ctx, TLS1_3_VERSION); - SSL_CTX_set_max_proto_version(ctx, TLS1_3_VERSION); - break; -#endif - default: - method = TLS_method(); - break; - } - - ctx = SSL_CTX_new(method); - if (ctx == NULL) { - Tcl_AppendResult(interp, GET_ERR_REASON(), NULL); - return TCL_ERROR; - } - - ssl = SSL_new(ctx); - if (ssl == NULL) { - Tcl_AppendResult(interp, GET_ERR_REASON(), NULL); - SSL_CTX_free(ctx); - return TCL_ERROR; - } - - /* Use list and order as would be sent in a ClientHello or all available ciphers */ - if (use_supported) { - sk = SSL_get1_supported_ciphers(ssl); - } else { - sk = SSL_get_ciphers(ssl); - } - - if (sk != NULL) { - if (!verbose) { - objPtr = Tcl_NewListObj(0, NULL); - for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) { - const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i); - if (c == NULL) continue; - - /* cipher name or (NONE) */ - cp = SSL_CIPHER_get_name(c); - if (cp == NULL) break; - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1)); - } - - } else { - objPtr = Tcl_NewStringObj("",0); - for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) { - const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i); - if (c == NULL) continue; - - /* textual description of the cipher */ - if (SSL_CIPHER_description(c, buf, sizeof(buf)) != NULL) { - Tcl_AppendToObj(objPtr, buf, (Tcl_Size) strlen(buf)); - } else { - Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8); - } - } - } - if (use_supported) { - sk_SSL_CIPHER_free(sk); - } - } - SSL_free(ssl); - SSL_CTX_free(ctx); - - Tcl_SetObjResult(interp, objPtr); - return TCL_OK; -} - -/* - *------------------------------------------------------------------- - * - * ProtocolsObjCmd -- list available protocols - * - * This procedure is invoked to process the "tls::protocols" command - * to list available protocols. - * - * Results: - * A standard Tcl result list. - * - * Side effects: - * none - * - *------------------------------------------------------------------- - */ -static int -ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr; - (void) clientData; - - dprintf("Called"); - - if (objc != 1) { - Tcl_WrongNumArgs(interp, 1, objv, ""); - return TCL_ERROR; - } - - ERR_clear_error(); - - 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) && !defined(OPENSSL_NO_SSL3_METHOD) - Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(protocols[TLS_SSL3], -1)); -#endif -#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) && !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) && !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 - - Tcl_SetObjResult(interp, objPtr); - return TCL_OK; -} - -/* - *------------------------------------------------------------------- - * * HandshakeObjCmd -- * * This command is used to verify whether the handshake is complete * or not. * @@ -1221,10 +1011,24 @@ dprintf("Returning TCL_OK with data \"%i\"", ret); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return(TCL_OK); } +static const char *command_opts [] = { + "-alpn", "-cadir", "-cafile", "-cert", "-certfile", "-cipher", "-ciphers", "-ciphersuites", + "-command", "-dhparams", "-key", "-keyfile", "-model", "-password", "-post_handshake", + "-request", "-require", "-security_level", "-server", "-servername", "-session_id", "-ssl2", + "-ssl3", "-tls1", "-tls1.1", "-tls1.2", "-tls1.3", "-validatecommand", "-vcmd", NULL}; + +enum _command_opts { + _opt_alpn, _opt_cadir, _opt_cafile, _opt_cert, _opt_certfile, _opt_cipher, _opt_ciphers, + _opt_ciphersuite, _opt_cmd, _opt_dhparams, _opt_key, _opt_keyfile, _opt_model, _opt_password, + _opt_handshake, _opt_request, _opt_require, _opt_security_level, _opt_server, _opt_servername, + _opt_session_id, _opt_ssl2, _opt_ssl3, _opt_tls1, _opt_tls11, _opt_tls12, _opt_tls13, + _opt_validate, _opt_vcmd +}; + /* *------------------------------------------------------------------- * * ImportObjCmd -- * @@ -1243,16 +1047,16 @@ 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 *script = NULL; - Tcl_Obj *password = NULL; + Tcl_Obj *cmdObj = NULL; + Tcl_Obj *passwdObj = NULL; Tcl_Obj *vcmd = NULL; Tcl_DString upperChannelTranslation, upperChannelBlocking, upperChannelEncoding, upperChannelEOFChar; int idx; - Tcl_Size len; + 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; @@ -1265,11 +1069,12 @@ char *CAdir = NULL; char *DHparams = NULL; char *model = NULL; char *servername = NULL; /* hostname for Server Name Indication */ const unsigned char *session_id = NULL; - Tcl_Obj *alpn = NULL; + 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; (void) clientData; @@ -1303,49 +1108,107 @@ /* Make sure to operate on the topmost channel */ chan = Tcl_GetTopChannel(chan); for (idx = 2; idx < objc; idx++) { - char *opt = Tcl_GetStringFromObj(objv[idx], (Tcl_Size *)NULL); + if (Tcl_GetIndexFromObj(interp, objv[idx], command_opts, "option", 0, &fn) != TCL_OK) { + return TCL_ERROR; + } - if (opt[0] != '-') + /* Validate arg has value */ + if (++idx >= objc) { + Tcl_AppendResult(interp, "No value for option \"", command_opts[fn], "\"", (char *) NULL); + return TCL_ERROR; + } + + switch(fn) { + case _opt_alpn: + alpnObj = objv[idx]; + break; + case _opt_cadir: + GET_OPT_STRING(objv[idx], CAdir, NULL); + break; + case _opt_cafile: + GET_OPT_STRING(objv[idx], CAfile, NULL); + break; + case _opt_cert: + GET_OPT_BYTE_ARRAY(objv[idx], cert, &cert_len); + break; + case _opt_certfile: + GET_OPT_STRING(objv[idx], certfile, NULL); + break; + case _opt_cipher: + case _opt_ciphers: + GET_OPT_STRING(objv[idx], ciphers, NULL); + break; + case _opt_ciphersuite: + GET_OPT_STRING(objv[idx], ciphersuites, NULL); + break; + case _opt_cmd: + cmdObj = objv[idx]; + break; + case _opt_dhparams: + GET_OPT_STRING(objv[idx], DHparams, NULL); + break; + case _opt_key: + GET_OPT_BYTE_ARRAY(objv[idx], key, &key_len); + break; + case _opt_keyfile: + GET_OPT_STRING(objv[idx], keyfile, NULL); + break; + case _opt_model: + GET_OPT_STRING(objv[idx], model, NULL); + break; + case _opt_password: + passwdObj = objv[idx]; + break; + case _opt_handshake: + GET_OPT_BOOL(objv[idx], &post_handshake); + break; + case _opt_request: + GET_OPT_BOOL(objv[idx], &request); + break; + case _opt_require: + GET_OPT_BOOL(objv[idx], &require); + break; + case _opt_security_level: + GET_OPT_INT(objv[idx], &level); + break; + case _opt_server: + GET_OPT_BOOL(objv[idx], &server); + break; + case _opt_servername: + GET_OPT_STRING(objv[idx], servername, NULL); + break; + case _opt_session_id: + GET_OPT_BYTE_ARRAY(objv[idx], session_id, &sess_len); + break; + case _opt_ssl2: + GET_OPT_INT(objv[idx], &ssl2); + break; + case _opt_ssl3: + GET_OPT_INT(objv[idx], &ssl3); + break; + case _opt_tls1: + GET_OPT_INT(objv[idx], &tls1); + break; + case _opt_tls11: + GET_OPT_INT(objv[idx], &tls1_1); + break; + case _opt_tls12: + GET_OPT_INT(objv[idx], &tls1_2); + break; + case _opt_tls13: + GET_OPT_INT(objv[idx], &tls1_3); + break; + case _opt_validate: + case _opt_vcmd: + vcmd = objv[idx]; 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("-request", request); - OPTBOOL("-require", require); - OPTINT("-security_level", level); - OPTBOOL("-server", server); - OPTSTR("-servername", servername); - OPTSTR("-session_id", session_id); - OPTBOOL("-ssl2", ssl2); - OPTBOOL("-ssl3", ssl3); - OPTBOOL("-tls1", tls1); - OPTBOOL("-tls1.1", tls1_1); - OPTBOOL("-tls1.2", tls1_2); - OPTBOOL("-tls1.3", tls1_3); - OPTOBJ("-validatecommand", vcmd); - OPTOBJ("-vcmd", vcmd); - - OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -post_handshake, -request, -require, -security_level, -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; @@ -1375,23 +1238,23 @@ statePtr->interp = interp; statePtr->vflags = verify; statePtr->err = ""; /* allocate script */ - if (script) { - (void) Tcl_GetStringFromObj(script, &len); + if (cmdObj != NULL) { + (void) Tcl_GetStringFromObj(cmdObj, &len); if (len) { - statePtr->callback = script; + statePtr->callback = cmdObj; Tcl_IncrRefCount(statePtr->callback); } } /* allocate password */ - if (password) { - (void) Tcl_GetStringFromObj(password, &len); + if (passwdObj != NULL) { + (void) Tcl_GetStringFromObj(passwdObj, &len); if (len) { - statePtr->password = password; + statePtr->password = passwdObj; Tcl_IncrRefCount(statePtr->password); } } /* allocate validate command */ @@ -1499,31 +1362,31 @@ return TCL_ERROR; } } /* Resume session id */ - if (session_id && strlen(session_id) <= SSL_MAX_SID_CTX_LENGTH) { + if (session_id && sess_len <= SSL_MAX_SID_CTX_LENGTH) { /* SSL_set_session() */ - if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) strlen(session_id))) { + if (!SSL_SESSION_set1_id_context(SSL_get_session(statePtr->ssl), session_id, (unsigned int) sess_len)) { Tcl_AppendResult(interp, "Resume session failed: ", GET_ERR_REASON(), (char *) NULL); Tcl_SetErrorCode(interp, "TLS", "IMPORT", "SESSION", "FAILED", (char *) NULL); Tls_Free((char *) statePtr); return TCL_ERROR; } } /* Enable Application-Layer Protocol Negotiation. Examples are: http/1.0, http/1.1, h2, h3, ftp, imap, pop3, xmpp-client, xmpp-server, mqtt, irc, etc. */ - if (alpn) { + if (alpnObj != NULL) { /* Convert a TCL list into a protocol-list in wire-format */ unsigned char *protos, *p; unsigned int protos_len = 0; Tcl_Size cnt, i; int j; Tcl_Obj **list; - if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, alpnObj, &cnt, &list) != TCL_OK) { Tls_Free((char *) statePtr); return TCL_ERROR; } /* Determine the memory required for the protocol-list */ @@ -1568,10 +1431,11 @@ /* * SSL Callbacks */ SSL_set_app_data(statePtr->ssl, (void *)statePtr); /* point back to us */ + SSL_set_verify(statePtr->ssl, verify, VerifyCallback); SSL_set_info_callback(statePtr->ssl, InfoCallback); /* Callback for observing protocol messages */ #ifndef OPENSSL_NO_SSL_TRACE @@ -2094,10 +1958,11 @@ if (objc == 2) { peer = SSL_get_peer_certificate(statePtr->ssl); } else { peer = SSL_get_certificate(statePtr->ssl); } + /* Get X509 certificate info */ if (peer) { objPtr = Tls_NewX509Obj(interp, peer); if (objc == 2) { X509_free(peer); @@ -2192,11 +2057,11 @@ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "channel"); return(TCL_ERROR); } - chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *)NULL), NULL); + chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], (Tcl_Size *) NULL), NULL); if (chan == (Tcl_Channel) NULL) { return(TCL_ERROR); } /* Make sure to operate on the topmost channel */ @@ -2222,11 +2087,11 @@ /* Get protocol */ LAPPEND_STR(interp, objPtr, "protocol", SSL_get_version(ssl), -1); /* Renegotiation allowed */ - LAPPEND_BOOL(interp, objPtr, "renegotiation_allowed", SSL_get_secure_renegotiation_support(ssl)); + LAPPEND_BOOL(interp, objPtr, "renegotiation_allowed", SSL_get_secure_renegotiation_support((SSL *) ssl)); /* Get security level */ LAPPEND_INT(interp, objPtr, "security_level", SSL_get_security_level(ssl)); /* Session info */ @@ -2262,44 +2127,45 @@ the rest of the bits are fixed, i.e. for limited export ciphers (bits < 56) */ /* Indicates which SSL/TLS protocol version first defined the cipher */ LAPPEND_STR(interp, objPtr, "min_version", SSL_CIPHER_get_version(cipher), -1); - /* Cipher NID */ + /* Cipher NID, digest NID (none for AEAD cipher suites), Key Exchange NID, and authentication NID */ LAPPEND_STR(interp, objPtr, "cipherNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_cipher_nid(cipher)), -1); LAPPEND_STR(interp, objPtr, "digestNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_digest_nid(cipher)), -1); LAPPEND_STR(interp, objPtr, "keyExchangeNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_kx_nid(cipher)), -1); LAPPEND_STR(interp, objPtr, "authenticationNID", (char *)OBJ_nid2ln(SSL_CIPHER_get_auth_nid(cipher)), -1); /* message authentication code - Cipher is AEAD (e.g. GCM or ChaCha20/Poly1305) or not */ /* Authenticated Encryption with associated data (AEAD) check */ LAPPEND_BOOL(interp, objPtr, "cipher_is_aead", SSL_CIPHER_is_aead(cipher)); - /* Digest used during the SSL/TLS handshake when using the cipher. */ - md = SSL_CIPHER_get_handshake_digest(cipher); - LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1); - /* Get OpenSSL-specific ID, not IANA ID */ LAPPEND_INT(interp, objPtr, "cipher_id", (int) SSL_CIPHER_get_id(cipher)); /* Two-byte ID used in the TLS protocol of the given cipher */ LAPPEND_INT(interp, objPtr, "protocol_id", (int) SSL_CIPHER_get_protocol_id(cipher)); - /* Textual description of the cipher */ + /* Textual description of the cipher. Includes: cipher name, protocol version, key + exchange, authentication, symmetric encryption method, message authentication code */ if (SSL_CIPHER_description(cipher, buf, sizeof(buf)) != NULL) { LAPPEND_STR(interp, objPtr, "description", buf, -1); } + + /* Digest used during the SSL/TLS handshake when using the cipher. */ + md = SSL_CIPHER_get_handshake_digest(cipher); + LAPPEND_STR(interp, objPtr, "handshake_digest", (char *)EVP_MD_name(md), -1); } /* Session info */ session = SSL_get_session(ssl); if (session != NULL) { const unsigned char *ticket; size_t len2; unsigned int ulen; const unsigned char *session_id, *proto; - char buffer[SSL_MAX_MASTER_KEY_LENGTH]; + unsigned char buffer[SSL_MAX_MASTER_KEY_LENGTH]; /* Report the selected protocol as a result of the ALPN negotiation */ SSL_SESSION_get0_alpn_selected(session, &proto, &len2); LAPPEND_STR(interp, objPtr, "alpn", (char *) proto, (Tcl_Size) len2); @@ -2332,12 +2198,14 @@ /* Session ticket lifetime hint (in seconds) */ LAPPEND_LONG(interp, objPtr, "lifetime", SSL_SESSION_get_ticket_lifetime_hint(session)); /* Ticket app data */ - SSL_SESSION_get0_ticket_appdata(session, &ticket, &len2); +#if OPENSSL_VERSION_NUMBER < 0x30000000L + SSL_SESSION_get0_ticket_appdata((SSL_SESSION *) session, &ticket, &len2); LAPPEND_BARRAY(interp, objPtr, "ticket_app_data", ticket, (Tcl_Size) len2); +#endif /* Get master key */ len2 = SSL_SESSION_get_master_key(session, buffer, SSL_MAX_MASTER_KEY_LENGTH); LAPPEND_BARRAY(interp, objPtr, "master_key", buffer, (Tcl_Size) len2); @@ -2384,10 +2252,11 @@ /* IF not a server, same as SSL_get0_peer_CA_list. If server same as SSL_CTX_get_client_CA_list */ listPtr = Tcl_NewListObj(0, NULL); STACK_OF(X509_NAME) *ca_list; if ((ca_list = SSL_get_client_CA_list(ssl)) != NULL) { char buffer[BUFSIZ]; + for (int i = 0; i < sk_X509_NAME_num(ca_list); i++) { X509_NAME *name = sk_X509_NAME_value(ca_list, i); if (name) { X509_NAME_oneline(name, buffer, BUFSIZ); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(buffer, -1)); @@ -2395,39 +2264,12 @@ } } LAPPEND_OBJ(interp, objPtr, "caList", listPtr); LAPPEND_INT(interp, objPtr, "caListCount", sk_X509_NAME_num(ca_list)); - Tcl_SetObjResult(interp, objPtr); - return TCL_OK; -} - -/* - *------------------------------------------------------------------- - * - * VersionObjCmd -- return version string from OpenSSL. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *------------------------------------------------------------------- - */ -static int -VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr; - (void) clientData; - (void) objc; - (void) objv; - - dprintf("Called"); - - objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); - Tcl_SetObjResult(interp, objPtr); - + + Tcl_SetObjResult(interp, objPtr); return TCL_OK; } /* *------------------------------------------------------------------- @@ -2779,19 +2621,22 @@ if (TlsLibInit(0) != TCL_OK) { Tcl_AppendResult(interp, "could not initialize SSL library", (char *) NULL); return TCL_ERROR; } - Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); + + Tls_DigestCommands(interp); + Tls_EncryptCommands(interp); + Tls_InfoCommands(interp); + Tls_KDFCommands(interp); + Tls_RandCommands(interp); if (interp) { Tcl_Eval(interp, tlsTclInitScript); } @@ -2921,10 +2766,10 @@ RAND_seed(rnd_seed, sizeof(rnd_seed)); } while (RAND_status() != 1); #endif #if defined(OPENSSL_THREADS) && defined(TCL_THREADS) - Tcl_MutexUnlock(&init_mx); + Tcl_MutexUnlock(&init_mx); #endif return(status); }