/usr/share/perl5/LWP/Protocol/https.pm is in liblwp-protocol-https-perl 6.04-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 | package LWP::Protocol::https;
use strict;
our $VERSION = "6.04";
require LWP::Protocol::http;
our @ISA = qw(LWP::Protocol::http);
require Net::HTTPS;
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';
}
else {
$ssl_opts{SSL_verify_mode} = 0;
}
if ($ssl_opts{SSL_verify_mode}) {
unless (exists $ssl_opts{SSL_ca_file} || exists $ssl_opts{SSL_ca_path}) {
$ssl_opts{SSL_ca_file} = '/etc/ssl/certs/ca-certificates.crt';
}
}
$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);
}
# upgrade plain socket to SSL, used for CONNECT tunnel when proxying https
# will only work if the underlying socket class of Net::HTTPS is
# IO::Socket::SSL, but code will only be called in this case
if ( $Net::HTTPS::SSL_SOCKET_CLASS->can('start_SSL')) {
*_upgrade_sock = sub {
my ($self,$sock,$url) = @_;
$sock = LWP::Protocol::https::Socket->start_SSL( $sock,
SSL_verifycn_name => $url->host,
$self->_extra_sock_opts,
);
$@ = LWP::Protocol::https::Socket->errstr if ! $sock;
return $sock;
}
}
#-----------------------------------------------------------
package LWP::Protocol::https::Socket;
our @ISA = qw(Net::HTTPS LWP::Protocol::http::SocketMethods);
1;
__END__
=head1 NAME
LWP::Protocol::https - Provide https support for LWP::UserAgent
=head1 SYNOPSIS
use LWP::UserAgent;
$ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 1 });
$res = $ua->get("https://www.example.com");
=head1 DESCRIPTION
The LWP::Protocol::https module provides support for using https schemed
URLs with LWP. This module is a plug-in to the LWP protocol handling, so
you don't use it directly. Once the module is installed LWP is able
to access sites using HTTP over SSL/TLS.
If hostname verification is requested by LWP::UserAgent's C<ssl_opts>, 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 Mozilla::CA. If the Mozilla::CA module
isn't available SSL requests will fail. Either install this module, set up an
alternative C<SSL_ca_file> or disable hostname verification.
This module used to be bundled with the libwww-perl, but it was unbundled in
v6.02 in order to be able to declare its dependencies properly for the CPAN
tool-chain. Applications that need https support can just declare their
dependency on LWP::Protocol::https and will no longer need to know what
underlying modules to install.
=head1 SEE ALSO
L<IO::Socket::SSL>, L<Crypt::SSLeay>, L<Mozilla::CA>
=head1 COPYRIGHT
Copyright 1997-2011 Gisle Aas.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
|