Initial stab at an outbound bounce_verp system.
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@321 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Matt Sergeant
parent
11c12711ee
commit
c341ff0d0f
248
plugins/bounce_verp
Normal file
248
plugins/bounce_verp
Normal file
@ -0,0 +1,248 @@
|
||||
#!/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).
|
||||
|
||||
=cut
|
||||
|
||||
use Mail::SRS;
|
||||
|
||||
sub register {
|
||||
my ($plugin) = @_;
|
||||
|
||||
$plugin->register_hook('data' => 'do_verp');
|
||||
$plugin->register_hook('data_post' => 'check_verp');
|
||||
}
|
||||
|
||||
sub do_verp {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
if ($transaction->relaying) {
|
||||
return $self->do_outbound_verp($transaction);
|
||||
}
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub check_verp {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
if ($transaction->relaying) {
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
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) = @_;
|
||||
|
||||
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 $new_address = join('=', $hash, $timestamp, $sender);
|
||||
|
||||
$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;
|
||||
|
||||
return DECLINED if $self->skip_verp($recip);
|
||||
|
||||
return DECLINED unless $self->is_bounce($transaction);
|
||||
|
||||
#return DENY, "Multiple recipients of bounces not allowed" if $not_allowed;
|
||||
|
||||
my $srs = $self->get_srs();
|
||||
|
||||
my ($hash, $timestamp, $address) = split('=', $recip, 3);
|
||||
|
||||
if (!$srs->hash_verify($hash, $timestamp, $address)) {
|
||||
return DENY, "This mail 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.
|
||||
$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);
|
||||
|
||||
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
|
||||
return 1 if $address =~ /[@\.]\Q$skip\E$/i;
|
||||
}
|
||||
else {
|
||||
# skip an address.
|
||||
return 1 if $address eq $skip;
|
||||
|
||||
# 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) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
62
t/plugin_tests/bounce_verp
Normal file
62
t/plugin_tests/bounce_verp
Normal file
@ -0,0 +1,62 @@
|
||||
# Bounce verp tests
|
||||
|
||||
sub register_tests {
|
||||
my $self = shift;
|
||||
|
||||
$self->register_test(test_skip_verp => 8);
|
||||
$self->register_test(test_is_bounce => 4);
|
||||
$self->register_test(test_do_verp => 1);
|
||||
$self->register_test(test_check_verp => 1);
|
||||
}
|
||||
|
||||
sub test_skip_verp {
|
||||
my $self = shift;
|
||||
|
||||
# poison the cache
|
||||
$self->qp->{_config_cache}->{'bounce_verp.skip'} = [
|
||||
'example.com',
|
||||
'qpsmtpd@perl.org',
|
||||
];
|
||||
|
||||
# check the cache poison
|
||||
my @skip = $self->qp->config('bounce_verp.skip');
|
||||
ok(@skip == 2, "skip contains right number of elements");
|
||||
|
||||
for (qw(test@example.com x@example.com qpsmtpd@perl.org qpsmtpd-foo@perl.org x@eXample.com))
|
||||
{
|
||||
ok($self->skip_verp($_), "Skip $_");
|
||||
}
|
||||
|
||||
for (qw(test@example.org p5p@perl.org)) {
|
||||
ok(!$self->skip_verp($_), "Skip $_");
|
||||
}
|
||||
}
|
||||
|
||||
sub test_is_bounce {
|
||||
my $self = shift;
|
||||
|
||||
my $tran = $self->transaction();
|
||||
|
||||
# check null sender
|
||||
$tran->sender(Qpsmtpd::Address->new('<>'));
|
||||
ok($self->is_bounce($tran), "Check null sender is_bounce");
|
||||
|
||||
# check postmaster mail
|
||||
$tran->sender(Qpsmtpd::Address->new('<postmaster@example.com>'));
|
||||
ok($self->is_bounce($tran), "Check postmaster is_bounce");
|
||||
|
||||
# check mailer-daemon mail
|
||||
$tran->sender(Qpsmtpd::Address->new('<mailer-daemon@example.com>'));
|
||||
ok($self->is_bounce($tran), "Check mailer-daemon is_bounce");
|
||||
$tran->sender(Qpsmtpd::Address->new('<Mailer_daemon@example.com>'));
|
||||
ok($self->is_bounce($tran), "Check mailer_daemon is_bounce");
|
||||
|
||||
}
|
||||
|
||||
sub test_do_verp {
|
||||
ok(1);
|
||||
}
|
||||
|
||||
sub test_check_verp {
|
||||
ok(1);
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user