Интернет технологии -> Perl -> Проверка e-mail адреса на существование

Проверка e-mail адреса на существование

Я уже много раз слышал вопрос: "Как проверить e-mail на существование?". Видел на них много ответов, но во всех было сказано, что проверить никак нельзя, предлагались только обходные пути, такие как отправка письма для подтверждения. Однако, я попытаюсь решить эту проблему.
Для проверки на существование будем делать следующее:

• Проверка на синтаксическую верность адреса
• Проверка существования почтового домена в DNS
• Проверка на доступность сервера
• Проверка существования аккаунта на сервере

Да, мой вариант решения тоже не идеален и стопроцентной гарантии не даёт, но все же даёт хороший результат!
Начнём с того, что в первой половине e-mail адреса могут присутствовать только цифры, латинские буквы, точка, тире и знак подчёркивания, прицем начианться адрес должен с буквы. В домене могут быть только цифры, латинские буквы, тире и точки. Проверить на соответствие такому формату в перле можно следующим образом:

$email = 'email@address.com';
if($email =~ /^[a-zA-Z_\.-][a-zA-Z0-9_\.-\d]*\@[a-zA-Z\.-\d]+\.[a-zA-Z]{2,4}$/)
{
 # действия, выполняемые если e-mail верный
}else{
       # действия, выполняемые если e-mail НЕверный
     }

#!/usr/bin/perl
use Net::DNS;

$email = 'email@address.com';
$dns = "212.164.166.11";        # DNS Сервер

$res = new Net::DNS::Resolver;
$res->nameservers($dns);

print "Content-type: text/html; charset=windows-1251\n\n";

$email =~ /.*\@(.*)$/;
$domain = $1;

my @mx = mx($res, $domain);
if(@mx)
{
 my $rr = shift(@mx);
 my $mxserver = $rr->exchange;
 print "Сервер для $email: $domain";
}else{
      print "Не удалось определить сервер для $email";
     }

#!/usr/bin/perl
use Net::DNS;
use IO::Socket;
use CGI::Carp qw(fatalsToBrowser);

my $email = 'my@mail.ru';
my $emailfrom = 'email@address.com';

print "Content-type: text/html; charset=windows-1251\n\n";

############################################################

if($email !~ /^[a-zA-Z_\.-][a-zA-Z0-9_\.-\d]*\@[a-zA-Z\.-\d]+\.[a-zA-Z]{2,4}$/)
{
 print "e-mail неправильного формата!<br>\n";
 exit;
}

############################################################

my $dns = "212.164.166.11";        # DNS Сервер

my $res = new Net::DNS::Resolver;
$res->nameservers($dns);

$email =~ /.*\@(.*)$/;
my $domain = $1;

my @mx = mx($res, $domain);
if (!@mx) {
print "Сервер для домена $domain не обнаружен!<br>\n";
exit;
}

my $rr = shift(@mx);
my $mxserver = $rr->exchange;

############################################################

my $handle = IO::Socket::INET->new(
Proto  => "tcp",
PeerAddr  => $mxserver,
PeerPort  => 25);

if ($handle) {
$handle->autoflush(1);
print $handle "HELO $mxserver\n";
print $handle "MAIL FROM: $emailfrom\n";
my $stype = 0;
my $regged = 0;
my $isvalid = 1;
$email =~ /^([a-z$ch2]+)\@([a-z$ch]+\.[a-z]{2,4})$/;
my ($em,$eh) = ($1,$2);
if ($stype) {
print $handle "RCPT TO: $email\n";
}
else {
print $handle "VRFY $em\n";
}
cycle:
my $rd = <$handle>;
chomp($rd);
# Hello From Server
if ($rd =~ /^220/) {goto cycle;}

# HELO Reply
elsif ($rd =~ /^250 \S+ hello/i) {goto cycle;}

# MAIL FROM Reply
elsif ($rd =~ /^250/i && !$regged) {$regged = 1;goto cycle;}

# Unknown command 'VRFY *'
# VRFY not available
elsif (($rd =~ /^252/ || $rd =~ /^550 5\.5\.2/ || $rd =~ /^502/) && !$stype)
{
 $stype = 1;print $handle "RCPT TO: $email\n"; goto cycle;
}

# 250 
 verified
# 250 
, Recipient ok
# 250 ok
# 250 2.1.5 *
# В принципе, можно, да и правильне будет просто 250 *, но при таком
# корявом написании скрипта так будет надежней
elsif($rd =~ /^250 <\S+> verified/i || 
      $rd =~ /^250 <\S+>,? recipient ok/i ||
      $rd =~ /^250 ok/i || 
      $rd =~ /^250 2\.1\.5/i) {
print "$email верный.<br>\n";
}

# 550 5.7.1  user unknown
elsif($rd =~ /^550/)
{
 print "$email неверный.<br>\n";
 $isvalid = 0;
}

if ($isvalid) {
# Отправляем почту... (как это сделать читай ниже)
}
close $handle;
if (!$isvalid) {exit;}
}
else {
print "Не удалось подулкчиться к серверу!<br>\n";
exit;
}
# Теперь делаем что угодно...

    if (!$stype) {
print $handle "RCPT TO: $email\n";
}
print $handle "DATA\n";
# Выводим заголовки
print $handle "From: <$emailfrom>\n";
print $handle "To: <$email>\n";
print $handle "Subject: Test letter\n\n";
# Печатаем текст письма
print $handle "Hello! It is test!\n";
# Одиночная точка - знак того что письмо закончилось
print $handle ".\n";

Автор: Skob
Источник: www.cwg.ru