view release on metacpan or  search on metacpan

lib/Net/SMTP/Verify.pm  view on Meta::CPAN

package Net::SMTP::Verify;

use Moose;

our $VERSION = '1.04'; # VERSION
# ABSTRACT: verify SMTP recipient addresses

use Net::SMTP::Verify::ResultSet;

use Net::DNS::Resolver;
use Net::SMTP;
use Net::Cmd qw( CMD_OK );
use Sys::Hostname;
use Digest::SHA qw(sha224_hex);


has 'host' => ( is => 'rw', isa => 'Maybe[Str]' );
has 'port' => ( is => 'rw', isa => 'Int', default => 25 );

has 'helo_name' => (
  is => 'rw', isa => 'Str', lazy => 1,
  default => sub { Sys::Hostname::hostname },
);
has 'timeout' => ( is => 'rw', isa => 'Int', default => 30 );

has 'resolver' => (
  is => 'rw', isa => 'Net::DNS::Resolver', lazy => 1,
  default => sub {
    Net::DNS::Resolver->new(
      dnssec => 1,
      adflag => 1,
    );
  },
);

has 'tlsa' => ( is => 'rw', isa => 'Bool', default => 0 );
has 'openpgpkey' => ( is => 'rw', isa => 'Bool', default => 0 );

has 'logging_callback' => (
  is => 'rw', isa => 'CodeRef', lazy => 1,
  traits => [ 'Code' ],
  handles => {
    log => 'execute',
  },
  default => sub { sub {} },
);

has 'debug' => ( is => 'ro', isa => 'Bool', default => 0 );

sub BUILD {
  my $self = shift;
  if( $self->debug ) {
    $self->logging_callback( sub {
      print STDERR shift."\n";
    } );
  }
}

has '_known_hosts' => (
  is => 'ro', isa => 'ArrayRef', lazy => 1,
  default => sub { [] },
  traits => [ 'Array' ],
  handles => {
    '_reset_known_hosts' => 'clear',
    '_add_known_host' => 'push',
  }
);

sub _is_known_host {
  my ( $self, $host ) = @_;
  if( grep { $_ eq $host } @{$self->_known_hosts} ) {
    return 1;
  }
  return 0;
}


sub resolve {
  my ( $self, $domain ) = @_;

  if( defined $self->host ) {
    return $self->host;
  } else {
    $self->log('looking up MX for '.$domain.'...');
    my $reply = $self->resolver->query( $domain, 'MX' );
    if( $reply->answer ) {
      my @mx = grep { $_->type eq 'MX' } $reply->answer;
      @mx = sort { $a->preference <=> $b->preference } @mx;
      my @known_hosts = grep { $self->_is_known_host($_->exchange) } @mx;

      my $ex;
      if( @known_hosts ) {
        $ex = $known_hosts[0]->exchange;
      } else {
        $ex = $mx[0]->exchange;
        $self->_add_known_host( $ex );
      }
      $self->log('found '.scalar(@mx).' records. using: '.$ex.
        ( @known_hosts ? ' (reuse)' : '') );
      return $ex;
    }
    $self->log('looking up AAAA,A for '.$domain.'...');
    $reply = $self->resolver->query( $domain, 'AAAA', 'A' );
    if( my @rr = $reply->answer ) {
      $self->log('found '.scalar(@rr).' address records');
      return $domain;
    }
    $self->log('unable to resolve domain '.$domain);
    return; # lookup failed
  }

  die('unknown mode: '.$self->mode);
  return;
}


sub check_tlsa {
  my ( $self, $host, $port ) = @_;
  if( ! defined $port ) {
    $port = 25;