File libwww-perl-5.837-CVE-2011-0633.patch of Package perl-libwww-perl.import4589

Index: libwww-perl-5.837/Makefile.PL
===================================================================
--- libwww-perl-5.837.orig/Makefile.PL
+++ libwww-perl-5.837/Makefile.PL
@@ -55,7 +55,7 @@ WriteMakefile(
     },
     META_MERGE => {
         recommends => {
-            'Crypt::SSLeay' => 0,
+            'IO::Socket::SSL' => "1.38",
         },
 	resources => {
             repository => 'http://github.com/gisle/libwww-perl',
Index: libwww-perl-5.837/README.SSL
===================================================================
--- libwww-perl-5.837.orig/README.SSL
+++ libwww-perl-5.837/README.SSL
@@ -8,17 +8,14 @@ encryption software in general and certa
 particular, in several countries, libwww-perl package doesn't include
 SSL functionality out-of-the-box.
 
-Encryption support is obtained through the use of Crypt::SSLeay or
-IO::Socket::SSL, which can both be found from CPAN. While libwww-perl
+Encryption support is obtained through the use of IO::Socket::SSL or
+Crypt::SSLeay, which can both be found from CPAN. While libwww-perl
 has "plug-and-play" support for both of these modules (as of v5.45),
-the recommended module to use is Crypt::SSLeay. In addition to
-bringing SSL support to the LWP package, IO::Socket::SSL can be used
-as an object oriented interface to SSL encrypted network sockets.
+the recommended module to use is IO::Socket::SSL.
 
 There is yet another SSL interface for perl called Net::SSLeay. It has
 a more complete SSL interface and can be used for web client
 programming among other things but doesn't directly support LWP.
 
 The underlying SSL support in all of these modules is based on OpenSSL
-<http://www.openssl.org/> (formerly SSLeay). For WWW-server side SSL
-support (e.g. CGI/FCGI scripts) in Apache see <http://www.modssl.org/>.
+<http://www.openssl.org/> (formerly SSLeay).
Index: libwww-perl-5.837/lib/LWP.pm
===================================================================
--- libwww-perl-5.837.orig/lib/LWP.pm
+++ libwww-perl-5.837/lib/LWP.pm
@@ -582,6 +582,20 @@ These environment variables can be set t
 a proxy server.  See the description of the C<env_proxy> method in
 L<LWP::UserAgent>.
 
+=item PERL_LWP_SSL_VERIFY_HOSTNAME
+
+The default C<verify_hostname> setting for M<LWP::UserAgent>.  If
+not set the default will be 1.  Set it as 0 to disable hostname
+verification (the default prior to libwww-perl 5.840.
+
+=item PERL_LWP_SSL_CA_FILE
+
+=item PERL_LWP_SSL_CA_PATH
+
+The file and/or directory
+where the trusted Certificate Authority certificates
+is located.  See L<LWP::UserAgent> for details.
+
 =item PERL_LWP_USE_HTTP_10
 
 Enable the old HTTP/1.0 protocol driver instead of the new HTTP/1.1
Index: libwww-perl-5.837/lib/LWP/Protocol/http.pm
===================================================================
--- libwww-perl-5.837.orig/lib/LWP/Protocol/http.pm
+++ libwww-perl-5.837/lib/LWP/Protocol/http.pm
@@ -40,8 +40,21 @@ sub _new_socket
 
     unless ($sock) {
 	# IO::Socket::INET leaves additional error messages in $@
-	$@ =~ s/^.*?: //;
-	die "Can't connect to $host:$port ($@)";
+	my $status = "Can't connect to $host:$port";
+	if ($@ =~ /\bconnect: (.*)/ ||
+	    $@ =~ /\b(Bad hostname)\b/ ||
+	    $@ =~ /\b(certificate verify failed)\b/ ||
+	    $@ =~ /\b(Crypt-SSLeay can't verify hostnames)\b/
+	) {
+	    $status .= " ($1)";
+	}
+	if ($@ =~ /\b(certificate verify failed)\b/ ||
+	    $@ =~ /\b(Crypt-SSLeay can't verify hostnames)\b/
+	) {
+	    $status .= "\n\nYou can disable hostname check by setting "
+	    . "environment variable PERL_LWP_SSL_VERIFY_HOSTNAME=0";
+	}
+	die "$status\n\n$@";
     }
 
     # perl 5.005's IO::Socket does not have the blocking method.
Index: libwww-perl-5.837/lib/LWP/Protocol/https.pm
===================================================================
--- libwww-perl-5.837.orig/lib/LWP/Protocol/https.pm
+++ libwww-perl-5.837/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_path} = '/etc/ssl/certs';
+ 	}
+     }
+    $self->{ssl_opts} = \%ssl_opts;
+    return (%ssl_opts, $self->SUPER::_extra_sock_opts);
+}
+
 sub _check_sock
 {
     my($self, $req, $sock) = @_;
@@ -36,8 +53,12 @@ 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");
     }
 }
 
