Index: doc/tls.html
==================================================================
--- doc/tls.html
+++ doc/tls.html
@@ -367,11 +367,11 @@
 	<br>
 
 	<dl>
 
 	<dt>
-	  <strong>alpn</strong> <em></em>
+	  <strong>alpn</strong> <em>protocol</em>
 	</dt>
 	<dd>
 	  This form of callback is invoked when server selects the first
 	  -alpn specified protocol common to the client and server. If none,
 	  first client one is used.

Index: generic/tls.c
==================================================================
--- generic/tls.c
+++ generic/tls.c
@@ -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;

Index: generic/tlsInt.h
==================================================================
--- generic/tlsInt.h
+++ generic/tlsInt.h
@@ -128,10 +128,13 @@
 	int vflags;             /* verify flags */
 	SSL *ssl;               /* Struct for SSL processing */
 	SSL_CTX *ctx;           /* SSL Context */
 	BIO *bio;               /* Struct for SSL processing */
 	BIO *p_bio;             /* Parent BIO (that is layered on Tcl_Channel) */
+
+	char *protos;		/* List of supported protocols in protocol format */
+	unsigned int protos_len; /* Length of protos */
 
 	char *err;
 } State;
 
 #ifdef USE_TCL_STUBS