#!/usr/bin/perl

use strict;
use Sys::Syslog qw(:DEFAULT setlogsock);
use DBI;
use Net::CIDR;

#
# Usage: sqlsenderpolicy.pl config.pl
#
# Demo delegated Postfix SMTPD policy server. This server implements
# sql based sender checks for specified networks.  Logging is sent to
# syslogd.
#
# How it works: each time a Postfix SMTP server process is started
# it connects to the policy service socket, and Postfix runs one
# instance of this PERL script.  By default, a Postfix SMTP server
# process terminates after 100 seconds of idle time, or after serving
# 100 clients. Thus, the cost of starting this PERL script is smoothed
# out over time.
#
# To run this from /etc/postfix/master.cf:
#
#    sqlpolicy  unix  -       n       n       -       -       spawn
#      user=nobody argv=/usr/bin/perl /usr/libexec/postfix/sqlsenderpolicy.pl conf.pl
#
# To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
#
#    smtpd_recipient_restrictions =
#	...
#	reject_unauth_destination
#	check_policy_service unix:private/sqlpolicy
#	...
#
# NOTE: specify check_policy_service AFTER reject_unauth_destination
# or else your system can become an open relay.
#
# To test this script by hand, execute:
#
#    % perl sqlsenderpolicy.pl
#
# Each query is a bunch of attributes. Order does not matter, and
# the demo script uses only a few of all the attributes shown below:
#
#    request=smtpd_access_policy
#    protocol_state=RCPT
#    protocol_name=SMTP
#    helo_name=some.domain.tld
#    queue_id=8045F2AB23
#    sender=foo@bar.tld
#    recipient=bar@foo.tld
#    client_address=1.2.3.4
#    client_name=another.domain.tld
#    instance=123.456.7
#    sasl_method=plain
#    sasl_username=you
#    sasl_sender=
#    size=12345
#    [empty line]
#
# The policy server script will answer in the same style, with an
# attribute list followed by a empty line:
#
#    action=dunno
#    [empty line]
#

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

# example config file content:
# $config={
# 	dbparams=>{
# 		ds=>'dbi:Pg:dbname=exampledb;host=examplehost',
# 		user=>'dbuser',
# 		passw=>'dbpass',
# 		attr=>{ RaiseError=>0, AutoCommit=>0}
# 	},
#	checkhosts=>['192.168.0.0/23','10.0.0.0/16'],
#	query=>'SELECT allowedfrom FROM mailrights WHERE machineip=?',
#	params=>['client_address'],
#	matchtype=>'pfa'
# };
# 1;

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

#
# Try to read a config file
#
if (! ($conffile=shift(@ARGV))) {
	$conffile='/etc/sqlsenderpolicy.conf';
}
if (! do $conffile) {
	fatal_exit('Can not parse the config file');
}

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

#
# Try to connect to database
#
if (!($dbh=DBI->connect($config->{dbparams}->{ds},
	$config->{dbparams}->{user},
	$config->{dbparams}->{passw},
	$config->{dbparams}->{attr}))) {
		fatal_exit "Error connecting to the database: $DBI::errstr\n";
	}

#
# 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 {
	# Check only clients listed in $config->{checkhosts}
	if(! Net::CIDR::cidrlookup($attr{'client_address'},@{$config->{checkhosts}})) {
		return "dunno";
	}

	# Prepare database query
	my @queryparams=map($attr{$_},@{$config->{params}});
	my $ref=$dbh->prepare($config->{query});
	$ref->execute(@queryparams);
	my $aref=$ref->fetchall_arrayref();

	syslog $syslog_priority, "request for $attr{'sender'}" if $verbose;

	# Check the entries
	if ($config->{matchtype} eq 'exact') {
		foreach my $i (@{$aref}) {
			if ($i eq (lc $attr{'sender'})) {
				return "dunno";
			}
		}
	} elsif ($config->{matchtype} eq 'regex') {
		foreach my $i (@{$aref}) {
			if ($attr{'sender'} =~ m/$i/i ) {
				return "dunno";
			}
		}
	} elsif ($config->{matchtype} eq 'pfa' ) {
		my ($lp,$dp)=split( /\@/ , lc $attr{'sender'} , 2 ) ;
		foreach my $i (@{$aref}) {
			if ($i =~ m/\@/ ) {
				my ($plp,$pdp)=split( /\@/ , $i , 2 ) ;
				if (($lp eq $plp or $lp =~m/^$plp\+/) and $dp eq $pdp) { return "dunno"; }
			} else {
				if($i=~m/^\./ ) {
					if ($dp=~m/$i$/) { return "dunno"; }
				} elsif ($i eq $dp) {
					return "dunno";
				}
			}
		}
	}

	return "reject You are not authorized to send this mail";

}

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

#
# Receive a bunch of attributes, evaluate the policy, send the result.
#
while (<STDIN>) {
    my $action;
    if (/([^=]+)=(.*)\n/) {
	$attr{substr($1, 0, 512)} = substr($2, 0, 512);
    } elsif ($_ eq "\n") {
	if ($verbose) {
	    for (keys %attr) {
		syslog $syslog_priority, "Attribute: %s=%s", $_, $attr{$_};
	    }
	}
	fatal_exit "unrecognized request type: '%s'", $attr{request}
	    unless $attr{"request"} eq "smtpd_access_policy";
	$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", $_;
    }
}
