Bug #81921 for IO-Async-SSL: SSL_VERIFY_PEER is not set

On Sun Dec 16 13:31:27 2012, PEVANS wrote: Show quoted text
Turns out that Mozilla::CA makes this quite simple. Version 0.07 on its way to CPAN now. -- Paul Evans

=== modified file 'lib/IO/Async/SSL.pm' --- lib/IO/Async/SSL.pm 2011-03-08 12:39:45 +0000 +++ lib/IO/Async/SSL.pm 2013-03-02 23:48:12 +0000 @@ -1,7 +1,7 @@ # You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # -# (C) Paul Evans, 2010-2011 -- leonerd@leonerd.org.uk +# (C) Paul Evans, 2010-2013 -- leonerd@leonerd.org.uk package IO::Async::SSL; @@ -62,8 +62,40 @@ instances, and two forms of C<SSL_upgrade> to upgrade an existing TCP connection to use SSL. +As an additional convenience, if the C<SSL_verify_mode> and C<SSL_ca_file> +options are omitted, the module will attempt to load L<Mozilla::CA> and, if +successful, use it to set C<SSL_VERIFY_PEER>. If C<Mozilla::CA> cannot be +loaded then it will set C<SSL_VERIFY_NONE>. + =cut +my $have_Mozilla_CA; + +sub _SSL_args +{ + my %args = @_; + + # SSL clients (i.e. non-server) require a verify mode + if( !$args{SSL_server} and !defined $args{SSL_verify_mode} and + !defined $args{SSL_ca_file} and !defined $args{SSL_ca_path} ) { + # Try to load Mozilla::CA; but if it fails remember that so we don't + # reload it repeatedly + defined $have_Mozilla_CA or + $have_Mozilla_CA = eval { require Mozilla::CA } || 0; + + if( $have_Mozilla_CA ) { + $args{SSL_verify_mode} = IO::Socket::SSL::SSL_VERIFY_PEER(); + $args{SSL_ca_file} = Mozilla::CA::SSL_ca_file(); + } + else { + carp "Unable to set SSL_VERIFY_PEER because Mozilla::CA is unavailable"; + $args{SSL_verify_mode} = IO::Socket::SSL::SSL_VERIFY_NONE(); + } + } + + return %args; +} + =head1 LOOP METHODS The following extra methods are added to L<IO::Async::Loop>. @@ -122,7 +154,7 @@ my %ssl_params = map { $_ => delete $params{$_} } grep m/^SSL_/, keys %params; - $socket = IO::Socket::SSL->start_SSL( $socket, + $socket = IO::Socket::SSL->start_SSL( $socket, _SSL_args SSL_startHandshake => 0, # Required to make IO::Socket::SSL not ->close before we have a chance to remove it from the loop @@ -223,7 +255,7 @@ my ( $socket ) = @_; $loop->SSL_upgrade( - %ssl_params, + _SSL_args( %ssl_params ), handle => $socket, @@ -299,8 +331,7 @@ my ( $socket ) = @_; $loop->SSL_upgrade( - SSL_server => 1, - %ssl_params, + _SSL_args( SSL_server => 1, %ssl_params ), handle => $socket, === modified file 't/01upgrade.t' --- t/01upgrade.t 2013-03-02 23:15:01 +0000 +++ t/01upgrade.t 2013-03-02 23:19:22 +0000 @@ -36,6 +36,7 @@ $loop->SSL_upgrade( handle => $client_sock, + SSL_verify_mode => 0, on_upgraded => sub { $client_upgraded++ }, on_error => sub { die "Test failed early - $_[-1]" }, @@ -90,6 +91,7 @@ my $client_errored; $loop->SSL_upgrade( handle => $client_sock, + SSL_verify_mode => 0, on_upgraded => sub { die "Test failed early - SSL upgrade succeeded" }, on_error => sub { $client_errored++ }, === modified file 't/02protocol-upgrade.t' --- t/02protocol-upgrade.t 2013-03-02 23:15:01 +0000 +++ t/02protocol-upgrade.t 2013-03-02 23:19:22 +0000 @@ -56,6 +56,7 @@ ); $client_proto->SSL_upgrade( + SSL_verify_mode => 0, on_upgraded => sub { $client_upgraded++ }, on_error => sub { die "Test failed early - $_[-1]" }, ); === modified file 't/03cross.t' --- t/03cross.t 2013-03-02 23:15:01 +0000 +++ t/03cross.t 2013-03-02 23:19:22 +0000 @@ -47,6 +47,8 @@ host => "localhost", service => $port, + SSL_verify_mode => 0, + on_connected => sub { $connected_sock = shift }, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, @@ -166,6 +168,8 @@ host => "localhost", service => $port, + SSL_verify_mode => 0, + on_connected => sub { $connected_sock = shift }, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, @@ -217,6 +221,8 @@ host => "localhost", service => $port, + SSL_verify_mode => 0, + on_connected => sub { $connected_sock = shift }, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, @@ -260,6 +266,8 @@ host => "localhost", service => $port, + SSL_verify_mode => 0, + on_connected => sub { $connected_sock = shift }, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, === modified file 't/10connect-openssl.t' --- t/10connect-openssl.t 2013-03-02 23:15:01 +0000 +++ t/10connect-openssl.t 2013-03-02 23:19:22 +0000 @@ -65,6 +65,8 @@ host => "localhost", service => "4433", # openssl s_server's default + SSL_verify_mode => 0, + on_connected => sub { $sslsock = shift }, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, === modified file 't/10connect-socat.t' --- t/10connect-socat.t 2013-03-02 23:15:01 +0000 +++ t/10connect-socat.t 2013-03-02 23:19:22 +0000 @@ -65,6 +65,8 @@ host => "localhost", service => "4434", + SSL_verify_mode => 0, + on_connected => sub { $sslsock = shift }, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" }, === modified file 't/20stream.t' --- t/20stream.t 2013-03-02 23:15:01 +0000 +++ t/20stream.t 2013-03-02 23:19:22 +0000 @@ -43,6 +43,8 @@ host => "localhost", service => "4433", + SSL_verify_mode => 0, + on_stream => sub { $c_stream = shift }, on_resolve_error => sub { die "Cannot resolve - $_[-1]\n" },