[perl-libwww-perl/f15] Fix CVE-2011-0633 by enabling hostname verification

Petr Pisar ppisar at fedoraproject.org
Thu Oct 13 15:10:35 UTC 2011


commit 29495fa16c75f4e059d8cb3cea67a6585a516d7d
Author: Petr Písař <ppisar at redhat.com>
Date:   Thu Oct 13 17:09:38 2011 +0200

    Fix CVE-2011-0633 by enabling hostname verification

 perl-libwww-perl-5.837-CVE-2011-0633.patch |  331 ++++++++++++++++++++++++++++
 perl-libwww-perl.spec                      |   12 +-
 2 files changed, 342 insertions(+), 1 deletions(-)
---
diff --git a/perl-libwww-perl-5.837-CVE-2011-0633.patch b/perl-libwww-perl-5.837-CVE-2011-0633.patch
new file mode 100644
index 0000000..6f6b3b0
--- /dev/null
+++ b/perl-libwww-perl-5.837-CVE-2011-0633.patch
@@ -0,0 +1,331 @@
+From b9e85e9268ebca5cc8ee3f8783dd4a440ba59745 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar at redhat.com>
+Date: Tue, 11 Oct 2011 16:54:08 +0200
+Subject: [PATCH] Back-port ssl_opts LWP::UserAgent argument
+
+This patch adds support for enabling/disabling certificate validation
+and host name match between URI and certificate. This can be done by
+ssl_opts LWP::UserAgent constructor argument or by environment
+variables. Default behaviour is to enable verification.
+
+SSL socket implementation can be selected by environment too. More
+advanced IO::Socket::SSL is prefered now.
+
+See <https://bugzilla.redhat.com/show_bug.cgi?id=705044>.
+This fixes CVE-2011-0633.
+
+These changes have been ported from version 6 to version 5.837.
+---
+ lib/LWP/Protocol/https.pm   |   25 +++++++++-
+ lib/LWP/Protocol/https10.pm |   16 +++---
+ lib/LWP/UserAgent.pm        |  106 +++++++++++++++++++++++++++++++++++++++++-
+ lib/Net/HTTPS.pm            |   47 ++++++++++++++-----
+ 4 files changed, 168 insertions(+), 26 deletions(-)
+
+diff --git a/lib/LWP/Protocol/https.pm b/lib/LWP/Protocol/https.pm
+index 367c8f7..2d0ca90 100644
+--- a/lib/LWP/Protocol/https.pm
++++ b/lib/LWP/Protocol/https.pm
+@@ -11,6 +11,23 @@ sub socket_type
+     return "https";
+ }
+ 
++sub _extra_sock_opts
++{
++    my $self = shift;
++    my %ssl_opts = %{$self->{ua}{ssl_opts} || {}};
++    if (delete $ssl_opts{verify_hostname}) {
++        $ssl_opts{SSL_verify_mode} ||= 1;
++        $ssl_opts{SSL_verifycn_scheme} = 'www';
++    }
++    if ($ssl_opts{SSL_verify_mode}) {
++        unless (exists $ssl_opts{SSL_ca_file} || exists $ssl_opts{SSL_ca_path}) {
++            $ssl_opts{SSL_ca_file} = '/etc/pki/tls/certs/ca-bundle.crt';
++        }
++    }
++    $self->{ssl_opts} = \%ssl_opts;
++    return (%ssl_opts, $self->SUPER::_extra_sock_opts);
++}
++
+ sub _check_sock
+ {
+     my($self, $req, $sock) = @_;
+@@ -36,9 +53,13 @@ sub _get_sock_info
+ 	$res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
+ 	$res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
+     }
+-    if(! eval { $sock->get_peer_verify }) {
+-       $res->header("Client-SSL-Warning" => "Peer certificate not verified");
++    if (!$self->{ssl_opts}{SSL_verify_mode}) {
++        $res->push_header("Client-SSL-Warning" => "Peer certificate not verified");
++    }
++    elsif (!$self->{ssl_opts}{SSL_verifycn_scheme}) {
++	$res->push_header("Client-SSL-Warning" => "Peer hostname match with certificate not verified");
+     }
++    $res->header("Client-SSL-Socket-Class" => $Net::HTTPS::SSL_SOCKET_CLASS); 
+ }
+ 
+ #-----------------------------------------------------------
+diff --git a/lib/LWP/Protocol/https10.pm b/lib/LWP/Protocol/https10.pm
+index 662ba76..45a3510 100644
+--- a/lib/LWP/Protocol/https10.pm
++++ b/lib/LWP/Protocol/https10.pm
+@@ -4,20 +4,20 @@ use strict;
+ 
+ # Figure out which SSL implementation to use
+ use vars qw($SSL_CLASS);
+-if ($Net::SSL::VERSION) {
+-    $SSL_CLASS = "Net::SSL";
+-}
+-elsif ($IO::Socket::SSL::VERSION) {
++if ($IO::Socket::SSL::VERSION) {
+     $SSL_CLASS = "IO::Socket::SSL"; # it was already loaded
+ }
++elsif ($Net::SSL::VERSION) {
++    $SSL_CLASS = "Net::SSL";
++}
+ else {
+-    eval { require Net::SSL; };     # from Crypt-SSLeay
++    eval { require IO::Socket::SSL; };
+     if ($@) {
+-	require IO::Socket::SSL;
+-	$SSL_CLASS = "IO::Socket::SSL";
++        require Net::SSL;     # from Crypt-SSLeay
++	$SSL_CLASS = "Net::SSL";
+     }
+     else {
+-	$SSL_CLASS = "Net::SSL";
++	$SSL_CLASS = "IO::Socket::SSL";
+     }
+ }
+ 
+diff --git a/lib/LWP/UserAgent.pm b/lib/LWP/UserAgent.pm
+index d098a44..80d1d20 100644
+--- a/lib/LWP/UserAgent.pm
++++ b/lib/LWP/UserAgent.pm
+@@ -41,6 +41,32 @@ sub new
+     my $timeout = delete $cnf{timeout};
+     $timeout = 3*60 unless defined $timeout;
+     my $local_address = delete $cnf{local_address};
++    my $ssl_opts = delete $cnf{ssl_opts};
++    unless ($ssl_opts) {
++        # The processing of HTTPS_CA_* below is for compatiblity with Crypt::SSLeay
++        $ssl_opts = {};
++        if (exists $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}) {
++            $ssl_opts->{verify_hostname} = $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME};
++        }
++        elsif ($ENV{HTTPS_CA_FILE} || $ENV{HTTPS_CA_DIR}) {
++            # Crypt-SSLeay compatiblity (verify peer certificate; but not the hostname)
++            $ssl_opts->{verify_hostname} = 0;
++            $ssl_opts->{SSL_verify_mode} = 1;
++        }
++        else {
++            $ssl_opts->{verify_hostname} = 1;
++        }
++    }
++    unless (exists $ssl_opts->{SSL_ca_file}) {
++        if (my $ca_file = $ENV{PERL_LWP_SSL_CA_FILE} || $ENV{HTTPS_CA_FILE}) {
++            $ssl_opts->{SSL_ca_file} = $ca_file;
++        }
++    }
++    unless (exists $ssl_opts->{SSL_ca_path}) {
++        if (my $ca_path = $ENV{PERL_LWP_SSL_CA_PATH} || $ENV{HTTPS_CA_DIR}) {
++            $ssl_opts->{SSL_ca_path} = $ca_path;
++        }
++    }
+     my $use_eval = delete $cnf{use_eval};
+     $use_eval = 1 unless defined $use_eval;
+     my $parse_head = delete $cnf{parse_head};
+@@ -83,6 +109,7 @@ sub new
+ 		      def_headers  => $def_headers,
+ 		      timeout      => $timeout,
+ 		      local_address => $local_address,
++		      ssl_opts     => $ssl_opts,
+ 		      use_eval     => $use_eval,
+                       show_progress=> $show_progress,
+ 		      max_size     => $max_size,
+@@ -161,10 +188,10 @@ sub send_request
+                 $@ =~ s/ at .* line \d+.*//s;  # remove file/line number
+                 $response =  _new_response($request, &HTTP::Status::RC_NOT_IMPLEMENTED, $@);
+                 if ($scheme eq "https") {
+-                    $response->message($response->message . " (Crypt::SSLeay or IO::Socket::SSL not installed)");
++                    $response->message($response->message . " (IO::Socket::SSL not installed)");
+                     $response->content_type("text/plain");
+                     $response->content(<<EOT);
+-LWP will support https URLs if either Crypt::SSLeay or IO::Socket::SSL
++LWP will support https URLs if either IO::Socket::SSL or Crypt::SSLeay
+ is installed. More information at
+ <http://search.cpan.org/dist/libwww-perl/README.SSL>.
+ EOT
+@@ -582,6 +609,31 @@ sub max_size     { shift->_elem('max_size',     @_); }
+ sub max_redirect { shift->_elem('max_redirect', @_); }
+ sub show_progress{ shift->_elem('show_progress', @_); }
+ 
++sub ssl_opts {
++    my $self = shift;
++    if (@_ == 1) {
++        my $k = shift;
++        return $self->{ssl_opts}{$k};
++    }
++    if (@_) {
++        my $old;
++        while (@_) {
++            my($k, $v) = splice(@_, 0, 2);
++            $old = $self->{ssl_opts}{$k} unless @_;
++            if (defined $v) {
++                $self->{ssl_opts}{$k} = $v;
++            }
++            else {
++                delete $self->{ssl_opts}{$k};
++            }
++        }
++        %{$self->{ssl_opts}} = (%{$self->{ssl_opts}}, @_);
++        return $old;
++    }
++
++    return keys %{$self->{ssl_opts}};
++}
++
+ sub parse_head {
+     my $self = shift;
+     if (@_) {
+@@ -800,7 +852,7 @@ sub clone
+     delete $copy->{conn_cache};
+ 
+     # copy any plain arrays and hashes; known not to need recursive copy
+-    for my $k (qw(proxy no_proxy requests_redirectable)) {
++    for my $k (qw(proxy no_proxy requests_redirectable ssl_opts)) {
+         next unless $copy->{$k};
+         if (ref($copy->{$k}) eq "ARRAY") {
+             $copy->{$k} = [ @{$copy->{$k}} ];
+@@ -1284,6 +1336,54 @@ is observed for C<timeout> seconds.  This means that the time it takes
+ for the complete transaction and the request() method to actually
+ return might be longer.
+ 
++=item $ua->ssl_opts
++
++=item $ua->ssl_opts( $key )
++
++=item $ua->ssl_opts( $key => $value )
++
++Get/set the options for SSL connections.  Without argument return the list
++of options keys currently set.  With a single argument return the current
++value for the given option.  With 2 arguments set the option value and return
++the old.  Setting an option to the value C<undef> removes this option.
++
++The options that LWP relates to are:
++
++=over
++
++=item C<verify_hostname> => $bool
++
++When TRUE LWP will for secure protocol schemes ensure it connects to servers
++that have a valid certificate matching the expected hostname.  If FALSE no
++checks are made and you can't be sure that you communicate with the expected peer.
++The no checks behaviour was the default for libwww-perl-5.837 and earlier releases.
++
++This option is initialized from the L<PERL_LWP_SSL_VERIFY_HOSTNAME> environment
++variable.  If this envirionment variable isn't set; then C<verify_hostname>
++defaults to 1.
++
++=item C<SSL_ca_file> => $path
++
++The path to a file containing Certificate Authority certificates.
++A default setting for this option is provided by checking the environment
++variables C<PERL_LWP_SSL_CA_FILE> and C<HTTPS_CA_FILE> in order. Last resort
++value is built-in value F</etc/pki/tls/certs/ca-bundle.crt>.
++
++=item C<SSL_ca_path> => $path
++
++The path to a directory containing files containing Certificate Authority
++certificates.
++A default setting for this option is provided by checking the environment
++variables C<PERL_LWP_SSL_CA_PATH> and C<HTTPS_CA_DIR> in order.
++
++=back
++
++Other options can be set and are processed directly by the SSL Socket implementation
++in use.  See L<IO::Socket::SSL> or L<Net::SSL> for details.
++
++SSL Socket implementation can be selected by environment variable
++C<PERL_NET_HTTPS_SSL_SOCKET_CLASS>. L<IO::Socket::SSL> is preferred by default.
++
+ =back
+ 
+ =head2 Proxy attributes
+diff --git a/lib/Net/HTTPS.pm b/lib/Net/HTTPS.pm
+index bfed714..750cf42 100644
+--- a/lib/Net/HTTPS.pm
++++ b/lib/Net/HTTPS.pm
+@@ -9,27 +9,34 @@ $VERSION = "5.819";
+ if ($SSL_SOCKET_CLASS) {
+     # somebody already set it
+ }
+-elsif ($Net::SSL::VERSION) {
+-    $SSL_SOCKET_CLASS = "Net::SSL";
++elsif ($SSL_SOCKET_CLASS = $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS}) {
++    unless ($SSL_SOCKET_CLASS =~ /^(IO::Socket::SSL|Net::SSL)\z/) {
++        die "Bad socket class [$SSL_SOCKET_CLASS]";
++    }
++    eval "require $SSL_SOCKET_CLASS";
++    die $@ if $@;
+ }
+ elsif ($IO::Socket::SSL::VERSION) {
+     $SSL_SOCKET_CLASS = "IO::Socket::SSL"; # it was already loaded
+ }
++elsif ($Net::SSL::VERSION) {
++    $SSL_SOCKET_CLASS = "Net::SSL";
++}
+ else {
+-    eval { require Net::SSL; };     # from Crypt-SSLeay
++    eval { require IO::Socket::SSL; };
+     if ($@) {
+-	my $old_errsv = $@;
+-	eval {
+-	    require IO::Socket::SSL;
+-	};
+-	if ($@) {
+-	    $old_errsv =~ s/\s\(\@INC contains:.*\)/)/g;
+-	    die $old_errsv . $@;
+-	}
+-	$SSL_SOCKET_CLASS = "IO::Socket::SSL";
++        my $old_errsv = $@;
++        eval {
++            require Net::SSL;  # from Crypt-SSLeay
++        };
++        if ($@) {
++            $old_errsv =~ s/\s\(\@INC contains:.*\)/)/g;
++            die $old_errsv . $@;
++        }
++        $SSL_SOCKET_CLASS = "Net::SSL";
+     }
+     else {
+-	$SSL_SOCKET_CLASS = "Net::SSL";
++        $SSL_SOCKET_CLASS = "IO::Socket::SSL";
+     }
+ }
+ 
+@@ -44,6 +51,20 @@ sub configure {
+ 
+ sub http_connect {
+     my($self, $cnf) = @_;
++    if ($self->isa("Net::SSL")) {
++        if ($cnf->{SSL_verify_mode}) {
++            if (my $f = $cnf->{SSL_ca_file}) {
++                $ENV{HTTPS_CA_FILE} = $f;
++            }
++            if (my $f = $cnf->{SSL_ca_path}) {
++                $ENV{HTTPS_CA_DIR} = $f;
++            }
++        }
++        if ($cnf->{SSL_verifycn_scheme}) {
++            $@ = "Net::SSL from Crypt-SSLeay can't verify hostnames; either install IO::Socket::SSL or turn off verification by setting the PERL_LWP_SSL_VERIFY_HOSTNAME environment variable to 0";
++            return undef;
++        }
++    }
+     $self->SUPER::configure($cnf);
+ }
+ 
+-- 
+1.7.6.4
+
diff --git a/perl-libwww-perl.spec b/perl-libwww-perl.spec
index 654c3e2..84105ee 100644
--- a/perl-libwww-perl.spec
+++ b/perl-libwww-perl.spec
@@ -1,12 +1,15 @@
 Name:           perl-libwww-perl
 Version:        5.837
-Release:        3%{?dist}
+Release:        4%{?dist}
 Summary:        A Perl interface to the World-Wide Web
 
 Group:          Development/Libraries
 License:        GPL+ or Artistic
 URL:            http://search.cpan.org/dist/libwww-perl/
 Source0:        http://www.cpan.org/authors/id/G/GA/GAAS/libwww-perl-%{version}.tar.gz
+# Fix CVE-2011-0633 by enabling hostname verification, bug #705044, Fixed in
+# upstream 6.00.
+Patch0:         %{name}-5.837-CVE-2011-0633.patch
 
 BuildArch:      noarch
 BuildRequires:  perl(HTML::Entities), perl(URI), perl(Test::More), perl(ExtUtils::MakeMaker)
@@ -28,6 +31,7 @@ use and even classes that help you implement simple HTTP servers.
 
 %prep
 %setup -q -n libwww-perl-%{version} 
+%patch0 -p1
 %{?filter_setup:
 %filter_from_provides /perl(HTTP::Headers)$/d
 %filter_from_requires /perl(HTTP::GHTTP)/d
@@ -87,6 +91,12 @@ rm -rf $RPM_BUILD_ROOT
 
 
 %changelog
+* Thu Oct 13 2011 Petr Pisar <ppisar at redhat.com> - 5.837-4
+- Fix CVE-2011-0633 by enabling hostname verification by default. If you insist
+  on no checking (the insecure way), set PERL_LWP_SSL_VERIFY_HOSTNAME=0
+  environment variable or modify your application to set ssl_opts correctly.
+  See LWP::UserAgent POD for more details. (bug #705044)
+
 * Wed Feb 09 2011 Fedora Release Engineering <rel-eng at lists.fedoraproject.org> - 5.837-3
 - Rebuilt for https://fedoraproject.org/wiki/Fedora_15_Mass_Rebuild
 


More information about the scm-commits mailing list