#!/usr/bin/perl

use Sendmail::Milter;
use Net::DNS;
use Net::CIDR;
use Socket;

my $res   = Net::DNS::Resolver->new;

my %my_milter_callbacks = (
'connect' => \&connect_callback,
'helo' => \&helo_callback,
'envfrom' => \&envfrom_callback,
'abort' => \&close_callback,
'close' => \&close_callback,
);

my $res = Net::DNS::Resolver->new;
my $DEBUG=0;

sub CheckDRIP
{
	my ($ip,$host) = @_;
	$ip =~ s/\./_/g;

	my @addrs = ();

	my $known=0;
	my $match=0;
	my $thost = $host;
	while (!$known && $#addrs == -1 && $thost =~ /\./) {
		my $driphost = "$ip.ipv4.relays._email_.$thost";
		print "checking $driphost\n"	if $DEBUG >= 2;
		my $query = $res->search($driphost);
		if ($query) {
			foreach my $rr ($query->answer) {
				next unless $rr->type eq "A";
				push @addrs,$rr->address;
			}
		}

		foreach $a (@addrs) {
			$a =~ s/\./_/g;
			print "$a\n"	if $DEBUG >= 2;

			$match = 1	if $ip eq $a && $host eq $thost;
			$known = 1;
		}

		$thost =~ s/^[^\.]+\.//;
	}

	if ($known && $match) {
		print "PASS the DRIP test\n"	if $DEBUG >= 2;
		return 0;
	}
	elsif ($known && !$match) {
		print "FAIL the drip test\n"	if $DEBUG >= 2;
		return 1;
	}
	else {
		print "no DRIP records found\n"	if $DEBUG >= 2;
		return -1;		# should this return 0 or 1?
	}
}

my @exemptions=("127.0.0.1/32");

for ($i=0 ; $i<= $#ARGV ; $i++) {
    if ($ARGV[$i] eq '-x') {
        push @exemptions,$ARGV[++$i];
    }
    elsif ($ARGV[$i] eq '--debug' || $ARGV[$i] eq '-d') {
        $DEBUG++;
    }
}

printf "DEBUG=%d\n",$DEBUG;

$| = 1;

sub connect_callback
{
	my $ctx = shift;	# Some people think of this as $self
	my $hostname = shift;
	my $sockaddr_in = shift;

# if a connection from any IP in our "exemption list" SMFIS_ACCEPT;
# no more processing...
# else save the IP

	print "my_connect: hostname($hostname)"		if $DEBUG >= 2;

	if (defined $sockaddr_in)
	{
		my ($port, $iaddr) = sockaddr_in($sockaddr_in);
		print "    port($port)"		if $DEBUG >= 2;
		my $ip = inet_ntoa($iaddr);
		print " iaddr($ip)\n"		if $DEBUG >= 2;

		return SMFIS_ACCEPT if Net::CIDR::cidrlookup($ip,@exemptions);

		$ctx->setpriv(\$ip);
	}

	return SMFIS_CONTINUE;
}

sub helo_callback
{
    my $ctx = shift;
    my $ip = $ctx->getpriv();
    my ($helohost,@args) = @_;

# lookup $helohost in the drip protocol...
# if $ip.ipv4._relays_._email_.$helohost does NOT exist...
#

    my $blah = $ctx->getsymval("_");
    my $rc = CheckDRIP(${$ip},$helohost);

    printf "helo: '%s' %d (%s)\n",$helohost,$rc,$blah  if $DEBUG;

    $ctx->setpriv(undef);

    return SMFIS_ACCEPT	if ($rc == 0);

    return SMFIS_ACCEPT if ($rc == -1);	# comment this out if you want to 
                                        # require connecting hosts to have
                                        # DRIP records defined in the future.
    return SMFIS_CONTINUE;
}


sub envfrom_callback
{
    my $ctx = shift;
    my @args = @_;

    # did the user AUTH?
    my $auth = $ctx->getsymval("auth_type");

    print "authed connection?   '$auth'\n"	if $DEBUG;

    return SMFIS_ACCEPT		if $auth ne "";

    # we failed the DRIP test, and the client did not use SMTP AUTH
    return SMFIS_REJECT;
}

sub close_callback
{
    my $ctx = shift;

    $ctx->setpriv(undef);

    return SMFIS_CONTINUE;
}


BEGIN:
{
# Get myfilter's connection information
# from /etc/mail/sendmail.cf

    Sendmail::Milter::auto_setconn("dripmilter");
    Sendmail::Milter::register("dripmilter",
            \%my_milter_callbacks, SMFI_CURR_ACTS);
    Sendmail::Milter::main();

# Never reaches here, callbacks are called from Milter.

}