Added ALPN support (client and server).

src/ssl/ssl_hs_client.t0

@@ -429,6 +429,21 @@ addr-ctx: hash_id
 : ext-point-format-length ( -- len )
 	supported-curves if 6 else 0 then ;
 
+\ Length of ALPN extension.
+cc: ext-ALPN-length ( -- len ) {
+	size_t u, len;
+
+	if (ENG->protocol_names_num == 0) {
+		T0_PUSH(0);
+		T0_RET();
+	}
+	len = 6;
+	for (u = 0; u < ENG->protocol_names_num; u ++) {
+		len += 1 + strlen(ENG->protocol_names[u]);
+	}
+	T0_PUSH(len);
+}
+
 \ Write handshake message: ClientHello
 : write-ClientHello ( -- )
 	{ ; total-ext-length }
@@ -438,6 +453,7 @@ addr-ctx: hash_id
 	ext-reneg-length ext-sni-length + ext-frag-length +
 	ext-signatures-length +
 	ext-supported-curves-length + ext-point-format-length +
+	ext-ALPN-length +
 	>total-ext-length
 
 	\ ClientHello type
@@ -542,6 +558,21 @@ addr-ctx: hash_id
 			0x0002 write16          \ extension length
 			0x0100 write16          \ value: 1 format: uncompressed
 		then
+		ext-ALPN-length dup if
+			0x0010 write16          \ extension type (16)
+			4 - dup write16         \ extension length
+			2- write16              \ list length
+			addr-protocol_names_num get16 0
+			begin
+				dup2 > while
+				dup copy-protocol-name
+				dup write8 addr-pad swap write-blob
+				1+
+			repeat
+			2drop
+		else
+			drop
+		then
 		ext-padding-amount 0< ifnot
 			0x0015 write16          \ extension value (21)
 			ext-padding-amount
@@ -595,6 +626,24 @@ addr-ctx: hash_id
 		then
 	then ;
 
+\ Read the ALPN extension from the server. It must contain a single name,
+\ and that name must match one of our names.
+: read-ALPN-from-server ( lim -- lim )
+	\ Extension contents length.
+	read16 open-elt
+	\ Length of list of names.
+	read16 open-elt
+	\ There should be a single name.
+	read8 addr-pad swap dup { len } read-blob
+	close-elt
+	close-elt
+	len test-protocol-name dup 0< if
+		3 flag? if ERR_UNEXPECTED fail then
+		drop
+	else
+		1+ addr-selected_protocol set16
+	then ;
+
 \ Save a value in a 16-bit field, or check it in case of session resumption.
 : check-resume ( val addr resume -- )
 	if get16 = ifnot ERR_RESUME_MISMATCH fail then else set16 then ;
