File Coverage

blib/lib/POE/Component/Client/DNSBL.pm

Criterion	Covered	Total	%
statement	94	114	82.4
branch	24	42	57.1
condition	4	11	36.3
subroutine	12	13	92.3
pod	4	4	100.0
total	138	184	75.0

package POE::Component::Client::DNSBL;
{
  $POE::Component::Client::DNSBL::VERSION = '1.08';
}

#ABSTRACT: A component that provides non-blocking DNSBL lookups

use strict;
use warnings;
use Net::IP::Minimal qw(ip_is_ipv4 ip_get_version);
use POE qw(Component::Client::DNS);

sub spawn {
  my $package = shift;
  my %opts = @_;
  $opts{lc $_} = delete $opts{$_} for keys %opts;
  $opts{dnsbl} = 'zen.spamhaus.org' unless $opts{dnsbl};
  my $options = delete $opts{options};
  my $self = bless \%opts, $package;
  $self->{session_id} = POE::Session->create(
	object_states => [
	   $self => { shutdown => '_shutdown', lookup => '_resolve' },
	   $self => [qw(_start _resolve _lookup _reason)],
	],
	heap => $self,
	( ref($options) eq 'HASH' ? ( options => $options ) : () ),
  )->ID();
  return $self;
}

sub session_id {
  return $_[0]->{session_id};
}

sub shutdown {
  my $self = shift;
  $poe_kernel->post( $self->{session_id}, 'shutdown' );
}

sub lookup {
  my $self = shift;
  $poe_kernel->post( $self->{session_id}, '_resolve', @_ );
}

sub _start {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  $self->{session_id} = $_[SESSION]->ID();
  if ( $self->{alias} ) {
     $kernel->alias_set( $self->{alias} );
  }
  else {
     $kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
  }
  unless ( $self->{resolver} and $self->{resolver}->isa('POE::Component::Client::DNS') ) {
     $self->{resolver} = POE::Component::Client::DNS->spawn(
	Alias => __PACKAGE__ . $self->{session_id},
     );
     $self->{_mydns} = 1;
  }
  return;
}

sub _shutdown {
  my ($kernel,$self) = @_[KERNEL,OBJECT];
  $kernel->alarm_remove_all();
  $kernel->alias_remove( $_ ) for $kernel->alias_list();
  $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ ) unless $self->{alias};
  $self->{resolver}->shutdown() if $self->{_mydns};
  delete $self->{resolver};
  return;
}

sub _resolve {
  my ($kernel,$self,$state,$sender) = @_[KERNEL,OBJECT,STATE,SENDER];
  my $sender_id = $sender->ID();
  my $args;
  if ( ref( $_[ARG0] ) eq 'HASH' ) {
    $args = { %{ $_[ARG0] } };
  }
  else {
    $args = { @_[ARG0..$#_] };
  }
  $args->{lc $_} = delete $args->{$_} for grep { !/^_/ } keys %{ $args };
  unless ( $args->{event} ) {
    warn "No 'event' specified for $state\n";
    return;
  }
  unless ( $args->{address} ) {
    warn "No 'address' specified for $state\n";
    return;
  }

  my $address = $args->{address};

  if ( ip_get_version( $args->{address} ) ) {
    unless ( ip_is_ipv4( $args->{address} ) ) {
      warn "Given 'address' is not an IPv4 address\n";
      return;
    }
    $address = reverse split /\./, $args->{address};
    $args->{dnsbl} ||= $self->{dnsbl};
  }
  else {
    $args->{dnsbl} ||= 'dbl.spamhaus.org';
  }

  if ( $args->{session} ) {
    if ( my $ref = $kernel->alias_resolve( $args->{session} ) ) {
	$sender_id = $ref->ID();
    }
    else {
	warn "Could not resolve 'session' to a valid POE session\n";
	return;
    }
  }
  $args->{dnsbl} ||= $self->{dnsbl};
  $args->{sender} = $sender_id;
  $kernel->refcount_increment( $sender_id, __PACKAGE__ )
	unless ref $args->{event} eq 'POE::Session::AnonEvent';
  my $response = $self->{resolver}->resolve(
    event => '_lookup',
    host  => join( '.', $address, $args->{dnsbl} ),
    type  => 'A',
    context => $args,
  );
  $kernel->yield( '_lookup', $response ) if $response;
  return;
}

sub _lookup {
  my ($kernel,$self,$record) = @_[KERNEL,OBJECT,ARG0];
  my $args = $record->{context};
  my $host = $record->{host};
  unless ( $record->{response} ) {
    $args->{error} = $record->{error};
    delete $args->{response};
  }
  else {
    delete $args->{error};
    my @answers = $record->{response}->answer();
    if ( @answers ) {
	foreach my $answer ( @answers ) {
	  $args->{response} = $answer->rdatastr();
	  my $response = $self->{resolver}->resolve(
		event => '_reason',
		host  => $host,
		type  => 'TXT',
		context => $args,
	  );
	  $kernel->yield( '_reason', $response ) if $response;
	}
	return;
    }
    else {
	$args->{response} = 'NXDOMAIN';
    }
  }
  my $sender_id = delete $args->{sender};
  my $event = delete $args->{event};
  if ( ref $event eq 'POE::Session::AnonEvent' ) {
    $event->( $args );
  }
  else {
    $kernel->post( $sender_id, $event, $args );
    $kernel->refcount_decrement( $sender_id, __PACKAGE__ );
  }
  return;
}

sub _reason {
  my ($kernel,$self,$record) = @_[KERNEL,OBJECT,ARG0];
  my $args = $record->{context};
  my $host = $record->{host};
  unless ( $record->{response} ) {
    $args->{error} = $record->{error};
    delete $args->{response};
  }
  else {
    delete $args->{error};
    my @answers = $record->{response}->answer();
    if ( @answers ) {
	foreach my $answer ( @answers ) {
	  $args->{reason} = $answer->rdatastr();
	}
    }
    else {
	$args->{reason} = '';
    }
  }
  my $sender_id = delete $args->{sender};
  $kernel->post( $sender_id, $args->{event}, $args );
  $kernel->refcount_decrement( $sender_id, __PACKAGE__ );
  return;
}

1;


__END__