Bug #101452 for IO-Socket-SSL: ALPN support (for spdy, http/2.0 etc.) - patch attached

Hi there, Patch attached for exposing basic ALPN interface - implementation is mostly copied from NPN, since the latter is deprecated in favour of ALPN. Tested locally with http/2, spdy/3.1 (via Protocol::SPDY) and some custom protocol implementations. Most distributions don't package a recent-enough version of openssl unfortunately, but openssl-1.0.2 is available in debian experimental. cheers, Tom

diff --git a/lib/IO/Socket/SSL.pm b/lib/IO/Socket/SSL.pm index eb1e033..90268cd 100644 --- a/lib/IO/Socket/SSL.pm +++ b/lib/IO/Socket/SSL.pm @@ -49,7 +49,8 @@ use constant SSL_OCSP_TRY_STAPLE => 0b10000; # capabilities of underlying Net::SSLeay/openssl my $can_client_sni; # do we support SNI on the client side my $can_server_sni; # do we support SNI on the server side -my $can_npn; # do we support NPN +my $can_npn; # do we support NPN (obsolete) +my $can_alpn; # do we support ALPN my $can_ecdh; # do we support ECDH key exchange my $can_ocsp; # do we support OCSP my $can_ocsp_staple; # do we support OCSP stapling @@ -57,6 +58,7 @@ BEGIN { $can_client_sni = Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000; $can_server_sni = defined &Net::SSLeay::get_servername; $can_npn = defined &Net::SSLeay::P_next_proto_negotiated; + $can_alpn = defined &Net::SSLeay::CTX_set_alpn_protos; $can_ecdh = defined &Net::SSLeay::CTX_set_tmp_ecdh && # There is a regression with elliptic curves on 1.0.1d with 64bit # http://rt.openssl.org/Ticket/Display.html?id=2975 @@ -89,6 +91,7 @@ my %DEFAULT_SSL_ARGS = ( SSL_verifycn_publicsuffix => undef, # fallback default list verification #SSL_verifycn_name => undef, # use from PeerAddr/PeerHost - do not override in set_args_filter_hack 'use_defaults' SSL_npn_protocols => undef, # meaning depends whether on server or client side + SSL_alpn_protocols => undef, # list of protocols we'll accept/send, for example ['http/1.1','spdy/3.1'] SSL_cipher_list => 'EECDH+AESGCM+ECDSA EECDH+AESGCM EECDH+ECDSA +AES256 EECDH EDH+AESGCM '. 'EDH ALL +SHA +3DES +RC4 !LOW !EXP !eNULL !aNULL !DES !MD5 !PSK !SRP', @@ -1791,6 +1794,7 @@ sub error { sub can_client_sni { return $can_client_sni } sub can_server_sni { return $can_server_sni } sub can_npn { return $can_npn } +sub can_alpn { return $can_alpn } sub can_ecdh { return $can_ecdh } sub can_ipv6 { return CAN_IPV6 } sub can_ocsp { return $can_ocsp } @@ -1890,6 +1894,13 @@ sub next_proto_negotiated { return Net::SSLeay::P_next_proto_negotiated($ssl); } +sub alpn_selected { + my $self = shift; + return $self->_internal_error("ALPN not supported in Net::SSLeay") if ! $can_alpn; + my $ssl = $self->_get_ssl_object || return; + return Net::SSLeay::P_alpn_selected($ssl); +} + sub opened { my $self = shift; return IO::Handle::opened($self) && ${*$self}{'_SSL_opened'}; @@ -2198,6 +2209,16 @@ WARN } } + if ( my $proto_list = $arg_hash->{SSL_alpn_protocols} ) { + return IO::Socket::SSL->_internal_error("ALPN not supported in Net::SSLeay") + if ! $can_alpn; + if($arg_hash->{SSL_server}) { + Net::SSLeay::CTX_set_alpn_select_cb($ctx, $proto_list); + } else { + Net::SSLeay::CTX_set_alpn_protos($ctx, $proto_list); + } + } + # Try to apply SSL_ca even if SSL_verify_mode is 0, so that they can be # used to verify OCSP responses. # If applying fails complain only if verify_mode != VERIFY_NONE. diff --git a/lib/IO/Socket/SSL.pod b/lib/IO/Socket/SSL.pod index e68ff3a..ff5f35d 100644 --- a/lib/IO/Socket/SSL.pod +++ b/lib/IO/Socket/SSL.pod @@ -1249,12 +1249,30 @@ On the client side it specifies the protocols offered by the client for NPN as an array ref. See also method C<next_proto_negotiated>. -Next Protocol Negotioation (NPN) is available with Net::SSLeay 1.46+ and +Next Protocol Negotiation (NPN) is available with Net::SSLeay 1.46+ and openssl-1.0.1+. To check support you might call C<IO::Socket::SSL->can_npn()>. If you use this option with an unsupported Net::SSLeay/OpenSSL it will throw an error. +=item SSL_alpn_protocols + +If used on the server side it specifies list of protocols supported by the SSL +server as an array ref, e.g. ['http/2.0', 'spdy/3.1','http/1.1']. +On the client side it specifies the protocols advertised by the client for ALPN +as an array ref. +See also method C<alpn_selected>. + +Application-Layer Protocol Negotiation (ALPN) is available with Net::SSLeay 1.56+ and +openssl-1.0.2+. More details about the extension are in RFC7301. +To check support you might call C< IO::Socket::SSL->can_alpn() >. +If you use this option with an unsupported Net::SSLeay/OpenSSL it will +throw an error. + +Note that some client implementations may encounter problems if both NPN and ALPN are +specified. Since ALPN is intended as a replacement for NPN, try providing ALPN protocols +then fall back to NPN if that fails. + =back =item B<accept> @@ -1557,6 +1575,14 @@ for both client and server side of SSL connection. NPN support is available with Net::SSLeay 1.46+ and openssl-1.0.1+. To check support you might call C<IO::Socket::SSL->can_npn()>. +=item B<alpn_selected()> + +Returns the protocol negotiated via ALPN as a string, e.g. 'http/1.1', 'http/2.0' or +'spdy/3.1'. + +NPN support is available with Net::SSLeay 1.56+ and openssl-1.0.2+. +To check support, use C<IO::Socket::SSL->can_alpn()>. + =item B<errstr()> Returns the last error (in string form) that occurred. If you do not have a diff --git a/t/alpn.t b/t/alpn.t new file mode 100644 index 0000000..2325e2f --- /dev/null +++ b/t/alpn.t @@ -0,0 +1,78 @@ +#!perl +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl t/alpn.t' + +use strict; +use warnings; +use Net::SSLeay; +use Socket; +use IO::Socket::SSL; +do './testlib.pl' || do './t/testlib.pl' || die "no testlib"; + +# check if we have ALPN available +# if it is available +if ( ! IO::Socket::SSL->can_alpn ) { + print "1..0 # Skipped: ALPN not available in Net::SSLeay\n"; + exit +} + +$|=1; +print "1..5\n"; + +# first create simple ssl-server +my $ID = 'server'; +my $addr = '127.0.0.1'; +my $server = IO::Socket::SSL->new( + LocalAddr => $addr, + Listen => 2, + SSL_cert_file => 'certs/server-cert.pem', + SSL_key_file => 'certs/server-key.pem', + SSL_alpn_protocols => [qw(one two)], +) || do { + ok(0,$!); + exit +}; +ok(1,"Server Initialization at $addr"); + +# add server port to addr +$addr = "$addr:".$server->sockport; +print "# server at $addr\n"; + +my $pid = fork(); +if ( !defined $pid ) { + die $!; # fork failed + +} elsif ( !$pid ) { ###### Client + + $ID = 'client'; + close($server); + my $to_server = IO::Socket::SSL->new( + PeerHost => $addr, + SSL_verify_mode => 0, + SSL_alpn_protocols => [qw(two three)], + ) or do { + ok(0, "connect failed: ".IO::Socket::SSL->errstr() ); + exit + }; + ok(1,"client connected" ); + my $proto = $to_server->alpn_selected; + ok($proto eq 'two',"negotiated $proto"); + + +} else { ###### Server + + my $to_client = $server->accept or do { + ok(0,"accept failed: ".$server->errstr() ); + kill(9,$pid); + exit; + }; + ok(1,"Server accepted" ); + my $proto = $to_client->alpn_selected; + ok($proto eq 'two',"negotiated $proto"); + wait; +} + +sub ok { + my $ok = shift; + print $ok ? '' : 'not ', "ok # [$ID] @_\n"; +}