|
@@ -0,0 +1,113 @@
|
|
1
|
+commit 62dd58188d8f8987d24bd84951813a54a8bf5987
|
|
2
|
+Author: Gisle Aas <gisle@aas.no>
|
|
3
|
+Date: Mon Jan 24 23:19:59 2011 +0100
|
|
4
|
+
|
|
5
|
+ Default to verifying hostnames when using SSL
|
|
6
|
+
|
|
7
|
+--- a/lib/LWP/Protocol/https.pm
|
|
8
|
++++ b/lib/LWP/Protocol/https.pm
|
|
9
|
+@@ -11,18 +11,30 @@ sub socket_type
|
|
10
|
+ return "https";
|
|
11
|
+ }
|
|
12
|
+
|
|
13
|
+-sub _check_sock
|
|
14
|
++sub _extra_sock_opts
|
|
15
|
+ {
|
|
16
|
+- my($self, $req, $sock) = @_;
|
|
17
|
+- if ($sock->can("verify_hostname")) {
|
|
18
|
+- if (!$sock->verify_hostname($req->uri->host, "www")) {
|
|
19
|
+- my $subject = $sock->peer_certificate("subject");
|
|
20
|
+- die "SSL-peer fails verification [subject=$subject]\n";
|
|
21
|
+- }
|
|
22
|
+- else {
|
|
23
|
+- $req->{ssl_sock_verified}++;
|
|
24
|
++ my $self = shift;
|
|
25
|
++ my %ssl_opts = %{$self->{ua}{ssl_opts} || {}};
|
|
26
|
++ unless (exists $ssl_opts{SSL_verify_mode}) {
|
|
27
|
++ $ssl_opts{SSL_verify_mode} = 1;
|
|
28
|
++ }
|
|
29
|
++ if (delete $ssl_opts{verify_hostname}) {
|
|
30
|
++ $ssl_opts{SSL_verify_mode} ||= 1;
|
|
31
|
++ $ssl_opts{SSL_verifycn_scheme} = 'www';
|
|
32
|
++ }
|
|
33
|
++ if ($ssl_opts{SSL_verify_mode}) {
|
|
34
|
++ unless (exists $ssl_opts{SSL_ca_file} || exists $ssl_opts{SSL_ca_path}) {
|
|
35
|
++ require Mozilla::CA;
|
|
36
|
++ $ssl_opts{SSL_ca_file} = Mozilla::CA::SSL_ca_file();
|
|
37
|
+ }
|
|
38
|
+ }
|
|
39
|
++ $self->{ssl_opts} = \%ssl_opts;
|
|
40
|
++ return (%ssl_opts, $self->SUPER::_extra_sock_opts);
|
|
41
|
++}
|
|
42
|
++
|
|
43
|
++sub _check_sock
|
|
44
|
++{
|
|
45
|
++ my($self, $req, $sock) = @_;
|
|
46
|
+ my $check = $req->header("If-SSL-Cert-Subject");
|
|
47
|
+ if (defined $check) {
|
|
48
|
+ my $cert = $sock->get_peer_certificate ||
|
|
49
|
+@@ -45,12 +57,11 @@ sub _get_sock_info
|
|
50
|
+ $res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
|
|
51
|
+ $res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
|
|
52
|
+ }
|
|
53
|
+- if (!$res->request->{ssl_sock_verified}) {
|
|
54
|
+- if(! eval { $sock->get_peer_verify }) {
|
|
55
|
+- my $msg = "Peer certificate not verified";
|
|
56
|
+- $msg .= " [$@]" if $@;
|
|
57
|
+- $res->header("Client-SSL-Warning" => $msg);
|
|
58
|
+- }
|
|
59
|
++ if (!$self->{ssl_opts}{SSL_verify_mode}) {
|
|
60
|
++ $res->push_header("Client-SSL-Warning" => "Peer certificate not verified");
|
|
61
|
++ }
|
|
62
|
++ elsif (!$self->{ssl_opts}{SSL_verifycn_scheme}) {
|
|
63
|
++ $res->push_header("Client-SSL-Warning" => "Peer hostname match with certificate not verified");
|
|
64
|
+ }
|
|
65
|
+ $res->header("Client-SSL-Socket-Class" => $Net::HTTPS::SSL_SOCKET_CLASS);
|
|
66
|
+ }
|
|
67
|
+--- a/lib/LWP/UserAgent.pm
|
|
68
|
++++ b/lib/LWP/UserAgent.pm
|
|
69
|
+@@ -41,6 +41,7 @@ sub new
|
|
70
|
+ my $timeout = delete $cnf{timeout};
|
|
71
|
+ $timeout = 3*60 unless defined $timeout;
|
|
72
|
+ my $local_address = delete $cnf{local_address};
|
|
73
|
++ my $ssl_opts = delete $cnf{ssl_opts};
|
|
74
|
+ my $use_eval = delete $cnf{use_eval};
|
|
75
|
+ $use_eval = 1 unless defined $use_eval;
|
|
76
|
+ my $parse_head = delete $cnf{parse_head};
|
|
77
|
+@@ -83,6 +84,7 @@ sub new
|
|
78
|
+ def_headers => $def_headers,
|
|
79
|
+ timeout => $timeout,
|
|
80
|
+ local_address => $local_address,
|
|
81
|
++ ssl_opts => { $ssl_opts ? %$ssl_opts : (verify_hostname => 1) },
|
|
82
|
+ use_eval => $use_eval,
|
|
83
|
+ show_progress=> $show_progress,
|
|
84
|
+ max_size => $max_size,
|
|
85
|
+@@ -582,6 +584,20 @@ sub max_size { shift->_elem('max_siz
|
|
86
|
+ sub max_redirect { shift->_elem('max_redirect', @_); }
|
|
87
|
+ sub show_progress{ shift->_elem('show_progress', @_); }
|
|
88
|
+
|
|
89
|
++sub ssl_opts {
|
|
90
|
++ my $self = shift;
|
|
91
|
++ if (@_ == 1) {
|
|
92
|
++ my $k = shift;
|
|
93
|
++ return $self->{ssl_opts}{$k};
|
|
94
|
++ }
|
|
95
|
++ if (@_) {
|
|
96
|
++ %{$self->{ssl_opts}} = (%{$self->{ssl_opts}}, @_);
|
|
97
|
++ }
|
|
98
|
++ else {
|
|
99
|
++ return keys %{$self->{ssl_opts}};
|
|
100
|
++ }
|
|
101
|
++}
|
|
102
|
++
|
|
103
|
+ sub parse_head {
|
|
104
|
+ my $self = shift;
|
|
105
|
+ if (@_) {
|
|
106
|
+@@ -1040,6 +1056,7 @@ The following options correspond to attr
|
|
107
|
+ cookie_jar undef
|
|
108
|
+ default_headers HTTP::Headers->new
|
|
109
|
+ local_address undef
|
|
110
|
++ ssl_opts { verify_hostname => 1 }
|
|
111
|
+ max_size undef
|
|
112
|
+ max_redirect 7
|
|
113
|
+ parse_head 1
|