diff options
author | franck cuny <franck@lumberjaph.net> | 2009-05-18 11:41:19 +0200 |
---|---|---|
committer | franck cuny <franck@lumberjaph.net> | 2009-05-18 11:41:19 +0200 |
commit | c00d47bb6eb43c6d33f8f7a0a1a48fa83fce1da6 (patch) | |
tree | 8e58eeed15bd2fb483c310ef7bbe23ff277ef6aa /lib/LWPx/Protocol/https_paranoid.pm | |
download | lwpx-paranoidagent-c00d47bb6eb43c6d33f8f7a0a1a48fa83fce1da6.tar.gz |
import version 1.04
Diffstat (limited to 'lib/LWPx/Protocol/https_paranoid.pm')
-rw-r--r-- | lib/LWPx/Protocol/https_paranoid.pm | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/lib/LWPx/Protocol/https_paranoid.pm b/lib/LWPx/Protocol/https_paranoid.pm new file mode 100644 index 0000000..c291f75 --- /dev/null +++ b/lib/LWPx/Protocol/https_paranoid.pm @@ -0,0 +1,49 @@ +# +package LWPx::Protocol::https_paranoid; + +# $Id: https_paranoid.pm 2 2005-06-01 23:12:25Z bradfitz $ + +use strict; + +use vars qw(@ISA); +require LWPx::Protocol::http_paranoid; +@ISA = qw(LWPx::Protocol::http_paranoid); + +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 LWPx::Protocol::https_paranoid::Socket; + +use vars qw(@ISA); +require Net::HTTPS; +@ISA = qw(Net::HTTPS LWPx::Protocol::http_paranoid::SocketMethods); + +1; |