File Coverage

blib/lib/Email/Verify/SMTP.pm

Criterion	Covered	Total	%
statement	18	68	26.4
branch	0	32	0.0
condition	0	9	0.0
subroutine	6	9	66.6
pod	1	1	100.0
total	25	119	21.0

package Email::Verify::SMTP;

use strict;
use warnings 'all';
use base 'Exporter';
use Net::Nslookup;
use IO::Socket::Telnet;
use Carp 'confess';

our @EXPORT  = ('verify_email');
our $VERSION = '0.003';
our $FROM    = 'root@localhost';
our $DEBUG   = 0;

sub verify_email
{
  my $email = shift or return;
  $email = lc($email);

  my $error;

  my (undef, $domain) = split /@/, $email;
  unless( $domain )
  {
    return _result(
      undef, "Invalid email address"
    );
  }# end unless()


  my $err = undef;
  my $host = $domain;
  local $SIG{ALRM} = sub {
    $err = "Timeout on host '$host'";
    die "Timeout on host '$host'";
  };

  alarm(4);
  my ($mx) = eval {
    my ($mx) = nslookup(domain => $domain, type => "MX")
      or do { $err = "No mx records found for '$domain'"; die };
    $mx;
  } or return _result(undef, "No mx records found for '$domain'");
  $host = $mx;
  alarm(0);
  return _result( undef, $err || $@ ) if $err || $@;

  my $t = IO::Socket::Telnet->new(
    PeerAddr => $mx,
    PeerPort => 25,
  ) or return _result(undef, "Cannot open socket to '$mx'");

  alarm(8);
  my $res = eval {
    $t->send("helo $domain\n");
    $t->recv(my $res, 4096) or do{ $err = "Socket error on HELO"; die };
    warn $res if $DEBUG;

    $t->send(qq(mail from: <$FROM>\n));
    $t->recv($res, 4096) or do{ $err = "Socket error on MAIL FROM"; die };
    warn $res if $DEBUG;

    $t->send(qq(rcpt to: <$email>\n));
    $t->recv($res, 4096) or do{ $err = "Socket error on RCPT TO"; die };
    warn $res if $DEBUG;

    $res;
  };
  alarm(0);

  $t->close;
  return _result( undef, $err || $@ ) if $@;

  my $is_valid = $res =~ m/^250\b/;
  return _result( $is_valid, $is_valid ? "" : $res );
}# end verify()


sub _result
{
  my ($valid, $msg) = @_;

  if( wantarray )
  {
    chomp($msg);
    return (
      $valid, $msg
    );
  }
  else
  {
    return unless defined $valid;
    return $valid;
  }# end if()
}# end _result()

1;# return true:

=pod

=head1 NAME

Email::Verify::SMTP - Verify an email address by using SMTP.

=head1 SYNOPSIS

  use Email::Verify::SMTP;

  # This is important:
  $Email::Verify::SMTP::FROM = '[e-mail]';

  # Just a true/false:
  if( verify_email('[e-mail]') ) {
    # Email is valid
  }

  # Find out if, and why not (if not):
  my ($is_valid, $msg) = verify_email('[e-mail]');
  if( $is_valid ) {
    # Email is valid:
  }
  else {
    # Email is *not* valid:
    warn "Email is bad: $msg";
  }

=head1 DESCRIPTION

C is what I came with when I needed to verify several email
addresses without actually sending them email.

To put that another way:

=over 4

B

=back

=head1 EXPORTED FUNCTIONS

=head2 verify_email( $email )

Verifies the supplied email address.

If called in scalar context, eg:

  my $is_valid = verify_email( $email )

then you get a true or false value.

If called in list context, eg:

  my ($is_valid, $why_not) = verify_email( $email )

then you get both a true/false value and any error message that came up.

=head1 PUBLIC STATIC VARIABLES

=head2 $Email::Verify::SMTP::FROM

Default value:

This is used as the "from" field on the email that is not actually sent.  It
should be a valid email address on a real domain - just like if you were sending
a normal email.

=head2 $Email::Verify::SMTP::DEBUG

Default value: C<0>

If set to a true value, extra diagnostics will be output to STDERR via C.

=head1 DEPENDENCIES

This module depends on the following:

=over 4

=item L

To discover the mail exchange servers for the email address provided.

=item L

A nice socket interface to use, even if you're not using Telnet.

=back

=head1 AUTHOR

John Drago

=head1 LICENSE

This software is B software and may be used, copied and redistributed under
the same terms as perl itself.

=cut