r72123 - in /branches/upstream/libwww-perl/current: ./ lib/ lib/LWP/ lib/LWP/Protocol/ t/ t/live/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Thu Mar 31 23:06:17 UTC 2011
Author: periapt-guest
Date: Thu Mar 31 23:06:07 2011
New Revision: 72123
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=72123
Log:
[svn-upgrade] new version libwww-perl (6.01)
Added:
branches/upstream/libwww-perl/current/lib/LWP/Protocol/http10.pm
branches/upstream/libwww-perl/current/lib/LWP/Protocol/https.pm
branches/upstream/libwww-perl/current/lib/LWP/Protocol/https10.pm
branches/upstream/libwww-perl/current/t/live/https.t
Modified:
branches/upstream/libwww-perl/current/Changes
branches/upstream/libwww-perl/current/MANIFEST
branches/upstream/libwww-perl/current/META.yml
branches/upstream/libwww-perl/current/Makefile.PL
branches/upstream/libwww-perl/current/README
branches/upstream/libwww-perl/current/README.SSL
branches/upstream/libwww-perl/current/lib/LWP.pm
branches/upstream/libwww-perl/current/lib/LWP/ConnCache.pm
branches/upstream/libwww-perl/current/lib/LWP/UserAgent.pm
branches/upstream/libwww-perl/current/t/TEST
Modified: branches/upstream/libwww-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/Changes?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/Changes (original)
+++ branches/upstream/libwww-perl/current/Changes Thu Mar 31 23:06:07 2011
@@ -1,29 +1,3 @@
-_______________________________________________________________________________
-2011-03-27 Release 6.02
-
-This is the release where we try to help the CPAN-toolchain be able to install
-the modules required for https-support in LWP. We have done this by unbundling
-the LWP::Protocol::https module from the libwww-perl distribution. In order to
-have https support you now need to install (or depend on) 'LWP::Protocol::https'
-and then this will make sure that all the prerequsite modules comes along.
-See [RT#66838].
-
-This release also removes the old http10 modules that has really been
-deprecated since v5.60. These should have been removed at the v6.00 jump, but
-I forgot.
-
-
-Christopher J. Madsen (1):
- Ignores env variables when ssl_opts provided [RT#66663]
-
-Gisle Aas (4):
- Fix typo; Authen::NTLM [RT#66884]
-
-Yury Zavarin (1):
- Support LWP::ConnCache->new(total_capacity => undef)
-
-
-
_______________________________________________________________________________
2011-03-09 Release 6.01
Modified: branches/upstream/libwww-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/MANIFEST?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/MANIFEST (original)
+++ branches/upstream/libwww-perl/current/MANIFEST Thu Mar 31 23:06:07 2011
@@ -25,6 +25,9 @@
lib/LWP/Protocol/ftp.pm Access with the FTP protocol
lib/LWP/Protocol/gopher.pm Access with the Gopher protocol
lib/LWP/Protocol/http.pm Access with HTTP/1.1 protocol
+lib/LWP/Protocol/http10.pm Access with HTTP/1.0 protocol
+lib/LWP/Protocol/https.pm Access with HTTP/1.1 protocol over SSL
+lib/LWP/Protocol/https10.pm Access with HTTP/1.0 protocol over SSL
lib/LWP/Protocol/loopback.pm Returns request (like HTTP TRACE)
lib/LWP/Protocol/mailto.pm Allows you to POST mail using sendmail
lib/LWP/Protocol/nntp.pm Handles access to news: and nntp: URLs
@@ -38,6 +41,7 @@
t/TEST Run tests
t/base/protocols.t Test protocol methods of LWP::UserAgent
t/base/ua.t Basic LWP::UserAgent tests
+t/live/https.t
t/live/jigsaw-auth-b.t
t/live/jigsaw-auth-d.t
t/live/jigsaw-chunk.t
Modified: branches/upstream/libwww-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/META.yml?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/META.yml (original)
+++ branches/upstream/libwww-perl/current/META.yml Thu Mar 31 23:06:07 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: libwww-perl
-version: 6.02
+version: 6.01
abstract: The World-Wide Web library for Perl
author:
- Gisle Aas <gisle at activestate.com>
@@ -42,11 +42,13 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.57_05
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
recommends:
- Authen::NTLM: 1.02
- Data::Dump: 0
- LWP::Protocol::https: 6.02
+ Authen::NTML: 2.12
+ Data::Dump: 0
+ IO::Socket::SSL: 1.38
+ Mozilla::CA: 20110101
+ Net::HTTPS: 6
Modified: branches/upstream/libwww-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/Makefile.PL?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/Makefile.PL (original)
+++ branches/upstream/libwww-perl/current/Makefile.PL Thu Mar 31 23:06:07 2011
@@ -66,8 +66,10 @@
},
META_MERGE => {
recommends => {
- 'LWP::Protocol::https' => '6.02',
- 'Authen::NTLM' => "1.02",
+ 'Net::HTTPS' => 6,
+ 'IO::Socket::SSL' => "1.38",
+ 'Mozilla::CA' => "20110101",
+ 'Authen::NTML' => "2.12",
'Data::Dump' => 0,
},
resources => {
Modified: branches/upstream/libwww-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/README?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/README (original)
+++ branches/upstream/libwww-perl/current/README Thu Mar 31 23:06:07 2011
@@ -36,7 +36,8 @@
WWW-RobotRules
If you want to access sites using the https protocol, then you need to
-install the LWP::Protocol::https module from CPAN.
+install the IO::Socket::SSL module or the Crypt::SSLeay module. The
+README.SSL file will tell you more about how libwww-perl supports SSL.
INSTALLATION
Modified: branches/upstream/libwww-perl/current/README.SSL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/README.SSL?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/README.SSL (original)
+++ branches/upstream/libwww-perl/current/README.SSL Thu Mar 31 23:06:07 2011
@@ -1,7 +1,21 @@
-As of libwww-perl v6.02 you need to install the LWP::Protocol::https module
-from its own separate distribution to enable support for https://... URLs for
-LWP::UserAgent.
+SSL SUPPORT
+-----------
-This makes it possible for that distribution to state the required dependencies
-as non-optional. See <https://rt.cpan.org/Ticket/Display.html?id=66838> for
-further discussion why we ended up with this solution.
+The libwww-perl package has support for using SSL/TLSv1 with its HTTP
+client and server classes. This support makes it possible to access
+https schemed URLs with LWP. Because of the problematic status of
+encryption software in general and certain encryption algorithms in
+particular, in several countries, libwww-perl package doesn't include
+SSL functionality out-of-the-box.
+
+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 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).
Modified: branches/upstream/libwww-perl/current/lib/LWP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/lib/LWP.pm?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/lib/LWP.pm (original)
+++ branches/upstream/libwww-perl/current/lib/LWP.pm Thu Mar 31 23:06:07 2011
@@ -1,6 +1,6 @@
package LWP;
-$VERSION = "6.02";
+$VERSION = "6.01";
sub Version { $VERSION; }
require 5.008;
@@ -595,6 +595,13 @@
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
+driver. You might want to set this to a TRUE value if you discover
+that your old LWP applications fails after you installed LWP-5.60 or
+better.
=item PERL_HTTP_URI_CLASS
Modified: branches/upstream/libwww-perl/current/lib/LWP/ConnCache.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/lib/LWP/ConnCache.pm?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/lib/LWP/ConnCache.pm (original)
+++ branches/upstream/libwww-perl/current/lib/LWP/ConnCache.pm Thu Mar 31 23:06:07 2011
@@ -3,16 +3,13 @@
use strict;
use vars qw($VERSION $DEBUG);
-$VERSION = "6.02";
+$VERSION = "6.00";
sub new {
my($class, %cnf) = @_;
-
- my $total_capacity = 1;
- if (exists $cnf{total_capacity}) {
- $total_capacity = delete $cnf{total_capacity};
- }
+ my $total_capacity = delete $cnf{total_capacity};
+ $total_capacity = 1 unless defined $total_capacity;
if (%cnf && $^W) {
require Carp;
Carp::carp("Unrecognised options: @{[sort keys %cnf]}")
Added: branches/upstream/libwww-perl/current/lib/LWP/Protocol/http10.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/lib/LWP/Protocol/http10.pm?rev=72123&op=file
==============================================================================
--- branches/upstream/libwww-perl/current/lib/LWP/Protocol/http10.pm (added)
+++ branches/upstream/libwww-perl/current/lib/LWP/Protocol/http10.pm Thu Mar 31 23:06:07 2011
@@ -1,0 +1,290 @@
+package LWP::Protocol::http10;
+
+use strict;
+
+require HTTP::Response;
+require HTTP::Status;
+require IO::Socket;
+require IO::Select;
+
+use vars qw(@ISA @EXTRA_SOCK_OPTS);
+
+require LWP::Protocol;
+ at ISA = qw(LWP::Protocol);
+
+my $CRLF = "\015\012"; # how lines should be terminated;
+ # "\r\n" is not correct on all systems, for
+ # instance MacPerl defines it to "\012\015"
+
+sub _new_socket
+{
+ my($self, $host, $port, $timeout) = @_;
+
+ local($^W) = 0; # IO::Socket::INET can be noisy
+ my $sock = IO::Socket::INET->new(PeerAddr => $host,
+ PeerPort => $port,
+ LocalAddr => $self->{ua}{local_address},
+ Proto => 'tcp',
+ Timeout => $timeout,
+ $self->_extra_sock_opts($host, $port),
+ );
+ unless ($sock) {
+ # IO::Socket::INET leaves additional error messages in $@
+ $@ =~ s/^.*?: //;
+ die "Can't connect to $host:$port ($@)";
+ }
+ $sock;
+}
+
+sub _extra_sock_opts # to be overridden by subclass
+{
+ return @EXTRA_SOCK_OPTS;
+}
+
+
+sub _check_sock
+{
+ #my($self, $req, $sock) = @_;
+}
+
+sub _get_sock_info
+{
+ my($self, $res, $sock) = @_;
+ if (defined(my $peerhost = $sock->peerhost)) {
+ $res->header("Client-Peer" => "$peerhost:" . $sock->peerport);
+ }
+}
+
+sub _fixup_header
+{
+ my($self, $h, $url, $proxy) = @_;
+
+ $h->remove_header('Connection'); # need support here to be useful
+
+ # HTTP/1.1 will require us to send the 'Host' header, so we might
+ # as well start now.
+ my $hhost = $url->authority;
+ if ($hhost =~ s/^([^\@]*)\@//) { # get rid of potential "user:pass@"
+ # add authorization header if we need them. HTTP URLs do
+ # not really support specification of user and password, but
+ # we allow it.
+ if (defined($1) && not $h->header('Authorization')) {
+ require URI::Escape;
+ $h->authorization_basic(map URI::Escape::uri_unescape($_),
+ split(":", $1, 2));
+ }
+ }
+ $h->init_header('Host' => $hhost);
+
+ if ($proxy) {
+ # Check the proxy URI's userinfo() for proxy credentials
+ # export http_proxy="http://proxyuser:proxypass@proxyhost:port"
+ my $p_auth = $proxy->userinfo();
+ if(defined $p_auth) {
+ require URI::Escape;
+ $h->proxy_authorization_basic(map URI::Escape::uri_unescape($_),
+ split(":", $p_auth, 2))
+ }
+ }
+}
+
+
+sub request
+{
+ my($self, $request, $proxy, $arg, $size, $timeout) = @_;
+
+ $size ||= 4096;
+
+ # check method
+ my $method = $request->method;
+ unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
+ return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
+ 'Library does not allow method ' .
+ "$method for 'http:' URLs");
+ }
+
+ my $url = $request->uri;
+ my($host, $port, $fullpath);
+
+ # Check if we're proxy'ing
+ if (defined $proxy) {
+ # $proxy is an URL to an HTTP server which will proxy this request
+ $host = $proxy->host;
+ $port = $proxy->port;
+ $fullpath = $method eq "CONNECT" ?
+ ($url->host . ":" . $url->port) :
+ $url->as_string;
+ }
+ else {
+ $host = $url->host;
+ $port = $url->port;
+ $fullpath = $url->path_query;
+ $fullpath = "/" unless length $fullpath;
+ }
+
+ # connect to remote site
+ my $socket = $self->_new_socket($host, $port, $timeout);
+ $self->_check_sock($request, $socket);
+
+ my $sel = IO::Select->new($socket) if $timeout;
+
+ my $request_line = "$method $fullpath HTTP/1.0$CRLF";
+
+ my $h = $request->headers->clone;
+ my $cont_ref = $request->content_ref;
+ $cont_ref = $$cont_ref if ref($$cont_ref);
+ my $ctype = ref($cont_ref);
+
+ # If we're sending content we *have* to specify a content length
+ # otherwise the server won't know a messagebody is coming.
+ if ($ctype eq 'CODE') {
+ die 'No Content-Length header for request with dynamic content'
+ unless defined($h->header('Content-Length')) ||
+ $h->content_type =~ /^multipart\//;
+ # For HTTP/1.1 we could have used chunked transfer encoding...
+ }
+ else {
+ $h->header('Content-Length' => length $$cont_ref)
+ if defined($$cont_ref) && length($$cont_ref);
+ }
+
+ $self->_fixup_header($h, $url, $proxy);
+
+ my $buf = $request_line . $h->as_string($CRLF) . $CRLF;
+ my $n; # used for return value from syswrite/sysread
+ my $length;
+ my $offset;
+
+ # syswrite $buf
+ $length = length($buf);
+ $offset = 0;
+ while ( $offset < $length ) {
+ die "write timeout" if $timeout && !$sel->can_write($timeout);
+ $n = $socket->syswrite($buf, $length-$offset, $offset );
+ die $! unless defined($n);
+ $offset += $n;
+ }
+
+ if ($ctype eq 'CODE') {
+ while ( ($buf = &$cont_ref()), defined($buf) && length($buf)) {
+ # syswrite $buf
+ $length = length($buf);
+ $offset = 0;
+ while ( $offset < $length ) {
+ die "write timeout" if $timeout && !$sel->can_write($timeout);
+ $n = $socket->syswrite($buf, $length-$offset, $offset );
+ die $! unless defined($n);
+ $offset += $n;
+ }
+ }
+ }
+ elsif (defined($$cont_ref) && length($$cont_ref)) {
+ # syswrite $$cont_ref
+ $length = length($$cont_ref);
+ $offset = 0;
+ while ( $offset < $length ) {
+ die "write timeout" if $timeout && !$sel->can_write($timeout);
+ $n = $socket->syswrite($$cont_ref, $length-$offset, $offset );
+ die $! unless defined($n);
+ $offset += $n;
+ }
+ }
+
+ # read response line from server
+ my $response;
+ $buf = '';
+
+ # Inside this loop we will read the response line and all headers
+ # found in the response.
+ while (1) {
+ die "read timeout" if $timeout && !$sel->can_read($timeout);
+ $n = $socket->sysread($buf, $size, length($buf));
+ die $! unless defined($n);
+ die "unexpected EOF before status line seen" unless $n;
+
+ if ($buf =~ s/^(HTTP\/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*)\012//) {
+ # HTTP/1.0 response or better
+ my($ver,$code,$msg) = ($1, $2, $3);
+ $msg =~ s/\015$//;
+ $response = HTTP::Response->new($code, $msg);
+ $response->protocol($ver);
+
+ # ensure that we have read all headers. The headers will be
+ # terminated by two blank lines
+ until ($buf =~ /^\015?\012/ || $buf =~ /\015?\012\015?\012/) {
+ # must read more if we can...
+ die "read timeout" if $timeout && !$sel->can_read($timeout);
+ my $old_len = length($buf);
+ $n = $socket->sysread($buf, $size, $old_len);
+ die $! unless defined($n);
+ die "unexpected EOF before all headers seen" unless $n;
+ }
+
+ # now we start parsing the headers. The strategy is to
+ # remove one line at a time from the beginning of the header
+ # buffer ($res).
+ my($key, $val);
+ while ($buf =~ s/([^\012]*)\012//) {
+ my $line = $1;
+
+ # if we need to restore as content when illegal headers
+ # are found.
+ my $save = "$line\012";
+
+ $line =~ s/\015$//;
+ last unless length $line;
+
+ if ($line =~ /^([a-zA-Z0-9_\-.]+)\s*:\s*(.*)/) {
+ $response->push_header($key, $val) if $key;
+ ($key, $val) = ($1, $2);
+ }
+ elsif ($line =~ /^\s+(.*)/ && $key) {
+ $val .= " $1";
+ }
+ else {
+ $response->push_header("Client-Bad-Header-Line" => $line);
+ }
+ }
+ $response->push_header($key, $val) if $key;
+ last;
+
+ }
+ elsif ((length($buf) >= 5 and $buf !~ /^HTTP\//) or
+ $buf =~ /\012/ ) {
+ # HTTP/0.9 or worse
+ $response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
+ $response->protocol('HTTP/0.9');
+ last;
+
+ }
+ else {
+ # need more data
+ }
+ };
+ $response->request($request);
+ $self->_get_sock_info($response, $socket);
+
+ if ($method eq "CONNECT") {
+ $response->{client_socket} = $socket; # so it can be picked up
+ $response->content($buf); # in case we read more than the headers
+ return $response;
+ }
+
+ my $usebuf = length($buf) > 0;
+ $response = $self->collect($arg, $response, sub {
+ if ($usebuf) {
+ $usebuf = 0;
+ return \$buf;
+ }
+ die "read timeout" if $timeout && !$sel->can_read($timeout);
+ my $n = $socket->sysread($buf, $size);
+ die $! unless defined($n);
+ return \$buf;
+ } );
+
+ #$socket->close;
+
+ $response;
+}
+
+1;
Added: branches/upstream/libwww-perl/current/lib/LWP/Protocol/https.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/lib/LWP/Protocol/https.pm?rev=72123&op=file
==============================================================================
--- branches/upstream/libwww-perl/current/lib/LWP/Protocol/https.pm (added)
+++ branches/upstream/libwww-perl/current/lib/LWP/Protocol/https.pm Thu Mar 31 23:06:07 2011
@@ -1,0 +1,90 @@
+package LWP::Protocol::https;
+
+use strict;
+
+use vars qw(@ISA);
+require LWP::Protocol::http;
+ at ISA = qw(LWP::Protocol::http);
+
+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}) {
+ eval {
+ require Mozilla::CA;
+ };
+ if ($@) {
+ if ($@ =! /^Can't locate Mozilla\/CA\.pm/) {
+ $@ = <<'EOT';
+Can't verify SSL peers without knowning which Certificate Authorities to trust
+
+This problem can be fixed by either setting the PERL_LWP_SSL_CA_FILE
+envirionment variable or by installing the Mozilla::CA module.
+
+To disable verification of SSL peers set the PERL_LWP_SSL_VERIFY_HOSTNAME
+envirionment variable to 0. If you do this you can't be sure that you
+communicate with the expected peer.
+EOT
+ }
+ die $@;
+ }
+ $ssl_opts{SSL_ca_file} = Mozilla::CA::SSL_ca_file();
+ }
+ }
+ $self->{ssl_opts} = \%ssl_opts;
+ return (%ssl_opts, $self->SUPER::_extra_sock_opts);
+}
+
+sub _check_sock
+{
+ my($self, $req, $sock) = @_;
+ my $check = $req->header("If-SSL-Cert-Subject");
+ if (defined $check) {
+ my $cert = $sock->get_peer_certificate ||
+ die "Missing SSL certificate";
+ my $subject = $cert->subject_name;
+ die "Bad SSL certificate subject: '$subject' !~ /$check/"
+ unless $subject =~ /$check/;
+ $req->remove_header("If-SSL-Cert-Subject"); # don't pass it on
+ }
+}
+
+sub _get_sock_info
+{
+ my $self = shift;
+ $self->SUPER::_get_sock_info(@_);
+ my($res, $sock) = @_;
+ $res->header("Client-SSL-Cipher" => $sock->get_cipher);
+ my $cert = $sock->get_peer_certificate;
+ if ($cert) {
+ $res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
+ $res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
+ }
+ 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);
+}
+
+#-----------------------------------------------------------
+package LWP::Protocol::https::Socket;
+
+use vars qw(@ISA);
+require Net::HTTPS;
+ at ISA = qw(Net::HTTPS LWP::Protocol::http::SocketMethods);
+
+1;
Added: branches/upstream/libwww-perl/current/lib/LWP/Protocol/https10.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/lib/LWP/Protocol/https10.pm?rev=72123&op=file
==============================================================================
--- branches/upstream/libwww-perl/current/lib/LWP/Protocol/https10.pm (added)
+++ branches/upstream/libwww-perl/current/lib/LWP/Protocol/https10.pm Thu Mar 31 23:06:07 2011
@@ -1,0 +1,76 @@
+package LWP::Protocol::https10;
+
+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) {
+ $SSL_CLASS = "IO::Socket::SSL"; # it was already loaded
+}
+else {
+ eval { require Net::SSL; }; # from Crypt-SSLeay
+ if ($@) {
+ require IO::Socket::SSL;
+ $SSL_CLASS = "IO::Socket::SSL";
+ }
+ else {
+ $SSL_CLASS = "Net::SSL";
+ }
+}
+
+
+use vars qw(@ISA);
+
+require LWP::Protocol::http10;
+ at ISA=qw(LWP::Protocol::http10);
+
+sub _new_socket
+{
+ my($self, $host, $port, $timeout) = @_;
+ local($^W) = 0; # IO::Socket::INET can be noisy
+ my $sock = $SSL_CLASS->new(PeerAddr => $host,
+ PeerPort => $port,
+ LocalAddr => $self->{ua}{local_address},
+ Proto => 'tcp',
+ Timeout => $timeout,
+ );
+ unless ($sock) {
+ # IO::Socket::INET leaves additional error messages in $@
+ $@ =~ s/^.*?: //;
+ die "Can't connect to $host:$port ($@)";
+ }
+ $sock;
+}
+
+sub _check_sock
+{
+ my($self, $req, $sock) = @_;
+ my $check = $req->header("If-SSL-Cert-Subject");
+ if (defined $check) {
+ my $cert = $sock->get_peer_certificate ||
+ die "Missing SSL certificate";
+ my $subject = $cert->subject_name;
+ die "Bad SSL certificate subject: '$subject' !~ /$check/"
+ unless $subject =~ /$check/;
+ $req->remove_header("If-SSL-Cert-Subject"); # don't pass it on
+ }
+}
+
+sub _get_sock_info
+{
+ my $self = shift;
+ $self->SUPER::_get_sock_info(@_);
+ my($res, $sock) = @_;
+ $res->header("Client-SSL-Cipher" => $sock->get_cipher);
+ my $cert = $sock->get_peer_certificate;
+ if ($cert) {
+ $res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
+ $res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
+ }
+ $res->header("Client-SSL-Warning" => "Peer certificate not verified");
+}
+
+1;
Modified: branches/upstream/libwww-perl/current/lib/LWP/UserAgent.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/lib/LWP/UserAgent.pm?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/lib/LWP/UserAgent.pm (original)
+++ branches/upstream/libwww-perl/current/lib/LWP/UserAgent.pm Thu Mar 31 23:06:07 2011
@@ -5,7 +5,7 @@
require LWP::MemberMixin;
@ISA = qw(LWP::MemberMixin);
-$VERSION = "6.02";
+$VERSION = "6.00";
use HTTP::Request ();
use HTTP::Response ();
@@ -15,6 +15,16 @@
use LWP::Protocol ();
use Carp ();
+
+if ($ENV{PERL_LWP_USE_HTTP_10}) {
+ require LWP::Protocol::http10;
+ LWP::Protocol::implementor('http', 'LWP::Protocol::http10');
+ eval {
+ require LWP::Protocol::https10;
+ LWP::Protocol::implementor('https', 'LWP::Protocol::https10');
+ };
+}
+
sub new
@@ -46,13 +56,9 @@
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;
}
@@ -177,11 +183,12 @@
$@ =~ 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 . " (LWP::Protocol::https 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 the LWP::Protocol::https module
-is installed.
+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
}
}
@@ -1354,10 +1361,10 @@
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.
+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 this envirionment variable isn't set; then C<verify_hostname>
+variable. If the this envirionment variable isn't set; then C<verify_hostname>
defaults to 1.
=item C<SSL_ca_file> => $path
@@ -1378,9 +1385,11 @@
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.
-The libwww-perl core no longer bundles protocol plugins for SSL. You will need
-to install L<LWP::Protocol::https> separately to enable support for processing
-https-URLs.
+If hostname verification is requested, and neither C<SSL_ca_file> nor
+C<SSL_ca_path> is set, then C<SSL_ca_file> is implied to be the one
+provided by L<Mozilla::CA>. If the Mozilla::CA module isn't available
+SSL requests will fail. Either install this module, set up an alternative
+SSL_ca_file or disable hostname verification.
=back
Modified: branches/upstream/libwww-perl/current/t/TEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/t/TEST?rev=72123&op=diff
==============================================================================
--- branches/upstream/libwww-perl/current/t/TEST (original)
+++ branches/upstream/libwww-perl/current/t/TEST Thu Mar 31 23:06:07 2011
@@ -39,6 +39,7 @@
@tests = (<base/*.t>, <html/*.t>, <robot/*.t>, <local/*.t>);
push(@tests, <live/*.t>) if -f "live/ENABLED";
push(@tests, <net/*.t>) if -f "net/config.pl";
+ @tests = grep !/jigsaw/, @tests; # service is not reliable any more
}
if ($formatter) {
Added: branches/upstream/libwww-perl/current/t/live/https.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libwww-perl/current/t/live/https.t?rev=72123&op=file
==============================================================================
--- branches/upstream/libwww-perl/current/t/live/https.t (added)
+++ branches/upstream/libwww-perl/current/t/live/https.t Thu Mar 31 23:06:07 2011
@@ -1,0 +1,20 @@
+#!perl -w
+
+use strict;
+use Test;
+
+use LWP::UserAgent;
+
+my $ua = LWP::UserAgent->new();
+my $res = $ua->simple_request(HTTP::Request->new(GET => "https://www.apache.org"));
+
+if ($res->code == 501 && $res->message =~ /Protocol scheme 'https' is not supported/) {
+ print "1..0 # Skipped: " . $res->message . "\n";
+ exit;
+}
+
+plan tests => 2;
+ok($res->is_success);
+ok($res->content =~ /Apache Software Foundation/);
+
+$res->dump(prefix => "# ");
More information about the Pkg-perl-cvs-commits
mailing list