5a7b0c937b
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@162 958fd67b-6ff1-0310-b445-bb7760255be9
84 lines
2.1 KiB
Plaintext
84 lines
2.1 KiB
Plaintext
|
|
=head1 NAME
|
|
|
|
SPF - plugin to implement Sender Permitted From
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
# in config/plugins
|
|
sender_permitted_from
|
|
|
|
Or if you wish to issue 5xx on SPF fail:
|
|
|
|
sender_permitted_from spf_deny 1
|
|
|
|
See also http://spf.pobox.com/
|
|
|
|
=cut
|
|
|
|
use Mail::SPF::Query;
|
|
|
|
sub register {
|
|
my ($self, $qp, @args) = @_;
|
|
%{$self->{_args}} = @args;
|
|
$self->register_hook("mail", "mail_handler");
|
|
$self->register_hook("rcpt", "rcpt_handler");
|
|
$self->register_hook("data_post", "data_handler");
|
|
}
|
|
|
|
sub mail_handler {
|
|
my ($self, $transaction, $sender) = @_;
|
|
|
|
return (DECLINED) unless ($sender->format ne "<>"
|
|
and $sender->host && $sender->user);
|
|
|
|
my $host = lc $sender->host;
|
|
my $from = $sender->user . '@' . $host;
|
|
|
|
my $ip = $self->qp->connection->remote_ip;
|
|
my $query = Mail::SPF::Query->new(ip => $ip, sender => $from)
|
|
|| die "Couldn't construct Mail::SPF::Query object";
|
|
$transaction->notes('spfquery', $query);
|
|
|
|
return (DECLINED);
|
|
}
|
|
|
|
sub rcpt_handler {
|
|
my ($self, $transaction, $rcpt) = @_;
|
|
|
|
# special addresses don't get SPF-tested.
|
|
return DECLINED if $rcpt and $rcpt->user and $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i;
|
|
|
|
my $query = $transaction->notes('spfquery');
|
|
my ($result, $comment) = $query->result();
|
|
|
|
$self->qp->connection->notes('spf_result', $result);
|
|
$self->qp->connection->notes('spf_comment', $comment);
|
|
$self->qp->connection->notes('spf_header', "$result ($comment)");
|
|
|
|
if ($result eq "fail" and $self->{_args}{spf_deny}) {
|
|
my $ip = $self->qp->connection->remote_ip;
|
|
my $sender = $transaction->sender;
|
|
|
|
my $why = "http://spf.pobox.com/why?sender=" . _uri_escape($sender) . "&ip=$ip";
|
|
return (DENY, "SPF forgery ($comment; see $why)");
|
|
}
|
|
|
|
return DECLINED;
|
|
}
|
|
|
|
sub _uri_escape {
|
|
my $str = shift;
|
|
$str =~ s/([^A-Za-z0-9\-_.!~*\'()])/sprintf "%%%X", ord($1)/eg;
|
|
return $str;
|
|
}
|
|
|
|
sub data_handler {
|
|
my ($self, $transaction) = @_;
|
|
|
|
$transaction->header->add('Received-SPF' => $self->qp->connection->notes('spf_header'), 0);
|
|
|
|
return DECLINED;
|
|
}
|
|
|