Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
openSUSE:Evergreen:11.4
perl-libwww-perl.import4589
libwww-perl-5.837-CVE-2011-0633.patch
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
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), "");
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor
