#!/usr/bin/perl -w use Net::IRC; use Net::AIM; use POSIX qw(strftime); ######################################################################## ### ### # # #### ### ### # # #### # ##### ### ### # # # # # # ## # # # # # # # # # # # # # # ## # # # # # # # ### # # ## # # #### ##### # # # # # # # # # # # # ## # # # # # # # # # # # # # # # ## ### ### # # # ### ### ### # # # # # ### ### # # ######################################################################## # Timestamp rate: # -1 - timestamp every public message # 0 - no timestamps # any positive number - insert timestamp every N seconds $::TimestampRate = -1; # set to 1 if you run it in a loop in the shell, 0 otherwise # if in loop, when the "last" irc session is closed, the bot will # quit (expecting to restart from the shell). this is another # AIM-speed-limit workaround, ie. if it gets blocked, maybe quit # and restart will reset the block... $::RunFromLoop = 1; # change if needed $::ConfFile = "$::ENV{'HOME'}/.aim2ircrc"; # set to 0 if you want to see the server motd. otherwise skip it. $::NoMotd = 1; ######################################################################## my $msgcnt = 0; my $irc = new Net::IRC; my $aim = new Net::AIM; #$aim->debug(1); my $conn = $aim->newconn(Screenname => $::ARGV[0], Password => $::ARGV[1]); my %defaults = readDefaults($::ConfFile); $0 = "AIM <=> IRC Gateway"; my $iconn = $irc->newconn(); addMyGlobals($iconn); my %users = (); # map AIM users to irc my %connmap = (); # maps irc connections to AIM users my %curchan = (); # keep track of channels for each user my %msgqueue = (); # messages queued to send to AIM user my %queueid = (); # event id in the Net::IRC queue for each AIM my %timestamps = (); # timestamp for each AIM. my %autofuncs = ( "away" => 1, "ignore" => 2, "info" => 1, "invite" => 2, "ison" => 1, "join" => 2, "kick" => 3, "lusers" => 1, "mode" => 3, "motd" => 0, "nick" => 1, "notice" => 2, "oper" => 2, "quit" => 1, "rehash" => 0, "restart" => 0, "sconnect" => 3, "squit" => 2, "stats" => 2, "summon" => 2, "time" => 1, "trace" => 1, "unignore" => 1, "userhost" => 1, "users" => 1, "version" => 1, "wallops" => 1, "who" => 2, "whois" => -1, "whowas" => 3 ); sub on_error { my $self = shift; my $event = shift; print "=== ERROR ===\n"; $event->dump(); } sub on_im { my $self = shift; my $event = shift; my ($from, $flag, $msg) = @{$event->{'args'}}; $from = lc($from); # strip HTML (and maybe a little more) $msg =~ s/\<[^>]+\>//g; handle_user_input($from, $msg); } sub handle_user_input { my ($from, $msg) = @_; my $ic = $users{$from}; my $curch = ""; if (defined $ic && defined $curchan{$ic} && @{$curchan{$ic}} > 0) { $curch = $curchan{$ic}->[0]; } if ($msg =~ s:^[/@](\w+)\s*::) { # command from user my $cmd = lc($1); if ($cmd eq "bonk") { $aim->send_im($from, "Bonk: $msg"); } elsif ($cmd eq "pong") { } elsif ($cmd eq "debug") { $aim->debug($msg); $irc->debug($msg); } elsif ($cmd eq "start" or $cmd eq "server") { my ($nick, $server, $name) = split(/\s+/, $msg, 3); if (!defined $nick or $nick eq "") { $nick = (defined $defaults{"$from-nick"}) ? $defaults{"$from-nick"} : $from; } if (!defined $server or $server eq "") { $server = (defined $defaults{"$from-server"}) ? $defaults{"$from-server"} : "irc.flamed.net"; } if (!defined($name) || $name eq "") { $name = (defined $defaults{"$from-name"}) ? $defaults{"$from-name"} : "via AIM as $from"; } # check for valid hostname my ($sn,$sa, $saddr, $length, @saddrs) = gethostbyname($server); print "Connecting to $sn for $from\n"; if ($sn eq "") { send_to_aim_user($from, "Unable to find server $server\n"); return; } if (defined $ic) { $ic->connect(Nick => $nick, Server => $server, Ircname => $name ); } else { $ic = $irc->newconn(Nick => $nick, Server => $server, LocalAddr => "10.0.1.202", Ircname => $name); $irc->addconn($ic); $users{$from} = $ic; $connmap{$ic} = $from; print "Started irc: $ic\n"; } } elsif (defined $ic) { if ($cmd eq "part") { # auto-prepend # if needed my $channel = $curch; if ($msg ne "") { $channel = $msg; if (defined $defaults{"shortcut-$channel"}) { $channel = $defaults{"shortcut-$channel"}; } else { $channel =~ s/^(\w)/\#$1/; } } if (defined $ic) { $ic->part($channel); } } elsif ($cmd eq "list") { if ($msg ne "") { $ic->list(split(/\s+/, $msg)); } else { send_to_aim_user($ic, "{E} Usage: /list channel [channel ...]"); } } elsif ($cmd eq "motd") { # asked for it, so unset $::NoMotd = 0; $ic->motd; } elsif ($cmd eq "me") { my ($to, $msg2) = split(/ /, $msg, 2); if ($to =~ s/^(\#\S+)//) { $ic->me($to, $msg2); } elsif (defined $defaults{"shortcut-$to"}) { $ic->me($defaults{"shortcut-$to"}, $msg2); } else { $ic->me($curch, $msg); } } elsif ($cmd eq "chan" or $cmd eq "join" or $cmd eq "j") { my ($channel, $pass) = split(/\s+/, $msg); # auto-prepend # if needed if (defined $defaults{"shortcut-$channel"}) { $channel = $defaults{"shortcut-$channel"}; } else { $channel =~ s/^(\w)/\#$1/; } my @newlist = (); my $found = 0; if (defined $curchan{$ic}) { foreach $newc (@{$curchan{$ic}}) { if ($channel ne $newc) { push @newlist, $newc; } else { $found = 1; } } } if ($found) { unshift @newlist, $channel; $curchan{$ic} = \@newlist; send_to_aim_user($ic, "===== $channel =====", 0, 1); } else { $ic->join($channel, $pass); } } elsif ($cmd eq "msg") { my ($to, $msg) = split(/\s+/, $msg, 2); # auto-prepend # if needed if (defined $defaults{"shortcut-$to"}) { $to = $defaults{"shortcut-$to"}; } if (defined $ic) { $ic->privmsg($to, $msg); } } elsif ($cmd eq "names") { my $c = ($msg ne "") ? $msg : $curch; if (defined $c && $c ne "") { $ic->names($c); } else { send_to_aim_user($ic, "{E} Usage: /names CHANNEL"); } } elsif ($cmd eq "topic") { if ($msg =~ s/^(\#\S+)//) { my $ch = $1; $ic->topic($ch, $msg); } else { $ic->topic($curch, $msg); } } elsif ($cmd eq "whois") { $ic->whois(split(/\s+/, $msg)); } elsif ($cmd eq "whowas") { $ic->whowas(split(/\s+/, $msg)); } elsif (defined $autofuncs{$cmd}) { if ($autofuncs{$cmd} > 1) { # split into args and call the function $ic->$cmd(split(/\s+/, $msg, $autofuncs{$cmd})); } elsif ($autofuncs{$cmd} == -1) { $ic->$cmd(split(/\s+/, $msg)); } else { $ic->$cmd($msg); } } } else { # no connection for this user yet send_to_aim_user($from, "No IRC connection for you, try '/server nickname ircservername' to get started"); } } else { if ($curch ne "") { $ic->privmsg($curch, $msg); } else { send_to_aim_user($from, "*** You are not in a channel"); } } } my $aconn = $aim->getconn(); $aconn->set_handler('error', \&on_error); $aconn->set_handler('im_in', \&on_im); #$aim->start(); #sub aim_irc_callback { # $aim->do_one_loop(); #} #sub stdin_callback { # my $line = ; # chomp($line); # # handle_user_input("stdin", $line); #} # add the AIM socket to the IRC loop (not needed w/ new loop) # my $aim_sock = $aconn->get_socket(); # warn "Adding $aim_sock to the thingy"; # $irc->addfh($$aim_sock, \&aim_irc_callback, "r"); #$irc->addfh(STDIN, \&stdin_callback, "r"); print "starting event loop..\n"; #$irc->start(); # new "manual" loop to handle both irc and aim while (1) { $irc->do_one_loop(); $aim->do_one_loop(); } # # irc gateway functions # sub send_to_aim_user { my ($conn, $msg, $noqueue, $nostamp) = @_; my $aol = (defined $connmap{$conn}) ? $connmap{$conn} : $conn; my $timestamp = ""; if ($::TimestampRate != 0 && !$nostamp) { my $now = time; if ($::TimestampRate == -1) { $timestamp = strftime("[%T]:", localtime($now)); } else { my $delta = $now - ((defined $timestamps{$aol}) ? $timestamps{$aol} : 0); if ($delta > $::TimestampRate) { $timestamps{$aol} = $now; $timestamp = strftime("%a %b %e, %Y %H:%M", localtime($now)); if (defined $curchan{$conn}) { $timestamp = "-- $curchan{$conn}->[0] : $timestamp --\n"; } else { $timestamp = "------ $timestamp ------\n"; } } } } if ($aol eq "stdin") { print "] $msg\n" if ($msg ne ""); } else { my $now = time(); if (defined $msgqueue{$aol}) { $msgqueue{$aol} .= "\n$timestamp$msg" if ($msg ne ""); #$irc->dequeue($queueid{$aol}); } else { $msgqueue{$aol} = ($msg ne "") ? "$timestamp$msg" : ""; } # queue up unless otherwise instructed if (!defined($queueid{$aol}) && !defined($noqueue) && !$noqueue) { $queueid{$aol} = $iconn->schedule(3, \&sendqueue, $aol); } } } sub sendqueue { my ($conn, $aol) = @_; if (defined $msgqueue{$aol}) { $msgcnt++; if ($msgcnt == 7) { $msgcnt = 0; $aim->send_im("bvwtelnet", "/ping"); } if (length($msgqueue{$aol}) > 1024) { my $pos = rindex($msgqueue{$aol}, "\n", 1024); my $send = substr($msgqueue{$aol}, 0, $pos); $msgqueue{$aol} = substr($msgqueue{$aol}, $pos+1); # send the first part $aim->send_im($aol, $send); # queue up the rest $queueid{$aol} = $iconn->schedule(5, \&sendqueue, $aol); } else { $aim->send_im($aol, $msgqueue{$aol}); delete $msgqueue{$aol}; delete $queueid{$aol}; } } } sub on_connect { my $self = shift; send_to_aim_user($self, "[END MOTD]", 0, 1); } sub on_init { my ($self, $event) = @_; my (@args) = ($event->args); shift (@args); send_to_aim_user($self, "[I] @args", 0, 1); } sub on_part { my ($self, $event) = @_; my ($channel) = ($event->to)[0]; my $nick = $event->nick; my $mynick = $self->nick; if ($nick eq $mynick && defined $curchan{$self}) { # find it in the list and remove my @newlist = (); my $c; foreach $c (@{$curchan{$self}}) { if ($channel ne $c) { push @newlist, $c; } } if (@newlist > 0) { $curchan{$self} = \@newlist; } elsif (defined $curchan{$self}) { delete $curchan{$self}; } print "$nick on channels: @newlist\n"; } send_to_aim_user($self, "[part] $nick <- $channel"); } sub on_join { my ($self, $event) = @_; my ($channel) = ($event->to)[0]; my $nick = $event->nick; my $uhost = $event->userhost; my $mynick = $self->nick; if ($nick eq $mynick) { my @newlist = (); if (defined $curchan{$self} and @{$curchan{$self}}>0) { my $c; foreach $c (@{$curchan{$self}}) { if ($channel ne $c) { push @newlist, $c; } } } unshift @newlist, $channel; $curchan{$self} = \@newlist; print "$nick on channels: @newlist\n"; send_to_aim_user($self, "[join] You are now on $channel"); } else { send_to_aim_user($self, "[join] $nick ($uhost) -> $channel"); } } sub on_msg { my ($self, $event) = @_; my ($nick) = $event->nick; print "*$nick* ", ($event->args), "\n"; send_to_aim_user($self, "*$nick* " . join(" ", $event->args)); } sub on_names { my ($self, $event) = @_; my (@list, $channel) = ($event->args); # eat yer heart out, mjd! # splice() only works on real arrays. Sigh. ($channel, @list) = splice @list, 2; send_to_aim_user($self, "Users on $channel: @list", 1, 1); } sub on_topic { my ($self, $event) = @_; my @args = $event->args(); # Note the use of the same handler sub for different events. if ($event->type() eq 'notopic') { print "No topic set for $args[1].\n"; # If it's being done _to_ the channel, it's a topic change. } elsif ($event->type() eq 'topic' and $event->to()) { # send_to_aim_user($self, "Topic $args[1]: $args[2]", 0, 1); } else { send_to_aim_user($self, "Topic for $args[1] is \"$args[2]\".", 0, 1); } } sub on_topicinfo { my ($self, $event) = @_; my @args = $event->args(); send_to_aim_user($self, "Topic $args[1] set by $args[2] at " . strftime("%c", localtime($args[3])), 0, 1); } sub on_public { my $self = shift; my $event = shift; my $aim = $connmap{$self}; my ($nick, $chan, $mynick) = ($event->nick, $event->to, $self->nick); my @args = ($event->args); if ($defaults{"$aim-urlfile"} && $args[0] =~ /http:|www\./i) { local *LOG; $now = time(); open(LOG, ">>".$defaults{"$aim-urlfile"}); print LOG "$now\t$nick\t$chan\t$args[0]\n"; close LOG; } if (defined $curchan{$self} and lc(${$curchan{$self}}[0]) eq lc($chan)) { send_to_aim_user($self, "<$nick> $args[0]"); } else { send_to_aim_user($self, "<$nick:$chan> $args[0]"); } } sub on_nick_taken { my ($self, $event) = @_; my @args = $event->args(); send_to_aim_user($self, "** $args[2]: $args[1]", 0, 1); } sub on_notreg { my ($self, $event) = @_; my @args = $event->args(); send_to_aim_user($self, "{E} $args[0] $args[1]", 0, 1); } sub on_action { my ($self, $event) = @_; my ($nick, @args) = ($event->nick, $event->args); send_to_aim_user($self, "* $nick @args"); } sub on_disconnect { my ($self, $event) = @_; my $aim = $connmap{$self}; send_to_aim_user($aim, "Disconnected."); delete $connmap{$self}; delete $curchan{$self} if defined $curchan{$self}; my @conns = keys %connmap; if (@conns == 0 && $::RunFromLoop) { send_to_aim_user($aim, "Exiting. Hopefully this runs in a loop."); exit; } } # motd sub on_motd { my ($self, $event) = @_; my @args = $event->args; send_to_aim_user($self, $args[1], 0, 1) unless $::NoMotd; } sub on_end_motd { my ($self, $event) = @_; my @args = $event->args; my $aim = $connmap{$self}; send_to_aim_user($self, $args[1], 0, 1) unless $::NoMotd; if (defined $defaults{"$aim-channels"}) { my @chs = split(/\s+/, $defaults{"$aim-channels"}); for ($i=$#chs; $i>=0; $i--) { print "Joining $aim ($chs[$i])\n"; $self->join(split(/:/, $chs[$i], 2)); } } } # who sub on_whoreply { my ($self, $event) = @_; my ($nick, @args) = ($event->nick, $event->args); send_to_aim_user($self, "$args[1] $args[5] $args[6] $args[2]\@$args[3] ($args[7])", 1); } sub on_endofwho { my ($self, $event) = @_; send_to_aim_user($self, ""); } # list sub on_liststart { my ($self, $event) = @_; send_to_aim_user($self, "Channel (# users) Topic", 0, 1); } sub on_list { my ($self, $event) = @_; my ($nick, @args) = ($event->nick, $event->args); send_to_aim_user($self, "$args[1] ($args[2]) $args[3]", 1, 1); } sub on_mode { my ($self, $event) = @_; my ($to, @args) = ($event->to, $event->args); send_to_aim_user($self, "[mode] $to @args"); } sub on_notice { my_generic_handler(@_, 0); } sub on_nick { my ($self, $event) = @_; my ($from, $to, $mynick, @args) = ($event->from, $event->to, $self->nick, $event->args); ($from) = split(/\!/, $from); ($to) = split(/\!/, $to); if ($mynick eq $args[0]) { send_to_aim_user($self, "[nick] You ($from) -> $args[0]"); } else { send_to_aim_user($self, "[nick] $from -> $args[0]"); } } sub on_quit { my ($self, $event) = @_; my ($from, $to, $mynick, @args) = ($event->from, $event->to, $self->nick, $event->args); ($from) = split(/\!/, $from, 2); send_to_aim_user($self, "[QUIT] $from ($args[0])"); } sub on_nosuchchannel { my ($self, $event) = @_; my ($args) = ($event->args); send_to_aim_user($self, "{E} $args[2]: $args[1]"); } sub on_gen1 { my_generic_handler(@_, 1); } sub my_generic_handler { my ($self, $event, $idx, $tag) = @_; my ($nick, @args) = ($event->nick, $event->args); $tag = "[$event->{'type'}]" unless defined $tag; send_to_aim_user($self, "$tag $args[$idx]", 0, 1); } sub my_really_generic { my ($self, $event) = @_; my ($type, $args) = ($event->{'type'}, $event->args); send_to_aim_user($self, "[$type] [" . join("][", $args) . "]", 0, 1); } sub addMyGlobals { my $conn = shift; $conn->add_global_handler([ qw(motdstart motd) ], \&on_motd); $conn->add_global_handler('endofmotd', \&on_end_motd); $conn->add_global_handler('msg', \&on_msg); $conn->add_global_handler('public', \&on_public); $conn->add_global_handler('caction', \&on_action); $conn->add_global_handler('join', \&on_join); # $conn->add_global_handler('umode', \&on_umode); $conn->add_global_handler('mode', \&on_mode); $conn->add_global_handler('part', \&on_part); $conn->add_global_handler('topic', \&on_topic); $conn->add_global_handler('topicinfo', \&on_topicinfo); $conn->add_global_handler('notopic', \&on_topic); $conn->add_global_handler('snotice', \&on_notice); $conn->add_global_handler('quit', \&on_quit); $conn->add_global_handler('time', \&on_time); $conn->add_global_handler('whoreply', \&on_whoreply); $conn->add_global_handler('endofwho', \&on_endofwho); $conn->add_global_handler('liststart', \&on_liststart); $conn->add_global_handler('list', \&on_list); $conn->add_global_handler('listend', \&on_endofwho); # $conn->add_global_handler('', \&); $conn->add_global_handler('time', \&on_time); $conn->add_global_handler([ qw(welcome yourhost created info ison nowaway unaway) ], \&on_gen1); $conn->add_global_handler([ 251,252,253,254,302,255 ], \&on_init); $conn->add_global_handler('disconnect', \&on_disconnect); $conn->add_global_handler("nick", \&on_nick); $conn->add_global_handler(433, \&on_nick_taken); $conn->add_global_handler("notregistered", \&on_notreg); $conn->add_global_handler("nosuchchannel", \&on_nosuchchannel); $conn->add_global_handler(353, \&on_names); $conn->add_global_handler("endofnames", \&on_endofwho); $conn->add_global_handler("default", \&mydefaulthandler, 1); } sub mydefaulthandler { my ($self, $event) = @_; my $type = $event->{'type'}; if (defined $type) { foreach (qw(ping map myinfo n_global n_local)) { return if $type eq $_; } } print "-" x 79 . "\n"; $event->dump; } sub readDefaults { my ($conf) = @_; my %def = (); if (-r "$conf") { print "Parsing config file:\n"; local *RC; open(RC, "<$conf") || return %def; my $prefix = ""; while () { print; chomp; s/^\s*//; s/\s*$//; next if /^$/; next if /^\#/; my ($key, $value) = split(/\s*:\s*/); my $lk = lc($key); if ($lk eq "section" or $lk eq "user") { $prefix = $value; } elsif ($prefix ne "") { $def{"$prefix-$key"} = $value; } else { $def{"$key"} = $value; } } close RC; } return %def; }