Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -29,11 +29,11 @@
tls::status ?-local? channel
tls::connection channel
tls::import channel ?options?
tls::unimport channel
- tls::ciphers protocol ?verbose? ?supported?
+ tls::ciphers ?protocol? ?verbose? ?supported?
tls::protocols
tls::version
tls::hash type data
tls::hashes
@@ -69,11 +69,11 @@
tls::connection channel
tls::handshake channel
tls::import channel ?options?
tls::unimport channel
-tls::ciphers protocol ?verbose? ?supported?
+tls::ciphers ?protocol? ?verbose? ?supported?
tls::protocols
tls::version
tls::hash type data
tls::hashes
@@ -427,16 +427,17 @@
Server cache mode (client, server, or both).
tls::ciphers
- protocol ?verbose? ?supported?
- Returns a list of supported ciphers available for protocol,
- where protocol must be one of ssl2, ssl3, tls1, tls1.1,
- tls1.2, or tls1.3. If verbose is specified as
- true then a verbose, human readable list is returned with
- additional information on the cipher. If supported
+ ?protocol? ?verbose? ?supported?
+ Without any args, returns a list of all ciphers. With
+ protocol, only the ciphers supportted for that protocol
+ are returned where protocol must be one of ssl2, ssl3,
+ tls1, tls1.1, tls1.2, or tls1.3. If verbose is
+ specified as true then a verbose, human readable list is returned
+ with additional information on the cipher. If supported
is specified as true, then only the ciphers supported for protocol
will be listed.
tls::protocols
Returns a list of supported protocols. Valid values are:
Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -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
@@ -926,11 +930,13 @@
/********************/
/*
*-------------------------------------------------------------------
*
- * Hash Calc -- return hash hex string for message digest
+ * Hash Calc --
+ *
+ * Calculate message digest of data using type hash algorithm.
*
* Results:
* A standard Tcl result.
*
* Side effects:
@@ -1054,31 +1060,44 @@
*-------------------------------------------------------------------
*/
void HashListCallback(const OBJ_NAME *obj, void *arg) {
Tcl_Obj *objPtr = (Tcl_Obj *) arg;
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(obj->name,-1));
-}
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(obj->name,-1));
+ }
/*
* Command to list available Hash values
*/
int
HashListCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
Tcl_Obj *objPtr = Tcl_NewListObj(0, NULL);
- OpenSSL_add_all_digests(); //make sure they're loaded
- OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, HashListCallback, (void *) objPtr);
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+ OpenSSL_add_all_digests(); /* Make sure they're loaded */
+#endif
+
+ OBJ_NAME_do_all(OBJ_NAME_TYPE_MD_METH, ListCallback, (void *) objPtr);
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
objc = objc;
objv = objv;
}
+/*
+ * 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
+};
+
/*
*-------------------------------------------------------------------
*
* CiphersObjCmd -- list available ciphers
*
@@ -1091,16 +1110,10 @@
* 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;
@@ -1110,15 +1123,28 @@
int index, verbose = 0, use_supported = 0;
const SSL_METHOD *method;
dprintf("Called");
- if ((objc < 2) || (objc > 4)) {
- Tcl_WrongNumArgs(interp, 1, objv, "protocol ?verbose? ?supported?");
+ if ((objc < 1) || (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) {
+ 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, ListCallback, (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) {
return TCL_ERROR;
}
@@ -1231,10 +1257,11 @@
}
}
SSL_free(ssl);
SSL_CTX_free(ctx);
+ Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
@@ -1290,10 +1317,38 @@
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
clientData = clientData;
}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * 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;
+
+ dprintf("Called");
+
+ objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
+ Tcl_SetObjResult(interp, objPtr);
+
+ return TCL_OK;
+ clientData = clientData;
+ objc = objc;
+ objv = objv;
+}
/*
*-------------------------------------------------------------------
*
* HandshakeObjCmd --
@@ -1995,10 +2050,14 @@
/* Force cipher selection order by server */
if (!isServer) {
SSL_CTX_set_options(ctx, SSL_OP_CIPHER_SERVER_PREFERENCE);
}
+
+#if OPENSSL_VERSION_NUMBER < 0x10100000L
+ OpenSSL_add_all_algorithms(); /* Load ciphers and digests */
+#endif
SSL_CTX_set_app_data(ctx, (void*)interp); /* remember the interpreter */
SSL_CTX_set_options(ctx, SSL_OP_ALL); /* all SSL bug workarounds */
SSL_CTX_set_options(ctx, SSL_OP_NO_COMPRESSION); /* disable compression even if supported */
SSL_CTX_set_options(ctx, off); /* disable protocol versions */
@@ -2543,38 +2602,10 @@
}
/*
*-------------------------------------------------------------------
*
- * 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;
-
- dprintf("Called");
-
- objPtr = Tcl_NewStringObj(OPENSSL_VERSION_TEXT, -1);
- Tcl_SetObjResult(interp, objPtr);
-
- return TCL_OK;
- clientData = clientData;
- objc = objc;
- objv = objv;
-}
-
-/*
- *-------------------------------------------------------------------
- *
* MiscObjCmd -- misc commands
*
* Results:
* A standard Tcl result.
*
@@ -2924,19 +2955,20 @@
if (TlsLibInit(0) != TCL_OK) {
Tcl_AppendResult(interp, "could not initialize SSL library", NULL);
return TCL_ERROR;
}
- Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::connection", ConnectionInfoObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::handshake", HandshakeObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::import", ImportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::unimport", UnimportObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::status", StatusObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::version", VersionObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
- Tcl_CreateObjCommand(interp, "tls::misc", MiscObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+
+ Tcl_CreateObjCommand(interp, "tls::ciphers", CiphersObjCmd, (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);
Tcl_CreateObjCommand(interp, "tls::hash", HashCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::hashes", HashListCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::md4", HashMD4Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateObjCommand(interp, "tls::md5", HashMD5Cmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);