Index: generic/tlsInfo.c ================================================================== --- generic/tlsInfo.c +++ generic/tlsInfo.c @@ -66,108 +66,118 @@ * constructs and destroys SSL context (CTX) * *------------------------------------------------------------------- */ 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]; + STACK_OF(SSL_CIPHER) *sk = NULL; int index, verbose = 0, use_supported = 0; - const SSL_METHOD *method; dprintf("Called"); - if ((objc < 1) || (objc > 4)) { +#if OPENSSL_VERSION_NUMBER < 0x10100000L + OpenSSL_add_all_ciphers(); /* Make sure they're loaded */ +#endif + + /* Clear errors */ + Tcl_ResetResult(interp); + ERR_clear_error(); + + /* Validate arg count */ + if (objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?protocol? ?verbose? ?supported?"); return TCL_ERROR; } + + /* List all ciphers */ if (objc == 1) { - /* List all ciphers */ Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL); -#if OPENSSL_VERSION_NUMBER < 0x10100000L - OpenSSL_add_all_ciphers(); /* Make sure they're loaded */ -#endif - OBJ_NAME_do_all(OBJ_NAME_TYPE_CIPHER_METH, NamesCallback, (void *) objPtr); - Tcl_ResetResult(interp); Tcl_SetObjResult(interp, objPtr); return TCL_OK; - } else 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) { + + /* Get options */ + if (Tcl_GetIndexFromObj(interp, objv[1], protocols, "protocol", 0, &index) != TCL_OK || + (objc > 2 && Tcl_GetBooleanFromObj(interp, objv[2], &verbose) != TCL_OK) || + (objc > 3 && Tcl_GetBooleanFromObj(interp, objv[3], &use_supported) != 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; + min_version = SSL3_VERSION; + max_version = SSL3_VERSION; + 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; + min_version = TLS1_VERSION; + max_version = TLS1_VERSION; + 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; + min_version = TLS1_1_VERSION; + max_version = TLS1_1_VERSION; + 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; + min_version = TLS1_2_VERSION; + max_version = TLS1_2_VERSION; + 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); + min_version = TLS1_3_VERSION; + max_version = TLS1_3_VERSION; break; #endif default: - method = TLS_method(); + min_version = SSL3_VERSION; + max_version = TLS1_3_VERSION; break; } - ctx = SSL_CTX_new(method); - if (ctx == NULL) { + /* Create context */ + if ((ctx = SSL_CTX_new(TLS_server_method())) == NULL) { Tcl_AppendResult(interp, REASON(), NULL); return TCL_ERROR; } - ssl = SSL_new(ctx); - if (ssl == NULL) { + /* Set protocol versions */ + if (SSL_CTX_set_min_proto_version(ctx, min_version) == 0 || + SSL_CTX_set_max_proto_version(ctx, max_version) == 0) { + SSL_CTX_free(ctx); + return TCL_ERROR; + } + + /* Create SSL context */ + if ((ssl = SSL_new(ctx)) == NULL) { Tcl_AppendResult(interp, REASON(), NULL); SSL_CTX_free(ctx); return TCL_ERROR; } @@ -174,15 +184,20 @@ /* 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); + /*sk = SSL_CTX_get_ciphers(ctx);*/ } if (sk != NULL) { + Tcl_Obj *objPtr = NULL; + if (!verbose) { + char *cp; 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) */ @@ -190,11 +205,13 @@ if (cp == NULL) break; Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(cp, -1)); } } else { + char buf[BUFSIZ]; objPtr = Tcl_NewStringObj("",0); + for (int i = 0; i < sk_SSL_CIPHER_num(sk); i++) { /* uint32_t id;*/ const SSL_CIPHER *c = sk_SSL_CIPHER_value(sk, i); if (c == NULL) continue; @@ -214,26 +231,28 @@ } else { Tcl_AppendToObj(objPtr, "UNKNOWN\n", 8); } } } + + /* Clean up */ if (use_supported) { sk_SSL_CIPHER_free(sk); } + Tcl_SetObjResult(interp, objPtr); } + SSL_free(ssl); SSL_CTX_free(ctx); - - Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; } /* *------------------------------------------------------------------- * - * DigestsObjCmd -- + * DigestsObjCmd -- * * Return a list of all valid hash algorithms or message digests. * * Results: * A standard Tcl list. @@ -242,28 +261,36 @@ * None. * *------------------------------------------------------------------- */ int DigestsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL); - + Tcl_Obj *objPtr; + + dprintf("Called"); + #if OPENSSL_VERSION_NUMBER < 0x10100000L OpenSSL_add_all_digests(); /* Make sure they're loaded */ #endif + /* Validate arg count */ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + /* List all digests */ + objPtr = Tcl_NewListObj(0, NULL); OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) objPtr); Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; - objc = objc; - objv = objv; } /* *------------------------------------------------------------------- * - * MacsObjCmd -- + * MacsObjCmd -- * * Return a list of all valid message authentication codes (MAC). * * Results: * A standard Tcl list. @@ -272,18 +299,27 @@ * None. * *------------------------------------------------------------------- */ int MacsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL); + Tcl_Obj *objPtr; + + dprintf("Called"); + + /* Validate arg count */ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + /* List all MACs */ + objPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cmac", -1)); Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("hmac", -1)); Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; - objc = objc; - objv = objv; } /* *------------------------------------------------------------------- * @@ -303,19 +339,18 @@ ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *objPtr; dprintf("Called"); + /* Validate arg count */ if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } - ERR_clear_error(); - + /* List all MACs */ 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)); @@ -330,11 +365,10 @@ 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; clientData = clientData; } @@ -356,17 +390,21 @@ static int VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *objPtr; dprintf("Called"); + + /* Validate arg count */ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); Tcl_SetObjResult(interp, objPtr); return TCL_OK; clientData = clientData; - objc = objc; - objv = objv; } /* *------------------------------------------------------------------- * @@ -383,10 +421,10 @@ *------------------------------------------------------------------- */ int Tls_InfoCommands(Tcl_Interp *interp) { Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::digests", DigestsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); - Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::macs", MacsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "tls::protocols", ProtocolsObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; }