Index: libwww-perl-5.837/lib/LWP/UserAgent.pm
===================================================================
--- libwww-perl-5.837.orig/lib/LWP/UserAgent.pm
+++ libwww-perl-5.837/lib/LWP/UserAgent.pm
@@ -41,6 +41,34 @@ 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};
@@ -58,7 +86,6 @@ sub new
     Carp::croak("Can't mix conn_cache and keep_alive")
 	  if $conn_cache && $keep_alive;
 
-
     my $protocols_allowed   = delete $cnf{protocols_allowed};
     my $protocols_forbidden = delete $cnf{protocols_forbidden};
     
@@ -83,6 +110,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 +189,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
@@ -175,14 +203,21 @@ EOT
         if (!$response && $self->{use_eval}) {
             # we eval, and turn dies into responses below
             eval {
-                $response = $protocol->request($request, $proxy,
-                                               $arg, $size, $self->{timeout});
+                $response = $protocol->request($request, $proxy, $arg, $size, $self->{timeout}) ||
+		    die "No response returned by $protocol";
             };
             if ($@) {
-                $@ =~ s/ at .* line \d+.*//s;  # remove file/line number
-                    $response = _new_response($request,
-                                              &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
-                                              $@);
+                if (UNIVERSAL::isa($@, "HTTP::Response")) {
+                    $response = $@;
+                    $response->request($request);
+                }
+                else {
+                    my $full = $@;
+                    (my $status = $@) =~ s/\n.*//s;
+                    $status =~ s/ at .* line \d+.*//s;  # remove file/line number
+                    my $code = ($status =~ s/^(\d\d\d)\s+//) ? $1 : &HTTP::Status::RC_INTERNAL_SERVER_ERROR;
+                    $response = _new_response($request, $code, $status, $full);
+                }
             }
         }
         elsif (!$response) {
@@ -582,6 +617,31 @@ sub max_size     { shift->_elem('max_siz
 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 +860,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}} ];
@@ -962,13 +1022,13 @@ sub no_proxy {
 
 
 sub _new_response {
-    my($request, $code, $message) = @_;
+    my($request, $code, $message, $content) = @_;
     my $response = HTTP::Response->new($code, $message);
     $response->request($request);
     $response->header("Client-Date" => HTTP::Date::time2str(time));
     $response->header("Client-Warning" => "Internal response");
     $response->header("Content-Type" => "text/plain");
-    $response->content("$code $message\n");
+    $response->content($content || "$code $message\n");
     return $response;
 }
 
@@ -1040,6 +1100,7 @@ The following options correspond to attr
    cookie_jar              undef
    default_headers         HTTP::Headers->new
    local_address           undef
+   ssl_opts		   { verify_hostname => 1 }
    max_size                undef
    max_redirect            7
    parse_head              1
@@ -1284,6 +1345,53 @@ is observed for C<timeout> seconds.  Thi
 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 older.
+
+This option is initialized from the L<PERL_LWP_SSL_VERIFY_HOSTNAME> environment
+variable.  If the 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.
+
+=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.
+
+If hostname verification is requested, and neither C<SSL_ca_file> nor
+C<SSL_ca_path> is set, then C<SSL_ca_path> is implied to be /etc/ssl/certs.
+
 =back
 
 =head2 Proxy attributes
Index: libwww-perl-5.837/lib/Net/HTTPS.pm
===================================================================
--- libwww-perl-5.837.orig/lib/Net/HTTPS.pm
+++ libwww-perl-5.837/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;
+	    require Net::SSL;  # from Crypt-SSLeay
 	};
 	if ($@) {
 	    $old_errsv =~ s/\s\(\@INC contains:.*\)/)/g;
 	    die $old_errsv . $@;
 	}
-	$SSL_SOCKET_CLASS = "IO::Socket::SSL";
+	$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);
 }
 
Index: libwww-perl-5.837/t/base/ua.t
===================================================================
--- libwww-perl-5.837.orig/t/base/ua.t
+++ libwww-perl-5.837/t/base/ua.t
@@ -3,7 +3,7 @@
 use strict;
 use Test;
 
-plan tests => 14;
+plan tests => 21;
 
 use LWP::UserAgent;
 
@@ -47,3 +47,11 @@ ok($ua->proxy('http'), undef);
 my $res = $ua->get("data:text/html,%3Chtml%3E%3Chead%3E%3Cmeta%20http-equiv%3D%22Content-Script-Type%22%20content%3D%22text%2Fjavascript%22%3E%3Cmeta%20http-equiv%3D%22Content-Style-Type%22%20content%3D%22text%2Fcss%22%3E%3C%2Fhead%3E%3C%2Fhtml%3E");
 ok($res->header("Content-Style-Type", "text/css"));
 ok($res->header("Content-Script-Type", "text/javascript"));
+
+ok(join(":", $ua->ssl_opts), "verify_hostname");
+ok($ua->ssl_opts("verify_hostname"), 1);
+ok($ua->ssl_opts(verify_hostname => 0), 1);
+ok($ua->ssl_opts("verify_hostname"), 0);
+ok($ua->ssl_opts(verify_hostname => undef), 0);
+ok($ua->ssl_opts("verify_hostname"), undef);
+ok(join(":", $ua->ssl_opts), "");