The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

use strict;
use warnings;

BEGIN {
    eval "use LWP";
    if ( $@ ) {
	print "1..0 # no LWP\n";
	exit
    }
}

use Net::SSLGlue::LWP;
use IO::Socket::SSL;
use LWP::Simple;

my $goodhost = 'google.de';
my $badhost = 'badcert.maulwuff.de';

my $capath = '/etc/ssl/certs/'; # unix?
-d $capath or do {
    print "1..0 # cannot find system CA-path\n";
    exit
};
Net::SSLGlue::LWP->import( 
    SSL_ca_path => $capath, 
    # LWP might define SSL_ca_file - remove it to avoid conflict
    SSL_ca_file => undef 
);

#
# first check everything directly with IO::Socket::SSL
#

diag("connecting to $goodhost:443 with IO::Socket::INET");
my $sock = IO::Socket::INET->new(
    PeerAddr => "$goodhost:443",
    Timeout => 10
) or do {
    print "1..0 # connect $goodhost failed: $!\n";
    exit
};
diag("ssl upgrade $goodhost");
IO::Socket::SSL->start_SSL( $sock,
    SSL_ca_path => $capath,
    SSL_verifycn_name => "$goodhost",
    SSL_verify_mode => 1,
    SSL_verifycn_scheme => 'http',
) or do {
    print "1..0 # ssl upgrade $goodhost failed: $SSL_ERROR\n";
    exit
};

diag("connecting to $badhost:443 with IO::Socket::INET");
if ( $sock = IO::Socket::INET->new( 
    PeerAddr => "$badhost:443",
    Timeout => 10,
)) {
    diag("upgrading to https - should fail because of bad certificate");
    if ( IO::Socket::SSL->start_SSL( $sock,
	SSL_ca_path => $capath,
	SSL_verify_mode => 1,
	SSL_verifycn_scheme => 'http',
	SSL_verifycn_name => $badhost,
    )) {
	diag("certificate for  $badhost unexpectly correct");
	$badhost = undef;
    };
} else {
    diag("connect to $badhost failed: $!");
    $badhost = undef;
}

#
# and than check, that LWP uses the same checks
#

print "1..".( $badhost ? 3:1 )."\n";

# $goodhost -> should succeed
diag("connecting to $goodhost:443 with LWP");
my $content = get( "https://$goodhost" );
print $content ? "ok\n": "not ok # lwp connect $goodhost: $@\n";

if ( $badhost ) {
    # $badhost -> should fail
    diag("connecting to $badhost:443 with LWP");
    $content = get( "https://$badhost" );
    print $content ? "not ok # lwp ssl connect $badhost should fail\n": "ok\n";

    # $badhost -> should succeed if verify mode is 0
    {
	local %Net::SSLGlue::LWP::SSLopts = %Net::SSLGlue::LWP::SSLopts;
	$Net::SSLGlue::LWP::SSLopts{SSL_verify_mode} = 0;
	$content = get( "https://$badhost" );
	print $content ? "ok\n": "not ok # lwp ssl $badhost w/o ssl verify\n";
    }
}

sub diag { print "# @_\n" }