| Subject: | recipient validation |
I would like to validate recipients during the smtp transaction. I was able
to accomplish this by editing the new subroutine in Server.pm:
RCPT => sub {
my ($s,$con,@args) = @_;
my $to = join ' ',@args;
$to =~ s{^to:}{}i or $con->reply('501 Usage: RCPT
TO:<mail addr>');
$con->{m}{from} or return $con->reply("503 Error: need
MAIL command");
my @addrs = map { $_->address } Mail::Address->parse
($to);
@addrs or $con->reply('501 Usage: RCPT TO:<mail
Show quoted text
addr>');
#everything is unchanged until this point
######### validate rcpt #####
my $domain;
if ($addrs[0] =~ /@(.*)\s*$/) {
$domain = $1;
}
if (not(grep $domain eq $_, @local_domains)) {
warn "$addrs[0]: Recipient address rejected: Relay
access denied";
return $con->reply("554 Error: $addrs[0]: Recipient
address rejected: Relay access denied");
}
######### validate rcpt #####
push @{ $con->{m}{to} ||= [] }, $addrs[0];
$con->ok;
},
It would be great if the user could write a validation function without
editing module files, like in the Net::Server::Mail::SMTP module
http://search.cpan.org/~guimard/Net-Server-Mail-0.17/lib/Net/Server/Mail/
SMTP.pm