qpsmtpd/plugins/sender_permitted_from

=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;
}