#!/usr/bin/perl
use warnings;
use Sys::Syslog qw(:DEFAULT setlogsock);
use DBI;
use strict;
# ----------------------------------------------------------
#                      configuration
# ----------------------------------------------------------
my @HANDLERS;
#push @HANDLERS, "testing";
push @HANDLERS, "whitelist";
my $VERBOSE = 1;
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_priority = "info";
my $syslog_ident    = "postfix/whitelist";

#
# 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 = ();
}


# ----------------------------------------------------------
#               update white_list for user
#               NOTE: This filter ALWAYS returns DUNNO
# ----------------------------------------------------------
sub whitelist {
	local %_ = @_;
	my %attr = %{ $_{attr} };
	my $username = $attr{sasl_username};
# Strip @ sign and everything after it
# This should be edited to match the correct username in the DB
	$username =~ s/\@(.*)//;
	my $recipient = lc($attr{recipient});
# Only work if user has done succesfull SASL authentication
	if($username) {
# Spammers use addresses in our own domains in From
# headers. If we whitelist our own domains, they will
# get into our INBOX. Therefore we do not whitelist
# those addresses.
# Dick Visser <dick@terena.org> 2007-02-13
		my @excluded = qw(terena.nl terena.org someotherdomain.org);
		if (grep $recipient =~ /\@$_$/, @excluded) {
			syslog(info=>"Not whitelisting $recipient because it is in one of our own domains") if $VERBOSE;
		} else {
			my $dbh = DBI->connect("DBI:mysql:spamassassin:127.0.0.1","spamassassin_user",
					"hackme",
					{ RaiseError => 1 });
# Check if whitelist entry already exists
			my $sql = "SELECT * FROM userpref WHERE username = ? AND preference = 'whitelist_from' AND value = ?";
			my $db = $dbh->prepare($sql);
			if($db->execute($username, $recipient )) {
				if($db->fetchrow_array()) {
					syslog(info=>"Address '$recipient' is already whitelisted for user '$username'") if $VERBOSE;
				} else {
					syslog(info=>"Whitelisting address '$recipient' for user '$username'") if $VERBOSE;
# 2008-03-11 Changed DO statement into prepared statement, to allow for email addresses
# with quotes and other stuff.
					my $insert = $dbh->prepare("INSERT INTO userpref (preference, username, value) VALUES (?, ?, ?)");
					$insert->execute('whitelist_from', $username, $recipient);
					$insert->finish();
				}
				$db->finish();
				$dbh->disconnect();
			} else {
				syslog(info=>"SQL query failed") if $VERBOSE;
			}
		}
	}
	return "DUNNO";
}






# ----------------------------------------------------------
#                     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";
}

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