#!/usr/bin/perl

use DB_File::Lock;
use Fcntl qw(:flock O_RDWR O_CREAT) ;
use Sys::Syslog qw(:DEFAULT setlogsock);


$database_name="/var/mta/liste_grise.db";
$greylist_delay=60;

#
# Syslogging options for verbose mode and for fatal errors.
# NOTE: comment out the $syslog_socktype line if syslogging does not
# work on your system.
#
$syslog_socktype = 'unix'; # inet, unix, stream, console
$syslog_facility="mail";
$syslog_options="pid";
$syslog_priority="info";

#
# Demo SMTPD access policy routine. The result is an action just like
# it would be specified on the right-hand side of a Postfix access
# table.  Request attributes are available via the %attr hash.
#
sub smtpd_access_policy {
	my($key, $time_stamp, $now, $retard, $ip,$ip1,$ip2,$ip3,$ip4);

	$attr{sender} =~ s/(?=.*@)\b\d+\b/#/g;


	# Lookup the time stamp for this client/sender/recipient.
	($ip1,$ip2,$ip3,$ip4)=split('\.',$attr{client_address});
	$ip="$ip1.$ip2.$ip3";
	
	$key = $ip."/".$attr{sender}."/".$attr{recipient};
	$key =~ tr /A-Z/a-z/;
	$now = time();

	# Read Database
	tie(%db_hash, 'DB_File::Lock', $database_name,O_CREAT|O_RDWR, 0644, $DB_BTREE, 'write' ) || die "Erreur d ecriture de $database_name";
	$time_stamp = $db_hash{$key};

	# If this is a new request add this client/sender/recipient to the database.
	if (! $time_stamp)
		{
		$time_stamp = $now;
		$db_hash{$key}=$time_stamp;
		}
	untie(%db_hash);

	# In case of success, return DUNNO instead of OK so that the
	# check_policy_service restriction can be followed by other restrictions.
	# In case of failure, specify DEFER_IF_PERMIT so that mail can
	# still be blocked by other access restrictions.
	syslog $syslog_priority, "request age %d", $now - $time_stamp if $verbose;

	$retard=$now - $time_stamp;
	if ($retard > $greylist_delay) {
		syslog(info=>"%s: whitelisted: key=%s, timestamp=%d",
			$attr{queue_id},
			$key,
			$now,
			);
		return "OK_AND_PREPEND";
	} else {
		syslog(info=>"%s: greylisted: key=%s, timestamp=%d",
			$attr{queue_id},
			$key,
			$now,
			);
		return "defer_if_permit Service temporarily unavailable";
	}
}

#
# Log an error and abort.
#
sub fatal_exit {
    my($first) = shift(@_);
    syslog "err", "fatal: $first", @_;
    exit 1;
}

#
# Signal 11 means that we have some kind of database corruption (yes
# Berkeley DB should handle this better).  Move the corrupted database
# out of the way, and start with a new database.
#
sub sigsegv_handler {
    my $backup = $database_name . "." . time();

    rename $database_name, $backup || 
	fatal_exit "Can't save %s as %s: $!", $database_name, $backup;
    fatal_exit "Caught signal 11; the corrupted database is saved as $backup";
}

$SIG{'SEGV'} = 'sigsegv_handler';

#
# 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 $0, $syslog_options, $syslog_facility;

#
# We don't need getopt() for now.
#
while ($option = shift(@ARGV)) {
	if ($option eq "-v") {
		$verbose = 1;
	} else {
		syslog $syslog_priority, "Invalid option: %s. Usage: %s [-v]",
			$option, $0;
		exit 1;
	}
}

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

#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
while (<STDIN>)
	{
	if (/([^=]+)=(.*)\n/)
		{
		($key,$value)=split(/=/);
		$key=substr($key, 0, 512);
		$value=substr($value, 0, 512);
		$key=~ s/^\s*(.*?)\s*$/$1/;
		$value=~ s/^\s*(.*?)\s*$/$1/;
		$attr{$key} = $value;
		}
	elsif ($_ eq "\n")
		{
		if ($verbose)
			{
			for (keys %attr)
				{
				syslog $syslog_priority, "Attribute: %s=%s", $_, $attr{$_};
				}
			}
		if ($attr{request} ne "smtpd_access_policy")
			{
			fatal_exit ("unrecognized request type: '%s'", $attr{request});
			}
		$action = smtpd_access_policy();
		syslog $syslog_priority, "Action: %s", $action if $verbose;
		print STDOUT "action=$action\n\n";
		%attr = ();
		}
	else
		{
		chop;
		syslog $syslog_priority, "warning: ignoring garbage: %.100s", $_;
		}
	}