SMTPd on 127.0.0.1 by Net::Server::Mail

net-server-mail-smtpd.pl

#!/usr/local/bin/perl
# SMTPd on 127.0.0.1 by Net::Server::Mail
use Net::Server::Mail::SMTP;
use IO::Socket::INET;

my $server = new IO::Socket::INET( 'Listen' => 1, 'LocalPort' => 2500 );
my $conn = undef();

while( $conn = $server->accept() )
{
	my $smtp = new Net::Server::Mail::SMTP( 'socket' => $conn );
	$smtp->set_callback( 'RCPT' => \&validate_recipient );
	$smtp->set_callback( 'DATA' => \&queue_message );
	$smtp->process();
	$conn->close()
}

sub validate_recipient
{
	my $sess = shift();
	my $rcpt = shift();
	my $domain = q();

	$domain = $1 if( $rcpt =~ m{[@](.*)>\s*\z} );
	return(0, 513, 'Syntax error.') unless $domain;
        return(1);
}

sub queue_message
{
	my $sess = shift();
	my $data = shift();
	printf(STDERR '.');
	return(1, 250, 'message queued');
}