Issue with cert checking

[Guillaume Rousse]

Hello list.

I'm currently working on a test suite for Fusioninventory Agent
(http://fusioninventory.org/wordpress). Part of the test suite checks
the ability of the agent to communicate with its server through HTTP,
using LWP. I'm using a minimalist test server, using
HTTP::Server::Simple. It works fine for http or https connection,
however I can't succeed having LWP bails out when a non-trusted
certificate is used, despite using Crypt::SSLeay and setting
$ENV{HTTPS_CA_FILE}.

The attached test case shows the issue, using a self-signed certificate:
perl test.pl crt/bad.pem key/bad.pem crt/ca.pem

Even more strange, even setting $ENV{HTTPS_DEBUG} doesn't even bring
additional output :(

The sample code at
http://stackoverflow.com/questions/74358/how-can-i-get-lwp-to-validate-ssl-server-certificates,
using an actual apache web server, works fine, so I guess the problem
probably comes from my testing setup.

Thanks for your suggestions.
-- 
BOFH excuse #204:

Just pick up the phone and give modem connect sounds. "Well you said we
should get more lines so we don't have voice lines."

#!/usr/bin/perl

package Server;

use warnings;
use strict;
use base qw(HTTP::Server::Simple::CGI);

use IO::Socket::SSL;

sub new {
    my ($class, $crt, $key) = @_;
    my $self = $class->SUPER::new(8080);
    $self->{crt} = $crt;
    $self->{key} = $key;
    return $self;
}

sub run {
    my $self = shift;
    $self->{pid} = $self->SUPER::run(@_);
    $SIG{__DIE__} = \&stop;
    return $self->{pid};
}

sub accept_hook {
   my $self = shift;
   my $fh   = $self->stdio_handle;

   $self->SUPER::accept_hook(@_);

   my $newfh =
   IO::Socket::SSL->start_SSL( $fh,
       SSL_server    => 1,
       SSL_use_cert  => 1,
       SSL_cert_file => $self->{crt},
       SSL_key_file  => $self->{key}
   ) or warn "problem setting up SSL socket: " . IO::Socket::SSL::errstr();

   $self->stdio_handle($newfh) if $newfh;
}

sub handle_request {
    my $self = shift;
    my $cgi  = shift;

    print "HTTP/1.0 200 OK\r\n";
    print "\r\n";
    print "OK\n";
}

sub stop {
    my $self = shift;
    my $signal = 15;
    if ($self->{pid}) {
        kill( $signal, $self->{pid} ) unless $^S;
        delete $self->{pid};
    }

    return;
}

sub background {
    my $self = shift;

    $self->{pid} = $self->SUPER::background()
        or Carp::confess( q{Can't start the test server} );

    sleep 1; # background() may come back prematurely, so give it a second to 
fire up

    return $self->{pid};
}

package main;

use LWP::UserAgent;

my $crt = shift || die "no cert";
my $key = shift || die "no key";
my $ca  = shift || die "no ca";

my $server = Server->new($crt, $key);
$server->background();

my $agent = LWP::UserAgent->new();
$ENV{HTTPS_CA_FILE} = $ca;
$ENV{HTTPS_DEBUG} = 1;

my $req = HTTP::Request->new(GET => "https://localhost:8080";);

my $response = $agent->request($req);
die unless $response->is_success();

$server->stop();

smime.p7s
Description: S/MIME Cryptographic Signature