cubixle/packages
1
0
Fork 0
mirror of https://github.com/novatiq/packages.git synced 2026-04-30 23:48:39 +01:00
Code Issues Packages Projects Releases Wiki Activity

perl-www: Default to verifying hostnames when using SSL

Browse Source 
This is a backport of perl-www 6.00's CVE-2011-0633 fix.

Signed-off-by: Marcel Denia <naoir@gmx.net>
This commit is contained in:
Marcel Denia
2014-08-11 17:18:04 +02:00
parent 4b71632e7c
commit c8a94c6d92
2 changed files with 154 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lang/perl-www/patches/010-lwp-https-call-verify-hostname-when-avail.patch
+41
View File
@@ -0,0 +1,41 @@
commit 3b266f17ccd5613a9c42d1e04118e94ca6467489
Author: Gisle Aas <gisle@aas.no>
Date: Sun Jan 16 12:56:30 2011 +0100
Call IO::Socket::SSL's verify_hostname when available
--- a/lib/LWP/Protocol/https.pm
+++ b/lib/LWP/Protocol/https.pm
@@ -14,6 +14,15 @@ sub socket_type
sub _check_sock
{
my($self, $req, $sock) = @_;
+ if ($sock->can("verify_hostname")) {
+ if (!$sock->verify_hostname($req->uri->host, "www")) {
+ my $subject = $sock->peer_certificate("subject");
+ die "SSL-peer fails verification [subject=$subject]\n";
+ }
+ else {
+ $req->{ssl_sock_verified}++;
+ }
+ }
my $check = $req->header("If-SSL-Cert-Subject");
if (defined $check) {
my $cert = $sock->get_peer_certificate ||
@@ -36,9 +45,14 @@ sub _get_sock_info
$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");
+ if (!$res->request->{ssl_sock_verified}) {
+ if(! eval { $sock->get_peer_verify }) {
+ my $msg = "Peer certificate not verified";
+ $msg .= " [$@]" if $@;
+ $res->header("Client-SSL-Warning" => $msg);
+ }
}
+ $res->header("Client-SSL-Socket-Class" => $Net::HTTPS::SSL_SOCKET_CLASS);
}
#-----------------------------------------------------------