--- /dev/null
+#!/usr/bin/perl -T
+
+# $Id$
+# $URL$
+
+use strict;
+use warnings;
+use DBI;
+use Config::General;
+use Sys::Syslog qw(:DEFAULT setlogsock);
+
+#
+# Usage: greylist.pl
+#
+# Delegated Postfix SMTPD policy server. This server implements
+# greylisting. State is kept in a Mysql database. 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:
+#
+# policy unix - n n - - spawn
+# user=nobody argv=/usr/bin/perl /usr/libexec/postfix/greylist.pl
+#
+# To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
+#
+# smtpd_recipient_restrictions =
+# ...
+# reject_unauth_destination
+# check_policy_service unix:private/policy
+# ...
+#
+# 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 greylist.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]
+#
+# database format
+# create table grey ( address varchar( 15 ) not null,
+# sender varchar( 200) not null,
+# recipient varchar(200) not null,
+# count int unsigned default 1 not null,
+# request_time timestamp not null,
+# expire_time timestamp not null,
+# primary key ( address, sender, recipient ) );
+#
+# create table white ( address varchar( 15 ) not null,
+# mask varchar( 15 ) not null,
+# count int unsgined default 0 not null,
+# descr text );
+# create table black ( address varchar( 15 ) not null,
+# mask varchar( 15 ) not null,
+# count int unsgined default 0 not null,
+# descr text );
+
+
+######################
+## Global Variables
+######################
+my ( $dbh, $config );
+######################
+
+# read configuration
+($config) = $0 =~ m#^(.+\.)pl$#;
+$config .= "cf";
+#
+{
+ my $conf;
+ $conf = new Config::General($config);
+ $config = { $conf->getall() };
+}
+
+$0 = 'postfix/greylist';
+
+#### main ####
+#
+# 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 $config->{'syslog'}{'socktype'};
+openlog $0, $config->{'syslog'}{'options'}, $config->{'syslog'}{'facility'};
+
+#
+# Unbuffer standard output.
+#
+select((select(STDOUT), $| = 1)[0]);
+
+#
+# Receive a bunch of attributes, evaluate the policy, send the result.
+#
+{
+ my ( $attr, $action );
+ while (<STDIN>) {
+ if (/([^=]+)=(.*)\n/) {
+ $attr->{substr($1, 0, 512)} = substr($2, 0, 512);
+ } elsif ($_ eq "\n") {
+ if ($config->{'verbose'}) {
+ foreach (keys %$attr) {
+ syslog $config->{'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($attr);
+ syslog $config->{'syslog'}{'priority'}, 'Action: %s', $action if $config->{'verbose'};
+ print STDOUT "action=$action\n\n";
+ $attr = {};
+ } else {
+ chop;
+ syslog $config->{'syslog'}{'priority'}, 'warning: ignoring garbage: %.100s', $_;
+ }
+ }
+ $dbh->disconnect() if $dbh;
+}
+
+#########################################
+### subs
+#########################################
+#
+# 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 ( $param ) = @_;
+ my $age;
+ #my ( $time_stamp, $now, $key );
+
+ # Open the database on the fly.
+ open_database() unless $dbh;
+
+ # first look up the whitelist
+ if ( $config->{'database'}{'whitelist_table'} && db_read_whitelist( $param ) ) {
+ syslog $config->{'syslog'}{'priority'}, 'request address in whitelist';
+ if ( $config->{'greylist'}{'whitelist_header_text'} ) {
+ return 'PREPEND X-GreyList: ' . $config->{'greylist'}{'whitelist_header_text'};
+ } else {
+ return 'dunno';
+ }
+ }
+ if ( $config->{'database'}{'blacklist_table'} && db_read_blacklist( $param ) ) {
+ syslog $config->{'syslog'}{'priority'}, 'request address in blacklist';
+ return 'defer_if_permit ' . ( $config->{'greylist'}{'blacklist_reason'} || 'Service is unavailable');
+ }
+
+ # timestamps will be generated within the database
+ # Lookup the time stamp for this client/sender/recipient.
+ $age = db_read_greylist( $param );
+ unless ( $age ) { # expired or unseen
+ db_add_greylist($param);
+ }
+
+ # The result can be any action that is allowed in a Postfix access(5) map.
+ #
+ # To label mail, return ``PREPEND'' headername: headertext
+ #
+ # 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 optional text...''
+ # so that mail can still be blocked by other access restrictions.
+ #
+ syslog $config->{'syslog'}{'priority'}, 'request age %d', $age;
+ if ( $age > $config->{'greylist'}{'delay'} ) {
+ return "dunno";
+ } else {
+ return 'defer_if_permit ' . ( $config->{'greylist'}{'delay_message'} || 'Service is unavailable' );
+ }
+}
+
+#
+# Log an error and abort.
+#
+sub fatal_exit {
+ my $first = shift;
+ syslog 'err', 'fatal: '.$first, @_;
+ $dbh->disconnect() if $dbh;
+ exit 1;
+}
+
+#
+# Open hash database.
+#
+sub open_database {
+ $dbh = DBI->connect(
+ "DBI:".$config->{'database'}{'db_type'}.':'.$config->{'database'}{'db_name'},
+ $config->{'database'}{'db_user'},
+ $config->{'database'}{'db_pass'},
+ { AutoCommit => 0, RaiseError => 0, PrintError => 0 }
+ );
+ fatal_exit( "Cannot open database %s: %s", $config->{'database'}{'db_name'}, $DBI::errstr ) unless $dbh;
+ syslog $config->{'syslog'}{'priority'}, "open db %s", $config->{'database'}{'db_name'} if $config->{'verbose'};
+}
+
+#
+# Read database. Use a lock to avoid reading the database
+# while it is being changed.
+#
+sub db_read_greylist {
+ my $param = shift;
+ my ( $sqlst, $sth, $val, $tofast );
+
+ $dbh->do( 'lock table '.$config->{'database'}{'greylist_table'}. ' write' ) or fatal_exit( "Cannot lock table: %s", $dbh->errstr );
+ # lc $attr{"client_address"}."/".$attr{"sender"}."/".$attr{"recipient"};
+ $sqlst = q( select unix_timestamp(now())-unix_timestamp(request_time) age from ).$config->{'database'}{'greylist_table'} .
+ q( where address = ? and sender = ? and recipient = ? and expire_time > now() );
+ $sth = $dbh->prepare( $sqlst ) or fatal_exit( 'Cannot prepare statement: %s with error: %s', $sqlst, $dbh->errstr );
+ $sth->execute( @$param{qw( client_address sender recipient )} ) or fatal_exit( 'Cannot execute: %s', $dbh->errstr );
+
+ $val = ($sth->fetchrow_hashref()||{})->{'age'};
+ $sth->finish();
+
+ if ( $val ) {
+ $tofast = $val < $config->{'greylist'}{'delay'};
+ # generate new expire time
+ $sqlst = 'update '.$config->{'database'}{'greylist_table'} . ' set ' .
+ ($tofast?'':'request_time = request_time, ') . # keep old time if old enough
+ 'expire_time = date_add( now(), interval ? second ), count = count + 1 where address = ? and sender = ? and recipient = ?';
+ $dbh->do( $sqlst, {}, $config->{'greylist'}{$tofast?'expire_short':'expire_long'},
+ @$param{qw( client_address sender recipient )} ) or
+ fatal_exit( "Cannot update record: %s", $dbh->errstr );
+ } else {
+ $val = 0; # prevent undef
+ }
+
+ syslog $config->{'syslog'}{'priority'},
+ 'lookup %s: %s', join('/', @$param{qw( client_address sender recipient )} ), $val if $config->{'verbose'};
+ $dbh->do("unlock tables");
+ return $val;
+}
+
+# add a new requester to db
+sub db_add_greylist {
+ my $param = shift;
+ my ( $sqlst );
+
+ # replace already existing record because its expired anyway
+ $sqlst = 'replace into '.$config->{'database'}{'greylist_table'} .
+ ' (address, sender, recipient, expire_time ) values ( ?, ?, ?, date_add( now(), interval ? second ) ) ';
+ $dbh->do( $sqlst, {}, @$param{qw( client_address sender recipient )}, $config->{'greylist'}{'expire_short'} ) or
+ fatal_exit( 'Cannot insert record: %s', $dbh->errstr );
+}
+
+# read whitelist table to avoid greylisting
+sub db_read_whitelist {
+ my $param = shift;
+ open_database() unless $dbh;
+
+ my ( $sqlst, $res );
+
+ $sqlst = 'update ' . $config->{'database'}{'whitelist_table'} . ' set count = count + 1' .
+ ' where INET_ATON( address ) & INET_ATON( mask ) = INET_ATON( ? ) & INET_ATON( mask )';
+ $res = $dbh->do( $sqlst, {}, $param->{'client_address'} ) or
+ fatal_exit( 'Cannot update whitelist, statement is: %s with error %s', $sqlst, $dbh->errstr );
+ return $res + 0; # transform number of rows to bool
+}
+
+# read blacklist table to never let mail through
+sub db_read_blacklist {
+ my $param = shift;
+ open_database() unless $dbh;
+
+ my ( $sqlst, $res );
+
+ $sqlst = 'update ' . $config->{'database'}{'blacklist_table'} . ' set count = count + 1' .
+ ' where INET_ATON( address ) & INET_ATON( mask ) = INET_ATON( ? ) & INET_ATON( mask ) limit 1';
+ $res = $dbh->do( $sqlst, {}, $param->{'client_address'} ) or
+ fatal_exit( 'Cannot prepare statement: %s with error %s', $sqlst, $dbh->errstr );
+ return $res + 0; # false if no records where updated
+}
+__END__
+
+#
+# We don't need getopt() for now.
+#
+# maybe later add a switch for config file
+#
+while ($option = shift(@ARGV)) {
+ if ($option eq "-v") {
+ $verbose = 1;
+ } else {
+ syslog $syslog_priority, "Invalid option: %s. Usage: %s [-v]",
+ $option, $0;
+ exit 1;
+ }
+}
+