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 2004-09-20 08:09:02 +00:00
parent 11c12711ee
commit c341ff0d0f
2 changed files with 310 additions and 0 deletions

248
plugins/bounce_verp Normal file
View 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;
}

View 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);
}