On Wednesday 18 April 2007 16:18, Mark Farver wrote:
> [EMAIL PROTECTED] wrote:
> > The spammers who take my domain name in vain tend to use a random
> > username for the emails, so I reject bounces sent to non-existent users
> > with a special message that says "Looks like you're bouncing a mail
> > witha spoofed sender - if you'd consider checking SPF records you could
> > have rejectd this spam much easier".
>
> That would be a nice feature to employ. Would you be willing to make
> your code available? The rcpt check is easy, but a chunk of code that
> recognizes all of the standard bounces would be handy.
Sure.. the entire module is one I've posted before that checks recipients are
properly configured (including wildcards and aliases), but when it's decided
that a message is for a non-existant user, it changes the DENY message
depending on whether the sender is empty (a bounce) or not.
You configure it by giving it the name of the qmail aliases files
check_goodrcptto /var/qmail/users/assign
The rcpt check is actually the tricky bit (given aliases and the like), the
easy bit is when you've decided the recipient is bad
# genuine mistake or, more likely, spammers flooding us
return(DENY, "No such account - mail to $user not accepted here")
unless (not(defined($sender)) or $sender eq "");
# bounce of email form a non-existant user - recommend SPF
return(DENY, "No such account as $user - checking SPF records would prevent
bouncing of joe-job emails");
Cheers
--
Tim
#/bin/perl
=head1 NAME
check_goodrcptto
=head1 DESCRIPTION
This plugin checks that the name recipient is valid according to the qmail
config and refuses the mail otherwise.
=head1 CONFIG
Takes the name of the qmail assign file - normally /var/qmail/users/assign
=cut
sub register {
my ($self, $qp, @args) = @_;
die "Requires the path of the assign file (usually /var/qmail/users/assign)"
unless (@args > 0 and -f $args[0]);
my $assign = ReadAssignments( $args[0] );
die $assign unless ref $assign;
$self->{_assign} = $assign;
$self->register_hook("rcpt", "rcpt_handler");
}
sub ReadAssignments {
my $lines = slurp($_[0], sub { [ grep(!/^\s*#/, @_) ] } )
or return "Can't read the assign file $_[0]";
chomp @$lines;
# last line should be a single dot
return "Assign file not properly terminated" unless $lines->[-1] eq ".";
# extract simple assignments first
# =address:user:uid:gid:directory:dash:extension:
# Messages for <address> will be delivered as user <user>, with the
# specified uid and gid, and the file <directory>/.qmail<dash><extension>
# will specify how the messages are to be delivered.
#
# +prefix:user:uid:gid:directory:dash:prepend:
# Messages received for <prefix><rest> will be delivered as user <user>,
# with the specified uid and gid, and the file
# <directory>/.qmail<dash><prepend><rest> will specify how the messages
# are to be delivered.
my %a;
foreach (@$lines) {
my $type = substr($_,0,1,"");
my($address,$user,$uid,$gid,$dir,$dash,$ext) = (split(":", $_), ("")x7);
if ($type eq "=") {
# got a user
$a{user}->{$address} = { user => $user,
dir => $dir,
dash => $dash,
ext => $ext };
} elsif ($type eq "+") {
# got a prefix
$a{prefix}->{$address} = { user => $user,
dir => $dir,
dash => $dash,
ext => $ext };
}
}
return \%a;
}
sub slurp {
my $file = shift;
my $fh;
open($fh,$file) or return undef;
my @lines = <$fh>;
close $fh;
return @_ ? $_[0]->(@lines) : [EMAIL PROTECTED];
}
# $recipient is a Mail::Address object, see if it looks deliverable
sub rcpt_handler {
my ($self, $transaction, $recipient) = @_;
$self->log(LOGDEBUG, "check_goodrcptto of ".$recipient->user);
return (DECLINED) if $recipient->user eq "";
# we only check recipients for the domains we accept - let any relayed
# mails pass thru (assuming that relaying is allowed) including
# no hostname (so plain "postmaster" and "abuse" works)
my @rcpthosts = $self->qp->config("rcpthosts") or return (DECLINED);
my @localhosts = ($self->qp->config("me"), "localhost", qx(hostname), "");
chomp @localhosts;
my $host = lc $recipient->host;
return(DECLINED) unless grep($_ eq $host, @rcpthosts, @localhosts) > 0;
# Look up this user and see if it looks like a valid user
my $user = $recipient->user;
$self->log(LOGDEBUG, "check_goodrcptto: $user needs checking");
if (CanBeDelivered($user => $self->{_assign}))
{
$self->log(LOGDEBUG, "$user accepted");
return DECLINED;
}
my $sender = $transaction->sender->address;
$sender = "" unless defined $sender;
$self->log(LOGDEBUG, "check_goodrcptto: $user is rejected, tell $sender");
# genuine mistake or, more likely, spammers flooding us
return(DENY, "No such account - mail to $user not accepted here")
unless (not(defined($sender)) or $sender eq "");
# bounce of email form a non-existant user - recommend SPF
return(DENY, "No such account as $user - checking SPF records would prevent
bouncing of joe-job emails");
}
# Returns a name if we believe a message can be delivered to the specified
# user, or undef if not...
sub CanBeDelivered {
my($user,$assign) = @_;
# Look up this user and see if it looks like a valid user
# Delivery will be according that user's ".qmail" or the defaultdelivery file
return $user if exists $assign->{user}->{$user};
# if the user isn't directly listed, check the prefixes, longest first
foreach my $prefix (reverse sort {length($a) <=> length($b)}
keys %{$assign->{prefix}}) {
if (substr($user,0,length($prefix)) eq $prefix) {
# this prefix matches the specified user part of the email address
my $v = $assign->{prefix}->{$prefix};
my $rest = substr($user,length($prefix));
my $dotqmail = $v->{dir}."/.qmail".$v->{dash}.$v->{ext};
foreach ($dotqmail.$rest, $dotqmail."default") {
if (-f $_)
{
my $d = slurp($_, sub { chomp @_;
return join(", ", grep(!/^#/,@_)) });
return $v->{user}." ($d)";
}
}
}
}
return undef;
}
1;
