Bug #76223 for IO-Socket-SSL: Next Protocol Negotiation (NPN) support

diff -ru OLD_IO-Socket-SSL\SSL.pm NEW_IO-Socket-SSL\SSL.pm --- OLD_IO-Socket-SSL\SSL.pm Wed Mar 28 07:47:55 2012 +++ NEW_IO-Socket-SSL\SSL.pm Sun Apr 01 22:45:11 2012 @@ -228,6 +228,7 @@ SSL_verify_callback => undef, SSL_verifycn_scheme => undef, # don't verify cn SSL_verifycn_name => undef, # use from PeerAddr/PeerHost + SSL_npn_protocols => undef, # meaning depends whether on server or client side ); # common problem forgetting SSL_use_cert @@ -1324,6 +1325,11 @@ } } +sub next_proto_negotiated { + my $ssl = shift()->_get_ssl_object || return; + return if !exists &Net::SSLeay::P_next_proto_negotiated; + return Net::SSLeay::P_next_proto_negotiated($ssl); +} sub opened { my $self = shift; @@ -1456,6 +1462,19 @@ Net::SSLeay::CTX_set_mode( $ctx, SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER|SSL_MODE_ENABLE_PARTIAL_WRITE); + my $proto_list = $arg_hash->{'SSL_npn_protocols'}; + if($proto_list && ref $proto_list && ref $proto_list eq ref [] && + exists &Net::SSLeay::P_next_proto_negotiated ) { + if($arg_hash->{'SSL_server'}) { + # on server side SSL_npn_protocols means a list of advertised protocols + Net::SSLeay::CTX_set_next_protos_advertised_cb($ctx , $proto_list); + } + else { + # on client side SSL_npn_protocols means a list of prefered protocols + # negotiation algorithm used is "as-openssl-implements-it" + Net::SSLeay::CTX_set_next_proto_select_cb($ctx, $proto_list); + } + } my $verify_mode = $arg_hash->{SSL_verify_mode}; if ( $verify_mode != Net::SSLeay::VERIFY_NONE() and @@ -1972,6 +1991,24 @@ a reference to the socket on which the SSL negotiation failed and and the full text of the error message. +=item SSL_npn_protocols + +This parameter is related to Next Protocol Negotioation (NPN) feature. + +B<BEWARE:> for NPN support you will need Net::SSLeay 1.46+ and openssl-1.0.1+ + +The semantic of this parameter differs depending whether on server or client +side of SSL connection. In both cases it has to be an array reference. + +B<On server side> this parameter specifies list of protocols advertised by SSL +server - e.g. ['spdy/2','http1.1'] + +B<On client side> this parameter specifies list of prefered protocols that are passed +to NPN negotioation process. The client will use a "common" negotiation algoritm +(as implemented by openssl's function SSL_select_next_proto). + +See also method L</next_proto_negotiated>. + =back =item B<close(...)> @@ -2126,6 +2163,39 @@ ($hostname,$commonName,@subjectAltNames), where hostname is the name given for verification, commonName is the result from peer_certificate('cn') and subjectAltNames is the result from peer_certificate('subjectAltNames'). + +=item B<next_proto_negotiated()> + +This method is related to Next Protocol Negotioation (NPN) feature. + +B<BEWARE:> for NPN support you will need Net::SSLeay 1.46+ and openssl-1.0.1+ + +This method returns the name of negotiated protocol - e.g. 'http/1.1'. It works +for both client and server side of SSL connection. + +SSL client example: + + use IO::Socket::SSL; + my $client = IO::Socket::SSL->new( + PeerAddr=>"encrypted.google.com:https", + SSL_npn_protocols=>['spdy/2','http/1.1'], + ) or die; + warn "Negotiated:", $client->next_proto_negotiated(), "\n"; + +SSL server example: + + use IO::Socket::SSL; + my $server = IO::Socket::SSL->new( + LocalAddr=>'127.0.0.1', + LocalPort=>5443, + Proto=>'tcp', + Listen => 5, + SSL_npn_protocols=>['protoX','protoA','protoB'], + ) or die; + warn "ssl server listening try to connect via:\n"; + warn "openssl s_client -connect localhost:5443 -nextprotoneg proto1,protoB,protoA,proto2\n"; + my $s = $server->accept(); + warn "Negotiated:", $s->next_proto_negotiated(), "\n"; =item B<errstr()>