#!/usr/bin/perl -w
#
# This bot is a proxy between AIM and IRC. You give the bot an AIM
# username, and any messages sent to it by people on its buddy list get
# forwarded to IRC. Originally written to allow poor disadvantaged
# Hiptop users to get on IRC.
#
# -- dennis taylor, <dennis@funkplanet.com>
use strict;
use Socket;
use POE qw( Wheel::SocketFactory Wheel::ReadWrite Filter::Line Driver::SysRW );
use Time::HiRes qw(gettimeofday tv_interval);
use constant MSG_INTERVAL => 2.2;
my $channel = '#tempura';
my $irc_server = $ARGV[1] || "scissorman.phreeow.net";
my $irc_port = $ARGV[2] || 6667;
my ($aim, $aimconn);
sub _start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
$aim = Net::AIM->new();
$aim->newconn(
Screenname => 'vscairc',
Password => $ARGV[0],
AutoReconnect => 1,
) or die "Can't connect to AIM server: $!";
$aimconn = $aim->getconn();
$aimconn->set_handler( 'update_buddy', \&_net_aim_update_buddy );
$aimconn->set_handler( 'config', \&_net_aim_config );
$aimconn->set_handler( 'im_in', \&_net_aim_im_in );
$aimconn->set_handler( 'error', \&_net_aim_error );
$kernel->alias_set( 'control' );
$kernel->yield( 'aim_listen' );
$heap->{aimqueue} = [];
$heap->{lastsend} = [gettimeofday];
}
sub _stop {
my ($kernel, $heap) = @_[KERNEL, HEAP];
print "Control session killed.\n";
foreach my $user (keys %{$heap->{queue}}) {
$kernel->call( "irc_$user", 'quit', '[aimproxy] Control session killed.' );
}
$aimconn->disconnect();
$kernel->alias_remove( 'control' );
}
sub aim_listen {
$aim->do_one_loop();
$_[KERNEL]->yield( 'aim_send' );
$_[KERNEL]->delay( 'aim_listen', 0.5 );
}
sub _net_aim_update_buddy {
my ($self, $evt) = @_;
my ($buddy, $online) = @{$evt->args()};
$poe_kernel->post( 'control', 'aim_buddy_update', $buddy, ($online == "T") );
}
sub aim_buddy_update {
my ($kernel, $heap, $buddy, $online) = @_[KERNEL, HEAP, ARG0, ARG1];
if ($online) {
$heap->{friends}->{$buddy} = 1;
} elsif (not $online and $kernel->alias_resolve( "irc_$buddy" )) {
$heap->{friends}->{$buddy} = 0;
$kernel->post( "irc_$buddy", 'quit',
"[aimproxy] $buddy has signed off AIM." );
}
}
sub _net_aim_config {
my ($self, $evt, $from, $to) = @_;
my $str = shift @{$evt->args()};
my @friends;
$self->set_config_str($str, 1);
$self->send_config();
foreach (split /[\r\n]+/, $str) {
if (/^b (\S+)$/) {
push @friends, $1;
print "$1 is my friend.\n";
}
}
$poe_kernel->post( 'control', 'aim_friends', \@friends );
}
sub aim_friends {
my ($heap, $friends) = @_[HEAP, ARG0];
$heap->{friends}->{$_} = 0 foreach @$friends;
}
sub _net_aim_im_in {
my ($self, $evt) = @_;
my ($nick, $auto_msg, $msg) = @{$evt->args()};
my $stripped = $msg;
return if $auto_msg eq 'T';
$stripped =~ s/<[^>]+>//g;
# $stripped =~ s/^\s+//g; will this interfere with /commands?
# $stripped =~ s/\s+$//g;
if (length $stripped) {
$poe_kernel->post( 'control', 'aim_got_message', $nick, $stripped );
}
}
sub aim_got_message {
my ($kernel, $heap, $nick, $msg) = @_[KERNEL, HEAP, ARG0, ARG1];
return unless exists $heap->{friends}->{$nick};
if ($kernel->alias_resolve( "irc_$nick" )) {
if ($msg =~ m|^/msg\s+(\S+)\s+(.*)$|i) {
$kernel->post( "irc_$nick", 'privmsg', $1, $2 );
} elsif ($msg =~ m|^/me\s+(.*)$|i) {
$kernel->post( "irc_$nick", 'ctcp', $channel, "ACTION $1" );
} elsif ($msg =~ m!^/(?:quit|part|leave)(?:\s+(.*))?$!i) {
my $quitmsg = $1 || "Client Exiting";
$kernel->post( "irc_$nick", 'quit', "[aimproxy] $quitmsg" );
} elsif ($msg =~ m|^/(\S+)|i) {
$kernel->yield( 'aim_queue', $nick, "[aimproxy] Unknown command: /$1" );
} else {
$kernel->post( "irc_$nick", 'privmsg', $channel, $msg );
}
} else {
$heap->{friends}->{$nick} = 1;
push @{$heap->{queue}->{$nick}}, $msg;
my $irc_nick = $nick;
$irc_nick =~ tr/A-Za-z0-9\-[]\\\`^{}/_/cs;
$irc_nick = substr $irc_nick, 0, 9;
POE::Component::IRC->new( "irc_$nick" )
or die "Can't create new IRC component for $nick: $!\n";
$kernel->post( "irc_$nick", 'register', 'all');
$kernel->post( "irc_$nick", 'connect', { Debug => 0,
Nick => $irc_nick,
Server => $irc_server,
Port => $irc_port,
Username => 'aimbot',
Ircname => 'VSCA AIM->IRC Proxy Bot', }
);
}
}
sub _net_aim_error {
my ($self, $evt) = @_;
my ($error, @stuff) = @{$evt->args()};
my $errstr = $evt->trans($error);
$errstr =~ s/\$(\d+)/$stuff[$1]/ge;
warn "AIM ERROR: $errstr\n";
}
sub aim_queue {
my ($kernel, $heap, $nick, $msg) = @_[KERNEL, HEAP, ARG0, ARG1];
return unless $heap->{friends}->{$nick};
push @{$heap->{aimqueue}}, [$nick, $msg];
$kernel->yield( 'aim_send' );
}
sub aim_send {
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $timenow = [gettimeofday];
if (@{$heap->{aimqueue}} > 0 and
tv_interval( $heap->{lastsend}, $timenow ) > MSG_INTERVAL) {
my $msg = shift @{$heap->{aimqueue}};
$aim->send_im( $msg->[0], $msg->[1] );
$heap->{lastsend} = $timenow;
}
}
sub irc_001 {
my $kernel = $_[KERNEL];
$kernel->post( $_[SENDER], "join", $channel );
}
sub irc_433 {
my ($kernel, $sender) = @_[KERNEL, SENDER];
my $user = _get_aim_username( @_ );
my $irc_nick = $user;
$irc_nick =~ tr/A-Za-z0-9\-[]\\\`^{}/_/cs;
$irc_nick = substr $irc_nick, 0, 8;
my @punct = ('^', '`', '_', '\\', '-');
$kernel->post( $sender, 'nick', $irc_nick . $punct[ int( rand @punct ) ] );
}
sub _get_aim_username {
my ($kernel, $sender, $heap) = @_[KERNEL, SENDER, HEAP];
my $user = (split /_/, ($kernel->alias_list( $sender ))[0], 2)[1];
die "No such user: \"$user\"" unless exists $heap->{friends}->{$user};
return $user;
}
sub irc_ctcp_action {
my ($kernel, $heap, $who, $msg) = @_[KERNEL, HEAP, ARG0, ARG2];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user, "* $nick $msg" );
}
sub irc_disconnected {
my ($kernel, $sender, $heap, $server) = @_[KERNEL, SENDER, HEAP, ARG0];
my $user = _get_aim_username( @_ );
print "$user: Lost connection to server $server.\n";
delete $heap->{queue}->{$user};
$kernel->post( $sender, "shutdown" );
$kernel->yield( 'aim_queue', $user,
"[aimproxy] Lost connection to IRC server!" );
}
sub irc_error {
my ($kernel, $heap, $err) = @_[KERNEL, HEAP, ARG0];
my $user = _get_aim_username( @_ );
print "$user: Server error occurred! $err\n";
$kernel->yield( 'aim_queue', $user,
"[aimproxy] Error from $irc_server: $err" );
}
sub irc_join {
my ($kernel, $heap, $who, $chan) = @_[KERNEL, HEAP, ARG0, ARG1];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user, "*** $nick joined channel $channel." );
if ($heap->{friends}->{$user} and @{$heap->{queue}->{$user}} > 0) {
$kernel->yield( 'aim_got_message', $user,
shift @{$heap->{queue}->{$user}} );
}
}
sub irc_kick {
my ($kernel, $heap, $who, $chan, $victim, $msg) =
@_[KERNEL, HEAP, ARG0 .. $#_];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user,
"*** $victim was kicked from $channel by $nick ($msg)" );
}
sub irc_mode {
my ($kernel, $heap, $who, $chan, $modes) = @_[KERNEL, HEAP, ARG0 .. $#_];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$modes .= " " . join( ' ', @_[ARG3 .. $#_] );
$kernel->yield( 'aim_queue', $user,
"*** Mode change on $chan by $nick: $modes" );
}
sub irc_msg {
my ($kernel, $heap, $who, $msg) = @_[KERNEL, HEAP, ARG0, ARG2];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user, "*$nick* $msg" );
}
sub irc_nick {
my ($kernel, $heap, $who, $newnick) = @_[KERNEL, HEAP, ARG0, ARG1];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user, "*** $nick is now known as $newnick." );
}
sub irc_notice {
my ($kernel, $heap, $who, $msg) = @_[KERNEL, HEAP, ARG0, ARG2];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user, "-$nick- $msg" );
}
sub irc_part {
my ($kernel, $heap, $who, $chan) = @_[KERNEL, HEAP, ARG0, ARG1];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user, "*** $nick has left $channel." );
}
sub irc_public {
my ($kernel, $heap, $who, $msg) = @_[KERNEL, HEAP, ARG0, ARG2];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user, "<$nick> $msg" );
}
sub irc_quit {
my ($kernel, $heap, $who, $msg) = @_[KERNEL, HEAP, ARG0, ARG1];
my $user = _get_aim_username( @_ );
my ($nick) = ($who =~ /^(.*)?!/);
$kernel->yield( 'aim_queue', $user, "*** $nick has quit IRC ($msg)." );
}
sub irc_socketerr {
my ($kernel, $heap, $err) = @_[KERNEL, HEAP, ARG0];
my $user = _get_aim_username( @_ );
print "$user: Can't connect to $irc_server:$irc_port! $err\n";
$kernel->yield( 'aim_queue', $user,
"[aimproxy] Can't connect to $irc_server:$irc_port: $err" );
}
POE::Session->new( 'main' => [qw( _start _stop aim_buddy_update aim_friends
aim_got_message aim_listen aim_queue aim_send
irc_001 irc_433 irc_ctcp_action
irc_disconnected irc_error irc_join irc_kick
irc_mode irc_msg irc_nick irc_notice irc_part
irc_public irc_quit irc_socketerr )]
);
$poe_kernel->run();
exit 0;