Small and Large Stones of Programming

The following program receives mails by SMTP and relays it to an SMTP server, but if it found a keyword "viagra", the proxy does not relay the message. To use this program, 'smtp.server.address' in the program must be replaced by the address or domain name of the SMTP server. (If the port number is not the default value, 25, it must be rewritten.)

############################################################################
#
#	Simple Mail Proxy
#
############################################################################

use Carp;
use Net::SMTP;
use Net::SMTP::Server;
use Mail::Message;
use Sys::Hostname;

use strict;

my $debug = 0;


## SMTP server address and port ##
#
my $SMTP_Server_Address = 'smtp.server.address';
my $SMTP_Server_Port = 25;


### Mail proxy (this server) address and port ##
#
my $Proxy_Port = 25;


#===========================================================================
#	Mail client connection service
#===========================================================================

### Constants ###

my $SUCCEEDED = 0;

my %commands = (DATA => \&cmd_data,
		EXPN => \&cmd_dummy,
		HELO => \&cmd_helo,
		HELP => \&cmd_help,
		MAIL => \&cmd_mail,
		NOOP => \&cmd_noop,
		QUIT => \&cmd_quit,
		RCPT => \&cmd_rcpt,
		RSET => \&cmd_rset,
		VRFY => \&cmd_dummy);

### Variables ###

my $client_socket;
my $from;
my @to;
my $message;


sub client_put ($) {
    my ($message) = @_;
    print "Sent:     $message\n" if ($debug);
    print $client_socket $message, "\r\n";
}

sub cmd_data () {
    if (!defined($from)) {
	client_put("503 5.5.1 Sender address not yet specified");
	return 1;
    };
    if (!@to) {
	client_put("503 5.5.1 Recepient address not yet specified");
	return 1;
    };
    client_put("354 Start mail input; end with .");

    my $done = 0;
    while (<$client_socket>) {
	# print "Received: $_" if ($debug);
	if (/^\.\r\n$/) {
	    $done = 1;
	    last;
	};
	s/^\.\./\./;
	$message .= $_;
    };
    if (!$done) {
	client_put("451 5.6.0 Message input failed");
	return 1;
    };
    return 0;
}

sub cmd_helo () {
    client_put("250-Action completed, okay");
    client_put("250 ENHANCEDSTATUSCODES");
}

sub cmd_help () {
    my $out = "214-Commands\r\n";
    my $total = keys %commands;
    my $i = 0;
    foreach my $cmd (keys %commands) {
	$out .= "\r\n214";
	if ($i++ % 5 != 0) {
	    $out .= $total - $i < 5 ? " " : "-";
	} else {
	    $out .= " ";
	};
    };
    client_put($out);
}

sub cmd_noop () {
    client_put("252 Unknown status, but attempting delivery");
}

sub cmd_quit () {
    client_put("221 Service closing");
    $client_socket->close();
    return 0;
}

sub cmd_mail ($) {
    my ($arg)  = @_;
    $arg =~ /FROM:\s*(\S+)$/i;
    $from = $1;
    client_put("250 Mail sender okay");
}

sub cmd_rcpt ($) {
    my ($arg) = @_;
    $arg =~ /TO:\s*(\S+)$/i;
    my $to = $1;
    push(@to, $to);
    client_put("250 Mail recepient okay");
}

sub cmd_rset () {
    $from = undef;
    @to = ();
    client_put("250 Reset action okay");
}

sub cmd_dummy () {
}



#===========================================================================
#	SMTP server connection service
#===========================================================================

### relay ($from, @to, $msg) ###
#   forward a mail to specified SMTP server
#
sub relay ($\@$) {
    my ($from, $to, $msg) = @_;
    
    $from =~ /<.*@(.*)>/;
    my $domain = $1;
    print "Domain: $domain\n" if ($debug);
    my $client = new Net::SMTP($SMTP_Server_Address, Port => $SMTP_Server_Port,
			       Hello => $domain, Timeout => 30, Debug => $debug) ||
	croak "Unable to connect to mail server: $!\n";
    if ($client) {
	$client->mail($from);
	foreach my $recipient (@$to) {
	    $client->to($recipient);
	};
	$client->data($msg);
	$client->quit() || croak "Relay failed: $!\n";
    };
}


#===========================================================================
#	Main
#===========================================================================

my $server = new Net::SMTP::Server(hostname(), $Proxy_Port) ||
    croak "Unable to create a new mail proxy: $!\n";

while ($client_socket = $server->accept()) {

    $from = undef;
    @to = ();
    $message = undef;
    my $accepted;

    client_put("220 Service ready");

    while (<$client_socket>) {
	print "Received: $_" if ($debug);
	chomp;
	my ($cmd, $arg);
	/^\s*(\S+)(\s+(.*\S))?\s*$/;
	$cmd = $1;
	$arg = $3;
	$cmd =~ tr/a-z/A-Z/;
	if (!defined($commands{$cmd})) {
	    client_put("500 5.5.2 Syntax error, command unrecognized");
	    next;
	};

	&{$commands{$cmd}}($arg);

	if ($cmd eq 'DATA') {
	    my $msg = Mail::Message->read($message);
	    my $body = $msg->body;
	    if ($body =~ /viagra/i) {
		client_put("554 5.6.0 Invalid keyword included: viagra");
		$accepted = 0;
	    } else {
		client_put("250 2.0.0 Message accepted for delivery");
		$accepted = 1;
	    };
	};
    };

    $client_socket->close();

    if ($accepted) {
	relay($from, @to, $message);
    };
}