File Coverage

blib/lib/Mail/MXplus.pm

Criterion	Covered	Total	%
statement	39	49	79.5
branch	8	18	44.4
condition			n/a
subroutine	5	5	100.0
pod	0	1	0.0
total	52	73	71.2

package Mail::MXplus;

use 5.008;
use strict;
use warnings;

#
# since there's only one thing to export, I export 'everything'
#
require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
	mxplus
) ] );

#our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	mxplus
);




our $VERSION = '0.02';


# the code goes here

use Net::DNS;

sub mxplus {
    my ($domain, $ip) = @_;

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

    my @list;
    my @answer;
    my $rr;
    my $type;
    my $testip;

    # Perform a lookup, without the searchlist
    my $packet = $res->query($domain, 'MX');
    # (returns undef if no MX records)

    if (defined($packet)) {
	@list = ();
	@answer = $packet->answer;
	foreach $rr (@answer) {
	    $type = $rr->type;
	    if ($type eq 'MX') {
		push (@list, $rr->exchange);
	    }
	}
    } else {
	@list = ($domain);
    }

    #truncate the IP to a dotted triplet for easier compare
    $testip = $ip;
    $testip =~ s/\.[0-9]+$/./;

    foreach (@list) {
	#lookup the A record.
	$packet = $res->query($_, 'A');
	if (defined($packet)) {
	    @answer = $packet->answer;
	    foreach $rr (@answer) {
		$type = $rr->type;
		if ($type eq 'A') {
		    #compare it to the IP.
		    if ($rr->address =~ /^$testip/) {
			return "pass";
		    }
		}
	    }
	}
    }

    #if none of those were it, then check the rDNS
    if ($ip =~ /([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/) {
	my $rdns = "$4.$3.$2.$1.in-addr.arpa";
	$packet = $res->query($rdns, 'PTR');
	if (defined($packet)) {
	    @answer = $packet->answer;
	    foreach $rr (@answer) {
		$type = $rr->type;
		if ($type eq 'PTR') {
		    if ($rr->ptrdname =~ /$domain$/) {
			return "pass";
		    }
		}
	    }
	}
    }
    return "fail";
}

1;
__END__