#!/usr/bin/perl -w
#
# grey3.pl
# John Simpson <jms1@jms1.net>
#
# does greylisting (with white and black listing) based on sender, recipient,
# and client IP address. designed to be called using the RCPTCHECK mechanism
# added to my combined qmail patch in version 7.07.
#
# combined patch:
#		http://qmail.jms1.net/patches/combined-details.shtml#7.07
#
# original RCPTCHECK patch info:
#		http://www.soffian.org/downloads/qmail/qmail-smtpd-doc.html
#
###############################################################################
#
# Copyright (C) 2008 John Simpson.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License, version 3, as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
#
###############################################################################

require 5.003 ;
use strict ;

use DBI ;

###############################################################################
#
# configuration and globals

my $time_to_valid = 119 ;

my $sql_server = "dbi:Pg(PrintError=>0):dbname=grey3" ;
my $sql_userid = "" ;
my $sql_passwd = "" ;

my ( $dbh ) ;

###############################################################################

sub sql_connect()
{
	$dbh ||= DBI->connect ( $sql_server , $sql_userid , $sql_passwd )
		or bad ( 120 , "unable to connect to SQL server: "
			. $DBI::errstr ) ;
}

sub sql_disconnect()
{
	return unless $dbh ;
	$dbh->disconnect() ;
	undef $dbh ;
}

END { sql_disconnect() } ;

sub sql_select($)
{
	my $query = shift ;

	sql_connect() ;

	my $sth = $dbh->prepare ( $query )
		or bad ( 120 , "prepare($query) failed: " . $DBI::errstr ) ;
	$sth->execute()
		or bad ( 120 , "execute($query) failed: " . $DBI::errstr ) ;

	my @rv = () ;
	while ( my @data = $sth->fetchrow_array() )
	{
		push ( @rv , @data ) ;
	}

	$sth->finish() ;

	return @rv ;
}

sub sql_do($)
{
	my $query = shift ;

	sql_connect() ;

	$dbh->do ( $query )
		or bad ( 120 , "do($query) failed: " . $DBI::errstr ) ;
}

sub sql_quote($)
{
	sql_connect() ;
	return $dbh->quote ( $_[0] ) ;
}

###############################################################################

sub logit($)
{
	my $msg = shift ;
	print "grey3: $msg\n" ;
}

sub bad($$)
{
	logit $_[1] ;
	exit $_[0] ;
}

sub log_msg($$$$)
{
	logit ( join ( " " , @_ ) ) ;

	my $qd = sql_quote ( $_[0] ) ;
	my $qs = sql_quote ( $_[1] ) ;
	my $qr = sql_quote ( $_[2] ) ;
	my $qi = sql_quote ( $_[3] ) ;

	sql_do <<EOF ;
INSERT INTO log ( disp , sender , recipient , ip )
VALUES ( $qd , $qs , $qr , $qi )
EOF
}

###############################################################################

sub errmsg($)
{
	# my modified RCPTCHECK code sets this envar
	# if present, a custom error message can be sent back to qmail-smtpd
	unless ( exists $ENV{"USE_FD4"} )
	{
		logit "USE_FD4 is not set, would have sent \"$_[0]\"" ;
		return ;
	}

	open ( M , ">&4" )
		or bad ( 120 , "Can't dup fd 4: $!" ) ;
	print M $_[0] ;
	close M ;
}

###############################################################################

sub refuse_with_msg($)
{
	errmsg ( $_[0] ) ;
	exit 100 ;
}

sub delay_with_msg($)
{
	errmsg ( $_[0] ) ;
	exit 111 ;
}

###############################################################################
###############################################################################
###############################################################################

my $sender    = lc ( $ENV{"SENDER"}      || "" ) ;
my $recipient = lc ( $ENV{"RECIPIENT"}   || bad ( 120, "RECIPIENT not set"   ) ) ;
my $ip        =    ( $ENV{"TCPREMOTEIP"} || bad ( 120, "TCPREMOTEIP not set" ) ) ;

########################################
# no sender, it's a bounce

unless ( $sender )
{
	log_msg ( "RCV-BOUNCE" , "<>" , $recipient , $ip ) ;
	exit 0 ;
}

########################################
# build the query

my $qsender    = sql_quote ( $sender    ) ;
my $qrecipient = sql_quote ( $recipient ) ;
my $qip        = sql_quote ( $ip        ) ;

my $query = <<EOF ;
SELECT black , white , EXTRACT ( EPOCH FROM first ) FROM greylist
WHERE $qsender LIKE sender
AND $qrecipient LIKE recipient
AND ip <<= $qip
ORDER BY seq , id
EOF

########################################
# run the query

my ( $black , $white , $first ) = sql_select ( $query ) ;

########################################
# did we find anything?
# if not, add an entry for it.

unless ( defined $first )
{
	log_msg ( "FIRST" , $sender , $recipient , $ip ) ;

	$query = <<EOF ;
INSERT INTO greylist ( sender , recipient , ip , last )
VALUES ( $qsender , $qrecipient , $qip , CURRENT_TIMESTAMP )
EOF
	sql_do ( $query ) ;

	delay_with_msg ( "450 greylisted, wait" ) ;
}

########################################
# see if it's whitelisted or blacklisted.

if ( $white )
{
	log_msg ( "WHITE" , $sender , $recipient , $ip ) ;

	sql_do <<EOF ;
UPDATE greylist SET count_msg = count_msg + 1 , last = CURRENT_TIMESTAMP
WHERE sender = $qsender AND recipient = $qrecipient AND ip = $qip
EOF

	exit 0 ;
}

if ( $black )
{
	log_msg ( "BLACK" , $sender , $recipient , $ip ) ;

	sql_do <<EOF ;
UPDATE greylist SET count_msg = count_msg + 1 , last = CURRENT_TIMESTAMP
WHERE sender = $qsender AND recipient = $qrecipient AND ip = $qip
EOF

	refuse_with_msg ( "550 $recipient is refusing mail from $sender" ) ;
}

########################################
# see if it's been long enough to accept the message.

my $when_ok = $first + $time_to_valid ;
if ( time() < $when_ok )
{
	log_msg ( "GREY2" , $sender , $recipient , $ip ) ;

	sql_do <<EOF ;
UPDATE greylist SET count_pre = count_pre + 1 , last = CURRENT_TIMESTAMP
WHERE sender = $qsender AND recipient = $qrecipient AND ip = $qip
EOF

	delay_with_msg ( "450 still greylisted, keep waiting" ) ;
}

########################################
# good to go

log_msg ( "OK" , $sender , $recipient , $ip ) ;

sql_do <<EOF ;
UPDATE greylist SET count_msg = count_msg + 1 , last = CURRENT_TIMESTAMP
WHERE sender = $qsender AND recipient = $qrecipient AND ip = $qip
EOF

exit 0 ;