Bot.pm.v2

• package Bot
  • new
  • handle
  • dns_resolve
• package Bot::Filter::Nettime
  • new
  • get
• EOF

package Bot;

use strict;
use warnings;
use Module::Reload;
use POE qw(
    Component::Client::DNS
    Component::Client::TCP
);

### direct subroutine: setup extra stuff
sub new {
    my($class, $kernel, $heap) = @_;
    $class = ref $class if ref $class;

    my $self = {
	Kernel => $kernel,
	Heap => $heap,
    };
    bless $self, $class;

    ### register "dns_resolve' state
    $kernel->state('dns_resolve', 'Bot');
    ### create DNS resolver
    $heap->{resolver} ||= POE::Component::Client::DNS->spawn();
    return $self;
}

### method invoked on Bot object
sub handle {
    my($self, $dest, $prefix, $what) = @_;

    my $heap = $self->{Heap};
    ### get list of valid Net::DNS::RR types
    my @rr = keys %Net::DNS::RR::RR;
    my $rr_regex = join("|", @rr);

    my $response;
    if ( $what =~ /^reload$/i ) {
        Module::Reload->check;
        $response = "OK, I reloaded";
        $self = $self->new( $self->{Kernel}, $heap );
    }
    elsif ( $what =~ /^($rr_regex)\s+([\w.-]+)\?\s*$/ ) {
        $heap->{resolver}->resolve(
            type        => $1,
            host        => $2,
            event       => 'dns_resolve',
            context     => { Dest => $dest, Prefix => $prefix },
            timeout     => 15,
        );
    }
    elsif ( $what =~ /^nettime\s+([\w.-]+)\s*$/ ) {
	my $remotehost = $1;
	POE::Component::Client::TCP->new(
	    RemoteAddress => $remotehost,
	    RemotePort => 'time',
	    Filter => 'Bot::Filter::Nettime',
	    ServerInput => sub {
		my($time) = $_[ARG0];
		my $response = "According to $remotehost, it is " .
		    localtime($time);
		$heap->{Irc}->yield( privmsg => $dest, "$prefix$response" );
	    },
	);
    }
    else {
        $response = "are you talking to me? $what?";
    }
    $heap->{Irc}->yield( privmsg => $dest, "$prefix$response" )
        if defined $response;
}

### a POE state: called when a question from irc is resolved
sub dns_resolve {
    my($kernel, $heap, $response) = @_[KERNEL, HEAP, ARG0];
    my $context = $response->{context};
    my $dest = $context->{Dest};
    my $prefix = $context->{Prefix};
    my $irc = $heap->{Irc};
    my $type = $response->{type};
    my $host = $response->{host};

    if ( my $pkt = $response->{response} ) {
        my $rcode = $pkt->header->rcode;
        my $aa = $pkt->header->aa;
        $irc->yield( privmsg => $dest, $prefix .
            "$type record for $host: got " .
                ($aa ? "" : "non-") . "authoritive answer" .
                ( $rcode eq "NOERROR" ? "" : ", $rcode"));
        my @answ = $pkt->answer();
        for my $a ( @answ ) {
            my $astr = $a->string();
            $astr =~ s/;.*$/ /gm;
            $astr =~ s/[\t\n]/  /g;
            $irc->yield( privmsg => $dest, $prefix . $astr );
        }
    }
    else {
        my $err = $response->{error};
        $irc->yield( privmsg => $dest, $prefix .
            "Cannot find $type records for $host: $err" );
    }
}

package Bot::Filter::Nettime;

use POE::Filter;

our @ISA = 'POE::Filter';

sub new {
    my $class = shift;
    my $self = { buffer => '' };
    bless $self, $class;
}

sub get {
    my($self, $data) = @_;

    for my $d ( @$data ) {
	$self->{buffer} .= $d;
    }
    my @ret;
    while ( length $self->{buffer} >= 4 ) {
	my $nettime_pkt = substr($self->{buffer}, 0, 4, '');
	### rfc868 (nettime) returns seconds since 1-jan-1900.
	### so we need to substract number of seconds before unix epoch,
	### 1-jan-1970: 70 years, and 17 leap days, or: (70*365+17)*86400
	push @ret, unpack("N", $nettime_pkt) - (70*365+17)*86400;
    }
    return \@ret;
}

1;