File Coverage

blib/lib/Bot/Cobalt/Plugin/Extras/DNS.pm

Criterion	Covered	Total	%
statement	13	79	16.4
branch	0	14	0.0
condition	0	6	0.0
subroutine	5	15	33.3
pod	0	9	0.0
total	18	123	14.6

package Bot::Cobalt::Plugin::Extras::DNS;
$Bot::Cobalt::Plugin::Extras::DNS::VERSION = '0.021001';
use Bot::Cobalt;
use Bot::Cobalt::Common;

use POE;

use Net::IP::Minimal qw/ip_is_ipv4 ip_is_ipv6/;

sub new { bless [], shift }

sub Cobalt_register {
  my ($self, $core) = splice @_, 0, 2;

  POE::Session->create(
    object_states => [
      $self => [
        '_start',
        'dns_resp_recv',
        'dns_issue_query',
      ],
    ],
  );

  register( $self, 'SERVER',
    qw/
      public_cmd_dns
      public_cmd_nslookup
      public_cmd_hextoip
      public_cmd_iptohex
    /
  );

  logger->info("Loaded: dns nslookup");

  return PLUGIN_EAT_NONE
}

sub Cobalt_unregister {
  my ($self, $core) = splice @_, 0, 2;

  $poe_kernel->alias_remove( 'p_'.$core->get_plugin_alias($self) );

  logger->info("Unloaded");

  return PLUGIN_EAT_NONE
}

sub Bot_public_cmd_nslookup { Bot_public_cmd_dns(@_) }
sub Bot_public_cmd_dns {
  my ($self, $core) = splice @_, 0, 2;
  my $msg     = ${ $_[0] };
  my $context = $msg->context;

  my $channel = $msg->channel;

  my ($host, $type) = @{ $msg->message_array };

  $self->_run_query($context, $channel, $host, $type);

  return PLUGIN_EAT_ALL
}

sub Bot_public_cmd_hextoip {
  my ($self, $core) = splice @_, 0, 2;

  my $msg = ${ $_[0] };

  my $hexip = $msg->message_array->[0];

  my $ip = join '.', unpack "C*", pack "H*", $hexip;

  broadcast( 'message',
    $msg->context,
    $msg->channel,
    "hex: $hexip --> ip: $ip"
  );

  return PLUGIN_EAT_ALL
}

sub Bot_public_cmd_iptohex {
  my ($self, $core) = splice @_, 0, 2;

  my $msg = ${ $_[0] };

  my $ip = $msg->message_array->[0];

  my $hexip = unpack 'H*', pack 'C*', split(/\./, $ip);

  broadcast( 'message',
    $msg->context,
    $msg->channel,
    "ip: $ip --> hex: $hexip"
  );

  return PLUGIN_EAT_ALL
}

sub _start {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];

  $kernel->alias_set( 'p_'. core()->get_plugin_alias($self) );

  logger->debug("Resolver-handling session spawned");
}

sub dns_resp_recv {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my $response = $_[ARG0];
  my $hints    = $response->{context};

  my $context = $hints->{Context};
  my $channel = $hints->{Channel};

  my $nsresp;
  unless ($nsresp = $response->{response}) {
    broadcast( 'message', $context, $channel,
      "DNS error."
    );
    return
  }

  my @send;
  for my $ans ($nsresp->answer) {
    if ($ans->type eq 'SOA') {
      push @send, 'SOA=' . join ':',
             $ans->mname, $ans->rname, $ans->serial, $ans->refresh,
             $ans->retry, $ans->expire, $ans->minimum
    } else {
      push @send, join '=', $ans->type, $ans->rdatastr
    }
  }

  my $str;
  my $host = $response->{host};
  if (@send) {
    $str = "nslookup: $host: ".join ' ', @send;
  } else {
    $str = "nslookup: No answer for $host";
  }

  broadcast('message', $context, $channel, $str) if $str;
}

sub _run_query {
  my ($self, $context, $channel, $host, $type) = @_;

  $type = 'A' unless $type
    and $type =~ /^(A|CNAME|NS|MX|PTR|TXT|AAAA|SRV|SOA)$/i;

  $type = 'PTR' if ip_is_ipv4($host) or ip_is_ipv6($host);

  logger->debug("issuing dns request: $host");

  $poe_kernel->post( 'p_'. core()->get_plugin_alias($self),
    'dns_issue_query',
    $context, $channel, $host, $type
  );
}

sub dns_issue_query {
  my ($self, $kernel) = @_[OBJECT, KERNEL];
  my ($context, $channel, $host, $type) = @_[ARG0 .. $#_];

  my $resp = core()->resolver->resolve(
    event => 'dns_resp_recv',
    host  => $host,
    type  => $type,
    context => { Context => $context, Channel => $channel },
  );

  POE::Kernel->yield('dns_resp_recv', $resp) if $resp;

  return 1
}

1;
__END__