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

use strict;
use warnings;

use IO::Socket;
use Net::Server::Mail::ESMTP;
use Test::SMTP;
use Test::More;
use Test::Builder::Tester tests => 2;

my $LOCAL_PORT = ($ENV{'SMTP_SERVER_PORT'} || 2525) + 1;

#spawn off a server

    my $server;
    while(not defined $server && $LOCAL_PORT < 4000)
    {
        $server = new IO::Socket::INET(
            Listen => 1,
            LocalPort => ++$LOCAL_PORT
        );
    }

my $server_pid;

$server_pid = fork();

if ($server_pid == 0){
    # I'm the child process
    my $conn_number = 0;
    my $conn;
    while ($conn = $server->accept)
    {
        my $issue_an_error_on_quit = 0;
	my $issue_an_error_on_rset = 0;

        my $esmtp = Net::Server::Mail::ESMTP->new(socket => $conn);
        # activate some extensions
        $esmtp->register('Net::Server::Mail::ESMTP::8BITMIME');
        $esmtp->register('Net::Server::Mail::ESMTP::PIPELINING');
	# adding some handlers
	$esmtp->set_callback(MAIL => sub {
            my ($session, $from) = @_;
	    if ($from eq 'temporary-450@failure.com'){
                return (0, 450, 'temporary failure for temporary-450@failure.com');
	    } elsif ($from eq 'permanent-550@failure.com'){
                return (0, 550, 'temporary failure for permanent-550@failure.com');
	    } elsif ($from eq 'success-220@success.com'){
                return (1, 220, 'success for success-220@success.com');
	    }
	});
        $esmtp->set_callback(RCPT => sub {
            my ($session, $recipient) = @_;
	    if ($recipient eq 'temporary-450@failure.com'){
                return (0, 450, 'temporary failure for temporary-450@failure.com');
	    } elsif ($recipient eq 'permanent-550@failure.com'){
                return (0, 550, 'temporary failure for permanent-550@failure.com');
	    } elsif ($recipient eq 'success-220@success.com'){
                return (1, 220, 'success for success-220@success.com');
	    }
	});
        $esmtp->set_callback(DATA => sub {
	    my ($session, $data) = @_;
	    if ($$data =~ m/DO NOT ACCEPT THIS MESSAGE/){
	        return (0, 550, 'message rejected');
	    } else {
	        return 1;
	    }
	});
	$esmtp->set_callback(HELP => sub {
            my ($session, $help) = @_;

	    if (not defined $help){
	         return (1, 214, 'HELP IN GENERAL');
            } elsif ($help eq 'RCPT'){
                 return (1, 214, 'HELP ON RCPT');
            } elsif ($help eq 'STRANGE_FAILURES'){
	         $issue_an_error_on_rset = 1;
		 $issue_an_error_on_quit = 1;
	         return (1, 250, 'STRANGE_FAILURES active');
	    } else {
                 return 0;
	    }
	});
        $esmtp->set_callback(RSET => sub {
            my ($session) = @_;
	    if ($issue_an_error_on_rset == 1){
	    	return (0, 550, 'Can\'t RSET');
	    } else {
                return 1;
	    }
	});
        $esmtp->set_callback(QUIT => sub {
            my ($session) = @_;
	    if ($issue_an_error_on_quit == 1){
	    	return (0, 550, 'Can\'t QUIT');
	    } else {
                return 1;
	    }
	});
	$esmtp->process();
        $conn->close();
	$conn_number++;
        if ($conn_number == 2) {
	   $server->close;
	   exit 1;
	};
    }
}

diag("Spawned server pid: $server_pid");
diag("Starting tests");
sleep 1; 

my $c1 = Test::SMTP->connect_ok("connects to SMTP on $LOCAL_PORT",
                                Host => '127.0.0.1', 
				Port => $LOCAL_PORT, 
				Hello => 'example.com',
				AutoHello => 1
				) or die "Can't connect to the SMTP server so can't go on testing";


test_out('not ok 1 - Fails if server announces 8BITMIME');
test_fail(+1);
$c1->supports_ko('8BITMIME',   'Fails if server announces 8BITMIME');
test_out('not ok 2 - Fails if server doesn\'t announce 888BITMIME');
test_fail(+1);
$c1->supports_ok('888BITMIME', 'Fails if server doesn\'t announce 888BITMIME');
test_out('not ok 3 - Fails if server announces PIPELINING');
test_fail(+1);
$c1->supports_ko('PIPELINING', 'Fails if server announces PIPELINING');
test_out('not ok 4 - Fails if the mail_from fails');
$c1->mail_from_ok('temporary-450@failure.com', 'Fails if the mail_from fails');
test_fail(+1);
test_out('not ok 5 - Fails if the mail_from fails');
test_fail(+1);
$c1->mail_from_ok('permanent-550@failure.com', 'Fails if the mail_from fails');
test_out('not ok 6 - Fails if the mail_from is ok');
test_fail(+1);
$c1->mail_from_ko('success-220@success.com', 'Fails if the mail_from is ok');

