Skip to content
Browse files

Unbundle LWP::Protocol::https [RT#66838]

  • Loading branch information...
1 parent a0f8029 commit 31278a53c9dfb66deb8d68e3926343b675b57edc @gisle gisle committed
Showing with 7 additions and 135 deletions.
  1. +0 −2 MANIFEST
  2. +1 −3 Makefile.PL
  3. +6 −20 README.SSL
  4. +0 −90 lib/LWP/Protocol/https.pm
  5. +0 −20 t/live/https.t
View
2 MANIFEST
@@ -25,7 +25,6 @@ lib/LWP/Protocol/file.pm Access local files
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/https.pm Access with HTTP/1.1 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
@@ -39,7 +38,6 @@ t/README How to run and set up tests
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
View
4 Makefile.PL
@@ -66,9 +66,7 @@ WriteMakefile(
},
META_MERGE => {
recommends => {
- 'Net::HTTPS' => 6,
- 'IO::Socket::SSL' => "1.38",
- 'Mozilla::CA' => "20110101",
+ 'LWP::Protocol::https' => '6.02',
'Authen::NTLM' => "1.02",
'Data::Dump' => 0,
},
View
26 README.SSL
@@ -1,21 +1,7 @@
-SSL SUPPORT
------------
+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.
-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).
+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.
View
90 lib/LWP/Protocol/https.pm
@@ -1,90 +0,0 @@
-package LWP::Protocol::https;
-
-use strict;
-
-use vars qw(@ISA);
-require LWP::Protocol::http;
-@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;
-@ISA = qw(Net::HTTPS LWP::Protocol::http::SocketMethods);
-
-1;
View
20 t/live/https.t
@@ -1,20 +0,0 @@
-#!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 => "# ");

0 comments on commit 31278a5

Please sign in to comment.
Something went wrong with that request. Please try again.