aboutsummaryrefslogtreecommitdiff
path: root/lang/perl-www/patches/010-lwp-https-call-verify-hostname-when-avail.patch
blob: 9166e891e5c63e859dfb93298d1ebd46e8ae893b (plain)
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
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);
 }
 
 #-----------------------------------------------------------