Bot.pm.v6

package Bot;

use strict;
use warnings;
use Module::Reload;
use Socket;
use POE qw(
    Component::Client::DNS
    Component::Client::TCP
    Wheel::Run
    Wheel::SocketFactory
    Wheel::ReadWrite
    Filter::Line
);

### 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');
    ### state to send back irc answers
    $kernel->state('send_reply', 'Bot');
    ### states to handle 'date' external command
    $kernel->state('date_closed', 'Bot');
    $kernel->state('date_output', 'Bot');
    ### create DNS resolver
    $heap->{resolver} ||= POE::Component::Client::DNS->spawn();
    ### create listening socket on port 12345
    $heap->{listener} ||= POE::Wheel::SocketFactory->new(
	BindPort => 12345,
	SuccessEvent => 'telnet_incoming',
	FailureEvent => 'telnet_failure',
    );
    $kernel->state('telnet_incoming', 'Bot');
    $kernel->state('telnet_failure', 'Bot');
    ### and more states to handle traffic to/from the clients
    $kernel->state('telnet_speaks', 'Bot');
    $kernel->state('telnet_closing', 'Bot');
    $kernel->state('say_telnet_clients', 'Bot');
    $kernel->state('channel_message', 'Bot');
    return $self;
}

### hash containing all connected telnet sessions
my %telnet_clients;

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

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

    ### how to send back replies: using a postback
    my $session = $kernel->get_active_session;
    my $sendreply = $session->postback( send_reply => $dest, $prefix );

    ### inform telnet clients of incoming request
    if ( $prefix ) {
        ### it's a channel message
	$kernel->yield( say_telnet_clients => "Thus spoketh $prefix$what" );
    } else {
	### it's a private message
	$kernel->yield( say_telnet_clients => "$dest tells me: $what" );
    }

    my $response;
    if ( $what =~ /^reload$/i ) {
        Module::Reload->check;
        $response = "OK, I reloaded";
        $self = $self->new( $kernel, $heap );
    }
    elsif ( $what =~ /^($rr_regex)\s+([\w.-]+)\?\s*$/ ) {
        $heap->{resolver}->resolve(
            type        => $1,
            host        => $2,
            event       => 'dns_resolve',
            context     => $sendreply,
            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);
		$sendreply->($response);
	    },
	    ConnectTimeout => 15,
	    ConnectError => sub {
		my($call, $why) = @_[ARG0, ARG2];
		my $response = "Doing $call to $remotehost failed: $why";
		$sendreply->($response);
	    },
	);
    }
    elsif ( $what =~ /^date\??\s*$/ ) {
	my $wheel = POE::Wheel::Run->new(
	    Program => 'date',
	    CloseEvent => 'date_closed',
	    StdoutEvent => 'date_output',
	);
	my $wheel_id = $wheel->ID;
	$heap->{Wheels}{$wheel_id} = {
	    Wheel => $wheel,
	    Sendreply => $sendreply,
	};
    }
    else {
        $response = "are you talking to me? $what?";
    }
    $sendreply->($response) if defined $response;
}

sub channel_message {
    my($kernel, $heap, $str) = @_[KERNEL, HEAP, ARG0];
    $heap->{Irc}->yield( privmsg => $heap->{Channel}, $str );
    $kernel->yield( say_telnet_clients => $str );
}

sub send_reply {
    my($kernel, $heap, $passtru, $passback) = @_[KERNEL, HEAP, ARG0, ARG1];
    my($dest, $prefix) = @$passtru;
    my($response) = @$passback;
    $heap->{Irc}->yield( privmsg => $dest, "$prefix$response" );
    $kernel->yield( say_telnet_clients => "Telling $dest: $prefix$response" );
}

### a POE state: called when a question from irc is resolved
sub dns_resolve {
    my($kernel, $heap, $response) = @_[KERNEL, HEAP, ARG0];
    my $sendreply = $response->{context};
    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;
	$sendreply->( "$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;
	    $sendreply->($astr);
        }
    }
    else {
        my $err = $response->{error};
	$sendreply->( "Cannot find $type records for $host: $err" );
    }
}

sub date_closed {
    my($heap, $wheel_id) = @_[HEAP, ARG0];
    delete $heap->{Wheels}{$wheel_id};
    return;
}

sub date_output {
    my($heap, $str, $wheel_id) = @_[HEAP, ARG0, ARG1];
    $str =~ s/\r?\n//g;
    my $sendreply = $heap->{Wheels}{$wheel_id}{Sendreply};
    $sendreply->($str);
    return;
}

sub telnet_failure {
    my($what, $why) = @_[ARG0, ARG2];
    warn "Incoming connection $what failed: $why\n";
}

sub telnet_incoming {
    my($kernel, $heap, $socket, $remote_addr, $remote_port) =
	@_[KERNEL, HEAP, ARG0, ARG1, ARG2];
    $remote_addr = inet_ntoa($remote_addr);
    my $who = "$remote_addr:$remote_port";

    my $ses = POE::Session->create(
	package_states => [
	    'Bot::Telnet' => [ qw(_start telnet_input telnet_death say) ],
	],
	args => [ $socket, $who ],
    );
    $telnet_clients{$who} = $ses->ID;
    $kernel->yield( channel_message => "$who connects" );
}

sub telnet_closing {
    my($kernel, $who) = @_[KERNEL, ARG0];
    if ( $telnet_clients{$who} ) {
	delete $telnet_clients{$who};
	$kernel->yield( channel_message => "$who closed connection" );
    }
}

sub telnet_speaks {
    my($kernel, $who, $str) = @_[KERNEL, ARG0, ARG1];
    $kernel->yield( channel_message => "$who says: $str" );
}

sub say_telnet_clients {
    my($kernel, $str) = @_[KERNEL, ARG0];

    while ( my($who, $ses) = each %telnet_clients ) {
	$kernel->post( $ses, say => $str );
    }
}

package Bot::Telnet;

use POE;

sub _start {
    my($kernel, $heap, $parent, $socket, $who) =
	@_[KERNEL, HEAP, SENDER, ARG0, ARG1];
    $heap->{socket_wheel} = POE::Wheel::ReadWrite->new(
	Handle => $socket,
	Filter => POE::Filter::Line->new,

	InputEvent => 'telnet_input',
	ErrorEvent => 'telnet_death',
    );
    $heap->{who} = $who;
    $heap->{parent} = $parent;
    $kernel->yield( say => "Welcome, $who.\n" );
}

sub say {
    my($heap, $str) = @_[HEAP, ARG0];
    $heap->{socket_wheel}->put($str);
}

sub telnet_input {
    my($kernel, $heap, $str) = @_[KERNEL, HEAP, ARG0];
    
    $kernel->post( $heap->{parent}, telnet_speaks => $heap->{who}, $str );
}

sub telnet_death {
    my($kernel, $heap, $what, $why) = @_[KERNEL, HEAP, ARG0, ARG2];

    warn "telnet connection from $heap->{who} $what failed: $why\n";
    delete $heap->{socket_wheel};
    $kernel->post( $heap->{parent}, telnet_closing => $heap->{who} );
}

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;