#!/usr/bin/perl
#
# # check_email.pl
# # Recebe um arquivo contendo uma lista de e-mails separados por
# # quebra de linha e um servidor de DNS e retorna somente endereços válidos com MX válidos.
# # Date == begin == 16/09/03
# # Produced by  -->
# #
# #      .....
# #   ,,$$$$$$$$$,    Alberto Pereira  
# #  ;$'      '$$$$:  Analista de suporte
# #  $:         $$$$:  
# #   $       o_)$$$: -"E ai linux, o que faremos hoje a noite??" 
# #   ;$,    _/\ &&:' -"O que fazemos todas as noites link, 
# #     '     /( &&&    tentaremos dominar o mundo"
# #         \_&&&&'    
# #        &&&&.      -DEBIAN, THE CHOICE OF NEW GNU LINUX GENERATION!!!! 
# #  &&&&&&&:          
# #
# # No Debian Woody necessários instalar os seguintes pacotes:
# # apt-get install libemail-valid-perl libnet-dns-perl 
#
use strict;
use Net::DNS;
use Mail::Address;

my $file = shift or die "Use: $0 arquivo servidor\n";
my $nameserver = shift or die "Use: $0 arquivo servidor\n";

if (! -f $file) {
   print "Erro: $file năo é um arquivo válido!\n";
}


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

$res->nameservers($nameserver);

open(READ, $file);

while(<READ>) {
   chomp;
   my @addrs = Mail::Address->parse($_);
   foreach my $addr (@addrs) {
      my $no = 0;
      my $user = $addr->user;
      my $domain = $addr->host;
      if ($user =~ m/[a-zA-Z0-9_\.\-]/g) {
         if ($user =~ m/\//g) { $no = 1;}
         if ($domain =~ m/[a-zA-Z0-9\.\-]/g) {
            if ($domain =~ m/\//g) { $no = 1; }
            if ($domain =~ m/\.$/g) { $no = 1; }
            if ($domain =~ m/^\./g) { $no = 1; }
            if ($domain =~ m/\'/g) { $no = 1; }
             my @mx = mx($res, $domain);
             if (!@mx) { $no = 1;} 
             print $addr->format,"\n" if (!$no);
         }
      }
   }
}
