#!/usr/bin/perl -w
use strict;
my $greydir="/var/qmail/greylist";

sub dogrey($) {
	my $ip=$_[0];
	my @stat=stat("$greydir/$ip");
	if(@stat) {
# Allow the email if the IP was greylisted over an hour ago:
		return if($stat[9]<time()-3600);
		open(LOG,">>","/tmp/greylist.log");
		print LOG "$ip greylisted since $stat[9]\n";
		close(LOG);
	} else {
# Allow the email if we can't create the greylist entry:
		return unless(open(GREY,">","$greydir/$ip"));
		close(GREY);
		open(LOG,">>","/tmp/greylist.log");
		print LOG "$ip greylisted at ".time()."\n";
		close(LOG);
	}
	print "421 Please try again later\r\n";
	exit(0);
}

sub forbid($) {
	my $reason=$_[0];
	$|=1;
	alarm(30);
	print "554 $reason\r\n";
	my $line;
	while(defined($line=<STDIN>)) {
		if($line =~ /^\s*quit/i) {
			print "221 closing connection\r\n";
			last;
		} else {
			print "503 bad sequence of commands; just send QUIT\r\n";
		}
	}
	exit(0);
}

while(@ARGV) {
	if($ARGV[0] =~ /^-rbl=(.+)/) {
		shift @ARGV;
		my $domain=$1;
		die "RBL check specified but no TCPREMOTEIP environment variable set\n" unless($ENV{TCPREMOTEIP});
		die "invalid TCPREMOTEIP\n" unless($ENV{TCPREMOTEIP} =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);
		my $revip="$4.$3.$2.$1";
		my $addr=gethostbyname("$revip.$domain");
		if(defined $addr) {
			$addr=join('.',unpack("C".length($addr),$addr));
			if($addr =~ /^127\.0\.0\.(?:[2-9]|1\d)\d*$/s) {
				forbid("Forbidden due to $addr entry on $domain");
			}
		}
	} elsif($ARGV[0] =~ /^-greyrbl=(.+)/) {
		shift @ARGV;
		my $domain=$1;
		die "GreyRBL check specified but no TCPREMOTEIP environment variable set\n" unless($ENV{TCPREMOTEIP});
		die "invalid TCPREMOTEIP\n" unless($ENV{TCPREMOTEIP} =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);
		my $revip="$4.$3.$2.$1";
		my $addr=gethostbyname("$revip.$domain");
		if(defined $addr) {
			$addr=join('.',unpack("C".length($addr),$addr));
			if($addr =~ /^127\.0\.0\.(?:[2-9]|1\d)\d*$/s) {
				dogrey($ENV{TCPREMOTEIP});
				open(LOG,">>","/tmp/greylist.log");
				print LOG "$ENV{TCPREMOTEIP} passed\n";
				close(LOG);
			}
		}
	} elsif($ARGV[0] =~ /^-relayonly$/) {
		shift @ARGV;
		forbid("You must be a relay client to use this SMTP service") unless(exists $ENV{RELAYCLIENT});
	} elsif($ARGV[0] =~ /^-white=(\d+\.\d+\.\d+\.\d+)$/) {
		shift @ARGV;
		if($1 eq $ENV{TCPREMOTEIP}) {
			shift @ARGV while(@ARGV and "-" eq substr($ARGV[0],0,1));
		}
	} elsif($ARGV[0] =~ /^-host=(.+)/) {
		shift @ARGV;
		my $host=$1;
		die "Hostname check specified but no TCPREMOTEHOST environment variable set\n" unless($ENV{TCPREMOTEHOST});
		forbid("Forbidden due to name=$host") if($host eq $ENV{TCPREMOTEHOST});
	} elsif($ARGV[0] =~ /^-dir=(\/.*)/) {
		shift @ARGV;
		my $dir=$1;
		die "dir check specified but directory doesn't exist\n" unless(-d $dir);
		die "dir check specified but no TCPREMOTEIP environment variable set\n" unless($ENV{TCPREMOTEIP});
		die "invalid TCPREMOTEIP\n" unless($ENV{TCPREMOTEIP} =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/);
		forbid("Forbidden due to directory check") if(-f "$dir/$ENV{TCPREMOTEIP}");
	} else {
		last;
	}
}
forbid("You are not authorized to use this SMTP server") unless(@ARGV);
exec @ARGV;
die "exec: $!";