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 Net::SMTP";
	if ( $@ ) {
		print "1..0 # no Net::SMTP\n";
		exit
	}
}

use Net::SSLGlue::SMTP;

my $capath = '/etc/ssl/certs/'; # unix?
-d $capath or do {
	print "1..0 # cannot find system CA-path\n";
	exit
};

# first try to connect w/o smtp
# plain
diag( "connect inet to mail.gmx.net:25" );
IO::Socket::INET->new( 'mail.gmx.net:25' ) or do {
	print "1..0 # mail.gmx.net:25 not reachable\n";
	exit
};

# ssl to the right host
diag( "connect ssl to mail.gmx.net:465" );
IO::Socket::SSL->new( 
	PeerAddr => 'mail.gmx.net:465',
	SSL_ca_path => $capath,
	SSL_verify_mode => 1,
	SSL_verifycn_scheme => 'smtp' 
) or do {
	print "1..0 # mail.gmx.net:465 not reachable with SSL\n";
	exit
};

# ssl to the wrong host 
# the certificate mail.gmx.de returns is for mail.gmx.net
diag( "connect ssl to mail.gmx.de:465" );
IO::Socket::SSL->new( 
	PeerAddr => 'mail.gmx.de:465',
	SSL_ca_path => $capath,
	SSL_verify_mode => 1,
	SSL_verifycn_scheme => 'smtp' 
) and do {
	print "1..0 # mail.gmx.de:465 reachable with SSL\n";
	exit
};

print "1..6\n";

# first direct SSL
my $smtp = Net::SMTP->new( 'mail.gmx.net', 
	SSL => 1, 
	SSL_ca_path => $capath,
);
print $smtp ? "ok\n" : "not ok # smtp connect mail.gmx.net\n";

# then starttls
$smtp = Net::SMTP->new( 'mail.gmx.net' );
my $ok = $smtp->starttls( SSL_ca_path => $capath );
print $ok ? "ok\n" : "not ok # smtp starttls mail.gmx.net\n";
# check that we can talk on connection
print $smtp->quit ? "ok\n": "not ok # quit failed\n";

# against wrong host should fail
$smtp = Net::SMTP->new( 'mail.gmx.de' ); # should succeed
$ok = $smtp->starttls( SSL_ca_path => $capath ); 
print $ok ? "not ok # smtp starttls mail.gmx.de did not fail\n": "ok\n";

# but not if we specify the right SSL_verifycn_name
$smtp = Net::SMTP->new( 'mail.gmx.de' ); # should succeed
$ok = $smtp->starttls( SSL_ca_path => $capath, SSL_verifycn_name => 'mail.gmx.net' ); 
print $ok ? "ok\n" : "not ok # smtp starttls mail.gmx.de/net\n";

# or disable verification
$smtp = Net::SMTP->new( 'mail.gmx.de' ); # should succeed
$ok = $smtp->starttls( SSL_verify_mode => 0 );
print $ok ? "ok\n" : "not ok # smtp starttls mail.gmx.de\n";

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