Skip to content

Commit 7559ec5

Browse files
gislegisle
committed
Merge branch 'ssl'
2 parents ce67e24 + f8fedc8 commit 7559ec5

8 files changed

Lines changed: 223 additions & 31 deletions

File tree

‎Makefile.PL‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,8 @@ WriteMakefile(
5757
},
5858
META_MERGE => {
5959
recommends => {
60-
'Crypt::SSLeay' => 0,
60+
'IO::Socket::SSL' => "1.38",
61+
'Mozilla::CA' => "20110101",
6162
},
6263
resources => {
6364
repository => 'http://github.com/gisle/libwww-perl',

‎README.SSL‎

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8,17 +8,14 @@ encryption software in general and certain encryption algorithms in
88
particular, in several countries, libwww-perl package doesn't include
99
SSL functionality out-of-the-box.
1010

11-
Encryption support is obtained through the use of Crypt::SSLeay or
12-
IO::Socket::SSL, which can both be found from CPAN. While libwww-perl
11+
Encryption support is obtained through the use of IO::Socket::SSL or
12+
Crypt::SSLeay, which can both be found from CPAN. While libwww-perl
1313
has "plug-and-play" support for both of these modules (as of v5.45),
14-
the recommended module to use is Crypt::SSLeay. In addition to
15-
bringing SSL support to the LWP package, IO::Socket::SSL can be used
16-
as an object oriented interface to SSL encrypted network sockets.
14+
the recommended module to use is IO::Socket::SSL.
1715

1816
There is yet another SSL interface for perl called Net::SSLeay. It has
1917
a more complete SSL interface and can be used for web client
2018
programming among other things but doesn't directly support LWP.
2119

2220
The underlying SSL support in all of these modules is based on OpenSSL
23-
<http://www.openssl.org/> (formerly SSLeay). For WWW-server side SSL
24-
support (e.g. CGI/FCGI scripts) in Apache see <http://www.modssl.org/>.
21+
<http://www.openssl.org/> (formerly SSLeay).

‎lib/LWP.pm‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -582,6 +582,20 @@ These environment variables can be set to enable communication through
582582
a proxy server. See the description of the C<env_proxy> method in
583583
L<LWP::UserAgent>.
584584
585+
=item PERL_LWP_SSL_VERIFY_HOSTNAME
586+
587+
The default C<verify_hostname> setting for M<LWP::UserAgent>. If
588+
not set the default will be 1. Set it as 0 to disable hostname
589+
verification (the default prior to libwww-perl 5.840.
590+
591+
=item PERL_LWP_SSL_CA_FILE
592+
593+
=item PERL_LWP_SSL_CA_PATH
594+
595+
The file and/or directory
596+
where the trusted Certificate Authority certificates
597+
is located. See L<LWP::UserAgent> for details.
598+
585599
=item PERL_LWP_USE_HTTP_10
586600
587601
Enable the old HTTP/1.0 protocol driver instead of the new HTTP/1.1

‎lib/LWP/Protocol/http.pm‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,8 +40,15 @@ sub _new_socket
4040

4141
unless ($sock) {
4242
# IO::Socket::INET leaves additional error messages in $@
43-
$@ =~ s/^.*?: //;
44-
die "Can't connect to $host:$port ($@)";
43+
my $status = "Can't connect to $host:$port";
44+
if ($@ =~ /\bconnect: (.*)/ ||
45+
$@ =~ /\b(Bad hostname)\b/ ||
46+
$@ =~ /\b(certificate verify failed)\b/ ||
47+
$@ =~ /\b(Crypt-SSLeay can't verify hostnames)\b/
48+
) {
49+
$status .= " ($1)";
50+
}
51+
die "$status\n\n$@";
4552
}
4653

4754
# perl 5.005's IO::Socket does not have the blocking method.

‎lib/LWP/Protocol/https.pm‎

Lines changed: 41 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,41 @@ sub socket_type
1111
return "https";
1212
}
1313

14+
sub _extra_sock_opts
15+
{
16+
my $self = shift;
17+
my %ssl_opts = %{$self->{ua}{ssl_opts} || {}};
18+
if (delete $ssl_opts{verify_hostname}) {
19+
$ssl_opts{SSL_verify_mode} ||= 1;
20+
$ssl_opts{SSL_verifycn_scheme} = 'www';
21+
}
22+
if ($ssl_opts{SSL_verify_mode}) {
23+
unless (exists $ssl_opts{SSL_ca_file} || exists $ssl_opts{SSL_ca_path}) {
24+
eval {
25+
require Mozilla::CA;
26+
};
27+
if ($@) {
28+
if ($@ =! /^Can't locate Mozilla\/CA\.pm/) {
29+
$@ = <<'EOT';
30+
Can't verify SSL peers without knowning which Certificate Authorities to trust
31+
32+
This problem can be fixed by either setting the PERL_LWP_SSL_CA_FILE
33+
envirionment variable or by installing the Mozilla::CA module.
34+
35+
To disable verification of SSL peers set the PERL_LWP_SSL_VERIFY_HOSTNAME
36+
envirionment variable to 0. If you do this you can't be sure that you
37+
communicate with the expected peer.
38+
EOT
39+
}
40+
die $@;
41+
}
42+
$ssl_opts{SSL_ca_file} = Mozilla::CA::SSL_ca_file();
43+
}
44+
}
45+
$self->{ssl_opts} = \%ssl_opts;
46+
return (%ssl_opts, $self->SUPER::_extra_sock_opts);
47+
}
48+
1449
sub _check_sock
1550
{
1651
my($self, $req, $sock) = @_;
@@ -36,9 +71,13 @@ sub _get_sock_info
3671
$res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
3772
$res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
3873
}
39-
if(! eval { $sock->get_peer_verify }) {
40-
$res->header("Client-SSL-Warning" => "Peer certificate not verified");
74+
if (!$self->{ssl_opts}{SSL_verify_mode}) {
75+
$res->push_header("Client-SSL-Warning" => "Peer certificate not verified");
76+
}
77+
elsif (!$self->{ssl_opts}{SSL_verifycn_scheme}) {
78+
$res->push_header("Client-SSL-Warning" => "Peer hostname match with certificate not verified");
4179
}
80+
$res->header("Client-SSL-Socket-Class" => $Net::HTTPS::SSL_SOCKET_CLASS);
4281
}
4382

4483
#-----------------------------------------------------------

‎lib/LWP/UserAgent.pm‎

Lines changed: 117 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,28 @@ sub new
4141
my $timeout = delete $cnf{timeout};
4242
$timeout = 3*60 unless defined $timeout;
4343
my $local_address = delete $cnf{local_address};
44+
my $ssl_opts = delete $cnf{ssl_opts};
45+
unless ($ssl_opts) {
46+
# The processing of HTTPS_CA_* below is for compatiblity with Crypt::SSLeay
47+
$ssl_opts = {};
48+
if (exists $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}) {
49+
$ssl_opts->{verify_hostname} = $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME};
50+
}
51+
elsif ($ENV{HTTPS_CA_FILE} || $ENV{HTTPS_CA_DIR}) {
52+
# Crypt-SSLeay compatiblity (verify peer certificate; but not the hostname)
53+
$ssl_opts->{verify_hostname} = 0;
54+
$ssl_opts->{SSL_verify_mode} = 1;
55+
}
56+
else {
57+
$ssl_opts->{verify_hostname} = 1;
58+
}
59+
if (my $ca_file = $ENV{PERL_LWP_SSL_CA_FILE} || $ENV{HTTPS_CA_FILE}) {
60+
$ssl_opts->{SSL_ca_file} = $ca_file;
61+
}
62+
if (my $ca_path = $ENV{PERL_LWP_SSL_CA_PATH} || $ENV{HTTPS_CA_DIR}) {
63+
$ssl_opts->{SSL_ca_path} = $ca_path;
64+
}
65+
}
4466
my $use_eval = delete $cnf{use_eval};
4567
$use_eval = 1 unless defined $use_eval;
4668
my $parse_head = delete $cnf{parse_head};
@@ -58,7 +80,6 @@ sub new
5880
Carp::croak("Can't mix conn_cache and keep_alive")
5981
if $conn_cache && $keep_alive;
6082

61-
6283
my $protocols_allowed = delete $cnf{protocols_allowed};
6384
my $protocols_forbidden = delete $cnf{protocols_forbidden};
6485

@@ -83,6 +104,7 @@ sub new
83104
def_headers => $def_headers,
84105
timeout => $timeout,
85106
local_address => $local_address,
107+
ssl_opts => $ssl_opts,
86108
use_eval => $use_eval,
87109
show_progress=> $show_progress,
88110
max_size => $max_size,
@@ -161,10 +183,10 @@ sub send_request
161183
$@ =~ s/ at .* line \d+.*//s; # remove file/line number
162184
$response = _new_response($request, &HTTP::Status::RC_NOT_IMPLEMENTED, $@);
163185
if ($scheme eq "https") {
164-
$response->message($response->message . " (Crypt::SSLeay or IO::Socket::SSL not installed)");
186+
$response->message($response->message . " (IO::Socket::SSL not installed)");
165187
$response->content_type("text/plain");
166188
$response->content(<<EOT);
167-
LWP will support https URLs if either Crypt::SSLeay or IO::Socket::SSL
189+
LWP will support https URLs if either IO::Socket::SSL or Crypt::SSLeay
168190
is installed. More information at
169191
<http://search.cpan.org/dist/libwww-perl/README.SSL>.
170192
EOT
@@ -175,14 +197,21 @@ EOT
175197
if (!$response && $self->{use_eval}) {
176198
# we eval, and turn dies into responses below
177199
eval {
178-
$response = $protocol->request($request, $proxy,
179-
$arg, $size, $self->{timeout});
200+
$response = $protocol->request($request, $proxy, $arg, $size, $self->{timeout}) ||
201+
die "No response returned by $protocol";
180202
};
181203
if ($@) {
182-
$@ =~ s/ at .* line \d+.*//s; # remove file/line number
183-
$response = _new_response($request,
184-
&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
185-
$@);
204+
if (UNIVERSAL::isa($@, "HTTP::Response")) {
205+
$response = $@;
206+
$response->request($request);
207+
}
208+
else {
209+
my $full = $@;
210+
(my $status = $@) =~ s/\n.*//s;
211+
$status =~ s/ at .* line \d+.*//s; # remove file/line number
212+
my $code = ($status =~ s/^(\d\d\d)\s+//) ? $1 : &HTTP::Status::RC_INTERNAL_SERVER_ERROR;
213+
$response = _new_response($request, $code, $status, $full);
214+
}
186215
}
187216
}
188217
elsif (!$response) {
@@ -582,6 +611,31 @@ sub max_size { shift->_elem('max_size', @_); }
582611
sub max_redirect { shift->_elem('max_redirect', @_); }
583612
sub show_progress{ shift->_elem('show_progress', @_); }
584613

614+
sub ssl_opts {
615+
my $self = shift;
616+
if (@_ == 1) {
617+
my $k = shift;
618+
return $self->{ssl_opts}{$k};
619+
}
620+
if (@_) {
621+
my $old;
622+
while (@_) {
623+
my($k, $v) = splice(@_, 0, 2);
624+
$old = $self->{ssl_opts}{$k} unless @_;
625+
if (defined $v) {
626+
$self->{ssl_opts}{$k} = $v;
627+
}
628+
else {
629+
delete $self->{ssl_opts}{$k};
630+
}
631+
}
632+
%{$self->{ssl_opts}} = (%{$self->{ssl_opts}}, @_);
633+
return $old;
634+
}
635+
636+
return keys %{$self->{ssl_opts}};
637+
}
638+
585639
sub parse_head {
586640
my $self = shift;
587641
if (@_) {
@@ -800,7 +854,7 @@ sub clone
800854
delete $copy->{conn_cache};
801855

802856
# copy any plain arrays and hashes; known not to need recursive copy
803-
for my $k (qw(proxy no_proxy requests_redirectable)) {
857+
for my $k (qw(proxy no_proxy requests_redirectable ssl_opts)) {
804858
next unless $copy->{$k};
805859
if (ref($copy->{$k}) eq "ARRAY") {
806860
$copy->{$k} = [ @{$copy->{$k}} ];
@@ -964,13 +1018,13 @@ sub no_proxy {
9641018

9651019

9661020
sub _new_response {
967-
my($request, $code, $message) = @_;
1021+
my($request, $code, $message, $content) = @_;
9681022
my $response = HTTP::Response->new($code, $message);
9691023
$response->request($request);
9701024
$response->header("Client-Date" => HTTP::Date::time2str(time));
9711025
$response->header("Client-Warning" => "Internal response");
9721026
$response->header("Content-Type" => "text/plain");
973-
$response->content("$code $message\n");
1027+
$response->content($content || "$code $message\n");
9741028
return $response;
9751029
}
9761030

@@ -1042,6 +1096,7 @@ The following options correspond to attribute methods described below:
10421096
cookie_jar undef
10431097
default_headers HTTP::Headers->new
10441098
local_address undef
1099+
ssl_opts { verify_hostname => 1 }
10451100
max_size undef
10461101
max_redirect 7
10471102
parse_head 1
@@ -1286,6 +1341,56 @@ is observed for C<timeout> seconds. This means that the time it takes
12861341
for the complete transaction and the request() method to actually
12871342
return might be longer.
12881343
1344+
=item $ua->ssl_opts
1345+
1346+
=item $ua->ssl_opts( $key )
1347+
1348+
=item $ua->ssl_opts( $key => $value )
1349+
1350+
Get/set the options for SSL connections. Without argument return the list
1351+
of options keys currently set. With a single argument return the current
1352+
value for the given option. With 2 arguments set the option value and return
1353+
the old. Setting an option to the value C<undef> removes this option.
1354+
1355+
The options that LWP relates to are:
1356+
1357+
=over
1358+
1359+
=item C<verify_hostname> => $bool
1360+
1361+
When TRUE LWP will for secure protocol schemes ensure it connects to servers
1362+
that have a valid certificate matching the expected hostname. If FALSE no
1363+
checks are made and you can't be sure that you communicate with the expected peer.
1364+
The no checks behaviour was the default for libwww-perl-5.837 and older.
1365+
1366+
This option is initialized from the L<PERL_LWP_SSL_VERIFY_HOSTNAME> environment
1367+
variable. If the this envirionment variable isn't set; then C<verify_hostname>
1368+
defaults to 1.
1369+
1370+
=item C<SSL_ca_file> => $path
1371+
1372+
The path to a file containing Certificate Authority certificates.
1373+
A default setting for this option is provided by checking the environment
1374+
variables C<PERL_LWP_SSL_CA_FILE> and C<HTTPS_CA_FILE> in order.
1375+
1376+
=item C<SSL_ca_path> => $path
1377+
1378+
The path to a directory containing files containing Certificate Authority
1379+
certificates.
1380+
A default setting for this option is provided by checking the environment
1381+
variables C<PERL_LWP_SSL_CA_PATH> and C<HTTPS_CA_DIR> in order.
1382+
1383+
=back
1384+
1385+
Other options can be set and are processed directly by the SSL Socket implementation
1386+
in use. See L<IO::Socket::SSL> or L<Net::SSL> for details.
1387+
1388+
If hostname verification is requested, and neither C<SSL_ca_file> nor
1389+
C<SSL_ca_path> is set, then C<SSL_ca_file> is implied to be the one
1390+
provided by L<Mozilla::CA>. If the Mozilla::CA module isn't available
1391+
SSL requests will fail. Either install this module, set up an alternative
1392+
SSL_ca_file or disable hostname verification.
1393+
12891394
=back
12901395
12911396
=head2 Proxy attributes

‎lib/Net/HTTPS.pm‎

Lines changed: 27 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -9,27 +9,34 @@ $VERSION = "5.819";
99
if ($SSL_SOCKET_CLASS) {
1010
# somebody already set it
1111
}
12-
elsif ($Net::SSL::VERSION) {
13-
$SSL_SOCKET_CLASS = "Net::SSL";
12+
elsif ($SSL_SOCKET_CLASS = $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS}) {
13+
unless ($SSL_SOCKET_CLASS =~ /^(IO::Socket::SSL|Net::SSL)\z/) {
14+
die "Bad socket class [$SSL_SOCKET_CLASS]";
15+
}
16+
eval "require $SSL_SOCKET_CLASS";
17+
die $@ if $@;
1418
}
1519
elsif ($IO::Socket::SSL::VERSION) {
1620
$SSL_SOCKET_CLASS = "IO::Socket::SSL"; # it was already loaded
1721
}
22+
elsif ($Net::SSL::VERSION) {
23+
$SSL_SOCKET_CLASS = "Net::SSL";
24+
}
1825
else {
19-
eval { require Net::SSL; }; # from Crypt-SSLeay
26+
eval { require IO::Socket::SSL; };
2027
if ($@) {
2128
my $old_errsv = $@;
2229
eval {
23-
require IO::Socket::SSL;
30+
require Net::SSL; # from Crypt-SSLeay
2431
};
2532
if ($@) {
2633
$old_errsv =~ s/\s\(\@INC contains:.*\)/)/g;
2734
die $old_errsv . $@;
2835
}
29-
$SSL_SOCKET_CLASS = "IO::Socket::SSL";
36+
$SSL_SOCKET_CLASS = "Net::SSL";
3037
}
3138
else {
32-
$SSL_SOCKET_CLASS = "Net::SSL";
39+
$SSL_SOCKET_CLASS = "IO::Socket::SSL";
3340
}
3441
}
3542

@@ -44,6 +51,20 @@ sub configure {
4451

4552
sub http_connect {
4653
my($self, $cnf) = @_;
54+
if ($self->isa("Net::SSL")) {
55+
if ($cnf->{SSL_verify_mode}) {
56+
if (my $f = $cnf->{SSL_ca_file}) {
57+
$ENV{HTTPS_CA_FILE} = $f;
58+
}
59+
if (my $f = $cnf->{SSL_ca_path}) {
60+
$ENV{HTTPS_CA_DIR} = $f;
61+
}
62+
}
63+
if ($cnf->{SSL_verifycn_scheme}) {
64+
$@ = "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";
65+
return undef;
66+
}
67+
}
4768
$self->SUPER::configure($cnf);
4869
}
4970

0 commit comments

Comments
 (0)