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