#!/usr/bin/perl -w
#
# This bot is a simple telnet proxy. You DCC CHAT with it, and it
# connects to somewhere else, and you talk to the somewhere else over
# the CHAT connection in your IRC client. I originally wrote it because
# I wanted to use XChat as an interface to a MOO instead of telnet. :-)
#
# All things considered, a good demonstration of DCC code.
#
# -- dennis taylor, <dennis@funkplanet.com>
use strict;
use Socket;
use POE qw( Wheel::SocketFactory Wheel::ReadWrite Filter::Line Driver::SysRW );
my $mynick = "moo";
my $user = "(fimm(tiu)?|(Half|Semi)jack|stimps)";
my $telnethost = "binky";
my $telnetport = 7788;
my $verbose = 0; # turn this on to enable lots of garbage.
my $chatsession = undef;
sub _start {
my ($kernel, $session) = @_[KERNEL, SESSION];
# $session->option( trace => 1 );
$kernel->post( 'irc', 'register', 'all');
$kernel->post( 'irc', 'connect', { Debug => 0,
Nick => $mynick,
Server => $ARGV[0] || 'irc.phreeow.net',
Port => $ARGV[1] || 6667,
Username => 'neenio',
Ircname => 'Ask me about my colon!', }
);
$kernel->sig( INT => "sigint" );
}
sub _connected {
my ($kernel, $heap, $sock, $addr, $port) = @_[KERNEL, HEAP, ARG0 .. ARG2];
$heap->{wheel} = POE::Wheel::ReadWrite->new(
Handle => $sock,
Filter => POE::Filter::Line->new(),
Driver => POE::Driver::SysRW->new(),
InputEvent => '_conn_data',
ErrorEvent => '_conn_error',
);
$kernel->post( 'irc', 'dcc_chat', $chatsession, "*** Connected." );
print "Connected.\n" if $verbose;
}
sub _connect_failed {
my ($kernel, $heap, $function, $errstr) = @_[KERNEL, HEAP, ARG0, ARG2];
$kernel->post( 'irc', 'dcc_chat', $chatsession,
"*** Couldn't connect to $telnethost:$telnetport: $errstr in $function" );
print "Couldn't connect to $telnethost:$telnetport: $errstr in $function\n";
delete $heap->{wheel};
}
sub _conn_data {
my ($kernel, $heap, $line) = @_[KERNEL, HEAP, ARG0];
$line = " " unless length $line;
$kernel->post( 'irc', 'dcc_chat', $chatsession, $line );
print "<== $line\n" if $verbose;
}
sub _conn_error {
my ($kernel, $heap, $function, $errstr) = @_[KERNEL, HEAP, ARG0, ARG2];
$kernel->post( 'irc', 'dcc_chat', $chatsession,
"*** Connection to $telnethost:$telnetport lost: $errstr in $function" );
print "Connection to $telnethost:$telnetport lost: $errstr in $function\n";
delete $heap->{wheel};
}
# After we successfully log into the IRC server, make ourselves invisible.
sub irc_001 {
$_[KERNEL]->post( 'irc', 'mode', $mynick, '+i' );
}
sub irc_dcc_request {
my ($kernel, $heap, $nick, $type, $port, $cookie) =
@_[KERNEL, HEAP, ARG0 .. ARG3];
$nick =~ s/^(.+?)!.*$/$1/;
unless ($nick =~ /^$user$/o and $type eq "CHAT") {
$kernel->post( 'irc', 'notice', $nick, "Buzz off." );
return;
}
if ($port < 1024) {
$kernel->post( 'irc', 'notice', $nick, "Reserved ports are beneath me." );
return;
}
if (defined $chatsession) {
$kernel->post( 'irc', 'notice', $nick, "There's already a user on." );
return;
}
$kernel->post( 'irc', 'dcc_accept', $cookie );
}
sub irc_dcc_start {
my ($kernel, $heap, $cookie, $nick, $port) =
@_[KERNEL, HEAP, ARG0, ARG1, ARG3];
unless ($chatsession) {
die "Who the hell is \"$nick\"?" unless $nick =~ /^$user!.*$/o;
print "DCC CHAT connection established with $nick on port $port.\n"
if $verbose;
}
$chatsession = $cookie; # save the magic cookie
$kernel->post( 'irc', 'dcc_chat', $chatsession,
"*** Connecting to $telnethost, port $telnetport..." );
$heap->{factory} = POE::Wheel::SocketFactory->new(
RemoteAddress => $telnethost,
RemotePort => $telnetport,
SuccessEvent => '_connected',
FailureEvent => '_connect_failed',
);
}
sub irc_dcc_chat {
my ($kernel, $heap, $peer, $line) = @_[KERNEL, HEAP, ARG1, ARG3];
if ($line eq "***reconnect" and not exists $heap->{wheel}) {
$kernel->yield( 'irc_dcc_start', $chatsession, '', $peer, 0 );
} elsif ($line eq "***quit") {
delete $heap->{factory};
delete $heap->{wheel};
} else {
if ($line =~ /^\001ACTION (.*)\001\015?$/) {
$line = ":$1";
}
$heap->{wheel}->put( $line ) if exists $heap->{wheel};
print "==> $line\n" if $verbose;
}
}
sub irc_dcc_done {
my ($nick, $type) = @_[ARG0, ARG1];
print "DCC $type to $nick closed.\n" if $verbose;
$chatsession = undef;
}
sub irc_dcc_error {
my ($err, $nick, $type) = @_[ARG1 .. ARG3];
print "DCC $type to $nick failed: $err.\n" if $verbose;
$chatsession = undef;
}
sub sigint {
my ($kernel, $heap) = @_[KERNEL, HEAP];
delete $heap->{factory};
delete $heap->{wheel};
$kernel->sig_handled();
}
sub _stop {
my ($kernel) = $_[KERNEL];
print "Control session stopped.\n";
$kernel->call( 'irc', 'quit', 'Control session stopped.' );
}
sub irc_disconnected {
my ($server) = $_[ARG0];
print "Lost connection to server $server.\n";
}
sub irc_error {
my $err = $_[ARG0];
print "Server error occurred! $err\n";
}
sub irc_socketerr {
my $err = $_[ARG0];
print "Couldn't connect to server: $err\n";
}
POE::Component::IRC->new( 'irc', trace => undef ) or
die "Can't instantiate new IRC component!\n";
POE::Session->create( package_states => [ 'main' => [qw( _start _stop _connected sigint
_connect_failed _conn_data _conn_error
irc_001 irc_error irc_disconnected
irc_socketerr irc_dcc_start irc_dcc_done
irc_dcc_chat irc_dcc_error irc_dcc_request)], ],
);
$poe_kernel->run();
exit 0;