[ Top page ]

« Receiving and playing linear voice (VoIP) using Perl | Main | Timer by JavaScript »

Network and communication

Simple mail proxy by Perl

Mail proxies (SMTP proxies) have become much more important to avoid errorneous mail delivery. There is a mail proxy written by Perl: Qsmtpd. However, when you want to build a simple proxy by yourself, this program might not be helpful because the program is too much complicated. So I wrote a proxy, which is as simple as possible.

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);
    };
}
Keywords:

TrackBack

TrackBack URL for this entry:
http://www.kanadas.com/mt/mt-tb.cgi/2068

Post a comment

About

This page contains a single entry from the blog posted on March 30, 2008 10:19 PM.

Many more can be found on the main index page or by looking through the archives.

Creative Commons License
This weblog is licensed under a Creative Commons License.
Powered by
Movable Type 3.36