Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -193,10 +193,12 @@
-servername host
Specify server hostname. Only available if the OpenSSL library
the package is linked against supports the TLS hostname extension
for 'Server Name Indication' (SNI). Use to name the logical host
we are talking to and expecting a certificate for.
+ -session_id string
+ Session id to resume session.
-ssl2 bool
Enable use of SSL v2. (default is false)
-ssl3 bool
Enable use of SSL v3. (default is false)
-tls1 bool
@@ -253,10 +255,12 @@
The PEM encoded certificate.
sha1_hash hash
The SHA1 hash of the certificate.
sha256_hash hash
The SHA256 hash of the certificate.
+ validation result
+ Certificate validation result.
alpn protocol
The protocol selected after Application-Layer Protocol
Negotiation (ALPN).
version value
The protocol version used for the connection:
@@ -272,11 +276,11 @@
- state state
- State of the connection: initializing, handshake, established
- - server name
+ - servername name
- The name of the connected to server.
- protocol version
- The protocol version used for the connection:
SSL2, SSL3, TLS1, TLS1.1, TLS1.2, TLS1.3, or unknown.
- securitylevel level
@@ -298,10 +302,20 @@
- alpn protocol
- The protocol selected after Application-Layer Protocol
Negotiation (ALPN).
- session_reused boolean
- Whether the session has been reused or not.
+ - session_id string
+ - Unique session id for use in resuming the session.
+ - session_ticket string
+ - Unique session ticket for use in resuming the session.
+ - resumable boolean
+ - Can the session be resumed or not.
+ - start_time seconds
+ - Time since session started in seconds since epoch.
+ - timeout seconds
+ - Max duration of session in seconds before time-out.
tls::ciphers
protocol ?verbose? ?supported?
@@ -382,10 +396,23 @@
SSL_state_string_long() or by
SSL_alert_desc_string_long(),
depending on context.
+
+
+
+ session session_id ticket lifetime
+
+
+ This form of callback is invoked by the OpenSSL function
+ SSL_CTX_sess_set_new_cb().
+ Where session_id is the current session identifier,
+ ticket is the session ticket info, and lifetime
+ is the the ticket lifetime in seconds.
+
+
verify channel depth cert status error
Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -414,10 +414,78 @@
}
/*
*-------------------------------------------------------------------
*
+ * SessionCallback for Clients --
+ *
+ * Called when a new session ticket has been received. In TLS 1.3
+ * this may be received multiple times after the handshake. For
+ * earlier versions, this will be received during the handshake.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Calls callback (if defined)
+ *-------------------------------------------------------------------
+ */
+static int
+SessionCallback(const 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;
+ int len;
+ int code;
+ size_t len2;
+
+ dprintf("Called");
+
+ if (statePtr->callback == (Tcl_Obj*)NULL)
+ return 0;
+
+ cmdPtr = Tcl_DuplicateObj(statePtr->callback);
+
+ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "session", -1));
+
+ /* Session id */
+ session = SSL_get_session(statePtr->ssl);
+ session_id = SSL_SESSION_get0_id_context(session, &len);
+ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(session_id, len));
+
+ /* Session ticket */
+ SSL_SESSION_get0_ticket(session, &ticket, &len2);
+ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(ticket, (int)len2));
+
+ /* Lifetime - number of seconds */
+ Tcl_ListObjAppendElement(interp, cmdPtr,
+ Tcl_NewLongObj((long) SSL_SESSION_get_ticket_lifetime_hint(session)));
+
+ Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve((ClientData) statePtr);
+
+ Tcl_IncrRefCount(cmdPtr);
+ code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+ if (code != TCL_OK) {
+#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6)
+ Tcl_BackgroundError(interp);
+#else
+ Tcl_BackgroundException(interp, code);
+#endif
+ }
+ Tcl_DecrRefCount(cmdPtr);
+
+ Tcl_Release((ClientData) statePtr);
+ Tcl_Release((ClientData) interp);
+ return 1;
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
* CiphersObjCmd -- list available ciphers
*
* This procedure is invoked to process the "tls::ciphers" command
* to list available ciphers, based upon protocol selected.
*
@@ -737,10 +805,11 @@
char *CAfile = NULL;
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;
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;
@@ -801,10 +870,11 @@
OPTBOOL("-require", require);
OPTBOOL("-request", request);
OPTINT("-securitylevel", level);
OPTBOOL("-server", server);
OPTSTR("-servername", servername);
+ OPTSTR("-session_id", session_id);
OPTOBJ("-alpn", alpn);
OPTBOOL("-ssl2", ssl2);
OPTBOOL("-ssl3", ssl3);
OPTBOOL("-tls1", tls1);
OPTBOOL("-tls1.1", tls1_1);
@@ -811,11 +881,11 @@
OPTBOOL("-tls1.2", tls1_2);
OPTBOOL("-tls1.3", tls1_3);
OPTBYTE("-cert", cert, cert_len);
OPTBYTE("-key", key, key_len);
- OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -securitylevel, -server, -servername, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or -tls1.3");
+ OPTBAD("option", "-alpn, -cadir, -cafile, -cert, -certfile, -cipher, -ciphersuites, -command, -dhparams, -key, -keyfile, -model, -password, -require, -request, -securitylevel, -server, -servername, -session_id, -ssl2, -ssl3, -tls1, -tls1.1, -tls1.2, or -tls1.3");
return TCL_ERROR;
}
if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
@@ -937,17 +1007,29 @@
Tcl_AppendResult(interp, "couldn't construct ssl session: ", REASON(), (char *) NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
+ /* Set host server name */
if (servername) {
if (!SSL_set_tlsext_host_name(statePtr->ssl, servername) && require) {
Tcl_AppendResult(interp, "setting TLS host name extension failed", (char *) NULL);
Tls_Free((char *) statePtr);
return TCL_ERROR;
}
}
+
+ /* Resume session id */
+ if (session_id && strlen(session_id) <= 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))) {
+ Tcl_AppendResult(interp, "Resume session id ", session_id, " failed", (char *) NULL);
+ Tls_Free((char *) statePtr);
+ return TCL_ERROR;
+ }
+ }
+
if (alpn) {
/* Convert a Tcl list into a protocol-list in wire-format */
unsigned char *protos, *p;
unsigned int protos_len = 0;
int i, len, cnt;
@@ -990,10 +1072,11 @@
* SSL Callbacks
*/
SSL_set_app_data(statePtr->ssl, (void *)statePtr); /* point back to us */
SSL_set_verify(statePtr->ssl, verify, VerifyCallback);
SSL_CTX_set_info_callback(statePtr->ctx, InfoCallback);
+ SSL_CTX_sess_set_new_cb(statePtr->ctx, SessionCallback);
/* Create Tcl_Channel BIO Handler */
statePtr->p_bio = BIO_new_tcl(statePtr, BIO_NOCLOSE);
statePtr->bio = BIO_new(BIO_f_ssl());
@@ -1467,10 +1550,20 @@
if ((ciphers != NULL) && (strcmp(ciphers, "(NONE)") != 0)) {
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("cipher", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(SSL_get_cipher(statePtr->ssl), -1));
}
+ /* Verify the X509 certificate presented by the peer */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("validation", -1));
+ if (SSL_get_verify_result(statePtr->ssl) != X509_V_OK) {
+ /* proto = "failed"; */
+ proto = REASON();
+ } else {
+ proto = "ok";
+ }
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(proto, -1));
+
/* Report the selected protocol as a result of the negotiation */
SSL_get0_alpn_selected(statePtr->ssl, &proto, &len);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("version", -1));
@@ -1496,10 +1589,11 @@
Tcl_Channel chan; /* The channel to set a mode on. */
State *statePtr; /* client state for ssl socket */
Tcl_Obj *objPtr;
const SSL *ssl;
const SSL_CIPHER *cipher;
+ const SSL_SESSION *session;
const unsigned char *proto;
unsigned int len;
#if defined(HAVE_SSL_COMPRESSION)
const COMP_METHOD *comp;
#endif
@@ -1576,20 +1670,50 @@
}
}
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("renegotiation", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(
- SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "disallowed", -1));
+ SSL_get_secure_renegotiation_support(ssl) ? "allowed" : "not supported", -1));
/* Report the selected protocol as a result of the negotiation */
SSL_get0_alpn_selected(ssl, &proto, &len);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int)len));
/* Session info */
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_reused", -1));
- Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_session_reused(ssl)));
+ session = SSL_get_session(ssl);
+ if (session != NULL) {
+ const unsigned char *ticket;
+ size_t len2;
+ const unsigned char *session_id;
+
+ /* Session info */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_reused", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_session_reused(ssl)));
+
+ /* Session id */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_id", -1));
+ session_id = SSL_SESSION_get0_id_context(session, &len);
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(session_id, (int)len));
+
+ /* Session ticket */
+ SSL_SESSION_get0_ticket(session, &ticket, &len2);
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("session_ticket", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj(ticket, (int) len2));
+
+ /* Resumable session */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("resumable", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_SESSION_is_resumable(session)));
+
+ /* Start time */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("start_time", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_time(session)));
+
+ /* Timeout value */
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("timeout", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewLongObj(SSL_SESSION_get_timeout(session)));
+ }
#if defined(HAVE_SSL_COMPRESSION)
/* Compression info */
comp = SSL_get_current_compression(ssl);
if (comp != NULL) {
Index: generic/tlsIO.c
==================================================================
--- generic/tlsIO.c
+++ generic/tlsIO.c
@@ -157,10 +157,11 @@
}
rc = SSL_get_error(statePtr->ssl, err);
dprintf("Got error: %i (rc = %i)", err, rc);
+ dprintf("Got error: %s", ERR_reason_error_string(ERR_get_error()));
bioShouldRetry = 0;
if (err <= 0) {
if (rc == SSL_ERROR_WANT_CONNECT || rc == SSL_ERROR_WANT_ACCEPT || rc == SSL_ERROR_WANT_READ || rc == SSL_ERROR_WANT_WRITE) {
bioShouldRetry = 1;
Index: library/tls.tcl
==================================================================
--- library/tls.tcl
+++ library/tls.tcl
@@ -46,10 +46,11 @@
{* -request iopts 1}
{* -require iopts 1}
{* -securitylevel iopts 1}
{* -autoservername discardOpts 1}
{* -servername iopts 1}
+ {* -session_id iopts 1}
{* -alpn iopts 1}
{* -ssl2 iopts 1}
{* -ssl3 iopts 1}
{* -tls1 iopts 1}
{* -tls1.1 iopts 1}