Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -484,11 +484,11 @@
</dd>
<br>
<dt>
- <strong>info</strong> <em>channel major minor message</em>
+ <strong>info</strong> <em>channel major minor message type</em>
</dt>
<dd>
This form of callback is invoked by the OpenSSL function
<code>SSL_CTX_set_info_callback()</code>.
<br>
@@ -503,10 +503,14 @@
The <em>message</em> argument is a descriptive string which may
be generated either by
<code>SSL_state_string_long()</code> or by
<code>SSL_alert_desc_string_long()</code>,
depending on context.
+ <dt>For alerts, the possible values for <em>type</em> are:</dt>
+ <dl>
+ <dd><code>warning, fatal, and unknown</code>.</dd>
+ </dl>
</dd>
<br>
<dt>
Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -154,26 +154,26 @@
else if (where & SSL_CB_LOOP) minor = "loop";
else if (where & SSL_CB_EXIT) minor = "exit";
else minor = "unknown";
}
+ /* info channel major minor message type */
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1));
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(major, -1));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(minor, -1));
- if (where & (SSL_CB_LOOP|SSL_CB_EXIT)) {
+ if (where & SSL_CB_ALERT) {
+ Tcl_ListObjAppendElement(interp, cmdPtr,
+ Tcl_NewStringObj(SSL_alert_desc_string_long(ret), -1));
Tcl_ListObjAppendElement(interp, cmdPtr,
- Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
- } else if (where & SSL_CB_ALERT) {
- const char *cp = (char *) SSL_alert_desc_string_long(ret);
-
- Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(cp, -1));
+ Tcl_NewStringObj(SSL_alert_type_string_long(ret), -1));
} else {
Tcl_ListObjAppendElement(interp, cmdPtr,
Tcl_NewStringObj(SSL_state_string_long(ssl), -1));
+ Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1));
}
Tcl_Preserve((ClientData) interp);
Tcl_Preserve((ClientData) statePtr);
Tcl_IncrRefCount(cmdPtr);
@@ -497,14 +497,15 @@
}
/*
*-------------------------------------------------------------------
*
- * ALPN Callback for Servers --
+ * ALPN Callback for Servers and Clients --
*
- * Perform server-side protocol (http/1.1, h2, h3, etc.) selection for the
- * incoming connection. Called after Hello and server callbacks
+ * Perform protocol (http/1.1, h2, h3, etc.) selection for the
+ * incoming connection. Called after Hello and server callbacks.
+ * Where 'out' is selected protocol and 'in' is the peer advertised list.
*
* Results:
* None
*
* Side effects:
@@ -527,24 +528,26 @@
Tcl_Obj *cmdPtr;
int code, res;
dprintf("Called");
- if (statePtr->callback == (Tcl_Obj*)NULL) {
- return SSL_TLSEXT_ERR_OK;
- } else if (ssl == NULL) {
+ if (ssl == NULL || arg == NULL) {
return SSL_TLSEXT_ERR_NOACK;
}
/* Select protocol */
if (SSL_select_next_proto(out, outlen, statePtr->protos, statePtr->protos_len,
in, inlen) == OPENSSL_NPN_NEGOTIATED) {
res = SSL_TLSEXT_ERR_OK;
} else {
- /* No overlap, so first client protocol used */
+ /* No overlap, so use first client protocol */
res = SSL_TLSEXT_ERR_NOACK;
}
+
+ if (statePtr->callback == (Tcl_Obj*)NULL) {
+ return SSL_TLSEXT_ERR_OK;
+ }
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(*out, -1));
@@ -565,10 +568,53 @@
Tcl_Release((ClientData) statePtr);
Tcl_Release((ClientData) interp);
return res;
}
+/*
+ *-------------------------------------------------------------------
+ *
+ * Advertise Protocols Callback for Servers Next Protocol Negotiation --
+ *
+ * called when a TLS server needs a list of supported protocols for Next
+ * Protocol Negotiation.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ *
+ * Return codes:
+ * SSL_TLSEXT_ERR_OK: NPN protocol selected. The connection continues.
+ * SSL_TLSEXT_ERR_NOACK: NPN protocol not selected. The connection continues.
+ *
+ *-------------------------------------------------------------------
+ */
+#ifdef USE_NPN
+static int
+NPNCallback(const SSL *ssl, const unsigned char **out, unsigned int *outlen, void *arg) {
+ State *statePtr = (State*)arg;
+
+ dprintf("Called");
+
+ if (ssl == NULL || arg == NULL) {
+ return SSL_TLSEXT_ERR_NOACK;
+ }
+
+ /* Set protocols list */
+ if (statePtr->protos != NULL) {
+ *out = statePtr->protos;
+ *outlen = statePtr->protos_len;
+ } else {
+ *out = NULL;
+ *outlen = 0;
+ return SSL_TLSEXT_ERR_NOACK;
+ }
+ return SSL_TLSEXT_ERR_OK;
+}
+#endif
+
/*
*-------------------------------------------------------------------
*
* SNI Callback for Servers --
*
@@ -600,20 +646,22 @@
int code;
char *servername = NULL;
dprintf("Called");
- if (statePtr->callback == (Tcl_Obj*)NULL) {
- return SSL_TLSEXT_ERR_OK;
- } else if (ssl == NULL) {
+ if (ssl == NULL || arg == NULL) {
return SSL_TLSEXT_ERR_NOACK;
}
servername = SSL_get_servername(ssl, TLSEXT_NAMETYPE_host_name);
if (!servername || servername[0] == '\0') {
return SSL_TLSEXT_ERR_NOACK;
}
+
+ if (statePtr->callback == (Tcl_Obj*)NULL) {
+ return SSL_TLSEXT_ERR_OK;
+ }
cmdPtr = Tcl_DuplicateObj(statePtr->callback);
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("sni", -1));
Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername , -1));
@@ -673,11 +721,11 @@
dprintf("Called");
if (statePtr->callback == (Tcl_Obj*)NULL) {
return SSL_CLIENT_HELLO_SUCCESS;
- } else if (ssl == NULL) {
+ } else if (ssl == NULL || arg == NULL) {
return SSL_CLIENT_HELLO_ERROR;
}
/* Get names */
if (!SSL_client_hello_get0_ext(ssl, TLSEXT_TYPE_server_name, &p, &remaining) || remaining <= 2) {
@@ -1354,23 +1402,34 @@
statePtr->p_bio = BIO_new_tcl(statePtr, BIO_NOCLOSE);
statePtr->bio = BIO_new(BIO_f_ssl());
if (server) {
/* Server callbacks */
- SSL_CTX_set_alpn_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr);
SSL_CTX_set_tlsext_servername_arg(statePtr->ctx, (void *)statePtr);
SSL_CTX_set_tlsext_servername_callback(statePtr->ctx, SNICallback);
SSL_CTX_set_client_hello_cb(statePtr->ctx, HelloCallback, (void *)statePtr);
+ if (statePtr->protos != NULL) {
+ SSL_CTX_set_alpn_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr);
+#ifdef USE_NPN
+ SSL_CTX_set_next_protos_advertised_cb(statePtr->ctx, NPNCallback, (void *)statePtr);
+#endif
+ }
/* Enable server to send cert request after handshake (TLS 1.3 only) */
if (request && post_handshake) {
SSL_verify_client_post_handshake(statePtr->ssl);
}
statePtr->flags |= TLS_TCL_SERVER;
SSL_set_accept_state(statePtr->ssl);
} else {
+ /* Client callbacks */
+ if (statePtr->protos != NULL) {
+#ifdef USE_NPN
+ SSL_CTX_set_next_proto_select_cb(statePtr->ctx, ALPNCallback, (void *)statePtr);
+#endif
+ }
/* Session caching */
SSL_CTX_set_session_cache_mode(statePtr->ctx, SSL_SESS_CACHE_CLIENT | SSL_SESS_CACHE_NO_INTERNAL_STORE);
SSL_CTX_sess_set_new_cb(statePtr->ctx, SessionCallback);
/* Enable post handshake Authentication extension. TLS 1.3 only, not http/2. */
@@ -1592,11 +1651,11 @@
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, off); /* disable protocol versions */
#if OPENSSL_VERSION_NUMBER < 0x10101000L
- SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY); /* handle new handshakes in background */
+ SSL_CTX_set_mode(ctx, SSL_MODE_AUTO_RETRY); /* handle new handshakes in background. On by default in OpenSSL 1.1.1. */
#endif
SSL_CTX_sess_set_cache_size(ctx, 128);
/* Set user defined ciphers, cipher suites, and security level */
if ((ciphers != NULL) && !SSL_CTX_set_cipher_list(ctx, ciphers)) {
@@ -2002,10 +2061,17 @@
/* Report the selected protocol as a result of the ALPN negotiation */
SSL_SESSION_get0_alpn_selected(session, &proto, &len2);
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("alpn", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int) len2));
+
+ /* Report the selected protocol as a result of the NPN negotiation */
+#ifdef USE_NPN
+ SSL_get0_next_proto_negotiated(ssl, &proto, &ulen);
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("npn", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj((char *)proto, (int) ulen));
+#endif
/* Resumable session */
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewStringObj("resumable", -1));
Tcl_ListObjAppendElement(interp, objPtr, Tcl_NewIntObj(SSL_SESSION_is_resumable(session)));