#
# RCPT TO TESTS
# 

test_out('not ok 7 - Fails if the mail_from fails');
test_fail(+1);
$c1->rcpt_to_ok('temporary-450@failure.com', 'Fails if the mail_from fails');
test_out('not ok 8 - Fails because last code was temporary');
test_fail(+1);
$c1->code_isnt_temporary('Fails because last code was temporary');
test_out('not ok 9 - Fails because last code was temporary');
test_fail(+1);
$c1->code_is_success('Fails because last code was temporary');
test_out('not ok 10 - Fails because last code was temporary');
test_fail(+1);
$c1->code_is_permanent('Fails because last code was temporary');
test_out('not ok 11 - Fails because last code was temporary');
test_fail(+1);
$c1->code_isnt_failure('Fails because last code was temporary');



test_out('not ok 12 - Fails if the mail_from fails');
test_fail(+1);
$c1->rcpt_to_ok('permanent-550@failure.com', 'Fails if the mail_from fails');
test_out('not ok 13 - Fails because last code was permanent');
test_fail(+1);
$c1->code_is_temporary('Fails because last code was permanent');
test_out('not ok 14 - Fails because last code was permanent');
test_fail(+1);
$c1->code_is_success('Fails because last code was permanent');
test_out('not ok 15 - Fails because last code was permanent');
test_fail(+1);
$c1->code_isnt_permanent('Fails because last code was permanent');
test_out('not ok 16 - Fails because last code was permanent');
test_fail(+1);
$c1->code_isnt_failure('Fails because last code was permanent');


test_out('not ok 17 - Fails if the mail_from is ok');
test_fail(+1);
$c1->rcpt_to_ko('success-220@success.com', 'Fails if the mail_from is ok');

test_out('not ok 18 - Fails because last code was success');
test_fail(+1);
$c1->code_is_permanent('Fails because last code was success');
test_out('not ok 19 - Fails because last code was success');
test_fail(+1);
$c1->code_isnt_success('Fails because last code was success');
test_out('not ok 20 - Fails because last code was success');
test_fail(+1);
$c1->code_is_temporary('Fails because last code was success');
test_out('not ok 21 - Fails because last code was success');
test_fail(+1);
$c1->code_is_failure('Fails because last code was success');



test_out('not ok 22 - Fails if data was accepted');
test_fail(+1);
$c1->data_ko('Fails if data was accepted');

$c1->datasend([ 
    "Line 1\n",
    "Line 2\n"
]);
test_out('not ok 23 - Fails if dataend was accepted');
test_fail(+1);
$c1->dataend_ko('Fails if dataend was accepted');

test_out('not ok 24 - Fails if RSET accepted');
test_fail(+1);
$c1->rset_ko('Fails if RSET accepted');
test_out('not ok 25 - Fails if didn\'t accept DATA');
test_fail(+1);
$c1->data_ok('Fails if didn\'t accept DATA');
test_out('not ok 26 - Fails if RSET accepted');
test_fail(+1);
$c1->rset_ko('Fails if RSET accepted');

$c1->hello('mydomain.com');

test_out('not ok 27 - Fails if QUIT accepted'); 
test_fail(+1);
$c1->quit_ko('Fails if QUIT accepted');

test_out("not ok 28 - connects to SMTP on $LOCAL_PORT");
test_fail(+1);
my $c2 = Test::SMTP->connect_ko("connects to SMTP on $LOCAL_PORT",
                                Host => '127.0.0.1',
                                Port => $LOCAL_PORT,
                                Hello => 'example.com',
                                AutoHello => 1,
                                ); 

$c2->mail_from('success-220@success.com');
$c2->rcpt_to('success-220@success.com');

$c2->data;
$c2->datasend([ "DO NOT ACCEPT THIS MESSAGE\n", "L2\n" ]);

test_out('not ok 29 - Fails because the message is not accepted');
test_fail(+1);
$c2->dataend_ok('Fails because the message is not accepted');

$c2->help('STRANGE_FAILURES');

test_out('not ok 30 - Fails because RSET was rejected');
test_fail(+1);
$c2->rset_ok('Fails because RSET was rejected');

test_out('not ok 31 - Fails because QUIT was rejected');
test_fail(+1);
$c2->quit_ok('Fails because QUIT was rejected');

test_test(name => "Planned failures work ok", skip_err => 1);

kill 1, $server_pid;
wait;