#!/usr/bin/perl

# Copyright Lars Magne Ingebrigtsen <larsi@gnus.org>
# Published under the GNU General Public License. 

use POSIX qw(strftime);
use Net::DNS;
use Mail::Address;
use IO::Socket;

$validation_dir = "/etc/news/validate";

sub callout {
    my $address = shift;
    my $server = shift;

    vlog("Callout for $address on $server");

    my $sock = new IO::Socket::INET(PeerAddr => $server,
				    PeerPort => 'smtp(25)',
				    Proto => 'tcp',
				    Timeout => 60,
				    );
    return "Couldn't contact SMTP server on $server" if ! $sock;

    $sock->autoflush();

    $line = <$sock>;
    return "Invalid response from SMTP server $server: $line" unless $line =~ /^220/;

    print $sock "HELO sea.gmane.org\r\n";
    $line = <$sock>;
    return "Invalid response from SMTP server $server: $line" unless $line =~ /^2/;

    print $sock "MAIL FROM:<auth\@gmane.org>\r\n";
    $line = <$sock>;
    return "Invalid response from SMTP server $server: $line" unless $line =~ /^2/;

    print $sock "RCPT TO:<$address>\r\n";
    $line = <$sock>;
    return "Invalid response from SMTP server $server: $line" unless $line =~ /^[24]/;

    print $sock "QUIT\r\n";
    $line = <$sock>;
 
    vlog("Successful callout for $address on $server");

    return "";
}

sub vlog {
    my $line = shift;
    my $now = strftime("%Y%m%dT%H%M%S", localtime);
    my $host = $hdr{'NNTP-Posting-Host'};
    print VLOG "$now $host $line\n";
}

sub whitelist_group_p {
    my $group = shift;
    my $ret = 0;

    #vlog("Checking group whitelist for $group");

    open(FILE, "$validation_dir/whitelist_group.txt") || return 0;
    while (<FILE>) {
	chop;
	if ($_ eq $group) {
	    $ret = 1;
	    last;
	}
    }
    close FILE;
    if ($ret) {
	#vlog("Found in group whitelist for $group");
    } else {
	#vlog("Not found in group whitelist for $group");	
    }
    return $ret;
}

sub whitelist_groups_p {
    my $groups = shift;
    my $ret = 1;

    foreach (split(/,/, $groups)) {
	if (! whitelist_group_p($_)) {
	    $ret = 0;
	}
    }
    return $ret;
}

sub whitelist_host_p {
    my $host = shift;
    my $ret = 0;

    open(FILE, "$validation_dir/whitelist_host.txt") || return 0;
    while (<FILE>) {
	chop;
	if ($_ eq $host) {
	    $ret = 1;
	    last;
	}
    }
    close FILE;
    if ($ret) {
	#vlog("Found in host whitelist for $host");
    } else {
	#vlog("Not found in host whitelist for $host");	
    }
    return $ret;
}

sub posted_too_much_p {
    my $host = shift;
    my $now = time();
    my $cutoff = $now - 60 * 2;
    my $postings = 0;

    $host =~ s/\//_/;

    $db = "$validation_dir/post_db/$host";
    open(DB, ">>$db") || return 0;
    print DB "$now\n";
    close DB;

    open(DB, "$db") || return 0;
    while (<DB>) {
	chop;
	if ($_ > $cutoff) {
	    $postings++;
	}
    }
    close DB;

    if ($postings > 20) {
	return "You post too much; try again later";
    } else { 
	vlog("Posting rate: $postings");
    }

    return 0;
}

sub unidirectional_groups_p {
    my $groups = shift;
    my $ret = 0;

    foreach (split(/,/, $groups)) {
	$ret = unidirectional_p($_);
	if ($ret) {
	    return $ret;
	}
    }
    return 0;
}

