diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-27 21:02:16 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-27 21:02:16 +0000 |
commit | f64d7ab506e73cd9643989e77ffd13654c3d5f55 (patch) | |
tree | 871f8105d75c09f2fba9e41a92fcad5d472c1d24 /Master/tlpkg/tlperl/lib/LWP/Protocol/https.pm | |
parent | cdce81b54ed4a0982aa4787b1db3e446aa84b59a (diff) |
LWP module plus dependencies
git-svn-id: svn://tug.org/texlive/trunk@21533 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/LWP/Protocol/https.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/LWP/Protocol/https.pm | 51 |
1 files changed, 51 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/LWP/Protocol/https.pm b/Master/tlpkg/tlperl/lib/LWP/Protocol/https.pm new file mode 100644 index 00000000000..367c8f793d8 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/LWP/Protocol/https.pm @@ -0,0 +1,51 @@ +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 _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(! eval { $sock->get_peer_verify }) { + $res->header("Client-SSL-Warning" => "Peer certificate not verified"); + } +} + +#----------------------------------------------------------- +package LWP::Protocol::https::Socket; + +use vars qw(@ISA); +require Net::HTTPS; +@ISA = qw(Net::HTTPS LWP::Protocol::http::SocketMethods); + +1; |