Retorna apenas emails válidos com MX válidos [Perl]

Retorna apenas emails válidos com MX válidos

Publicado por Romulo 16/09/2003

[ Hits: 6.336 ]

Download check_mail.pl

0 0

Denuncie Favoritos Indicar

Recebe um arquivo contendo uma lista de e-mails separados por quebra de linha e retorna somente os endereços válidos. Além de verificar a sintaxe do e-mail também verifica se existe um servidor de e-mail válido para o domínio.

Esconder código-fonte

#!/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);
         }
      }
   }
}

Scripts recomendados

Email UserAdmin

Remover caixas postais do Cyrus IMAP

Validando lista de e-mail no MX

newsletter.pl

Envia e-mail com anexo

Comentários

Nenhum comentário foi encontrado.