293 lines
8.4 KiB
Perl
293 lines
8.4 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
=head1 NAME
|
|
|
|
bounce_verp - verp all your outgoing mail to make bounces work again
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Anyone who has been using mail for a long time will know that bounces from mail
|
|
you didn't send is a real problem. Some solutions have been proposed to handle
|
|
this such as SPF which rely on the rest of the internet to implement SPF
|
|
checking so that they will not send you bounces. This solution works without
|
|
global cooperation.
|
|
|
|
See also the BATV proposal from Dave Crocker, which uses a slightly different
|
|
syntax.
|
|
|
|
This module will basically change all your outbound email (those that are considered
|
|
to be B<"relaying">) from the format:
|
|
|
|
localpart@domain
|
|
|
|
Into:
|
|
|
|
securehash=ts=localpart@domain
|
|
|
|
The securehash and ts (timestamp) are short base32 encoded versions of HMAC and epoch
|
|
time respectively. They should be secure enough. The format used is also known as a
|
|
"VERP" or Variable Envelope Return Path.
|
|
|
|
=head1 ISSUES
|
|
|
|
There are some problems with verping the return path.
|
|
|
|
=over 4
|
|
|
|
=item * Ezmlm - this uses the return path to decide who is sending the mail and thus
|
|
figure out if you are a member of the mailing list.
|
|
|
|
=item * Qmail - qmail provides very easy access to the return path via the dot-qmail
|
|
files, and so there are likely many systems built on qmail which behave this way.
|
|
|
|
=item * (Your Entry Here)
|
|
|
|
=back
|
|
|
|
Each of these things can be added to the bounce_verp.skip list. (See
|
|
L</bounce_verp.skip> below).
|
|
|
|
=head1 Configuration
|
|
|
|
There are a few configuration files you can create. All are optional except for
|
|
F<bounce_verp.secret>.
|
|
|
|
=head2 bounce_verp.secret
|
|
|
|
This file is mandatory, and should contain your secrets (no, not those ones).
|
|
|
|
Each line should contain a secret. The topmost one is used for outbound verping,
|
|
the following lines are used for validation. This allows you to rotate secrets
|
|
should you fear they have been found out.
|
|
|
|
=head2 bounce_verp.maxage
|
|
|
|
Default: 7 (days)
|
|
|
|
The maximum number of days a bounce verp should be valid for. Set this to the
|
|
longest delay you are willing to accept bounces for, on mails you sent.
|
|
|
|
=head2 bounce_verp.hashlength
|
|
|
|
Default: 4
|
|
|
|
The number of characters to store in your email address for your hash. Normally
|
|
four characters is sufficient, however you may wish to increase this if you are
|
|
security concious.
|
|
|
|
=head2 bounce_verp.hashmin
|
|
|
|
Default: 4
|
|
|
|
=head2 bounce_verp.skip
|
|
|
|
This file should contain a list of email addresses or domains that you should
|
|
skip this verp magic for. The code tries to be a little bit clever to cope with
|
|
systems that send out mails from multiple email addresses, such as ezmlm, so
|
|
that you only have to specify the main address. e.g.:
|
|
|
|
foo.com
|
|
qpsmtpd@perl.org
|
|
|
|
Will skip verping/checking for all emails to/from any address or subdomain of I<foo.com>,
|
|
and skip verping/checking for all emails to/from the qpsmtpd mailing list, including
|
|
help, unsubscribe, and other sub-list requests.
|
|
|
|
Note: These addresses are easily forgeable. Patches welcome to add checking of rDNS
|
|
into the mix to eliminate the forgery problem (though rDNS isn't available to everyone).
|
|
|
|
=head2 bounce_verp.bounce_heuristics
|
|
|
|
Put a 1 in this file to tell the plugin to use more aggressive heuristics
|
|
in determining whether this email is a bounce or not. The default rules
|
|
for detecting a bounce are:
|
|
|
|
MailFrom = <>
|
|
or MailFrom = <postmaster@domain>
|
|
or MailFrom = <mailer-daemon@domain>
|
|
|
|
Setting C<bounce_verp.bounce_heuristics> makes bounce_verp look in the mail
|
|
headers for various clues too.
|
|
|
|
=cut
|
|
|
|
use Mail::SRS;
|
|
|
|
sub register {
|
|
my ($plugin) = @_;
|
|
|
|
$plugin->register_hook('data' => 'do_verp');
|
|
if ($plugin->qp->config('bounce_verp.bounce_heuristics')) {
|
|
$plugin->register_hook('data_post' => 'check_verp');
|
|
}
|
|
else {
|
|
$plugin->register_hook('data' => 'check_verp');
|
|
}
|
|
}
|
|
|
|
sub do_verp {
|
|
my ($self, $transaction) = @_;
|
|
|
|
if ($self->qp->connection->relaying) {
|
|
$self->log(LOGINFO, "doing outbound verp");
|
|
return $self->do_outbound_verp($transaction);
|
|
}
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
sub check_verp {
|
|
my ($self, $transaction) = @_;
|
|
|
|
if ($self->qp->connection->relaying) {
|
|
return DECLINED;
|
|
}
|
|
|
|
$self->log(LOGINFO, "checking inbound verp");
|
|
return $self->do_inbound_verp($transaction);
|
|
}
|
|
|
|
sub get_srs {
|
|
my $self = shift;
|
|
|
|
my @secrets = $self->qp->config('bounce_verp.secret') ||
|
|
die "No secrets defined";
|
|
my $max_age = $self->qp->config('bounce_verp.maxage') || 7; # days
|
|
my $hash_length = $self->qp->config('bounce_verp.hashlength') || 4;
|
|
my $hash_min = $self->qp->config('bounce_verp.hashmin') || 4;
|
|
|
|
my $srs = Mail::SRS->new(Secret => \@secrets,
|
|
MaxAge => $max_age,
|
|
HashLength => $hash_length,
|
|
HashMin => $hash_min,
|
|
);
|
|
|
|
return $srs;
|
|
}
|
|
|
|
sub do_outbound_verp {
|
|
my ($self, $transaction) = @_;
|
|
|
|
foreach my $recip ($transaction->recipients) {
|
|
if ($self->skip_verp($recip->address))
|
|
my $sender = $transaction->sender->address;
|
|
|
|
return DECLINED if $self->skip_verp($sender);
|
|
|
|
my $srs = $self->get_srs();
|
|
|
|
my $timestamp = $srs->timestamp_create();
|
|
|
|
my $hash = $srs->hash_create($timestamp, $sender);
|
|
|
|
my ($local, $domain) = ($sender =~ /^(.*)\@(.*?)$/);
|
|
my $new_address = join('-', $local, $hash, $timestamp);
|
|
$new_address = "$new_address\@$domain";
|
|
|
|
$self->log(LOGDEBUG, "setting sender to $new_address");
|
|
$transaction->sender(Qpsmtpd::Address->new($new_address));
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
sub do_inbound_verp {
|
|
my ($self, $transaction) = @_;
|
|
|
|
my ($recip, $not_allowed) = $transaction->recipients;
|
|
|
|
$recip = $recip->address;
|
|
|
|
if ($self->skip_verp($recip)) {
|
|
$self->log(LOGINFO, "skipping inbound check");
|
|
return DECLINED;
|
|
}
|
|
|
|
unless ($self->is_bounce($transaction)) {
|
|
$self->log(LOGINFO, "this mail is not a bounce - no need to check verp");
|
|
return DECLINED;
|
|
}
|
|
|
|
$self->log(LOGDEBUG, "validating bounce recipient: $recip");
|
|
#return DENY, "Multiple recipients of bounces not allowed" if $not_allowed;
|
|
|
|
my $srs = $self->get_srs();
|
|
|
|
my ($local, $domain) = ($recip =~ /^(.*)\@(.*?)$/);
|
|
my ($user, $hash, $timestamp) = split('-', $local, 3);
|
|
|
|
my $address = "$user\@$domain";
|
|
if (!$srs->hash_verify($hash, $timestamp, $address)) {
|
|
return DENY, "Mail from $recip probably did not originate here.";
|
|
}
|
|
|
|
if (!$srs->timestamp_check($timestamp)) {
|
|
return DENY, "You took too long to send this bounce,\n" .
|
|
"or someone is trying a replay attack on an old VERP of mine";
|
|
}
|
|
|
|
# now set RCPTs to proper address.
|
|
$self->log(LOGDEBUG, "fixing inbound recipient to be $address");
|
|
$transaction->recipients(Qpsmtpd::Address->new($address));
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
sub is_bounce {
|
|
my ($self, $transaction) = @_;
|
|
|
|
my $sender = $transaction->sender->address;
|
|
|
|
return 1 if ($sender eq '');
|
|
|
|
return 1 if ($sender =~ /^postmaster\@/i);
|
|
|
|
return 1 if ($sender =~ /^mailer[_-]daemon\@/i);
|
|
|
|
return 0 unless $self->qp->config('bounce_verp.bounce_heuristics');
|
|
|
|
my $headers = $transaction->header();
|
|
my $from = $headers->get('From');
|
|
my $subject = $headers->get('Subject');
|
|
|
|
return 1 if ($from =~ /\bpostmaster\@/i);
|
|
return 1 if ($from =~ /\bmailer-daemon\@/i);
|
|
|
|
return 1 if ($subject =~ /^failure notice/i);
|
|
return 1 if ($subject =~ /^Rejected mail/i);
|
|
|
|
return 0;
|
|
}
|
|
|
|
# Should we skip verping for this transaction?
|
|
sub skip_verp {
|
|
my ($self, $address) = @_;
|
|
|
|
my @skips = $self->qp->config('bounce_verp.skip');
|
|
|
|
foreach my $skip (@skips) {
|
|
if (index($skip, '@') < 0) {
|
|
# skip a domain, and any subdomains
|
|
if ($address =~ /[@\.]\Q$skip\E$/i) {
|
|
$self->log(LOGDEBUG, "skip domain: $skip");
|
|
return 1;
|
|
}
|
|
}
|
|
else {
|
|
# skip an address.
|
|
if ($address eq $skip) {
|
|
$self->log(LOGDEBUG, "skip address: $skip");
|
|
return 1;
|
|
}
|
|
|
|
# OK, it's not that address, but is it a mailing list verp
|
|
my ($local, $domain) = ($skip =~ /^(.*)\@(.*?)$/);
|
|
if ($address =~ /^\Q$local\E\b/i and $address =~ /\@\Q$domain\E$/i) {
|
|
$self->log(LOGDEBUG, "skip partial address: $skip");
|
|
return 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
return 0;
|
|
}
|