>From befea2a83ef4cf9381fe64dc3641b89a56dd9636 Mon Sep 17 00:00:00 2001
From: Guillaume Rousse <Guillaume.Rousse@inria.fr>
Date: Tue, 28 Jun 2011 11:01:16 +0200
Subject: [PATCH 1/2] force use of IO::Socket::SSL when SSL checking is needed
 with LWP < 6, and use builtin checking functions,
 instead of half-backed LWP ones


Signed-off-by: Guillaume Rousse <Guillaume.Rousse@inria.fr>
---
 lib/FusionInventory/Agent/HTTP/Protocol/https.pm |   33 +++++++
 lib/FusionInventory/Agent/Network.pm             |  104 ++++-----------------
 2 files changed, 53 insertions(+), 84 deletions(-)
 create mode 100644 lib/FusionInventory/Agent/HTTP/Protocol/https.pm

diff --git a/lib/FusionInventory/Agent/HTTP/Protocol/https.pm b/lib/FusionInventory/Agent/HTTP/Protocol/https.pm
new file mode 100644
index 0000000..a5a382a
--- /dev/null
+++ b/lib/FusionInventory/Agent/HTTP/Protocol/https.pm
@@ -0,0 +1,33 @@
+package FusionInventory::Agent::HTTP::Protocol::https;
+
+use strict;
+use warnings;
+use base qw(LWP::Protocol::https);
+
+use IO::Socket::SSL;
+
+sub _extra_sock_opts {
+    my ($self, $host, $port) = @_;
+
+    return (
+        SSL_verify_mode     => $self->{ua}->{ssl_check},
+        SSL_verifycn_scheme => 'http',
+        SSL_verifycn_name   => $host
+    );
+}
+
+package FusionInventory::Agent::HTTP::Protocol::https::Socket;
+
+use base qw(Net::HTTPS LWP::Protocol::http::SocketMethods);
+
+1;
+__END__
+
+=head1 NAME
+
+FusionInventory::Agent::HTTP::Protocol::https - HTTPS protocol handler for LWP
+
+=head1 DESCRIPTION
+
+This is an overrided HTTPS protocol handler for LWP, allowing to use
+subjectAltNames for checking server certificate.
diff --git a/lib/FusionInventory/Agent/Network.pm b/lib/FusionInventory/Agent/Network.pm
index fe9fb64..245a135 100644
--- a/lib/FusionInventory/Agent/Network.pm
+++ b/lib/FusionInventory/Agent/Network.pm
@@ -119,6 +119,26 @@ sub createUA {
         if ($config->{'ca-cert-dir'}) {
             $ua->ssl_opts(SSL_ca_path => $config->{'ca-cert-dir'});
         }
+    } elsif (!$config->{'no-ssl-check'}) {
+        # use a custom HTTPS handler, forcing the use of IO::Socket::SSL
+        FusionInventory::Agent::HTTP::Protocol::https->require();
+        if ($EVAL_ERROR) {
+            die "failed to load FusionInventory::Agent::HTTP::Protocol::https" .
+            ", unable to validate SSL certificates";
+        }
+        LWP::Protocol::implementor(
+            'https', 'FusionInventory::Agent::HTTP::Protocol::https'
+        );
+
+        # abuse user agent to pass values to the handler 
+        $ua->{ssl_check} = $config->{'no-ssl-check'} ?
+            Net::SSLeay::VERIFY_NONE() : Net::SSLeay::VERIFY_PEER();
+
+        # set default context
+        IO::Socket::SSL::set_ctx_defaults(ca_file => $config->{'ca-cert-file'})
+            if $config->{'ca-cert-file'};
+        IO::Socket::SSL::set_ctx_defaults(ca_path => $config->{'ca-cert-dir'})
+            if $config->{'ca-cert-dir'};
     }
 
     if ($noProxy) {
@@ -159,11 +179,6 @@ sub createUA {
     $ua->agent($version);
     $ua->timeout($timeout);
 
-    $self->setSslRemoteHost({
-            ua => $ua,
-            url => $uri
-        });
-
     # Auth
     my $realm = $forceRealm || $self->{config}->{realm};
     $ua->credentials(
@@ -290,85 +305,6 @@ sub send {
     return $response;
 }
 
-# No POD documentation here, it's an internal fuction
-# http://stackoverflow.com/questions/74358/validate-server-certificate-with-lwp
-sub turnSSLCheckOn {
-    my ($self, $args) = @_;
-
-    my $logger = $self->{logger};
-    my $config = $self->{config};
-
-
-    return if $config->{'no-ssl-check'};
-
-    if (!$config->{'ca-cert-file'} && !$config->{'ca-cert-dir'}) {
-        $logger->debug("You may need to use either --ca-cert-file ".
-            "or --ca-cert-dir to give the location of your SSL ".
-            "certificat. You can also disable SSL check with ".
-            "--no-ssl-check but this is very unsecure.");
-    }
-
-
-    if ($config->{'ca-cert-file'}) {
-        if (!-f $config->{'ca-cert-file'} && !-l $config->{'ca-cert-file'}) {
-            $logger->fault("--ca-cert-file doesn't existe ".
-                "`".$config->{'ca-cert-file'}."'");
-        }
-
-        $ENV{HTTPS_CA_FILE} = $config->{'ca-cert-file'};
-        $ENV{PERL_LWP_SSL_CA_FILE} = $config->{'ca-cert-file'};
-
-    } elsif ($config->{'ca-cert-dir'}) {
-        if (!-d $config->{'ca-cert-dir'}) {
-            $logger->fault("--ca-cert-dir doesn't existe ".
-                "`".$config->{'ca-cert-dir'}."'");
-        }
-
-        $ENV{HTTPS_CA_DIR} = $config->{'ca-cert-dir'};
-        $ENV{PERL_LWP_SSL_CA_PATH} = $config->{'ca-cert-dir'};
-
-    }
-
-}
-
-sub setSslRemoteHost {
-    my ($self, $args) = @_;
-
-    my $config = $self->{config};
-    my $logger = $self->{logger};
-
-    my $uri = $args->{URI};
-    my $ua = $args->{ua};
-
-    if ($config->{'no-ssl-check'}) {
-        return;
-    }
-
-    if (!$self->{URI}) {
-        $logger->fault("setSslRemoteHost(), no url parameter!");
-    }
-
-    if ($self->{URI} !~ /^https:/i) {
-        return;
-    }
-
-# Compatibility with LWP5
-    if ($LWP::VERSION < 6) {
-        $self->turnSSLCheckOn();
-    # Check server name against provided SSL certificate
-        if ( $self->{URI} =~ /^https:\/\/([^\/]+).*$/i ) {
-            my $re = $1;
-# Accept SSL cert will hostname with wild-card
-# http://forge.fusioninventory.org/issues/542
-            $re =~ s/^([^\.]+)/($1|\\*)/;
-# protect some characters, $re will be evaluated as a regex
-            $re =~ s/([\-\.])/\\$1/g;
-            $ua->default_header('If-SSL-Cert-Subject' => '/CN='.$re.'($|\/)');
-        }
-    }
-}
-
-
 =item getStore()
 
 Acts like LWP::Simple::getstore.
-- 
1.7.6

