Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -29,10 +29,11 @@
tls::status ?-local? channel
tls::connection channel
tls::import channel ?options?
tls::unimport channel
+ tls::cipher name
tls::ciphers ?protocol? ?verbose? ?supported?
tls::digests ?name?
tls::macs
tls::protocols
tls::version
@@ -73,10 +74,11 @@
tls::connection channel
tls::handshake channel
tls::import channel ?options?
tls::unimport channel
+tls::cipher name
tls::ciphers ?protocol? ?verbose? ?supported?
tls::digests ?name?
tls::macs
tls::protocols
tls::version
@@ -433,10 +435,15 @@
Unique session master key.
session_cache_mode mode
Server cache mode (client, server, or both).
+
+ tls::cipher name
+ Return a list of property names and values describing cipher
+ name. Properties include name, description, block_size,
+ key_length, iv_length, type, and mode list.
tls::ciphers
?protocol? ?verbose? ?supported?
Without any args, returns a list of all ciphers. With protocol,
only the ciphers supported for that protocol are returned. See
Index: generic/tlsInfo.c
==================================================================
--- generic/tlsInfo.c
+++ generic/tlsInfo.c
@@ -48,11 +48,127 @@
if (strstr(obj->name, "rsa") == NULL && strstr(obj->name, "RSA") == NULL) {
Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(obj->name,-1));
}
}
}
-
+
+/*******************************************************************/
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * CipherInfo --
+ *
+ * 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[]) {
+ Tcl_Obj *objPtr, *listPtr;
+ unsigned char *cipherName = NULL, *modeName = NULL;
+ const EVP_CIPHER *cipher;
+ unsigned long flags, mode;
+
+#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 != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+
+ /* Get cipher */
+ cipherName = Tcl_GetStringFromObj(objv[1], NULL);
+ cipher = EVP_get_cipherbyname(cipherName);
+
+ if (cipher == NULL) {
+ Tcl_AppendResult(interp, "Invalid cipher \"", cipherName, "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Get properties */
+ objPtr = Tcl_NewListObj(0, NULL);
+ LAPPEND_STR(interp, objPtr, "nid", OBJ_nid2ln(EVP_CIPHER_nid(cipher)), -1);
+ LAPPEND_STR(interp, objPtr, "name", EVP_CIPHER_name(cipher), -1);
+ LAPPEND_STR(interp, objPtr, "description", "", -1);
+ LAPPEND_INT(interp, objPtr, "block_size", EVP_CIPHER_block_size(cipher));
+ LAPPEND_INT(interp, objPtr, "key_length", EVP_CIPHER_key_length(cipher));
+ LAPPEND_INT(interp, objPtr, "iv_length", EVP_CIPHER_iv_length(cipher));
+ LAPPEND_STR(interp, objPtr, "type", OBJ_nid2ln(EVP_CIPHER_type(cipher)), -1);
+ LAPPEND_STR(interp, objPtr, "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, objPtr, "mode", modeName, -1);
+
+ /* Flags */
+ listPtr = Tcl_NewListObj(0, NULL);
+ LAPPEND_BOOL(interp, listPtr, "Variable Length", flags & EVP_CIPH_VARIABLE_LENGTH);
+ LAPPEND_BOOL(interp, listPtr, "Always Call Init", flags & EVP_CIPH_ALWAYS_CALL_INIT);
+ LAPPEND_BOOL(interp, listPtr, "Custom IV", flags & EVP_CIPH_CUSTOM_IV);
+ LAPPEND_BOOL(interp, listPtr, "Control Init", flags & EVP_CIPH_CTRL_INIT);
+ LAPPEND_BOOL(interp, listPtr, "Custom Cipher", flags & EVP_CIPH_FLAG_CUSTOM_CIPHER);
+ LAPPEND_BOOL(interp, listPtr, "AEAD Cipher", flags & EVP_CIPH_FLAG_AEAD_CIPHER);
+ LAPPEND_BOOL(interp, listPtr, "Custom Copy", flags & EVP_CIPH_CUSTOM_COPY);
+ LAPPEND_BOOL(interp, listPtr, "Non FIPS Allow", flags & EVP_CIPH_FLAG_NON_FIPS_ALLOW);
+ LAPPEND_OBJ(interp, objPtr, "flags", listPtr);
+
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+}
+
/*
*-------------------------------------------------------------------
*
* CiphersObjCmd --
*
@@ -210,24 +326,13 @@
} 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;
- /* Get OpenSSL-specific ID, not IANA ID */
- /*id = SSL_CIPHER_get_id(c);*/
-
- /* TLS protocol two-byte id */
- /*id = SSL_CIPHER_get_protocol_id(c);*/
-
- /* Standard RFC name of cipher or (NONE) */
- /*const char *nm = SSL_CIPHER_standard_name(c);
- if (nm == NULL) {nm = "UNKNOWN";}*/
-
/* 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);
@@ -245,11 +350,13 @@
SSL_free(ssl);
SSL_CTX_free(ctx);
return TCL_OK;
clientData = clientData;
}
-
+
+/*******************************************************************/
+
/*
*-------------------------------------------------------------------
*
* DigestInfo --
*
@@ -295,11 +402,11 @@
LAPPEND_OBJ(interp, objPtr, "flags", listPtr);
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
-
+
/*
*-------------------------------------------------------------------
*
* DigestsObjCmd --
*
@@ -336,11 +443,13 @@
OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, NamesCallback, (void *) objPtr);
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
-
+
+/*******************************************************************/
+
/*
*-------------------------------------------------------------------
*
* MacsObjCmd --
*
@@ -371,11 +480,13 @@
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("hmac", -1));
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
-
+
+/*******************************************************************/
+
/*
*-------------------------------------------------------------------
*
* ProtocolsObjCmd --
*
@@ -423,11 +534,13 @@
#endif
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
-
+
+/*******************************************************************/
+
/*
*-------------------------------------------------------------------
*
* VersionObjCmd --
*
@@ -456,11 +569,13 @@
objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
-
+
+/*******************************************************************/
+
/*
*-------------------------------------------------------------------
*
* Tls_InfoCommands --
*
@@ -473,12 +588,13 @@
* Creates commands
*
*-------------------------------------------------------------------
*/
int Tls_InfoCommands(Tcl_Interp *interp) {
+ Tcl_CreateObjCommand(interp, "tls::cipher", CipherObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
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::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;
}