[RFC] example Postfix-compatible greylist implementation

[RFC] example Postfix-compatible greylist implementation

[Eric Wong]

I couldn't find a way to limit postgrey to only greylist
public-inbox addresses (and not my personal mail).  I also
didn't want to deal with BerkeleyDB or have to read through
more implementations.  So I figured it'd be easier to hack
up my own to do exactly what I want.

*shrug* it seems to be working...
---
 MANIFEST               |   1 +
 examples/greylist.perl | 190 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 191 insertions(+)
 create mode 100755 examples/greylist.perl

diff --git a/MANIFEST b/MANIFEST
index fb175e5f..fd6b4fc1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -128,6 +128,7 @@ examples/README.unsubscribe
 examples/cgit-commit-filter.lua
 examples/cgit-wwwhighlight-filter.lua
 examples/cgit.psgi
+examples/greylist.perl
 examples/grok-pull.post_update_hook.sh
 examples/highlight.psgi
 examples/lib/.gitignore
diff --git a/examples/greylist.perl b/examples/greylist.perl
new file mode 100755
index 00000000..74e58dfa
--- /dev/null
+++ b/examples/greylist.perl
@@ -0,0 +1,190 @@
+#!/usr/bin/perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: GPL-2.0+ <https://www.gnu.org/licenses/gpl-2.0.txt>
+#
+# Postfix greylister using SQLite, loosely based on the one
+# distributed with postfix and postgrey (uses postgrey-compatible
+# whitelist), but only affects addresses used by public-inboxes,
+# not every single message accepted by a system.
+#
+# Not many knobs here, edit the script to modify.
+# I don't get enough mail to justify multiple processes
+# (and I only have one CPU on my mail host)
+#
+# in /etc/postfix/master.cf:
+#
+#    policy  unix  -       n       n       -       1       spawn
+#      user=foo argv=/usr/bin/perl -w /path/to/greylist.perl
+#
+# in /etc/postfix/main.cf:
+#
+#    smtpd_recipient_restrictions =
+#	...
+#	reject_unauth_destination
+#	check_policy_service unix:private/policy
+#	...
+use v5.12;
+use autodie qw(open);
+use DBI;
+use Fcntl qw(LOCK_EX LOCK_UN);
+use IO::Handle ();
+use Sys::Syslog qw(:DEFAULT);
+use NetAddr::IP;
+
+# make sure user= in master.cf line can write to this
+my $db_file = '/var/lib/greylist/greylist.sqlite3';
+my $delay = 60;
+my ($dbh, $lockfh, $dbg, %GREY_ADDR);
+my $allow_clients = '/etc/greylist.allow'; # postgrey-compatible
+my $pi_config = $ENV{PI_CONFIG} // "$ENV{HOME}/.public-inbox/config";
+if (-r $pi_config) { # read addresses from public-inbox config
+	open my $fh, '-|', qw(git config -z -l --includes -f), $pi_config;
+	local $/ = "\0";
+	my @l = grep /\.address\n/, <$fh>;
+	chomp(@l);
+	$GREY_ADDR{(split(/\n/, $_, 2))[1]} = undef for @l;
+}
+
+my (@allow_clients, @allow_ips);
+if (-r $allow_clients) { # compatible with postgrey
+	open my $fh, '<', $allow_clients;
+	while (<$fh>) {
+		s/#.*$//; s/^\s+//; s/\s+$//;
+		next if $_ eq '';
+		if (/^\/(\S+)\/$/) { # aready an RE
+			push @allow_clients, qr{$1}i;
+		} elsif (/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(?:\/\d{1,2})?$/) {
+			my $ip = NetAddr::IP->new($_);
+			push @allow_ips, $ip if defined $ip;
+		} elsif (/^\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
+			my $ip = NetAddr::IP->new($_, 24);
+			push @allow_ips, $ip if defined $ip;
+		} elsif (/^\d{1,3}\.\d{1,3}$/) {
+			my $ip = NetAddr::IP->new($_, 16);
+			push @allow_ips, $ip if defined $ip;
+		} elsif (/^.*\:.*\:.*(?:\/\d{1,3})?$/) { # IPv6
+			my $ip = NetAddr::IP->new($_);
+			push @allow_ips, $ip if defined $ip;
+		} elsif (/^\S+$/) {
+			push @allow_clients, qr{(?:^|\.)\Q$_\E$}i;
+		} else {
+			warn "$allow_clients line $.: ",
+				"doesn't look like a hostname: $_\n";
+		}
+	}
+}
+
+sub xflock ($$) {
+	until (flock($_[0], $_[1])) { return unless $!{EINTR} }
+	1;
+}
+
+# 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 ($attr) = @_;
+
+	my $recipient = lc $attr->{recipient};
+	return 'dunno' unless exists $GREY_ADDR{$recipient};
+
+	state $get = $dbh->prepare(<<'');
+SELECT expires FROM greystate WHERE key = ?
+
+	state $upd = $dbh->prepare(<<'');
+INSERT OR REPLACE INTO greystate (key,expires) VALUES (?,?)
+
+	state $clean = $dbh->prepare(<<'');
+DELETE FROM greystate WHERE expires < ?
+
+	if (@allow_clients) {
+		my $client_name = $attr->{client_name};
+		for my $name_re (@allow_clients) {
+			return 'dunno' if $client_name =~ $name_re;
+		}
+	}
+
+	my $client_ip = NetAddr::IP->new($attr->{client_address});
+	for my $range (@allow_ips) {
+		return 'dunno' if $client_ip->within($range);
+	}
+	my $bits = $client_ip->bits == 32 ? 24 : 64;
+	my $subnet = NetAddr::IP->new($client_ip->addr, $bits)->network;
+	my $key = $subnet.'|'.lc($attr->{sender});
+	$get->bind_param(1, $key);
+
+	xflock $lockfh, LOCK_EX;
+	$dbh->begin_work;
+
+	$get->execute;
+	my ($ok_at) = $get->fetchrow_array;
+	if (defined $ok_at) {
+		$dbh->rollback;
+		xflock $lockfh, LOCK_UN;
+
+		time >= $ok_at ? 'dunno' : 'defer_if_permit still greylisted';
+	} else {
+		my $now = time;
+		$upd->bind_param(1, $key);
+		$upd->bind_param(2, $now + $delay);
+		$clean->bind_param(1, $now - 86400 * 31);
+
+		$clean->execute;
+		$upd->execute;
+
+		$dbh->commit;
+		xflock $lockfh, LOCK_UN;
+
+		syslog 'info', "greylisted $key";
+		'defer_if_permit Greylisted';
+	}
+}
+
+openlog 'greylist', 'pid', 'mail';
+$| = 1;
+#open $dbg, '>>', "/tmp/dbg.$<.greylist"; # uncomment to debug
+my $pid = $$;
+if ($dbg) {
+	$dbg->autoflush;
+	open STDERR, '>&', $dbg;
+	print $dbg "$pid | $_\n" for (sort keys %GREY_ADDR);
+	print $dbg "$pid + $_\n" for (@allow_ips, @allow_clients);
+}
+open $lockfh, '>>', "$db_file.grey-flock";
+$dbh = DBI->connect("dbi:SQLite:dbname=$db_file", '', '', {
+	AutoCommit => 1,
+	RaiseError => 1,
+	PrintError => 0,
+	sqlite_use_immediate_transaction => 1,
+	sqlite_see_if_its_a_number => 1,
+}) or die "failed to open $db_file: $!";
+$dbh->do('PRAGMA journal_mode = WAL');
+$dbh->sqlite_busy_timeout(60_000); # slow disk :<
+xflock $lockfh, LOCK_EX;
+$dbh->do(<<'EOS');
+CREATE TABLE IF NOT EXISTS greystate (
+	key TEXT PRIMARY KEY NOT NULL,
+	expires INTEGER NOT NULL,
+	UNIQUE (key)
+)
+EOS
+xflock $lockfh, LOCK_UN;
+my ($k, $v, $attr, $action);
+
+while (<STDIN>) {
+	if (/([^=]+)=(.*)\n/) {
+		$k = substr($1, 0, 512);
+		$v = substr($2, 0, 512);
+		$attr->{$k} = $v;
+		print $dbg "$pid < $k=$v\n" if $dbg;
+	} elsif ($_ eq "\n") {
+		$action = smtpd_access_policy $attr;
+		print $dbg "$pid > $action\n" if $dbg;
+		print 'action='.$action."\n\n";
+		%$attr = ();
+	} else {
+		%$attr = ();
+		chop;
+		syslog 'error', 'unhandled garbage: %.100s', $_;
+	}
+}