#!/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 POE::Component::IRC; use Time::HiRes qw(gettimeofday tv_interval); use Net::AIM; 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;