sub unidirectional_p {
    my $group = shift;
    my $conf = $group;
    my $res;
    
    $conf =~ s/\./\//g;
    $conf = "/var/spool/news/articles/$conf/.conf";

    open (CONF, $conf) || return 0;
    my $line = <CONF>;
    close CONF;

    chop($line);
    my @spec = split(/:/, $line);
    my $description = $spec[3];
    if ($description =~ /\(read-only\)$/i) {
	return "$group is read-only";
    } elsif ($description =~ /\(unidirectional\)$/i) {
	return "$group is unidirectional";
    }
    
    foreach (@spec) {
	if (/^dead=/) {
	    (my $dummy, my $reason) = split(/=/);
	    return "$group is dead ($reason)";
	}
    }

    return 0;
}

sub get_address {
    my $from = $hdr{"From"};
    my $reply_to = $hdr{"Reply-To"};
    my $address;

    $from = $reply_to if $reply_to;

    foreach my $addr (Mail::Address->parse($from)) {
	$address = $addr->address();
    }

    return $address;
}

sub validated_address_p {
    my $address = shift;
    my $ret = 0;
    my $dummy;
    my $vaddress;

    #vlog("Checking whether $address has already been validated");

    open(FILE, "$validation_dir/validated_address.txt") || return 0;
    while (<FILE>) {
	chop;
	($dummy, $vaddress) = split;
	if ($vaddress eq $address) {
	    $ret = 1;
	    last;
	}
    }
    close FILE;
    if ($ret) {
	vlog("$address already validated");
    } else {
	vlog("$address not already validated");	
    }
    return $ret;
}

sub validate_address {
    my $address = shift;
    my $host;
    my @mtas;
    my $i;
    my $dummy;
    my $found_address = 0;

    ($dummy, $host) = split(/@/, $address);

    vlog("Validating $address");

    return "No valid host in $from" if ! $host;
    return "Invalid host name: $host" if $host !~ /\./;
    
    my $res = Net::DNS::Resolver->new;
    my $answer = $res->query($host, 'MX');
    # First add all the MXs in preference order.
    if ($answer) {
	my  @ret = sort { $a->preference <=> $b->preference } 
	grep { $_->type eq 'MX'} $answer->answer;
	foreach $rr (@ret) {
	    $mtas[$i++] = $rr->exchange;
	}
    }
    # Then add the host itself as a fallback.
    $mtas[$i++] = $host;

    # And then we start testing.
  check:
    foreach my $mta (@mtas) {
	vlog("Doing MTA $mta");
	$answer = $res->query($mta);
	if ($answer) {
	    foreach $rr ($answer->answer) {
		if ($rr->type eq "A") {
		    $found_address = 1;
		    $mta_address = $rr->address;
		    $mta_name = $mta;
		    vlog("Checking $mta_name ($mta_address)");
		    $callout = callout($address, $mta_name);
		    last check if ! $callout;
		    last check if $callout =~ /^Invalid/;
		    vlog("Callout result for $mta_address: $callout");
		}
	    }
	}
    }

    if (! $found_address) {
	$mta = $mtas[0];
	return "Found no address for $mta";
    }

    return $callout;
}

sub validate_poster {
    open(VLOG, ">>/tmp/svalidation.log");
    my $res = validate_1();
    
    if ($hdr{"NNTP-Posting-Host"} ne "main.gmane.org") {
	if ($res) {
	    vlog("Failed: $res");
	} else {
	    vlog("Success");
	}
    }

    close VLOG;
    return $res;
}

sub validate_1 {
    my $host = $hdr{"NNTP-Posting-Host"};
    my $groups = $hdr{"Newsgroups"};
    my $address = get_address();
    my $ret;

    return '' if $hdr{"Control"};

    return '' if whitelist_host_p($host);
    return '' if whitelist_groups_p($groups);

    $ret = posted_too_much_p($host);
    if ($ret) {
	vlog($ret);
	return $ret;
    }

    $ret = unidirectional_groups_p($groups);
    if ($ret) {
	vlog($ret);
	return $ret;
    }

    return '' if validated_address_p($address);
    $ret = validate_address($address);

    if (! $ret) {
	if (open(FILE, ">>$validation_dir/validated_address.txt")) {
	    my $now = strftime("%Y%m%dT%H%M%S", localtime);
	    print FILE "$now $address\n";
	    close FILE;
	}
    } else {
	$ret = "You need a valid email address to post: $ret";
    }

    return $ret;
}

1;