Last change
on this file since 27183 was 27183, checked in by davidb, 11 years ago |
Changing to using installed version of LWP that comes from libwww-perl, which is more self-contained than v6.x
|
File size:
1.2 KB
|
Line | |
---|
1 | package LWP::Protocol::https;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 |
|
---|
5 | use vars qw(@ISA);
|
---|
6 | require LWP::Protocol::http;
|
---|
7 | @ISA = qw(LWP::Protocol::http);
|
---|
8 |
|
---|
9 | sub socket_type
|
---|
10 | {
|
---|
11 | return "https";
|
---|
12 | }
|
---|
13 |
|
---|
14 | sub _check_sock
|
---|
15 | {
|
---|
16 | my($self, $req, $sock) = @_;
|
---|
17 | my $check = $req->header("If-SSL-Cert-Subject");
|
---|
18 | if (defined $check) {
|
---|
19 | my $cert = $sock->get_peer_certificate ||
|
---|
20 | die "Missing SSL certificate";
|
---|
21 | my $subject = $cert->subject_name;
|
---|
22 | die "Bad SSL certificate subject: '$subject' !~ /$check/"
|
---|
23 | unless $subject =~ /$check/;
|
---|
24 | $req->remove_header("If-SSL-Cert-Subject"); # don't pass it on
|
---|
25 | }
|
---|
26 | }
|
---|
27 |
|
---|
28 | sub _get_sock_info
|
---|
29 | {
|
---|
30 | my $self = shift;
|
---|
31 | $self->SUPER::_get_sock_info(@_);
|
---|
32 | my($res, $sock) = @_;
|
---|
33 | $res->header("Client-SSL-Cipher" => $sock->get_cipher);
|
---|
34 | my $cert = $sock->get_peer_certificate;
|
---|
35 | if ($cert) {
|
---|
36 | $res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
|
---|
37 | $res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
|
---|
38 | }
|
---|
39 | if(! eval { $sock->get_peer_verify }) {
|
---|
40 | $res->header("Client-SSL-Warning" => "Peer certificate not verified");
|
---|
41 | }
|
---|
42 | }
|
---|
43 |
|
---|
44 | #-----------------------------------------------------------
|
---|
45 | package LWP::Protocol::https::Socket;
|
---|
46 |
|
---|
47 | use vars qw(@ISA);
|
---|
48 | require Net::HTTPS;
|
---|
49 | @ISA = qw(Net::HTTPS LWP::Protocol::http::SocketMethods);
|
---|
50 |
|
---|
51 | 1;
|
---|
Note:
See
TracBrowser
for help on using the repository browser.