@@ -688,6 +737,7 @@ cc: DEBUG-BLOB ( addr len -- ) {
 		ext-signatures-length { ok-signatures }
 		ext-supported-curves-length { ok-curves }
 		ext-point-format-length { ok-points }
+		ext-ALPN-length { ok-ALPN }
 		begin dup while
 			read16
 			case
@@ -753,6 +803,15 @@ cc: DEBUG-BLOB ( addr len -- ) {
 					read-ignore-16
 				endof
 
+				\ ALPN.
+				0x0010 of
+					ok-ALPN ifnot
+						ERR_EXTRA_EXTENSION fail
+					then
+					0 >ok-ALPN
+					read-ALPN-from-server
+				endof
+
 				ERR_EXTRA_EXTENSION fail
 			endcase
 		repeat
@@ -1102,6 +1161,7 @@ cc: do-client-sign ( -- sig_len ) {
 : do-handshake ( -- )
 	0 addr-application_data set8
 	22 addr-record_type_out set8
+	0 addr-selected_protocol set16
 	multihash-init
 
 	write-ClientHello

src/ssl/ssl_hs_common.t0

@@ -157,6 +157,8 @@ addr-eng: pad
 addr-eng: action
 addr-eng: alert
 addr-eng: close_received
+addr-eng: protocol_names_num
+addr-eng: selected_protocol
 
 \ Similar to 'addr-eng:', for fields in the 'session' substructure.
 : addr-session-field:
@@ -1235,3 +1237,33 @@ cc: get-key-type-usages ( -- key-type-usages ) {
 
 	\ Return key type and usages.
 	get-key-type-usages ;
+
+\ =======================================================================
+
+\ Copy a specific protocol name from the list to the pad. The byte
+\ length is returned.
+cc: copy-protocol-name ( idx -- len ) {
+	size_t idx = T0_POP();
+	size_t len = strlen(ENG->protocol_names[idx]);
+	memcpy(ENG->pad, ENG->protocol_names[idx], len);
+	T0_PUSH(len);
+}
+
+\ Compare name in pad with the configured list of protocol names.
+\ If a match is found, then the index is returned; otherwise, -1
+\ is returned.
+cc: test-protocol-name ( len -- n ) {
+	size_t len = T0_POP();
+	size_t u;
+
+	for (u = 0; u < ENG->protocol_names_num; u ++) {
+		const char *name;
+
+		name = ENG->protocol_names[u];
+		if (len == strlen(name) && memcmp(ENG->pad, name, len) == 0) {
+			T0_PUSH(u);
+			T0_RET();
+		}
+	}
+	T0_PUSHi(-1);
+}

src/ssl/ssl_hs_server.t0

@@ -528,6 +528,41 @@ cc: set-max-frag-len ( len -- ) {
 	close-elt
 	close-elt ;
 
+\ Read the ALPN extension from client.
+: read-ALPN-from-client ( lim -- lim )
+	\ If we do not have configured names, then we just ignore the
+	\ extension.
+	addr-protocol_names_num get16 ifnot read-ignore-16 ret then
+
+	\ Open extension value.
+	read16 open-elt
+
+	\ Open list of protocol names.
+	read16 open-elt
+
+	\ Get all names and test for their support. We keep the one with
+	\ the lowest index (because we apply server's preferences, as
+	\ recommended by RFC 7301, section 3.2. We set the 'found' variable
+	\ to -2 and use an unsigned comparison, making -2 a huge value.
+	-2 { found }
+	begin dup while
+		read8 dup { len } addr-pad swap read-blob
+		len test-protocol-name dup found u< if
+			>found
+		else
+			drop
+		then
+	repeat
+
+	\ End of extension.
+	close-elt
+	close-elt
+
+	\ Write back found name index (or not). If no match was found,
+	\ then we write -1 (0xFFFF) in the index value, not 0, so that
+	\ the caller knows that we tried to match, and failed.
+	found 1+ addr-selected_protocol set16 ;
+
 \ Call policy handler to get cipher suite, hash function identifier and
 \ certificate chain. Returned value is 0 (false) on failure.
 cc: call-policy-handler ( -- bool ) {
@@ -709,6 +744,11 @@ cc: save-session ( -- ) {
 				\ 	read-ignore-16
 				\ endof
 
+				\ ALPN
+				0x0010 of
+					read-ALPN-from-client
+				endof
+
 				\ Other extensions are ignored.
 				drop read-ignore-16 0
 			endcase
@@ -832,6 +872,12 @@ cc: save-session ( -- ) {
 	then
 	addr-client_suites_num set8
 
+	\ Check ALPN.
+	addr-selected_protocol get16 0xFFFF = if
+		3 flag? if 120 fail-alert then
+		0 addr-selected_protocol set16
+	then
+
 	\ Call policy handler to obtain the cipher suite and other
 	\ parameters.
 	call-policy-handler ifnot 40 fail-alert then
@@ -842,20 +888,28 @@ cc: save-session ( -- ) {
 \ Write ServerHello.
 : write-ServerHello ( initial -- )
 	{ initial }
-	\ Compute ServerHello length. Right now we only send the
-	\ "secure renegotiation" extension.
+	\ Compute ServerHello length.
 	2 write8 70
 
+	\ Compute length of Secure Renegotiation extension.
 	addr-reneg get8 2 = if
 		initial if 5 else 29 then
 	else
 		0
 	then
 	{ ext-reneg-len }
+
+	\ Compute length of Max Fragment Length extension.
 	addr-peer_log_max_frag_len get8 if 5 else 0 then
 	{ ext-max-frag-len }
 
-	ext-reneg-len ext-max-frag-len + dup if 2 + then +
+	\ Compute length of ALPN extension. This also copy the
+	\ selected protocol name into the pad.
+	addr-selected_protocol get16 dup if 1- copy-protocol-name 7 + then
+	{ ext-ALPN-len }
+
+	\ Adjust ServerHello length to account for the extensions.
+	ext-reneg-len ext-max-frag-len + ext-ALPN-len + dup if 2 + then +
 	write24
 
 	\ Protocol version
@@ -880,7 +934,7 @@ cc: save-session ( -- ) {
 	0 write8
 
 	\ Extensions
-	ext-reneg-len ext-max-frag-len + dup if
+	ext-reneg-len ext-max-frag-len + ext-ALPN-len + dup if
 		write16
 		ext-reneg-len dup if
 			0xFF01 write16
@@ -893,6 +947,16 @@ cc: save-session ( -- ) {
 			0x0001 write16
 			1 write16 addr-peer_log_max_frag_len get8 8 - write8
 		then
+		ext-ALPN-len dup if
+			\ Note: the selected protocol name was previously
+			\ copied into the pad.
+			0x0010 write16
+			4 - dup write16
+			2- dup write16
+			1- addr-pad swap write-blob-head8
+		else
+			drop
+		then
 	else
 		drop
 	then ;
@@ -1289,6 +1353,7 @@ cc: verify-CV-sig ( sig-len -- err ) {
 : do-handshake ( initial -- )
 	0 addr-application_data set8
 	22 addr-record_type_out set8
+	0 addr-selected_protocol set16
 	multihash-init
 	read-ClientHello
 	more-incoming-bytes? if ERR_UNEXPECTED fail then