Moved to the attic
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@324 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Matt Sergeant
parent
1b977fbb5e
commit
31eed901be
@ -1,292 +0,0 @@
|
||||
#!/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;
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user