@@ -528,13 +528,16 @@ dprintf("Called"); if (statePtr->callback == (Tcl_Obj*)NULL) return SSL_TLSEXT_ERR_OK; + /* Select protocol */ + SSL_select_next_proto(out, outlen, statePtr->protos, statePtr->protos_len, in, inlen); + cmdPtr = Tcl_DuplicateObj(statePtr->callback); - - Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj( "alpn", -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1)); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(*out, -1)); Tcl_Preserve((ClientData) interp); Tcl_Preserve((ClientData) statePtr); Tcl_IncrRefCount(cmdPtr); @@ -1238,14 +1241,16 @@ /* Convert a Tcl list into a protocol-list in wire-format */ unsigned char *protos, *p; unsigned int protos_len = 0; int i, len, cnt; Tcl_Obj **list; + if (Tcl_ListObjGetElements(interp, alpn, &cnt, &list) != TCL_OK) { Tls_Free((char *) statePtr); return TCL_ERROR; } + /* Determine the memory required for the protocol-list */ for (i = 0; i < cnt; i++) { Tcl_GetStringFromObj(list[i], &len); if (len > 255) { Tcl_AppendResult(interp, "alpn protocol name too long", (char *) NULL); @@ -1252,28 +1257,36 @@ Tls_Free((char *) statePtr); return TCL_ERROR; } protos_len += 1 + len; } + /* Build the complete protocol-list */ protos = ckalloc(protos_len); /* protocol-lists consist of 8-bit length-prefixed, byte strings */ for (i = 0, p = protos; i < cnt; i++) { char *str = Tcl_GetStringFromObj(list[i], &len); *p++ = len; memcpy(p, str, len); p += len; } + + /* SSL_set_alpn_protos makes a copy of the protocol-list */ /* Note: This functions reverses the return value convention */ if (SSL_set_alpn_protos(statePtr->ssl, protos, protos_len)) { Tcl_AppendResult(interp, "failed to set alpn protocols", (char *) NULL); Tls_Free((char *) statePtr); ckfree(protos); return TCL_ERROR; } - /* SSL_set_alpn_protos makes a copy of the protocol-list */ - ckfree(protos); + + /* Store protocols list */ + statePtr->protos = protos; + statePtr->protos_len = protos_len; + } else { + statePtr->protos = NULL; + statePtr->protos_len = 0; } /* * SSL Callbacks */ @@ -2261,10 +2274,14 @@ if (statePtr->timer != (Tcl_TimerToken) NULL) { Tcl_DeleteTimerHandler(statePtr->timer); statePtr->timer = NULL; } + if (statePtr->protos) { + ckfree(statePtr->protos); + statePtr->protos = NULL; + } if (statePtr->bio) { /* This will call SSL_shutdown. Bug 1414045 */ dprintf("BIO_free_all(%p)", statePtr->bio); BIO_free_all(statePtr->bio); statePtr->bio = NULL;