/* * Information Commands Module * * Provides commands that return info related to the OpenSSL config and data. * * Copyright (C) 2023 Brian O'Hagan * */ #include "tlsInt.h" #include #include #include #if OPENSSL_VERSION_NUMBER >= 0x30000000L #include #endif /* * Valid SSL and TLS Protocol Versions */ 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 }; /*******************************************************************/ /* *------------------------------------------------------------------- * * NamesCallback -- * * Callback to add algorithm or method names to a TCL list object. * * Results: * Append name to TCL list object. * * Side effects: * None. * *------------------------------------------------------------------- */ void NamesCallback(const OBJ_NAME *obj, void *arg) { Tcl_Obj *listObj = (Tcl_Obj *) arg; /* Fields: (int) type and alias, (const char*) name (alias from) and data (alias to) */ if (strstr(obj->name, "rsa") == NULL && strstr(obj->name, "RSA") == NULL) { Tcl_ListObjAppendElement(NULL, listObj, Tcl_NewStringObj(obj->name, -1)); } } /*******************************************************************/ /* *------------------------------------------------------------------- * * CipherInfo -- * * Return a list of properties and values for cipher. * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int CipherInfo(Tcl_Interp *interp, Tcl_Obj *nameObj) { const EVP_CIPHER *cipher; Tcl_Obj *resultObj, *listObj; unsigned long flags, mode; char *modeName = NULL; char *name = Tcl_GetString(nameObj); /* Get cipher */ cipher = EVP_get_cipherbyname(name); if (cipher == NULL) { Tcl_AppendResult(interp, "Invalid cipher \"", name, "\"", (char *) NULL); return TCL_ERROR; } /* Get properties */ resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } LAPPEND_STR(interp, resultObj, "nid", OBJ_nid2ln(EVP_CIPHER_nid(cipher)), -1); LAPPEND_STR(interp, resultObj, "name", EVP_CIPHER_name(cipher), -1); LAPPEND_STR(interp, resultObj, "description", "", -1); LAPPEND_INT(interp, resultObj, "block_size", EVP_CIPHER_block_size(cipher)); LAPPEND_INT(interp, resultObj, "key_length", EVP_CIPHER_key_length(cipher)); LAPPEND_INT(interp, resultObj, "iv_length", EVP_CIPHER_iv_length(cipher)); LAPPEND_STR(interp, resultObj, "type", OBJ_nid2ln(EVP_CIPHER_type(cipher)), -1); LAPPEND_STR(interp, resultObj, "provider", "", -1); flags = EVP_CIPHER_flags(cipher); mode = EVP_CIPHER_mode(cipher); /* EVP_CIPHER_get_mode */ switch(mode) { case EVP_CIPH_STREAM_CIPHER: modeName = "STREAM"; break; case EVP_CIPH_ECB_MODE: modeName = "ECB"; break; case EVP_CIPH_CBC_MODE: modeName = "CBC"; break; case EVP_CIPH_CFB_MODE: modeName = "CFB"; break; case EVP_CIPH_OFB_MODE: modeName = "OFB"; break; case EVP_CIPH_CTR_MODE: modeName = "CTR"; break; case EVP_CIPH_GCM_MODE: modeName = "GCM"; break; case EVP_CIPH_XTS_MODE: modeName = "XTS"; break; case EVP_CIPH_CCM_MODE: modeName = "CCM"; break; case EVP_CIPH_OCB_MODE: modeName = "OCB"; break; case EVP_CIPH_WRAP_MODE : modeName = "WRAP"; break; default: modeName = "unknown"; break; } LAPPEND_STR(interp, resultObj, "mode", modeName, -1); /* Flags */ listObj = Tcl_NewListObj(0, NULL); LAPPEND_BOOL(interp, listObj, "Variable Length", flags & EVP_CIPH_VARIABLE_LENGTH); LAPPEND_BOOL(interp, listObj, "Always Call Init", flags & EVP_CIPH_ALWAYS_CALL_INIT); LAPPEND_BOOL(interp, listObj, "Custom IV", flags & EVP_CIPH_CUSTOM_IV); LAPPEND_BOOL(interp, listObj, "Control Init", flags & EVP_CIPH_CTRL_INIT); LAPPEND_BOOL(interp, listObj, "Custom Cipher", flags & EVP_CIPH_FLAG_CUSTOM_CIPHER); LAPPEND_BOOL(interp, listObj, "AEAD Cipher", flags & EVP_CIPH_FLAG_AEAD_CIPHER); LAPPEND_BOOL(interp, listObj, "Custom Copy", flags & EVP_CIPH_CUSTOM_COPY); LAPPEND_BOOL(interp, listObj, "Non FIPS Allow", flags & EVP_CIPH_FLAG_NON_FIPS_ALLOW); LAPPEND_OBJ(interp, resultObj, "flags", listObj); /* CTX only properties */ { EVP_CIPHER_CTX *ctx = EVP_CIPHER_CTX_new(); int tag_len = 0; EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL); if (mode == EVP_CIPH_GCM_MODE || mode == EVP_CIPH_OCB_MODE) { tag_len = EVP_GCM_TLS_TAG_LEN; /* EVP_MAX_AEAD_TAG_LENGTH */ } else if (mode == EVP_CIPH_CCM_MODE) { tag_len = EVP_CCM_TLS_TAG_LEN; } else if (cipher == EVP_get_cipherbyname("chacha20-poly1305")) { tag_len = EVP_CHACHAPOLY_TLS_TAG_LEN; /* POLY1305_BLOCK_SIZE */ } EVP_CIPHER_CTX_free(ctx); LAPPEND_INT(interp, resultObj, "tag_length", tag_len); } /* AEAD properties */ { int aad_len = 0; if (flags & EVP_CIPH_FLAG_AEAD_CIPHER) { aad_len = EVP_AEAD_TLS1_AAD_LEN; } LAPPEND_INT(interp, resultObj, "aad_length", aad_len); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *------------------------------------------------------------------- * * CipherList -- * * Return a list of all cipher algorithms * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int CipherList(Tcl_Interp *interp) { Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } /* Same as EVP_CIPHER_do_all */ OBJ_NAME_do_all(OBJ_NAME_TYPE_CIPHER_METH, NamesCallback, (void *) resultObj); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *------------------------------------------------------------------- * * CipherObjCmd -- * * Return a list of properties and values for cipherName. * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ static int CipherObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { (void) clientData; dprintf("Called"); /* Clear errors */ Tcl_ResetResult(interp); ERR_clear_error(); /* Validate arg count */ if (objc == 1) { return CipherList(interp); } else if (objc == 2) { return CipherInfo(interp, objv[1]); } else { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } return TCL_OK; } /* *------------------------------------------------------------------- * * CiphersObjCmd -- * * 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 int CiphersObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { SSL_CTX *ctx = NULL; SSL *ssl = NULL; STACK_OF(SSL_CIPHER) *sk = NULL; Tcl_Size index; int verbose = 0, use_supported = 0, res = TCL_OK; int min_version, max_version; (void) clientData; dprintf("Called"); /* 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) { return CipherList(interp); } /* 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; } switch ((enum protocol)index) { case TLS_SSL2: Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL); return TCL_ERROR; case TLS_SSL3: #if defined(NO_SSL3) || defined(OPENSSL_NO_SSL3) || defined(OPENSSL_NO_SSL3_METHOD) Tcl_AppendResult(interp, protocols[index], ": protocol not supported", (char *) NULL); return TCL_ERROR; #else 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", (char *) NULL); return TCL_ERROR; #else 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", (char *) NULL); return TCL_ERROR; #else 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", (char *) NULL); return TCL_ERROR; #else 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", (char *) NULL); return TCL_ERROR; #else min_version = TLS1_3_VERSION; max_version = TLS1_3_VERSION; break; #endif default: min_version = SSL3_VERSION; max_version = TLS1_3_VERSION; break; } /* Create context */ if ((ctx = SSL_CTX_new(TLS_server_method())) == NULL) { Tcl_AppendResult(interp, GET_ERR_REASON(), (char *) NULL); return TCL_ERROR; } /* 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, GET_ERR_REASON(), (char *) 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); /*sk = SSL_CTX_get_ciphers(ctx);*/ } if (sk != NULL) { Tcl_Obj *resultObj = NULL; if (!verbose) { const char *cp; resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { res = TCL_ERROR; goto done; } 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, resultObj, Tcl_NewStringObj((char *) cp, -1)); } } else { char buf[BUFSIZ]; resultObj = Tcl_NewStringObj("", 0); if (resultObj == NULL) { res = TCL_ERROR; goto done; } 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(resultObj, buf, (Tcl_Size) strlen(buf)); } else { Tcl_AppendToObj(resultObj, "UNKNOWN\n", 8); } } } /* Clean up */ if (use_supported) { sk_SSL_CIPHER_free(sk); } Tcl_SetObjResult(interp, resultObj); } done: SSL_free(ssl); SSL_CTX_free(ctx); return res; } /*******************************************************************/ /* *------------------------------------------------------------------- * * DigestInfo -- * * Return a list of properties and values for digest. * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int DigestInfo(Tcl_Interp *interp, Tcl_Obj *nameObj) { const EVP_MD *md; Tcl_Obj *resultObj, *listObj; unsigned long flags; char *name = Tcl_GetString(nameObj); /* Get message digest */ md = EVP_get_digestbyname(name); if (md == NULL) { Tcl_AppendResult(interp, "Invalid digest \"", name, "\"", (char *) NULL); return TCL_ERROR; } /* Get properties */ resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } LAPPEND_STR(interp, resultObj, "name", EVP_MD_name(md), -1); LAPPEND_STR(interp, resultObj, "description", "", -1); LAPPEND_INT(interp, resultObj, "size", EVP_MD_size(md)); LAPPEND_INT(interp, resultObj, "block_size", EVP_MD_block_size(md)); LAPPEND_STR(interp, resultObj, "provider", "", -1); LAPPEND_STR(interp, resultObj, "type", OBJ_nid2ln(EVP_MD_type(md)), -1); LAPPEND_STR(interp, resultObj, "pkey_type", OBJ_nid2ln(EVP_MD_pkey_type(md)), -1); flags = EVP_MD_flags(md); /* Flags */ listObj = Tcl_NewListObj(0, NULL); LAPPEND_BOOL(interp, listObj, "One-shot", flags & EVP_MD_FLAG_ONESHOT); LAPPEND_BOOL(interp, listObj, "XOF", flags & EVP_MD_FLAG_XOF); LAPPEND_BOOL(interp, listObj, "DigestAlgorithmId_NULL", flags & EVP_MD_FLAG_DIGALGID_NULL); LAPPEND_BOOL(interp, listObj, "DigestAlgorithmId_Abscent", flags & EVP_MD_FLAG_DIGALGID_ABSENT); LAPPEND_BOOL(interp, listObj, "DigestAlgorithmId_Custom", flags & EVP_MD_FLAG_DIGALGID_CUSTOM); LAPPEND_BOOL(interp, listObj, "FIPS", flags & EVP_MD_FLAG_FIPS); LAPPEND_OBJ(interp, resultObj, "flags", listObj); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *------------------------------------------------------------------- * * DigestList -- * * Return a list of all digest algorithms * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int DigestList(Tcl_Interp *interp) { Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } /* Same as EVP_MD_do_all */ OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) resultObj); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *------------------------------------------------------------------- * * DigestsObjCmd -- * * Return a list of all valid hash algorithms or message digests. * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int DigestsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { (void) clientData; dprintf("Called"); /* Clear errors */ Tcl_ResetResult(interp); ERR_clear_error(); /* Validate arg count */ if (objc == 1) { return DigestList(interp); } else if (objc == 2) { return DigestInfo(interp, objv[1]); } else { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } return TCL_OK; } /*******************************************************************/ /* *------------------------------------------------------------------- * * KdfList -- * * Return a list of all KDF algorithms * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int KdfList(Tcl_Interp *interp, char *select_name) { Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("hkdf", -1)); Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("pbkdf2", -1)); Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("scrypt", -1)); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *------------------------------------------------------------------- * * KdfsObjCmd -- * * Return a list of all valid Key Derivation Function (KDF). * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int KdfsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { (void) clientData; dprintf("Called"); /* Clear errors */ Tcl_ResetResult(interp); ERR_clear_error(); /* Validate arg count */ if (objc == 1) { return KdfList(interp, NULL); } else if (objc == 2) { } else { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } return TCL_OK; } /*******************************************************************/ /* *------------------------------------------------------------------- * * MacInfo -- * * Return a list of properties and values for macName. * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int MacInfo(Tcl_Interp *interp, Tcl_Obj *nameObj) { Tcl_Obj *resultObj; int res = TCL_OK; char *name = Tcl_GetString(nameObj); if (strcmp(name, "cmac") != 0 && strcmp(name, "hmac") != 0) { Tcl_AppendResult(interp, "Invalid MAC \"", name, "\"", (char *) NULL); return TCL_ERROR; } /* Get properties */ resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } LAPPEND_STR(interp, resultObj, "name", name, -1); LAPPEND_STR(interp, resultObj, "description", "", -1); LAPPEND_STR(interp, resultObj, "provider", "", -1); Tcl_SetObjResult(interp, resultObj); return res; } /* *------------------------------------------------------------------- * * MacList -- * * Return a list of all MAC algorithms * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int MacList(Tcl_Interp *interp) { Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("cmac", -1)); Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj("hmac", -1)); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *------------------------------------------------------------------- * * MacsObjCmd -- * * Return a list of all valid message authentication codes (MAC). * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int MacsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { (void) clientData; dprintf("Called"); /* Clear errors */ Tcl_ResetResult(interp); ERR_clear_error(); /* Validate arg count */ if (objc == 1) { return MacList(interp); } else if (objc == 2) { return MacInfo(interp, objv[1]); } else { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } return TCL_OK; } /*******************************************************************/ /* *------------------------------------------------------------------- * * PkeyInfo -- * * Return a list of properties and values for pkey. * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int PkeyInfo(Tcl_Interp *interp, Tcl_Obj *nameObj) { Tcl_Obj *resultObj; int res = TCL_OK; char *name = Tcl_GetString(nameObj); EVP_PKEY *pkey = NULL; if (pkey == NULL) { Tcl_AppendResult(interp, "Invalid public key method \"", name, "\"", (char *) NULL); return TCL_ERROR; } /* Get properties */ resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } LAPPEND_STR(interp, resultObj, "name", OBJ_nid2ln(EVP_PKEY_id(pkey)), -1); LAPPEND_STR(interp, resultObj, "description", "", -1); LAPPEND_INT(interp, resultObj, "size", EVP_PKEY_size(pkey)); LAPPEND_INT(interp, resultObj, "bits", EVP_PKEY_bits(pkey)); LAPPEND_INT(interp, resultObj, "security_bits", EVP_PKEY_security_bits(pkey)); LAPPEND_STR(interp, resultObj, "baseId", OBJ_nid2ln(EVP_PKEY_base_id(pkey)), -1); LAPPEND_STR(interp, resultObj, "provider", "", -1); LAPPEND_STR(interp, resultObj, "type", OBJ_nid2ln(EVP_PKEY_type(EVP_PKEY_id(pkey))), -1); { int pnid; if (EVP_PKEY_get_default_digest_nid(pkey, &pnid) > 0) { LAPPEND_STR(interp, resultObj, "default_digest", OBJ_nid2ln(pnid), -2); } } Tcl_SetObjResult(interp, resultObj); return res; } /* *------------------------------------------------------------------- * * PkeyList -- * * Return a list of all public key methods * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int PkeyList(Tcl_Interp *interp) { Tcl_Obj *resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } for (size_t i = 0; i < EVP_PKEY_meth_get_count(); i++) { const EVP_PKEY_METHOD *pmeth = EVP_PKEY_meth_get0(i); int pkey_id, pkey_flags; EVP_PKEY_meth_get0_info(&pkey_id, &pkey_flags, pmeth); /*LAPPEND_STR(interp, resultObj, "name", OBJ_nid2ln(pkey_id), -1); LAPPEND_STR(interp, resultObj, "type", pkey_flags & ASN1_PKEY_DYNAMIC ? "External" : "Built-in", -1);*/ Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(OBJ_nid2ln(pkey_id), -1)); } Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /* *------------------------------------------------------------------- * * PkeysObjCmd -- * * Return a list of all valid hash algorithms or message digests. * * Results: * A standard Tcl list. * * Side effects: * None. * *------------------------------------------------------------------- */ int PkeysObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { (void) clientData; dprintf("Called"); /* Clear errors */ Tcl_ResetResult(interp); ERR_clear_error(); /* Validate arg count */ if (objc == 1) { return PkeyList(interp); } else if (objc == 2) { return PkeyInfo(interp, objv[1]); } else { Tcl_WrongNumArgs(interp, 1, objv, "?name?"); return TCL_ERROR; } return TCL_OK; } /*******************************************************************/ /* *------------------------------------------------------------------- * * ProtocolsObjCmd -- * * Return a list of the available or supported SSL/TLS protocols. * * Results: * A standard Tcl list. * * Side effects: * none * *------------------------------------------------------------------- */ static int ProtocolsObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj; (void) clientData; dprintf("Called"); /* Clear errors */ Tcl_ResetResult(interp); ERR_clear_error(); /* Validate arg count */ if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } /* List all protocols */ resultObj = Tcl_NewListObj(0, NULL); if (resultObj == NULL) { return TCL_ERROR; } #if OPENSSL_VERSION_NUMBER < 0x10100000L && !defined(NO_SSL2) && !defined(OPENSSL_NO_SSL2) Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(protocols[TLS_SSL2], -1)); #endif #if !defined(NO_SSL3) && !defined(OPENSSL_NO_SSL3) && !defined(OPENSSL_NO_SSL3_METHOD) Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(protocols[TLS_SSL3], -1)); #endif #if !defined(NO_TLS1) && !defined(OPENSSL_NO_TLS1) && !defined(OPENSSL_NO_TLS1_METHOD) Tcl_ListObjAppendElement(interp, resultObj, 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, resultObj, 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, resultObj, Tcl_NewStringObj(protocols[TLS_TLS1_2], -1)); #endif #if !defined(NO_TLS1_3) && !defined(OPENSSL_NO_TLS1_3) Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewStringObj(protocols[TLS_TLS1_3], -1)); #endif Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /*******************************************************************/ /* *------------------------------------------------------------------- * * ProviderObjCmd -- * * Load a provider. * * Results: * A standard Tcl result. * * Side effects: * None. * *------------------------------------------------------------------- */ #if OPENSSL_VERSION_NUMBER >= 0x30000000L static int ProviderObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { char *name; (void) clientData; dprintf("Called"); /* Validate arg count */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } name = Tcl_GetString(objv[1]); if (!OSSL_PROVIDER_try_load(NULL, (const char *) name, 1)) { Tcl_AppendResult(interp, GET_ERR_REASON(), (char *) NULL); return TCL_ERROR; } return TCL_OK; } #endif /*******************************************************************/ /* *------------------------------------------------------------------- * * VersionObjCmd -- * * Return a string with the OpenSSL version info. * * Results: * A standard Tcl result. * * Side effects: * None. * *------------------------------------------------------------------- */ static int VersionObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj; (void) clientData; dprintf("Called"); /* Validate arg count */ if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } resultObj = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } /*******************************************************************/ /* *------------------------------------------------------------------- * * Tls_InfoCommands -- * * Create info commands * * Returns: * TCL_OK or TCL_ERROR * * Side effects: * Creates commands * *------------------------------------------------------------------- */ int Tls_InfoCommands(Tcl_Interp *interp) { #if OPENSSL_VERSION_NUMBER < 0x10100000L OpenSSL_add_all_ciphers(); OpenSSL_add_all_digests(); OpenSSL_add_all_algorithms(); #endif Tcl_CreateObjCommand(interp, "::tls::cipher", CipherObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "::tls::ciphers", CiphersObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "::tls::digests", DigestsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "::tls::kdfs", KdfsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "::tls::macs", MacsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "::tls::pkeys", PkeysObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "::tls::protocols", ProtocolsObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); #if OPENSSL_VERSION_NUMBER >= 0x30000000L Tcl_CreateObjCommand(interp, "::tls::provider", ProviderObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); #endif Tcl_CreateObjCommand(interp, "::tls::version", VersionObjCmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; }