From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <e@80x24.org>
X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on dcvr.yhbt.net
X-Spam-Level: 
X-Spam-ASN:  
X-Spam-Status: No, score=-2.9 required=3.0 tests=ALL_TRUSTED,AWL,BAYES_00,
	DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,LOTS_OF_MONEY,
	MONEY_NOHTML shortcircuit=no autolearn=no autolearn_force=no
	version=3.4.6
Received: from localhost (dcvr.yhbt.net [127.0.0.1])
	by dcvr.yhbt.net (Postfix) with ESMTP id 3C5651F568;
	Sun, 12 May 2024 22:42:51 +0000 (UTC)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=80x24.org;
	s=selector1; t=1715553771;
	bh=kPbCxY9ZljTY6pF9UdAW+Q5YEuUVGZmxJi8hmAN9tP0=;
	h=Date:From:To:Subject:From;
	b=c4vF6Z6oeP20/Xh7ZMs00OYIuZJdC3hOSCD3Mv1t93lqvxPJIJY9AUkeYuVg3pmBY
	 MPLC8MmPVMTiEbuimipLAx6ZuYSYfjLGokKh+ONlcNjZYStp5Pis6BNbq/2x64Ss7g
	 i2AE8X5B8wdue11QRW4l+WC8g5b0ZzjQhUd4oDeQ=
Date: Sun, 12 May 2024 22:42:51 +0000
From: Eric Wong <e@80x24.org>
To: test@public-inbox.org
Subject: greylist example
Message-ID: <20240512224251.M136833@dcvr>
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Disposition: inline
List-Id: <test.public-inbox.org>

#!/usr/bin/perl -w
use v5.12;
use autodie qw(open);
use DBI;
use Fcntl qw(LOCK_EX LOCK_UN);
use IO::Handle ();
use Sys::Syslog qw(:DEFAULT);

# sample Postfix greylister using SQLite
#
# in /etc/postfix/master.cf:
#
#    policy  unix  -       n       n       -       -       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
#	...

# 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 $pi_config = '/home/pi/.public-inbox/config';
if (-r $pi_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;
}

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 < ?

	my $key = $attr->{client_address};
	$key =~ s/\.[0-9]+\z// or $key =~ s/:[0-9a-f]+\z//i;
	$key .= '|'.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";
my $pid = $$;
if ($dbg) {
	$dbg->autoflush;
	open STDERR, '>&', $dbg;
	print $dbg "$pid | $_\n" for (sort keys %GREY_ADDR);
}
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 {
		chop;
		syslog 'error', 'unhandled garbage: %.100s', $_;
	}
}