#!/usr/bin/perl -wT

use strict;
use Mail::Audit;
use Net::DNS;
use Net::IPv4Addr qw( ipv4_chkip ipv4_in_network );

# Don't consider private networks, personal networks. reserved networks,
# multicast networks, etc.
# Check http://www.iana.org/assignments/ipv4-address-space periodically
# for changes in network assignments
# I assume IANA is authoritative but it's quite possible that other
# registries have reserved blocks within their own allocation.
my @excluded_nets = ('10.0.0.0/8','172.16.0.0/12','192.168.0.0/16',
                     '127.0.0.1/8','0.0.0.0/7','2.0.0.0/8','5.0.0.0/8',
		     '7.0.0.0/8','23.0.0.0/8','27.0.0.0/8','31.0.0.0/8',
		     '36.0.0.0/7','39.0.0.0/8','41.0.0.0/8','42.0.0.0/8',
		     '58.0.0.0/7','70.0.0.0/7','72.0.0.0/5','83.0.0.0/8',
		     '84.0.0.0/6','88.0.0.0/5','96.0.0.0/3','173.0.0.0/8',
		     '174.0.0.0/7','176.0.0.0/5','184.0.0.0/6',
		     '189.0.0.0/8','190.0.0.0/8','197.0.0.0/8',
		     '223.0.0.0/8','224.0.0.0/3' );

# Allow reading from file instead of stdin, shouldn't this be automatic???
if ($ARGV[0]) {
    -f $ARGV[0] || die "File $ARGV[0] doesn't exist.\n";
    close(STDIN);
    open(STDIN,$ARGV[0]);
}
my $mail = Mail::Audit->new;

my @received = [];
unless (@received = $mail->get('Received')) {
    die "Not an email message";
}

my $num_received = @received;
my $sender_ip = '';
while ($num_received > 0) {
    if ($sender_ip = ipv4_chkip($received[$num_received-1])) {
	my $ignore = 0;
	foreach (@excluded_nets) {
	    if (ipv4_in_network($_,"${sender_ip}/32")) {
		$ignore = 1;
	    }
	}
        $num_received = 0 if (! $ignore);
    }
    $num_received--;
}
die "Could not find a sending IP!\n" if ! $sender_ip;

my $ptr = '';
my $resolver = Net::DNS::Resolver->new;
{
    my $query = $resolver->query($sender_ip);
    if ($query) {
        foreach ($query->answer) {
            next unless $_->type eq "PTR";
	    $ptr = $_->ptrdname;
	}
    }
}

my $sender_domain = '';
if ($ptr) {
    my $tmp_domain = $ptr;
    while ($tmp_domain =~ /\./) {
        my @mx = mx($resolver, $tmp_domain);
        if (@mx) {
	    $sender_domain = $tmp_domain;
	    $tmp_domain = '';
        } else {
            my @parts = split(/\./, $tmp_domain);
            shift @parts;
            $tmp_domain = join('.', @parts);
	}
    }
    if ($sender_domain) {
        print "$sender_domain\n" if $sender_domain;
    } else {
        exit 1;
    }
} else {
    exit 1;
}