|
|
- commit 62dd58188d8f8987d24bd84951813a54a8bf5987
- Author: Gisle Aas <gisle@aas.no>
- Date: Mon Jan 24 23:19:59 2011 +0100
-
- Default to verifying hostnames when using SSL
-
- --- a/lib/LWP/Protocol/https.pm
- +++ b/lib/LWP/Protocol/https.pm
- @@ -11,18 +11,30 @@ sub socket_type
- return "https";
- }
-
- -sub _check_sock
- +sub _extra_sock_opts
- {
- - 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 $self = shift;
- + my %ssl_opts = %{$self->{ua}{ssl_opts} || {}};
- + unless (exists $ssl_opts{SSL_verify_mode}) {
- + $ssl_opts{SSL_verify_mode} = 1;
- + }
- + if (delete $ssl_opts{verify_hostname}) {
- + $ssl_opts{SSL_verify_mode} ||= 1;
- + $ssl_opts{SSL_verifycn_scheme} = 'www';
- + }
- + if ($ssl_opts{SSL_verify_mode}) {
- + unless (exists $ssl_opts{SSL_ca_file} || exists $ssl_opts{SSL_ca_path}) {
- + require Mozilla::CA;
- + $ssl_opts{SSL_ca_file} = Mozilla::CA::SSL_ca_file();
- }
- }
- + $self->{ssl_opts} = \%ssl_opts;
- + return (%ssl_opts, $self->SUPER::_extra_sock_opts);
- +}
- +
- +sub _check_sock
- +{
- + my($self, $req, $sock) = @_;
- my $check = $req->header("If-SSL-Cert-Subject");
- if (defined $check) {
- my $cert = $sock->get_peer_certificate ||
- @@ -45,12 +57,11 @@ sub _get_sock_info
- $res->header("Client-SSL-Cert-Subject" => $cert->subject_name);
- $res->header("Client-SSL-Cert-Issuer" => $cert->issuer_name);
- }
- - 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);
- - }
- + if (!$self->{ssl_opts}{SSL_verify_mode}) {
- + $res->push_header("Client-SSL-Warning" => "Peer certificate not verified");
- + }
- + elsif (!$self->{ssl_opts}{SSL_verifycn_scheme}) {
- + $res->push_header("Client-SSL-Warning" => "Peer hostname match with certificate not verified");
- }
- $res->header("Client-SSL-Socket-Class" => $Net::HTTPS::SSL_SOCKET_CLASS);
- }
- --- a/lib/LWP/UserAgent.pm
- +++ b/lib/LWP/UserAgent.pm
- @@ -41,6 +41,7 @@ sub new
- my $timeout = delete $cnf{timeout};
- $timeout = 3*60 unless defined $timeout;
- my $local_address = delete $cnf{local_address};
- + my $ssl_opts = delete $cnf{ssl_opts};
- my $use_eval = delete $cnf{use_eval};
- $use_eval = 1 unless defined $use_eval;
- my $parse_head = delete $cnf{parse_head};
- @@ -83,6 +84,7 @@ sub new
- def_headers => $def_headers,
- timeout => $timeout,
- local_address => $local_address,
- + ssl_opts => { $ssl_opts ? %$ssl_opts : (verify_hostname => 1) },
- use_eval => $use_eval,
- show_progress=> $show_progress,
- max_size => $max_size,
- @@ -582,6 +584,20 @@ sub max_size { shift->_elem('max_siz
- sub max_redirect { shift->_elem('max_redirect', @_); }
- sub show_progress{ shift->_elem('show_progress', @_); }
-
- +sub ssl_opts {
- + my $self = shift;
- + if (@_ == 1) {
- + my $k = shift;
- + return $self->{ssl_opts}{$k};
- + }
- + if (@_) {
- + %{$self->{ssl_opts}} = (%{$self->{ssl_opts}}, @_);
- + }
- + else {
- + return keys %{$self->{ssl_opts}};
- + }
- +}
- +
- sub parse_head {
- my $self = shift;
- if (@_) {
- @@ -1040,6 +1056,7 @@ The following options correspond to attr
- cookie_jar undef
- default_headers HTTP::Headers->new
- local_address undef
- + ssl_opts { verify_hostname => 1 }
- max_size undef
- max_redirect 7
- parse_head 1
|
