#!/usr/bin/perl

# postfix-policyd-spf-perl
# http://www.openspf.org/source/software/postfix-policyd-spf-perl/
# version 1.08
# $Id$

use version; our $VERSION = qv('1.08.1');

use strict;

use Fcntl;
use Sys::Syslog qw(:DEFAULT setlogsock);
use Mail::SPF::Query;

# ----------------------------------------------------------
#                      configuration
# ----------------------------------------------------------

my @HANDLERS;
push @HANDLERS, "testing";
push @HANDLERS, "sender_permitted_from";

my $VERBOSE = 0;

my $DEFAULT_RESPONSE = "DUNNO";

#
# Syslogging options for verbose mode and for fatal errors.
# NOTE: comment out the $syslog_socktype line if syslogging does not
# work on your system.
#

my $syslog_socktype = 'unix'; # inet, unix, stream, console
my $syslog_facility = "mail";
my $syslog_options  = "pid";
my $syslog_ident    = "postfix/policy-spf";

# ----------------------------------------------------------
#                      initialization
# ----------------------------------------------------------

#
# Log an error and abort.
#
sub fatal_exit {
    syslog(err     => "fatal_exit: @_");
    syslog(warning => "fatal_exit: @_");
    syslog(info    => "fatal_exit: @_");
    die "fatal: @_";
}

#
# Unbuffer standard output.
#
select((select(STDOUT), $| = 1)[0]);

#
# This process runs as a daemon, so it can't log to a terminal. Use
# syslog so that people can actually see our messages.
#
setlogsock $syslog_socktype;
openlog $syslog_ident, $syslog_options, $syslog_facility;

# ----------------------------------------------------------
#                           main
# ----------------------------------------------------------

#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
my %attr;
while (<STDIN>) {
    chomp;
    if (/=/)       { my ($k, $v) = split (/=/, $_, 2); $attr{$k} = $v; next }
    elsif (length) { syslog(warning => sprintf("warning: ignoring garbage: %.100s", $_)); next; }
    
    if ($VERBOSE) {
        for (sort keys %attr) {
            syslog(debug => "Attribute: %s=%s", $_, $attr{$_});
        }
    }
    
    fatal_exit("unrecognized request type: '$attr{request}'") unless $attr{request} eq "smtpd_access_policy";
    
    my $action = $DEFAULT_RESPONSE;
    my %responses;
    foreach my $handler (@HANDLERS) {
        no strict 'refs';
        my $response = $handler->(attr=>\%attr);
        syslog(debug => "handler %s: %s", $handler, $response);
        if ($response and $response !~ /^dunno/i) {
            syslog(info => "handler %s: %s is decisive.", $handler, $response);
            $action = $response; last;
        }
    }
    
    syslog(info => "decided action=%s", $action);
    
    print STDOUT "action=$action\n\n";
    %attr = ();
}

# ----------------------------------------------------------
#                     plugin: SPF
# ----------------------------------------------------------
sub sender_permitted_from {
    local %_ = @_;
    my %attr = %{ $_{attr} };
    
    my $query = eval {
        Mail::SPF::Query->new(
            ip      => $attr{client_address},
            sender  => $attr{sender},
            helo    => $attr{helo_name}
        )
    };
    if ($@) {
        syslog(
            info => "%s: Mail::SPF::Query->new(%s, %s, %s) failed: %s",
            $attr{queue_id}, $attr{client_address}, $attr{sender}, $attr{helo_name}, $@
        );
        return "DUNNO";
    }
    my ($result, $smtp_comment, $header_comment) = $query->result();
    
    syslog(
        info => "%s: SPF %s: smtp_comment=%s, header_comment=%s",
        $attr{queue_id}, $result, $smtp_comment, $header_comment
    );
    
    if    ($result eq "fail")  { return "REJECT $smtp_comment"; }
    elsif ($result eq "error") { return "DEFER_IF_PERMIT $smtp_comment"; }
    else                       { return "PREPEND Received-SPF: $result ($header_comment)"; }
}

# ----------------------------------------------------------
#                     plugin: testing
# ----------------------------------------------------------
sub testing {
    local %_ = @_;
    my %attr = %{ $_{attr} };
    
    if (
        lc(address_stripped($attr{sender})) eq lc(address_stripped($attr{recipient})) and
        $attr{recipient} =~ /policyblock/
    ) {
        
        syslog(info => "%s: testing: will block as requested", $attr{queue_id});
        return "REJECT smtpd-policy blocking $attr{recipient}";
    }
    else {
        syslog(
            info => "%s: testing: stripped sender=%s, stripped rcpt=%s",
            $attr{queue_id},
            address_stripped($attr{sender}),
            address_stripped($attr{recipient}),
        );
    }
    return "DUNNO";
}

# my $foo = address_stripped('foo+bar@baz.com'); # returns 'foo@baz.com'
sub address_stripped {
    my $string = shift;
    $string =~ s/[+-].*\@/\@/;
    return $string;
}
