#!/usr/bin/perl -w

use strict;
use Net::DNS; #Put in filter_initialize

#Tests correct DNS
print &check_primary_mx('kevin.mcgrail@mcgrail.com');
print "\n";
#Tests non-rfc compliant DNS using cname for MX
print &check_primary_mx('test@tri-llama.com');
print "\n";

print &check_primary_mx('zqy152214@liyuanculture.com');
print "\n";
print &check_primary_mx('formation2005@carmail.com');
print "\n";
print &check_primary_mx('chaifai@flashmail.net');
print "\n";

sub check_primary_mx {
  #Based on Idea from Les Miksell
  #KAM 9-12-05 
  #takes the sender, extracts the domain name and performs an MX Lookup on it.
  #if the primary MX exchange eq's 127.0.0.1, then fail.
  #
  #Still returns true on an error because we assume you are testing resolution with sendmail and
  #some stupid things like bob@donotreply.bigcorporation.com 

  my ($sender) = @_;
  my ($res, $packet, @answer, $SenderDomain, @answer2, @answer3);

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

  if (defined ($res)) {
    $res->tcp_timeout(4);              #Number of Seconds before query will fail
    $res->udp_timeout(4);              #Number of Seconds before query will fail

    #Strip domain name from an email address
    $SenderDomain = $sender;
    $SenderDomain =~ s/(^<|>$)//g;
    $SenderDomain =~ s/.*\@//g;

    #Perform the DNS Query
    $packet = $res->query($SenderDomain,'MX');

    #print "\nDEBUG: $SenderDomain\n";

    #Parse the Query
    if (defined ($packet)) {
      if (defined ($packet->answer)) {
        @answer = $packet->answer;

        #Sort to put answers into ascending order by preference 
        @answer = sort {$a->preference <=> $b->preference} @answer;

        #print "DEBUG: Answer 1 - ".$answer[0]->type." - ".$answer[0]->exchange."\n";
        if ($answer[0]->type eq "MX") {
          #localhost isn't a valid MX so return false
          if ($answer[0]->exchange eq 'localhost') {
            return (0);
          } else {
            #resolve the first (lowest priority) exchange record
            $packet = $res->query($answer[0]->exchange); 
            if (defined ($packet)) {
              if (defined ($packet->answer)) {
                @answer2 = $packet->answer;
                #print "DEBUG: Answer 2 - ".$answer2[0]->type."\n"; 
                if ($answer2[0]->type eq "A") {
                  #print "DEBUG: Answer 2 - address is ".$answer2[0]->address."\n";
                  if (&invalid_mx($answer2[0]->address)) {
                    return (0);
                  } 
                } elsif ($answer2[0]->type eq "CNAME") {
                  $packet = $res->query($answer2[0]->cname,);
                  if (defined ($packet)) {
                    if (defined ($packet->answer)) {
                      @answer3 = $packet->answer; 
                      #print "DEBUG: Answer 3 - ".$answer3[0]->type." - ".$answer3[0]->address."\n";
                      if ($answer3[0]->type eq "A") {
                        if (&invalid_mx($answer3[0]->address)) {
                          return (0);
                        }
                      } else {
                        #CNAMEs aren't RFC valid for MX's so if they chained two together, I'm not recursively resolving, I'm just failing it
                        return 0
                      }
                    }
                  }
                }
              }
            }
          }
        }
      }
    }
  }

  return (1);
}

sub invalid_mx {
  my ($ip) = @_;
  my ($flag_intranets);

  #0/8, 255/8, 127/8 aren't a valid MX so return false - added per Matthew van Eerde recomendation
  if ($ip =~ /^(255|127|0)\./) {
    return 1;
  }

  #Intranets only - KAM doesn't recommend bouncing because of this, DFS does... change flag_intranets to 1 to use. added per Matthew van Eerde recomendation
  $flag_intranets = 0;

  #10/8 
  if ($flag_intranets && $ip =~ /^10\./) {
    return 1;
  }
  #172.16/12 - Fixed per Matthen van Eerde
  if ($flag_intranets && $ip =~ /^172\.(16|17|18|19|20|21|22|23|24|25|26|27|28|29|30|31)\./) {
    return 1;
  }
  #192.168/16
  if ($flag_intranets && $ip =~ /^192\.168\./) {
    return 1;
  }

  #DHCP auto-discover added per Matthew van Eerde recomendation 169.254/16
  if ($ip =~ /^169\.254\./) {
    return 1;
  }

  #Multicast 224/8 through 239/8 added per Matthew van Eerde recomendation
  if ($ip =~ /^(224|225|226|227|228|229|230|231|232|233|234|235|236|237|238|239)\./) {
    return 1;
  } 
  
  return 0;
}