=head1 NAME

SPF - plugin to implement Sender Permitted From

=head1 SYNOPSIS

Prevents email sender address spoofing by checking the SPF policy of the purported senders domain.

=head1 DESCRIPTION

Sender Policy Framework (SPF) is an e-mail validation system designed to prevent spam by addressing source address spoofing. SPF allows administrators to specify which hosts are allowed to send e-mail from a given domain by creating a specific SPF record in the public DNS. Mail exchangers then use the DNS to check that mail from a given domain is being sent by a host sanctioned by that domain's administrators. -- http://en.wikipedia.org/wiki/Sender_Policy_Framework

=head1 CONFIGURATION

In config/plugins, add arguments to the sender_permitted_from line.

  sender_permitted_from spf_deny 1

=head2 spf_deny

Setting spf_deny to 0 will prevent emails from being rejected, even if they fail SPF checks. sfp_deny 1 is the default, and a reasonable setting. It temporarily defers connections (4xx) that have soft SFP failures and only rejects (5xx) messages when the sending domains policy suggests it. Settings spf_deny to 2 is more aggressive and will cause soft failures to be rejected permanently.

See also http://spf.pobox.com/

=head1 AUTHOR

Matt Simerson <msimerson@cpan.org>

=head1 ACKNOWLEDGEMENTS

whomever wrote the original SPF plugin, upon which I based this.

=cut

use strict;
use Mail::SPF 2.000;
use Data::Dumper;

sub register {
    my ($self, $qp, @args) = @_;
    %{$self->{_args}} = @args;
}

sub hook_mail {
    my ($self, $transaction, $sender, %param) = @_;

    my $format    = $sender->format;
    return (DECLINED, "SPF - null sender") if $format eq '<>';
    return (DECLINED, "SPF - null sender")
        unless ($sender->host && $sender->user);

    my $client_ip = $self->qp->connection->remote_ip;
    my $from      = $sender->user . '@' . lc($sender->host);
    my $helo      = $self->qp->connection->hello_host;

    # If we are receiving from a relay permitted host, then we are probably
    # not the delivery system, and so we shouldn't check
    return (DECLINED, "SPF - relaying permitted")
      if $self->qp->connection->relay_client();

    my @relay_clients      = $self->qp->config("relayclients");
    my $more_relay_clients = $self->qp->config("morerelayclients", "map");
    my %relay_clients      = map { $_ => 1 } @relay_clients;
    while ($client_ip) {
        return (DECLINED, "SPF - relaying permitted")
          if exists $relay_clients{$client_ip};
        return (DECLINED, "SPF - relaying permitted")
          if exists $more_relay_clients->{$client_ip};
        $client_ip =~ s/\d+\.?$//;    # strip off another 8 bits
    }

    my $scope = $from ? 'mfrom' : 'helo';
    $client_ip = $self->qp->connection->remote_ip;
    my %req_params = (
        versions => [1, 2],           # optional
        scope => $scope,
        ip_address => $client_ip,
                     );

    if ($scope =~ /mfrom|pra/) {
        $req_params{identity} = $from;
        $req_params{helo_identity} = $helo if $helo;
    }
    elsif ($scope eq 'helo') {
        $req_params{identity}      = $helo;
        $req_params{helo_identity} = $helo;
    }

    my $spf_server = Mail::SPF::Server->new();
    my $request    = Mail::SPF::Request->new(%req_params);
    my $result     = $spf_server->process($request);

    $transaction->notes('spfquery', $result);
    $transaction->notes('spfcode', $result->code);

    return (OK) if $result->code eq 'pass';    # this test passed
    return (DECLINED, "SPF - $result->code");
}

sub hook_rcpt {
    my ($self, $transaction, $rcpt, %param) = @_;

    # special addresses don't get SPF-tested.
    return DECLINED
      if $rcpt
          and $rcpt->user
          and $rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i;

    my $result = $transaction->notes('spfquery') or return DECLINED;
    my $code   = $result->code;
    my $why    = $result->local_explanation;
    my $deny   = $self->{_args}{spf_deny};

    return (DECLINED, "SPF - $code: $why")   if $code eq "pass";
    return (DECLINED, "SPF - $code, $why")   if !$deny;
    return (DENYSOFT, "SPF - $code: $why")   if $code eq "error";
    return (DENY,     "SPF - forgery: $why") if $code eq 'fail';

    if ($code eq "softfail") {
        return (DENY, "SPF probable forgery: $why") if $deny > 1;
        return (DENYSOFT, "SPF probable forgery: $why");
    }

    $self->log(LOGDEBUG, "result for $rcpt->address was $code: $why");

    return (DECLINED, "SPF - $code, $why");
}

sub hook_data_post {
    my ($self, $transaction) = @_;

    my $result = $transaction->notes('spfquery') or return DECLINED;

    $self->log(LOGDEBUG, "result was $result->code");

    $transaction->header->add('Received-SPF' => $result->received_spf_header,
                              0);

    return DECLINED;
}