#!/usr/bin/perl $license = < 1; use constant DCC_STATE_WRITE => 2; use constant DCC_STATE_SEND_LISTEN => DCC_STATE_SEND | (1<<2); #5 use constant DCC_STATE_SEND_READY => DCC_STATE_SEND | DCC_STATE_WRITE | (2<<2); #8 use constant DCC_STATE_SEND_NEEDACK => DCC_STATE_SEND | (3<<2); #13 use constant DCC_STATE_GET_CONNECT => DCC_STATE_WRITE | 1<<2; #6 use constant DCC_STATE_GET_READY => 2<<2; #8 use constant DCC_STATE_GET_SENDACK => DCC_STATE_WRITE | (3<<2); #14 use constant RELNOTES => { 1.6 => < <import(qw(:standard :loglevels)); Net::OSCAR::Utility->import(qw(normalize)); require HTML::FormatText; require HTML::Parse; require MIME::Base64; import MIME::Base64; }; $@ .= "We require Net::OSCAR 1.11 or newer - you have $Net::OSCAR::VERSION.\n" unless $Net::OSCAR::VERSION >= 1.11; if($@) { print STDERR "We couldn't load some required modules for the following reason:\n"; print STDERR "$@\n"; print STDERR "\n\n"; print STDERR "And here's what that probably means...\n\n"; print STDERR "You do not have the necessary modules installed.\n"; print STDERR "Please run the getmodules script included with the IMIRC distribution.\n"; print STDERR "You may of course install the modules by hand if you prefer.\n"; die "\n"; } } use IO::Handle; use IO::Socket; use POSIX; use Carp; use Getopt::Long; use File::Basename; use File::Spec; use Fcntl; use FormatIMIRC; use Symbol; use Text::ParseWords; $Carp::Verbose = 1; eval { require Data::Dumper; }; $SIG{__DIE__} = sub { croak $_[0] }; $SIG{PIPE} = 'IGNORE'; $home = (getpwuid($>))[7]; $version = $VERSION = '1.6-CVS $Revision$'; @args = @ARGV; # setpriority(0, $$, 19); #Defaults $prefix = "AIM-"; $usnick = "IMServ"; $oldnick = "AIMServ"; $localhelp = ""; $confversion = 0; $chatchan = "#aimchat-"; $nickchan = "#aimchan-"; $us = "imserv.your.irc.net"; $them = "127.0.0.1"; $themport = 6667; $ourpass = "foo"; $theirpass = "bar"; $servermode = "dal2"; @ignorehosts = qw(services.*); $ignoreuhosts = 1; $time = 60*5; #Five minutes $user_loglevel = OSCAR_DBG_WARN; @default_conffiles = ("/etc/aimirc.conf", "/etc/imirc.conf", "$home/.aimirc", "$home/.imirc"); $fork = 1; $verbose = 0; $sendidle = 1; $oscarserver = 'login.oscar.aol.com'; $oscarport = 5190; $dcc = 1; $shortcircuit = 1; $numeric = num2base64(42); $require_qlines = 1; $kill_impersonaters = 1; $usepoll = 1; $debug = 0; *debuglevel = *debug; #We can now reference debuglevels as %debuglevel or %debug loadconf(); if($prefix eq "") { warn "Disabling kill_impersonaters - \$prefix = \"\"\n" if $kill_impersonaters; warn "Disabling require_qlines - \$prefix = \"\"\n" if $require_qlines; $require_qlines = $kill_impersonaters = 0; } unless($reload) { if($servermode eq "p0210" and ($require_qlines or $ignoreuhosts)) { print "Due to ircd 2.10 restrictions, IMIRC will pause for 75 seconds after connecting to your IRC server but before doing anything else.\n"; } if($fork) { #We don't need no stinking ampersands! my $pid = fork; exit if $pid; die "Couldn't fork: $!" unless defined($pid); POSIX::setsid() or die "Can't start a new session: $!"; } sub kill_handler { my($connection); &going_down; $upstream->close; foreach $connection(values %$aim_connections) { $connection->{oscar}->signoff if $connection->{oscar}; } exit 1; } } $SIG{INT} = $SIG{TERM} = \&kill_handler; $SIG{CHLD} = 'IGNORE'; #Restart on SIGHUP sub phoenix { my($connection, $screenname); &going_down; $upstream->close; foreach $connection(values %$aim_connections) { foreach $screenname(values %{$connection->{screennames}}) { $screenname->{oscar}->signoff if $screenname->{oscar}; } } exec($0, @args); } $SIG{HUP} = \&rehash; #Hello Mort! sub REAPER { 1 until (-1 == waitpid(-1, WNOHANG)); $SIG{CHLD} = \&REAPER; } $SIG{CHLD} = \&REAPER; $lasttime = $checktime = time; $keepalive = 0; mainloop(); sub loadconf() { my($errors, $foundconfig, $conffile, %temp, $server, $output); #First we check to see what config files to use. #Then we use the config files. #Then we process command-line options. #We do it this way so that command-line options can override config files, and # you can still specify config files on the command-line. Getopt::Long::Configure("no_ignore_case"); Getopt::Long::Configure("pass_through"); $errors = &GetOptions( "version|V" => \&dispver, "license" => \&license, "config|C=s\@" => \@conffiles, "help|h" => \&help, "output=s" => \$output ); @conffiles = @default_conffiles unless $conffiles[0]; if(!$errors) { print STDERR "Try $0 --help if you need help.\n"; exit 1; } #Okay, try loading the config files $foundconfig = 0; foreach $conffile(@conffiles) { $conffile =~ s/~/$home/; print STDERR "Trying to read config file $conffile\n" if $verbose; if(-d $conffile) { print STDERR "$conffile is a directory!\n"; } elsif(-r $conffile) { print STDERR "Reading config file $conffile\n" if $verbose; $confversion = 0; do $conffile; die $@ if $@; if($confversion < 1.5) { print STDERR "Not using config file $conffile - it is too old (\$confversion must be >= 1.5)\n"; $foundconfig = -1 unless $foundconfig; } else { if($confversion == 1.5) { print STDERR "Do you have a channel where people can ask for help with IMIRC?\n"; print STDERR "If so, set \$localhelp to that channel (e.g. '\$localhelp = \"#imirc\";') in your IMIRC configuration file.\n"; print STDERR "In either case, change \$confversion to 1.6 in your config file to suppress this message.\n"; print STDERR "(Sleeping for 10 seconds to give you a chance to read this...)\n"; sleep 10; } $foundconfig = 1; } } elsif(-e $conffile) { print STDERR "Couldn't read config file $conffile\n"; } else { print STDERR "$conffile does not exist\n" if $verbose; } } unless($foundconfig) { print STDERR "We couldn't find a config file.\n"; print STDERR "You must edit imirc.conf and copy it to either /etc/imirc.conf or\n"; print STDERR " $home/.imirc. If you have already done this, make sure the IMIRC\n"; print STDERR " user has permission to read it.\n"; print STDERR "Or, perhaps you specified a config file with the --config (-C) option.\n"; print STDERR "If you want to specify everything on the command-line and not use a config\n"; print STDERR " file (why?) then just give it a blank config file to make it happy.\n"; exit 1; } if($foundconfig == -1) { print STDERR "Your configuration is too old.\n"; print STDERR "Please copy the imirc.conf file distributed with IMIRC to either\n"; print STDERR "/etc/imirc.conf or $home/.imirc and modify it as needed for your site.\n"; exit 1; } #Now process additional command-line options Getopt::Long::Configure("no_pass_through"); $errors = &GetOptions( "us=s" => \$us, "them=s" => \$them, "themport=i" => \$themport, "ourpass=s" => \$ourpass, "theirpass=s" => \$theirpass, "servermode=s" => \$servermode, "prefix=s" => \$prefix, "usnick=s" => \$usnick, "localhelp=s" => \$localhelp, "time=i" => \$time, "fork:i" => \$fork, "verbose|v" => \$verbose, "debug:i" => \$debug, "debuglevel=s\%" => \%debuglevel, "user_loglevel:i" => \$user_loglevel, "sendidle:i" => \$sendidle, "oscarserver=s" => \$oscarserver, "oscarport=i" => \$oscarport, "dccip=s" => \$dccip, "dcc:i" => \$dcc, "shortcircuit:i" => \$shortcircuit, "numeric=s" => \$numeric, "chatchan=s" => \$chatchan, "nickchan=s" => \$nickchan, "oldnick=s" => \$oldnick, "ignoreuhosts=s" => \$ignoreuhosts, "ignorehosts=s\@" => \@ignorehosts, "require_qlines:i" => \$require_qlines, "kill_impersonaters:i" => \$kill_impersonaters, "usepoll:i" => \$usepoll, ); if(!$errors) { print STDERR "Try $0 --help if you need help.\n"; exit 1; } %temp = %ircservers; #Preserve custom ircservers %ircservers = ( dal2 => { nick => "NICK _NICK_ 1 _TIME_ _USER_ _USER_.$us $us 0 :AOL Instant Messenger client via IMIRC\r\n:_NICK_ MODE _MODES_\r\n", server => "SERVER $us 1 :AOL Instant Messenger services\r\n", uspass => 1, theirpass => 1, nicklen => 30, pass => "PASS $ourpass :1\r\n", }, dragonfire => { nick => "NICK _NICK_ 1 _TIME_ _USER_ _USER_.$us $us :AOL Instant Messenger client via IMIRC\r\n:_NICK_ MODE _MODES_\r\n", server => "SERVER $us 1 :AOL Instant Messenger services\r\n", uspass => 1, theirpass => 1, nicklen => 10, pass => "PASS $ourpass :1\r\n" }, ircu => { nick => "NICK _NICK_ 1 _TIME_ _USER_ _USER_.$us _MODES_ :AOL Instant Messenger services\r\n", server => "SERVER $us 1 _TIME_ _TIME_ P09 :AOL Instant Messenger Services\r\n", uspass => 1, theirpass => 1, nicklen => 9, pass => "PASS :$ourpass\r\n" }, rfc => { nick => "NICK _NICK_ 1\r\n:_NICK_ USER _USER_ _USER_.$us $us :AOL Instant Messenger client via IMIRC\r\n:_NICK_ MODE _MODES_\r\n", server => "SERVER $us 1 :AOL Instant Messenger Services\r\n", uspass => 1, theirpass => 1, nicklen => 9, pass => "PASS :$ourpass\r\n" }, ts => { nick => "NICK _NICK_ 1 _TIME_ _MODES_ _USER_ _USER_.$us $us :AOL Instant Messenger client via IMIRC\r\n", server => "SERVER $us 1 :AOL Instant Messenger Services\r\nSVINFO 5 1 0 :_TIME_\r\n", uspass => 1, theirpass => 1, nicklen => 9, pass => "PASS $ourpass :TS\r\n", }, ts4 => { nick => "NICK _NICK_ 1 _TIME_ _MODES_ _USER_ _USER_.$us _USER_.$us $us :AOL Instant Messenger client via IMIRC\r\n", server => "CAPAB :QS EX PTS4\r\nSERVER $us 1 :AOL Instant Messenger Services\r\nSVINFO 4 4\r\nSVSINFO _TIME_ 0\r\n", uspass => 1, theirpass => 1, nicklen => 20, pass => "PASS $ourpass :TS\r\n", opermodes => "+oaA", }, unreal => { nick => "NICK _NICK_ 1 _TIME_ _USER_ _USER_.$us $us 0 :AOL Instant Messenger client via IMIRC\r\n:_NICK_ MODE _MODES_\r\n", server => "SERVER $us 1 :AOL Instant Messenger Services\r\n", uspass => 1, theirpass => 1, nicklen => 30, pass => "PASS :$ourpass\r\n", }, p0210 => { nick => "NICK _NICK_ 1 _USER_ _USER_.$us 1 _MODES_ :AOL Instant Messenger client via IMIRC\r\n", server => "SERVER $us 1 :AOL Instant Messenger Services\r\n", uspass => 1, nicklen => 9, pass => "PASS $ourpass 0210030002 IRC|aEfiIJMuw P\r\n", }, p10 => { nick => "$numeric N _NICK_ 1 _TIME_ _USER_ _USER_.$us _MODES_ A ${numeric}_NUMERIC_ :AOL Instant Messenger client via IMIRC\r\n", server => "SERVER $us 1 _TIME_ _TIME_ J10 ${numeric}]]] :AOL Instant Messenger Services\r\n$numeric EB\r\n$numeric EA\r\n", uspass => 1, theirpass => 1, nicklen => 9, pass => "PASS :$ourpass\r\n", }, bahamut => { nick => "NICK _NICK_ 2 _TIME_ _MODES_ _USER_ _USER_.$us $us _TIME_ :AOL Instant Messenger client via IMIRC\r\n", server => "SERVER $us 1 :AOL Instant Messenger Services\r\nSVINFO 3 1 0 :_TIME_\r\n", uspass => 1, theirpass => 1, nicklen => 30, pass => "PASS $ourpass :TS\r\n", }, dancer => { nick => "NICK _NICK_ 1 _TIME_ _MODES_ _USER_ _USER_.$us $us 0 :AOL Instant Messenger client via IMIRC\r\nSNICK _NICK_ _NICK_ _TIME_\r\n", server => "CAPAB :EX DNCR SRV DE\r\nSERVER $us 1 :AOL Instant Messenger Services\r\nSVINFO 5 1 0 :_TIME_\r\n:$us BURST KLINES\r\n", uspass => 1, theirpass => 1, nicklen => 30, pass => "PASS $ourpass :TS\r\n", opermodes => "+mopS3", }, ); foreach $server(keys %temp) { #Preserve custom ircservers $ircservers{$server} = $temp{$server}; } $usnick = new Net::OSCAR::Screenname $usnick; $oldnick = new Net::OSCAR::Screenname $oldnick if $oldnick; if($usepoll) { eval { require IO::Poll; }; if($@) { print STDERR "Couldn't load IO::Poll - falling back to select\n"; print STDERR "$@\n"; $usepoll = 0; } elsif($IO::Poll::VERSION < 0.05) { print STDERR "Your version of IO::Poll is too old - falling back to select\n"; $usepoll = 0; } elsif($IO::Poll::VERSION == 0.05) { print STDERR "Your version of IO::Poll has the remove bug - enabling workaround.\n"; *{IO::Poll::remove} = sub { my $self = shift; my $io = shift; $self->mask($io, 0); my $fd = fileno($io); delete $self->[0]{$fd} unless %{$self->[0]{$fd}}; #print STDERR "Called IO::Poll workaround\n"; }; } $poll = new IO::Poll if $usepoll; } if($usnick eq $oldnick) { print STDERR "\$usnick eq \$oldnick - ignoring \$oldnick\n"; undef $oldnick; } if(defined $output) { close STDOUT; close STDERR; open(STDOUT, ">>$output") or die "Couldn't open STDOUT: $!\n"; open(STDERR, ">>&STDOUT") or die "Couldn't open STDERR: $!\n"; select STDOUT; $| = 1; select STDERR; $| = 1; select STDOUT; } } sub mainloop() { my($connection, $screenname, $msg, $multinick, $i, $rv, $buff, $getrv, $rvbuff, $currtime, $nick, $sndata); my($rin, $win, $ein); $rin = $win = $ein = ''; my $oscardbg = $user_loglevel; $oscardbg = $debuglevel{oscar} if $debug and $debuglevel{oscar} > $user_loglevel; $oscarprime = Net::OSCAR->new(capabilities => [qw(extended_status buddy_icons)]); $oscarprime->loglevel($oscardbg); $oscarprime->set_callback_error(\&oscar_error); $oscarprime->set_callback_rate_alert(\&oscar_rate_alert); $oscarprime->set_callback_admin_error(\&oscar_admin_error); $oscarprime->set_callback_admin_ok(\&oscar_admin_ok); $oscarprime->set_callback_chat_closed(\&oscar_chat_closed); $oscarprime->set_callback_buddy_in(\&oscar_buddy_in); $oscarprime->set_callback_chat_buddy_in(\&oscar_chat_buddy_in); $oscarprime->set_callback_buddy_out(\&oscar_buddy_out); $oscarprime->set_callback_chat_buddy_out(\&oscar_chat_buddy_out); $oscarprime->set_callback_im_in(\&oscar_im_in); $oscarprime->set_callback_chat_im_in(\&oscar_chat_im_in); $oscarprime->set_callback_chat_invite(\&oscar_chat_invite); $oscarprime->set_callback_chat_joined(\&oscar_chat_joined); $oscarprime->set_callback_evil(\&oscar_evil); $oscarprime->set_callback_buddy_info(\&oscar_buddy_info); $oscarprime->set_callback_signon_done(\&oscar_signon_done); $oscarprime->set_callback_log(\&oscar_log); $oscarprime->set_callback_buddylist_error(\&oscar_buddylist_error); $oscarprime->set_callback_buddylist_ok(\&oscar_buddylist_ok); $oscarprime->set_callback_connection_changed(\&oscar_connection_changed); $oscarprime->set_callback_auth_challenge(\&oscar_auth_challenge); $oscarprime->set_callback_extended_status(\&oscar_extended_status); $oscarprime->set_callback_new_buddy_icon(\&oscar_new_buddy_icon); $oscarprime->set_callback_buddy_icon_uploaded(\&oscar_buddy_icon_uploaded); $oscarprime->set_callback_buddy_icon_downloaded(\&oscar_buddy_icon_downloaded); unless($reload) { $chatseq = 0; $usercount = 0; $maxusers = 0; foreach my $hashref ($aim_connections, $irc_connections, $nicks, $irc_away, $away, $longnicks, $shortnicks, $nickservers, $chants, $bouncequeue) { $hashref = $oscarprime->buddyhash(); } connect_to_irc(); $imircdebug = 0; sleep 60 if $servermode eq "p0210" and ($ignoreuhosts or $require_qlines); irc_send(irc_newnick($usnick, $ircservers{$servermode}{opermodes})) or die "Couldn't make usnick $usnick: $!\n"; irc_send(":$us OPER $usnick +\r\n") if $servermode eq "dancer"; $nicks->{$usnick}->{$usnick} = -1; if($oldnick) { irc_send(irc_newnick($oldnick, $ircservers{$servermode}{opermodes})) or die "Couldn't make oldnick $oldnick: $!\n"; irc_send(":$us OPER $oldnick +\r\n") if $servermode eq "dancer"; $nicks->{$oldnick}->{$usnick} = -1; } irc_send(irc_join($usnick, "#imirc-debug")); irc_send(irc_mode($us, "#imirc-debug", "+o $usnick")); irc_send(irc_mode($usnick, "#imirc-debug", "+nsk $ourpass")); $imircdebug = 1; $longnicks->{'#imirc-debug'} = '#imirc-debug'; checkstats() if $themname; while(1 == 1) { exit(255) unless $upstream; my $timeout = @getbuff ? 0.01 : 5; my($rout, $wout, $eout); if(!$usepoll) { select($rout=$select_rd, $wout=$select_wr, $eout=$select_err, $timeout) or @getbuff or goto CLEANUP; } else { my $rv = $poll->poll($timeout); # poll timeout is in milliseconds if($rv == -1) { next if $! == EINTR; die "Poll error: $!"; } $rv or @getbuff or goto CLEANUP; } local $SIG{ALRM} = sub { confess "IMIRC got stuck?" }; alarm 10; my($do_irc, @do_dcc) = 0; $do_irc = 1 if @getbuff; my $dccno = 0; my %dccmap = map { $_ => $dccno++ } @dccqueue; foreach my $handle ( $usepoll ? grep { $_ } $poll->handles(POLLIN | POLLOUT | POLLHUP | POLLERR | POLLNVAL) : grep { vec($rout|$wout|$eout, $_, 1) } keys %fdmap ) { next unless $handle; my $connection = $usepoll ? $fdmap{fileno($handle)} : $fdmap{$handle}; my ($read, $write, $error) = (0, 0, 0); if($usepoll) { my $events = $poll->events($handle); $read = 1 if $events & POLLIN; $write = 1 if $events & POLLOUT; $error = 1 if $events & (POLLNVAL | POLLERR | POLLHUP); } else { $read = 1 if vec($rout, $handle, 1); $write = 1 if vec($wout, $handle, 1); $error = 1 if vec($eout, $handle, 1); } # If we get, say, both can_read and connection_closed, ignore the closed until we're done reading #$error = 0 if $read or $write; io_events($handle, "deleted") if $error; if(UNIVERSAL::isa($connection, "Net::OSCAR::Connection")) { eval { $connection->process_one($read, $write, $error); }; if($@) { my $screenname = $connection->session->screenname if $connection->session; my $nick = $irc_connections->{$screenname} if $screenname; irc_send(irc_privmsg($usnick, $nick, "There was a problem with your AIM connection: $@", "", "", $screenname)); do_signoff($nick, $aim_connections->{$nick}->{screennames}->{$screenname}->{oscar}) if $aim_connections->{$nick}; } } elsif($connection == $upstream) { $do_irc = $read | ($error << 1); } else { # DCC $do_dcc[$dccmap{$connection}] = [$read, $write, $error]; } } if($do_irc or @getbuff) { debug_print("Processing IRC...", "irc", 2); my $irc_msg = irc_recv(1); if($irc_msg) { if($irc_msg =~ s/^:(\S+)(!\S+@\S+)?\s+//) { $nick = new Net::OSCAR::Screenname $1; } else { $nick = new Net::OSCAR::Screenname $themname; } eval { process_irc_message($irc_msg, $nick); }; if($@) { irc_send(irc_privmsg($usnick, $nick, "Error while processing your request: $@")); } } } $currtime = time; for(my $i = scalar(@dccqueue) - 1; $i >= 0; $i--) { my $dcc = $dccqueue[$i]; #debug_print("(proc'ing) dccqueue has DCC $dcc->{desc} from $dcc->{from} to $dcc->{to} (state=$dcc->{state}, fileno=".fileno($dcc->{socket}).")", "DCC", 3); if($currtime - $dcc->{time} > 3600) { irc_send(irc_privmsg($usnick, $dcc->{for}, "DCC connection timed out.", "", "", $dcc->{screenname})); close $dcc->{socket}; splice(@dccqueue, $i, 1); } if($dcc->{state} & DCC_STATE_WRITE) { next unless $do_dcc[$i]; } else { next unless $do_dcc[$i]; } eval { splice(@dccqueue, $i, 1) unless process_dcc($dcc, $currtime, @{$do_dcc[$i]}); }; if($@) { irc_send(irc_privmsg($usnick, $dcc->{for}, "Error with your DCC: $@")); } } CLEANUP: $currtime ||= time; foreach $nick(keys %$aim_connections) { next unless $nick; $connection = $aim_connections->{$nick}; foreach $screenname(keys %{$connection->{screennames}}) { next unless $screenname; $sndata = $connection->{screennames}->{$screenname}; next unless $sndata and ref $sndata eq "HASH" and defined $sndata->{signontime}; unless($sndata->{ison}) { next if ($currtime - $sndata->{signontime}) <= 10; irc_send(irc_privmsg($usnick, $nick, "Your attempt to connect to AOL Instant Messenger has failed.")); do_signoff($nick, $sndata->{oscar}, 1); } } } #Do this loop no more than once every 100 seconds if(($currtime - $lasttime) >= 100) { #Cleanup nicks timestuff($currtime); $lasttime = $currtime; } alarm 0; } } } sub connect_to_irc() { my($flags, $in, $pass); $upstream = IO::Socket::INET->new(PeerAddr => "$them:$themport", Timeout => 5) or die "Couldn't connect to IRC server $them:$themport ($!)\n"; ${*$upstream}{imirc_connected} = 0; set_blocking($upstream, 0); do { irc_send($ircservers{$servermode}{pass}) if $ourpass and $ircservers{$servermode}{uspass}; } or die "Couldn't send PASS: $!\n"; irc_send(irc_subparms($ircservers{$servermode}{server})) or die "Couldn't send PASS: $!\n"; $in = "..."; if($theirpass and $ircservers{$servermode}{theirpass}) { while($in and ($in !~ /PASS :?(.+)/)) { $in = irc_recv(); chomp $in; if($in =~ /^ERROR :(.+)/) { print STDERR "IRC connection error: $1\n"; exit 1; } elsif($in =~ /^SERVER (\S+)/) { $themname = $1; } } $in =~ s/ :1// if $in; $in =~ s/ :TS// if $in; $in =~ /^PASS :?(.+)/ if $in; $pass = $1; $pass =~ s/\s*//g if $pass; #Remove spaces from crypted password if($pass and $theirpass and ($pass ne $theirpass and $pass ne crypt($theirpass, substr($pass, 0, 2)))) { die("Upstream server gave the wrong password!\n"); } } ${*$upstream}{imirc_connected} = 1; io_events($upstream, "read", $upstream); } # Create a new IRCnick, with mangling and anti-collide sub irc_newnick($;$) { my($nick, $modes, $user, $string, $shortnick) = @_; $nick =~ tr/ //d; $user = $nick; $user =~ s/^$prefix//; $user =~ tr/0-9a-zA-Z//dc; $modes ||= "+i"; $nick = new Net::OSCAR::Screenname $nick; debug_print("Shall we create $nick?", "nicks", 2); return if exists($nicks->{noprefix($nick)}); $shortnick = new Net::OSCAR::Screenname ircify($nick); $nicks->{noprefix($nick)} = $oscarprime->buddyhash(); debug_print("\tCreating $nick (shortnick $shortnick)", "nicks", 1); $longnicks->{$shortnick} = $nick; $shortnicks->{$nick} = $shortnick; $string = irc_subparms($ircservers{$servermode}{nick}, $user, $shortnick, $modes); $string .= ":$shortnick MODE $shortnick +i\r\n"; return $string; } # Remove $prefix sub noprefix($) { my $nick = shift; $nick =~ s/^$prefix//i; return $nick; } # Does the hashref have any keys? sub haskeys($) { my $hashref = shift; return scalar keys %$hashref; } # Substitute parameters in %ircservers strings sub irc_subparms($;$$$) { my($input, $user, $nick, $modes, $time) = @_; $time = time; $user = substr($user, 0, 9); # Restrict username to 9 characters $input =~ s/_TIME_/$time/g; $input =~ s/_USER_/$user/g; $input =~ s/_NICK_/$nick/g; $input =~ s/_MODES_/$modes/g; return $input; } # Format an IRC private message - you must still irc_send it! sub irc_privmsg($$$;$$$) { my($from, $to, $msg, $prefix, $notice, $screenname, $line, $ret, $text, $maxlen, $temp) = @_; $prefix ||= ""; return unless $from and $to and $msg ne ""; if($screenname and $from eq $usnick and exists($aim_connections->{$to}->{screennames}->{$screenname}) and $aim_connections->{$to}->{screennames}->{$screenname}->{inchan}) { $to = nickchan($screenname); } elsif($screenname and $aim_connections->{$to} and normalize($screenname) ne normalize($aim_connections->{$to}->{aimnick})) { $msg = "{$screenname} " . $msg; } $maxlen = 450 - length($from) - length($to); foreach $line(split(/[\r\n]+/, $msg)) { $text = "$prefix$line"; while($text ne "") { #IRC has a max cmd len of 512. #Split up messages which would exceed this length #Try to split up on word boundaries. if(length($text) > $maxlen) { $temp = substr($text, 0, $maxlen, ""); $text = $1.$text if $temp =~ s/\s+(\S+)$//; } else { $temp = $text; $text = ""; } $ret .= ":$from " . ($notice ? "NOTICE" : "PRIVMSG") . " $to :$temp\r\n"; } } return $ret ne "" ? $ret : $msg; } # Process an incoming IRC message sub process_irc_message($$) { my($screenname, $nick, $sndata, $oscar); my $us_or_old = "$usnick"; $us_or_old .= "|$oldnick" if $oldnick; $_ = shift; return unless $_; $nick = shift; if($aim_connections->{$nick}) { foreach my $tmpscreenname(keys %{$aim_connections->{$nick}->{screennames}}) { $sndata = $aim_connections->{$nick}->{screennames}->{$tmpscreenname}; $sndata->{idletime} = time; if($sndata->{is_idle}) { $sndata->{is_idle} = 0; $sndata->{oscar}->set_idle(0); } } $oscar = $aim_connections->{$nick}->{oscar}; $screenname = $aim_connections->{$nick}->{aimnick}; $sndata = $aim_connections->{$nick}->{aimnick}; } if(/^ERROR +:(.+)/) { print STDERR "IRC server error: $1\n"; exit 1; } elsif(/^KILL +(\S+)/i) { my $nick = $1; if($nick eq $usnick or $nick eq $oldnick) { debug_print("We were killed: $_", "irc", 1); delete $nicks->{$nick}; irc_send(irc_newnick($nick)); irc_send(irc_mode($nick, $nick, "-i")); irc_send(irc_mode($nick, $nick, "+o")); $nicks->{$usnick}->{$usnick} = -1; } elsif($nick =~ /^$prefix/) { #One of our nicks was killed delete $nicks->{noprefix $1}; } else { #One of our users was killed did_quit($nick); } } elsif(/^VERSION/i) { irc_send(irc_error($nick, 351, "IMIRC-$VERSION. $us :IMIRC")); } elsif(/^JOIN +:?(.+)/i) { my $chans = $1; foreach my $chan (split(/,/, $chans)) { did_join($nick, $chan); } } elsif(/^(SJOIN) +(\d+) +(?:\d* *)(\S+?) +\S+ +: *(\S+)/i or /^(NJOIN) +(\S+?) +:(\S+)/i) { my $chan = ($1 eq "SJOIN") ? $3 : $2; $chants->{$chan} = $2 if $1 eq "SJOIN"; $nick = ($1 eq "SJOIN") ? $4 : $3; $nick =~ tr/\@+//d; if($1 eq "NJOIN") { $nick =~ s/,.*//; $nick =~ s/\x07.*//; } did_join(new Net::OSCAR::Screenname($nick), $chan); } elsif(/^INVITE +(\S+) +:?$chatchan(\d+)/i) { my $recipient = noprefix($longnicks->{$1}); my $chat = $2; my $topic = $chats{$chat}->{name}; return if $nick eq $usnick; $topic =~ s/^{.+?} //; $chats{$chat}->{obj}->invite($recipient, "Please come to $topic.") if $chats{$chat}->{obj}; } elsif(/^MODE +($nickchan|$chatchan)(\S+) +:?(.+)/i) { my $chantype = $1; my $chanparm = $2; my $chan = $1.$2; my $modes = $3; my ($mode, $parms, @matches, @modes, @params, @tparams, $params, $modestring, $modechar, $modeparm, $modetype, $status); if($nick eq $themname and $servermode eq "unreal") { $modes =~ s/\s*(\d+)$//; # Argh. # Unreal 3.1: # :somedude JOIN #chan # MODE #chan +o somedude 1234 # MODE #chan + somedude 1233 # Unreal 3.2: # :somedude JOIN #chan # MODE #chan +o somedude 1233 $chants->{$chan} = $1 - 10; return bounce_join(delete($bouncequeue->{$chan}), $chan) if $bouncequeue->{$chan}; return if $modes =~ /^&/; # TS uses this to indicate that it's bouncing the modes } irc_send(irc_error($nick, 504, "You cannot change modes in AIM ".(($chantype eq $chatchan) ? "chat" : "nick")." channels.")) if $aim_connections->{$nick}; $modes =~ tr/+-/-+/; $modes =~ s/\s*\d+[\r\n]*$// unless $aim_connections->{$nick}; #debug_print("Modes: $modes", "errors", 3); @matches = $modes =~ m/([-+][a-zA-Z]+)\s*/g or debug_print("Mode parse failed.", "errors", 3); foreach $modestring(@matches) { #debug_print("Mode parse suceeded: $modestring", "errors", 3); $modetype = substr($modestring, 0, 1, ""); #debug_print("modetype is $modetype", "errors", 3); MODE: while($modechar = substr($modestring, 0, 1, "")) { #debug_print("Got modechar $modechar", "errors", 3); if($modechar =~ /[vbokl]/) { #Mode takes a parm $modes =~ s/(?:\s|\A)([^-+]\S*)(?:\s|\Z)/ / or next MODE; $modeparm = $1; #debug_print("Mode takes parm, parm is $modeparm", "errors", 3); } else { $modeparm = ""; } if($modechar eq "o" and $modeparm eq $usnick) { if($modetype eq "+") { irc_send(irc_mode(IsTS() ? $us : $usnick, $chan, "+o $usnick")); } } elsif($modechar eq "o" and $aim_connections->{$modeparm} and $modetype eq "-") { #Do nothing } elsif(($modechar eq "t" or $modechar eq "s" or $modechar eq "n" or $modechar eq "i") and $modetype eq "-") { #Do nothing } else { #debug_print("Adding to \@modes: (char => $modechar, type => $modetype, parm => $modeparm)", "errors", 3); push @modes, { char => $modechar, type => $modetype, parm => $modeparm }; } } } #foreach $mode(@modes) { # debug_print("Got mode: " . $mode->{type} . $mode->{char} . " " . $mode->{parm}, "irc", 3); #} $modestring = ""; $parms = ""; foreach $mode(sort { $a->{type} cmp $b->{type} } @modes) { if($mode->{type} eq "-" and not $status & 1) { #We have a -, modestring doesn't $modestring .= "-"; $status |= 1; } elsif($mode->{type} eq "+" and not $status & 2) { #We have a +, modestring doesn't $modestring .= "+"; $status |= 2; } $modestring .= $mode->{char}; $parms .= " $mode->{parm}" if $mode->{parm}; } $modestring .= $parms; #debug_print("Mode parse final: $modestring", "errors", 3); irc_send(irc_mode($usnick, $chan, $modestring)) if $modestring; } elsif(/^TOPIC +$chatchan(\d+)/i) { irc_send(irc_error($nick, 505, "Cannot change topic in AIM chat channels.")); irc_send(irc_topic($usnick, chatchan($1), $chats{$1}->{name})); } elsif(/^KICK +$chatchan(\d+) +(\S+)/i) { irc_send(irc_error($nick, 503, "Cannot kick users from AIM chat channels.")); irc_send(irc_join($2, chatchan($1))); if($2 eq $usnick) { irc_send(irc_mode(IsTS() ? $us : $usnick, chatchan($1), "+o $usnick")); } } elsif(/^PART +$chatchan(\d+)/i) { my $chat = $1; if(exists $aim_connections->{$nick}->{screennames}->{$chats{$1}->{screenname}}) { debug_print("$nick left chat $1 (".$chats{$1}->{name}.").", "chat", 1); if($aim_connections->{$nick} and $chats{$1}->{name}) { $chats{$chat}->{obj}->part() if $chats{$chat}->{obj}; irc_send(irc_part($usnick, chatchan($1))); foreach my $who(keys %{$chats{$1}->{members}}) { delete $chats{$1}->{members}->{$who}; irc_send(irc_part(aimnick($who, $screenname), chatchan($1))); rm_nick_user($who, $chatchan.$1); } delete $chats{$1}; } } } elsif(!/#imirc-debug/i and /^PART +$nickchan(\S+)/i) { my $screenname = $1; my $dude; if(exists $aim_connections->{$nick}->{screennames}->{$screenname} and $aim_connections->{$nick}->{screennames}->{$screenname}->{inchan}) { $aim_connections->{$nick}->{screennames}->{$screenname}->{inchan} = 0; foreach $dude(keys %$nicks) { next unless $nicks->{$dude}->{$screenname}; irc_send(irc_part(aimnick($dude, $screenname), nickchan($screenname))); } irc_send(irc_part($usnick, nickchan($screenname))); } } elsif(!/#imirc-debug/i and (/^(PRIVMSG|NOTICE) +(?:$us_or_old)(\@\S+)? +:?(.+)/i or /^(PRIVMSG|NOTICE) +$nickchan(\S+) +:?(.+)/i)) { my($cmd, $param, $extra); return if ignorenick($nick); my $notice = ($1 eq "NOTICE" ? 1 : 0); $screenname = $sndata = ""; $screenname = $2 if exists $aim_connections->{$nick}->{screennames}->{$2}; $screenname ||= $aim_connections->{$nick}->{aimnick} if exists $aim_connections->{$nick}; $screenname = new Net::OSCAR::Screenname $screenname if $screenname; my $msg = process_ctcp($nick, $usnick, $3, $screenname, $notice); return unless $msg; $cmd = undef; $extra = undef; $param = undef; $msg =~ /(\S+) ?(\S*)( ?.*)/ or $cmd = $msg; $cmd = $1 unless $cmd; $param = $2 if $2 or $2 eq "0"; $extra = substr($3, 1) || "" if $3; $cmd ||= $msg; #For cmds w/o param #warn "Cmd: $cmd\nParam: $param: Extra: $extra\n\n"; $nick = lc($nick); $param ||= ""; debug_print("Received IRC command $cmd from '$screenname'", "irc", 2) if $screenname; if($aim_connections->{$nick}) { my $connection = $aim_connections->{$nick} if exists $aim_connections->{$nick} and ref $aim_connections->{$nick}; $sndata = $connection->{screennames}->{$screenname} if $connection; $oscar = $sndata->{oscar} if $sndata; # Let the user talk to buddies in #imirc-screenname # This triggers inchan==2 mode if($cmd =~ /(?:$prefix)?(.+?)\x02?:\x02?/ and $sndata->{inchan}) { my $recipient = $1; $sndata->{inchan} = 2 unless $sndata->{inchan} == 3; $msg =~ s/.*?:\x02? //; send_im($oscar, $recipient, $msg); return; } } unless($screenname or ($cmd eq "stats") or ($cmd eq "signon") or ($cmd eq "help")) { irc_send(irc_privmsg($usnick, $nick, "You must use the signon command to sign on to AOL Instant Messenger before using this service.")); } elsif($cmd eq "stats") { if($param eq "users" and $msg =~ /users $ourpass/) { irc_send(irc_privmsg($usnick, $nick, "$usercount users (max $maxusers): " . join(", " , keys %$irc_connections))); } elsif($param eq "users") { irc_send(irc_privmsg($usnick, $nick, "$usercount users (max $maxusers)")); } elsif($param eq "uptime") { my($days, $hours, $minutes, $seconds); $seconds = time - $starttime; $minutes = int($seconds / 60); $seconds -= $minutes*60; $hours = int($minutes / 60); $minutes -= $hours*60; $days = int($hours / 24); $hours -= $days*24; irc_send(irc_privmsg($usnick, $nick, sprintf("Up $days day(s), %02d:%02d:%02d", $hours, $minutes, $seconds))); } elsif($param eq "version") { irc_send(irc_privmsg($usnick, $nick, "Version IMIRC $version (Net::OSCAR $Net::OSCAR::VERSION)")); } else { irc_send(irc_privmsg($usnick, $nick, "Unknown stat - try 'stats users', 'stats version', or 'stats uptime'")); } } elsif($cmd eq "signon") { unless($param and $extra) { irc_send(irc_privmsg($usnick, $nick, "Usage: signon [--loglevel loglevel] [--hashpass] screenname password")); } elsif($irc_connections->{$param} and !$aim_connections->{$irc_connections->{$param}}->{screennames}->{$param}->{ison}) { irc_send(irc_privmsg($usnick, $nick, "A signon attempt for that screenname is already in progress.")); } else { if($aim_connections->{$nick}->{screennames}->{$param}) { irc_send(irc_privmsg($usnick, $nick, "You are already signed onto AOL instant messenger under that screenname.")); } else { irc_send(irc_privmsg($usnick, $nick, "Signing on to AOL Instant Messenger...")); local @ARGV = split(/\s+/, "$param $extra"); my $loglevel = $user_loglevel; my $hashpass = 0; my $errors = &GetOptions( "loglevel|l|d=i" => \$loglevel, "hashpass|h" => \$hashpass, ); if(!$errors) { irc_send(irc_privmsg($usnick, $nick, "Invalid signon command - '/msg $usnick signon' for usage.")); } else { my $params = {loglevel => $loglevel}; my $cmdline = "$param $extra"; $cmdline =~ s/-+(loglevel|l|d)\s+\d+\s+//; $cmdline =~ s/-+(hashpass|h)\s+//; my($screenname, $password) = split(/\s+/, $cmdline, 2); if(!$password and !$hashpass) { irc_send(irc_privmsg($usnick, $nick, "You must provide a password.")); } else { do_signon($screenname, $password, $nick, $params); # If using hashpass, give user extra time to sign on $aim_connections->{$nick}->{screennames}->{$screenname}->{signontime} += 60 if $hashpass;; } } } } } elsif ($cmd eq "buddylist") { my(%groups, $buddy, $group, $xbuddy, $evil, $line, $buddat); foreach $group($oscar->groups) { irc_send(irc_privmsg($usnick, $nick, "$group:", "", "", $screenname)); foreach $buddy(sort { $b->{online} <=> $a->{online} or $a->{away} <=> $b->{away} or $a->{idle_since} <=> $b->{idle_since} } map { $oscar->buddy($_, $group) } $oscar->buddies($group)) { $evil = $buddy->{evil}; $line = "\t" . $buddy->{screenname}; $line .= " {$buddy->{comment}}" if $buddy->{comment}; $line .= " (POUNCE)" if exists $buddy->{data}->{0x0200}; $line .= " [online]" if $buddy->{online}; $line .= " [icon]" if $buddy->{icon_md5sum}; $line .= " [away]" if $buddy->{online} and $buddy->{away}; $line .= " [warning level $evil%]" if $evil; $line .= " {Alias: $buddy->{alias}}" if $buddy->{alias} and $buddy->{screenname} ne $buddy->{alias}; $line .= " {Status: $buddy->{extended_status}}" if $buddy->{extended_status}; irc_send(irc_privmsg($usnick, $nick, $line, "", "", $screenname)); } } irc_send(irc_privmsg($usnick, $nick, "[End of Buddylist]", "", "", $screenname)); } elsif ($cmd eq "onbuddies") { my(%groups, $buddy, $group, $xbuddy, $line, $evil, $buddat); foreach $group($oscar->groups) { my $showedgroup = 0; foreach $buddy(sort { $a->{away} <=> $b->{away} or $a->{idle_since} <=> $b->{idle_since} } map { $oscar->buddy($_, $group) } $oscar->buddies($group)) { irc_send(irc_privmsg($usnick, $nick, "$group:", "", "", $screenname)) unless $showedgroup++; $evil = $buddy->{evil}; $line = "\t".$buddy->{screenname}; next unless $buddy->{online}; $line .= " {$buddy->{comment}}" if $buddy->{comment}; $line .= " (POUNCE)" if exists $buddy->{data}->{0x0200}; $line .= " [icon]" if $buddy->{icon_md5sum}; $line .= " [away]" if $buddy->{away}; $line .= " [warning level $evil%]" if $evil; $line .= " {Alias: $buddy->{alias}}" if $buddy->{alias} and $buddy->{screenname} ne $buddy->{alias}; $line .= " {Status: $buddy->{extended_status}}" if $buddy->{extended_status}; irc_send(irc_privmsg($usnick, $nick, $line, "", "", $screenname)); } } irc_send(irc_privmsg($usnick, $nick, "[End of OnBuddies]", "", "", $screenname)); } elsif ($cmd eq "permitlist") { my @permitlist = $oscar->get_permitlist(); irc_send(irc_privmsg($usnick, $nick, "Permit List:", "", "", $screenname)); if(@permitlist) { irc_send(irc_privmsg($usnick, $nick, "\t" . join("\n\t", sort @permitlist), "", "", $screenname)); } irc_send(irc_privmsg($usnick, $nick, "[End of Permit List]", "", "", $screenname)); } elsif ($cmd eq "denylist") { my @denylist = $oscar->get_denylist(); irc_send(irc_privmsg($usnick, $nick, "Deny List:", "", "", $screenname)); if(@denylist) { irc_send(irc_privmsg($usnick, $nick, "\t" . join("\n\t", sort @denylist), "", "", $screenname)); } irc_send(irc_privmsg($usnick, $nick, "[End of Deny List]", "", "", $screenname)); } elsif ($cmd eq "signoff") { do_signoff($nick, $oscar); } elsif ($cmd eq "buddyinfo") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: buddyinfo screenname", "", "", $screenname)); } else { my $buddyconf = $oscar->buddy($param); if($buddyconf->{online}) { my $msg = "Buddy Info for $buddyconf->{screenname}\r\n"; $msg .= "Group: \t".$oscar->findbuddy($param)."\r\n"; $msg .= printable_user_info($buddyconf); irc_send(irc_privmsg($usnick, $nick, $msg, "", "", $screenname)); } else { irc_send(irc_privmsg($usnick, $nick, "That person is either not on your buddy list or not signed on.", "", "", $screenname)); } } } elsif ($cmd eq "rename_group") { unless($param and $extra) { irc_send(irc_privmsg($usnick, $nick, "Usage: rename_group oldgroup newgroup", "", "", $screenname)); } else { $oscar->rename_group($param, $extra); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++;; } } elsif ($cmd eq "add_buddy") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: add_buddy screenname [group]", "", "", $screenname)); } else { my $group = $extra || "Buddies"; my %rembuds = (); my @buddies = split(/,\s*/, $param); $oscar->add_buddy($group, @buddies); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } elsif ($cmd eq "remove_buddy") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: remove_buddy screenname", "", "", $screenname)); } else { my @buddies = split(/,\s*/, $param); map { irc_send(irc_part(aimnick($_, $screenname), nickchan($screenname), "Removed from buddylist.")) if $sndata->{inchan}; rm_nick_user($_, $screenname); } @buddies; my %rembuds = (); foreach my $buddy(@buddies) { my $currgroup = $oscar->findbuddy($buddy); push @{$rembuds{$currgroup}}, $buddy; } foreach my $remgroup(keys %rembuds) { $oscar->remove_buddy($remgroup, @{$rembuds{$remgroup}}); } $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } elsif ($cmd eq "evil" or $cmd eq "warn") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: $cmd screenname [anon]", "", "", $screenname)); } else { $param = lc($param); if($extra ne "anon") { $extra = 0; } else { $extra = 1; } $oscar->evil($param, $extra); } } elsif ($cmd eq "add_permit") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: add_permit screenname", "", "", $screenname)); } else { my @buddies = split(/,\s*/, $param); $oscar->add_permit(@buddies); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } elsif ($cmd eq "add_deny") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: add_deny screenname", "", "", $screenname)); } else { my @buddies = split(/,\s*/, $param); $oscar->add_deny(@buddies); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } elsif ($cmd eq "remove_deny") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: remove_deny screenname", "", "", $screenname)); } else { my @buddies = split(/,\s*/, $param); $oscar->remove_deny(@buddies); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } elsif ($cmd eq "remove_permit") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: remove_permit screenname", "", "", $screenname)); } else { my @buddies = split(/,\s*/, $param); $oscar->remove_permit(@buddies); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } elsif ($cmd eq "join") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: join chat_name", "", "", $screenname)); } else { $param = "$param $extra" if $extra; $oscar->chat_join($param); } } elsif ($cmd eq "join_exchange") { unless($param and $extra) { irc_send(irc_privmsg($usnick, $nick, "Usage: join_exchange exchange chat_name", "", "", $screenname)); } else { $oscar->chat_join($extra, $param); } } elsif ($cmd eq "get_permit_mode") { irc_send(irc_privmsg($usnick, $nick, "Your permit mode is " . $oscar->visibility . ".", "", "", $screenname)); } elsif ($cmd eq "set_permit_mode") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: set_permit_mode newmode", "", "", $screenname)); } else { if($param != 1 and $param != 2 and $param != 3 and $param != 4 and $param != 5) { irc_send(irc_privmsg($usnick, $nick, "That is not a valid permit mode. See list_permit_modes for valid permit modes.", "", "", $screenname)); } else { $oscar->set_visibility($param); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } } elsif ($cmd eq "list_permit_modes") { irc_send(irc_privmsg($usnick, $nick, "1=Permit All, 2=Deny All, 3=Permit if and only if on permitlist, 4=Deny if and only if on denylist, 5=Permit if and only if on buddylist", "", "", $screenname)); } elsif ($cmd eq "info" or $cmd eq "get_info" or $cmd eq "get_profile") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: info screenname", "", "", $screenname)); } else { $sndata->{info_requested}->{$param} = 1; $oscar->get_info($param); } } elsif ($cmd eq "set_info" or $cmd eq "set_profile") { my $text; unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: $cmd info", "", "", $screenname)); } else { $extra ? ($text = "$param $extra") : ($text = $param); $oscar->set_info($text); $oscar->commit_buddylist; $oscar->{__IMIRC_blmod}++; } } elsif ($cmd eq "set_away") { my $text; $extra ? ($text = "$param $extra") : ($text = $param); $oscar->set_away($text); } elsif ($cmd eq "get_dir") { #unless($param) { # irc_send(irc_privmsg($usnick, $nick, "Usage: get_dir screenname", "", "", $screenname)); #} else { # get_directory($sndata->{socket}, $param); #} irc_send(irc_privmsg($usnick, $nick, "Not implemented.", "", "", $screenname)); } elsif ($cmd eq "set_dir") { irc_send(irc_privmsg($usnick, $nick, "Not implemented.", "", "", $screenname)); #$param = "$param $extra" if $extra; #if($param and $param ne "set_dir") { # @temp = split(/:/, $param); # %temp = ( # first_name => shift @temp, # middle_name => shift @temp, # last_name => shift @temp, # maiden_name => shift @temp, # city => shift @temp, # state => shift @temp, # country => shift @temp, # allow_web_searches => shift @temp # ); # set_directory($sndata->{socket}, %temp); #} else { # irc_send(irc_privmsg($usnick, $nick, "first name:middle name:last name:maiden name:city:state:country:websearch. Don't put any colons in any of these. If you put anything in the websearch field, people can find your directory info using web searches.", "", "", $screenname)); #} } elsif ($cmd eq "dir_search") { irc_send(irc_privmsg($usnick, $nick, "Not implemented.", "", "", $screenname)); #$param = "$param $extra" if $extra; #if($param and $param ne "dir_search") { # @temp = split(/:/, $param); # %temp = ( # first_name => shift @temp, # middle_name => shift @temp, # last_name => shift @temp, # maiden_name => shift @temp, # city => shift @temp, # state => shift @temp, # country => shift @temp, # allow_web_searches => shift @temp # ); # directory_search($sndata->{socket}, %temp); #} else { # irc_send(irc_privmsg($usnick, $nick, "first name:middle name:last name:maiden name:city:state:country:websearch. Don't put any colons in any of these. If you put anything in the websearch field, people can find your directory info using web searches.", "", "", $screenname)); #} } elsif ($cmd eq "add") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: add screenname", "", "", $screenname)); } else { $param = noprefix($param); unless($nicks->{$param}) { irc_send(irc_newnick($prefix . $param)); } manglewarn($nick, $prefix.$param, $screenname); $nicks->{$param}->{$screenname} = time; irc_send(irc_privmsg($usnick, $nick, "$param has been created on IRC.", "", "", $screenname)); irc_send(irc_join(aimnick($param, $screenname), nickchan($screenname))) if $sndata->{inchan}; } } elsif ($cmd eq "sendidle") { unless($param == 0 or $param == 1) { irc_send(irc_privmsg($usnick, $nick, "Usage: sendidle (0|1)", "", "", $screenname)); } else { $sndata->{report_idle} = $param; irc_send(irc_privmsg($usnick, $nick, "Idle reporting changed.", "", "", $screenname)); } } elsif ($cmd eq "format_nickname" or $cmd eq "format_screenname") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: $cmd screenname", "", "", $screenname)); } else { $param .= " $extra" if $extra; $oscar->format_screenname($param); } } elsif ($cmd eq "change_password") { unless($param and $extra) { irc_send(irc_privmsg($usnick, $nick, "Usage: change_password old_password new_password", "", "", $screenname)); } else { $oscar->change_password($param, $extra); } } elsif ($cmd eq "change_email") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: change_email new_email")); } else { $oscar->change_email($param); } } elsif ($cmd eq "confirm_account") { $oscar->confirm_account(); } elsif ($cmd eq "loadbuddies") { $sndata->{blmerge} = $param; $dccget{$nick} = [$screenname, "list"]; irc_send(irc_ctcp($usnick, $nick, "loadbuddies")); irc_send(irc_privmsg($usnick, $nick, "Please DCC SEND $usnick your buddylist.", "", "", $screenname)); } elsif ($cmd eq "savebuddies") { my $fmtoscar = 1; my($filename, $message); unless($dccip) { irc_send(irc_privmsg($usnick, $nick, "savebuddies is not available on this server - the administrator has not specified a DCC IP in the IMIRC configuration file.", "", "", $screenname)); } else { $fmtoscar = 0 if $param and lc($param) eq "toc"; my $config = export_buddylist($oscar, $fmtoscar); if($fmtoscar) { $filename = "$screenname.blt"; } else { $filename = "$screenname.txt"; } $message = irc_dcc($usnick, $nick, $config, "savebuddies", $filename, $screenname); if($message) { irc_send($message); irc_send(irc_ctcp($usnick, $nick, "savebuddies")); irc_send(irc_privmsg($usnick, $nick, "Please accept the DCC SEND from $usnick. The file being sent is your buddylist.", "", "", $screenname)); } } } elsif ($cmd eq "get_icon") { unless($dccip) { irc_send(irc_privmsg($usnick, $nick, "get_icon is not available on this server - the administrator has not specified a DCC IP in the IMIRC configuration file.", "", "", $screenname)); } elsif(!$param) { irc_send(irc_privmsg($usnick, $nick, "Usage: get_icon screenname", "", "", $screenname)); } elsif(!$oscar->buddy($param) or !$oscar->buddy($param)->{icon_md5sum}) { irc_send(irc_privmsg($usnick, $nick, "Couldn't find icon information for $param.", "", "", $screenname)); } else { irc_send(irc_privmsg($usnick, $nick, "Requesting buddy icon for $param...", "", "", $screenname)); $oscar->get_icon($param, $oscar->buddy($param)->{icon_md5sum}); } } elsif ($cmd eq "set_icon") { unless($dccip) { irc_send(irc_privmsg($usnick, $nick, "set_icon is not available on this server - the administrator has not specified a DCC IP in the IMIRC configuration file.", "", "", $screenname)); } else { $dccget{$nick} = [$screenname, "icon"]; irc_send(irc_ctcp($usnick, $nick, "set_icon")); irc_send(irc_privmsg($usnick, $nick, "Please DCC SEND $usnick your buddy icon.", "", "", $screenname)); } } elsif ($cmd eq "set_status") { $param .= " $extra" if $extra; $oscar->set_extended_status($param); } elsif ($cmd eq "add_pounce") { unless($param and $extra) { irc_send(irc_privmsg($usnick, $nick, "Usage: add_pounce buddy text", "", "", $screenname)); } else { my $group = $oscar->findbuddy($param); if(!defined($group)) { irc_send(irc_privmsg($usnick, $nick, "You may only add pounces for people on your buddylist.", "", "", $screenname)); } else { $oscar->get_app_data($group, $param)->{0x0200} = $extra; $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } } elsif ($cmd eq "remove_pounce") { unless(defined $param) { irc_send(irc_privmsg($usnick, $nick, "Usage: remove_pounce buddy", "", "", $screenname)); return; } else { my $group = $oscar->findbuddy($param); if(!defined($group)) { irc_send(irc_privmsg($usnick, $nick, "You may only remove pounces for people on your buddylist.", "", "", $screenname)); } else { delete $oscar->get_app_data($group, $param)->{0x0200}; $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } } elsif ($cmd eq "show_pounce") { unless(defined $param) { irc_send(irc_privmsg($usnick, $nick, "Usage: remove_pounce buddy", "", "", $screenname)); return; } else { my $group = $oscar->findbuddy($param); if(!defined($param)) { irc_send(irc_privmsg($usnick, $nick, "You may only show pounces for people on your buddylist.", "", "", $screenname)); } else { my $pounce = $oscar->get_app_data($group, $param)->{0x0200}; if($pounce) { irc_send(irc_privmsg($usnick, $nick, $pounce, "", "", $screenname)); } else { irc_send(irc_privmsg($usnick, $nick, "You do not have a pounce for that person.", "", "", $screenname)); } } } } elsif($cmd eq "help") { my $foo = ":$usnick PRIVMSG $nick"; $foo = ":$usnick PRIVMSG ".nickchan($screenname) if $sndata->{inchan}; if($param eq "basics") { irc_send("$foo :help - Show this screen.\r\n", 1); irc_send("$foo :signon [--loglevel loglevel] [--hashpass] screenname pass - Sign on to AOL Instant Messenger (AIM). You must do this before any of the other commands.\r\n", 1); irc_send("$foo : loglevel should be a number between ".OSCAR_DBG_NONE." and ".OSCAR_DBG_PACKETS.". Higher numbers give you more information.\r\n", 1); irc_send("$foo : If --hashpass is present, you do not have to provide your password; you will be responsible for performing an MD5 digest.\r\n", 1); irc_send("$foo : With the hashpass mechanism, there is no way for IMIRC to determine your AIM password, but if you don't know what an MD5 digest is or how to do one, you can't take advantage of this. Sorry.\r\n", 1); irc_send("$foo :signoff - Sign off of AIM.\r\n", 1); irc_send("$foo :add screenname - Create an IRC nickname for screenname. Use this to talk to someone who's not on your buddylist.\r\n", 1); irc_send("$foo :get_permit_mode - See your current permit mode.\r\n", 1); irc_send("$foo :set_permit_mode newmode - Set your permit mode.\r\n", 1); irc_send("$foo :list_permit_modes - List the valid permit modes and their definitions.\r\n", 1); } elsif($param eq "buddylist") { irc_send("$foo :NOTE: For the commands that take screenname[,screenname2,...screennameN] as a parameter, you must have only commas between the screennames.\r\n", 1); irc_send("$foo :You may NOT have spaces between the screennames!\r\n", 1); irc_send("$foo : \r\n", 1); irc_send("$foo :rename_group oldgroup newgroup - Rename a group\r\n", 1); irc_send("$foo :add_buddy screenname[,screenname2,...,screennameN] [group] - Add screenname (possibly multiple screennames) to your buddy list. If you give a group, the screenname will be added to that buddy group.\r\n", 1); irc_send("$foo :remove_buddy screenname[,screenname2,...,screennameN] - Remove screenname (possibly multiple screennames) from your buddy list.\r\n", 1); irc_send("$foo :onbuddies - List buddies who are currently signed on (and who don't have you on block.)\r\n", 1); irc_send("$foo :buddylist - List everyone on your buddylist.\r\n", 1); irc_send("$foo :savebuddies [TOC] - DCC SENDs you a copy of your buddylist. By default it will be in \"OSCAR format\" - use the TOC parameter for \"TOC format\".\r\n", 1) if $dccip; irc_send("$foo :loadbuddies [merge] - DCC GETs a copy of your buddylist and uses that as your new buddylist. You must do this before sending the file. If the merge parameter is present, the new buddylist will be merged with your current buddylist. Otherwise, it will replace your buddylist.\r\n", 1); irc_send("$foo :clonebuddies [--merge] to|from screenname - Copy the buddylist to/from your current screenname to/from another screenname you are signed on under. The direction given in the command is with respect to your default screenname, i.e. use 'to' to clone the buddylist of your default screenname \2to\2 the other screenname. Behavior in regards to merging/replacing of the buddylist is the same as that of loadbuddies.\r\n", 1); irc_send("$foo :reorder_groups group1, group2, ... - Changes the order of the groups in your buddylist.\r\n", 1); irc_send("$foo :reorder_groups group buddy1, buddy2, ... - Changes the order of the buddies in a group on your buddylist.\r\n", 1); irc_send("$foo : \r\n", 1); irc_send("$foo :Note on savebuddies\\loadbuddies: savebuddies will send you a CTCP savebuddies (loadbuddies sends CTCP loadbuddies.\r\n", 1); irc_send("$foo :This allows IRC client scripts to be written to automate the sending and receiving of the file.\r\n", 1); irc_send("$foo :There are two buddylist formats which savebuddies and loadbuddies understand.\r\n", 1); irc_send("$foo :OSCAR format is the format that the Windows AOL Instant Messenger client exports its buddylist in.\r\n", 1); irc_send("$foo :TOC format is used internally by TOC and most TOC clients will export in this format.\r\n", 1); } elsif($param eq "privacy") { irc_send("$foo :add_permit screenname[,screenname2,...,screennameN] - Add screenname (possibly multiple screenname) to your permit list, removing from deny list.\r\n", 1); irc_send("$foo :add_deny screenname[,screenname2,...,screennameN] - Add nick (possibly multiple screenname) to your deny list, removing from permit list.\r\n", 1); irc_send("$foo :remove_permit screenname[,screenname2,...,screennameN] - Remove screenname (possibly multiple screennames) from permit list.\r\n", 1); irc_send("$foo :remove_deny screenname[,screenname2,...,screennameN] - Remove screenname (possibly multiple screennames) from deny list.\r\n", 1); irc_send("$foo :permitlist - See who is on your permit list.\r\n", 1); irc_send("$foo :denylist - See who is on your deny list.\r\n", 1); } elsif($param eq "buddyinfo") { irc_send("$foo :buddyinfo screenname - Get signon time, idle time, evil level, and user class for a buddy.\r\n", 1); irc_send("$foo :warn screenname [anon] - Warn screenname, optionally anonymously.\r\n", 1); irc_send("$foo :set_buddy_comment buddy comment - Associate a brief comment with a buddy. This can be something like the buddy's real name.\r\n", 1); irc_send("$foo :get_away screenname - View someone's away message.\r\n", 1); irc_send("$foo :get_icon screenname - Download someone's buddy icon.\r\n", 1); } elsif($param eq "chat") { irc_send("$foo :join chat_name - Create/join a chatroom called chat_name.\r\n", 1); irc_send("$foo :join_exchange exchange chat_name - Create/join a chatroom in a different exchange (see below.)\r\n", 1); #I don't think AOL has implemented this. --MS #irc_send("$foo :chat_evil chat_id nick [anon] (or chat_warn chat_id nick [anon]) - Warn nick inside chat_id, optionally anonymously.\r\n", 1); irc_send("$foo : \r\n", 1); irc_send("$foo :Note on join_exchange: The default exchange is 4. However, many AIM chats (including most/all listed in AOL's 'Hot Chats' use exchange 5.\r\n", 1); irc_send("$foo : \r\n", 1); irc_send("$foo :To invite someone into a chat, use the IRC INVITE command on their AIM- screenname.\r\n", 1); irc_send("$foo :Example: /invite AIM-SomeDude ${chatchan}1234\r\n", 1); irc_send("$foo :Your IRC client might have an easier way to do that - many allow you to omit the channel name when inviting into the channel you are currently in.\r\n", 1); } elsif($param eq "misc") { irc_send("$foo :loglevel newlevel - Sets the logging level for your connection. newlevel should be a number between ".OSCAR_DBG_NONE." and ".OSCAR_DBG_PACKETS.". Higher numbers give you more information.\r\n", 1); irc_send("$foo :get_profile screenname - Get profile for screenname.\r\n", 1); irc_send("$foo :set_profile new profile - Set your profile. You can use some HTML formating.\r\n", 1); irc_send("$foo :set_away away message - Set your away message. You should normally just use the IRC AWAY command, but if for some reason you can't or don't want to, this will work. A blank away message will mark you as not away. Mixing this with IRC AWAY may produce odd results.\r\n", 1); irc_send("$foo :set_icon - Set your buddy icon. You must then DCC SEND $usnick your buddy icon.\r\n", 1); irc_send("$foo :set_status status - Set your status.\r\n", 1); #irc_send("$foo :get_dir screenname - Get directory info for screenname.\r\n", 1); #irc_send("$foo :set_dir [info] - Without info, gives you the syntax that info must be in. With info, sets your directory info.\r\n", 1); #irc_send("$foo :dir_search [info] - Without info, gets the syntax that info must be in (the same as that of set_dir). With info, searches the AOL Instant Messenger directory.\r\n", 1); irc_send("$foo :sendidle (0|1) - Send the TOC server your idle information?\r\n", 1); irc_send("$foo :format_screenname screenname - Change the formatting (capitalization, spaces) of your screenname\r\n", 1); irc_send("$foo :change_email new_email - Change the email address assigned to your AIM account\r\n", 1); irc_send("$foo :confirm_account - Use this if your account has trial status\r\n", 1); irc_send("$foo :relnotes [release note] - View important changes in IMIRC releases\r\n", 1); irc_send("$foo :stats - See various info about IMIRC\r\n", 1); } elsif($param eq "set") { irc_send("$foo :set imchan (on|off) - If set to on, incoming IMs for your screenname will appear in ${nickchan}YourScreenName.\r\n", 1); irc_send("$foo :set nicklen (limit) - If limit is non-zero, when an AIM user who has a nickname longer than the limit talks to you, you will receive a warning containing the full nickname of the sender. A limit of zero (the default setting) turns this off. This setting is preserved across AIM sessions and even IMIRC servers. DreamCast users will want to set the limit to 9.\r\n", 1); irc_send("$foo :set ctcp (on|off) - If set to on (the default), people will be able to CTCP you over AIM. Setting this to off will block CTCPs from coming over AIM.\r\n", 1); } elsif($param eq "debug") { if($debug) { irc_send("$foo :restart - Restart IMIRC. This will close the IRC connection and all AIM connections and launch a new IMIRC process.\r\n", 1); irc_send("$foo :newnick nick - Create a new nickname on irc.\r\n", 1); irc_send("$foo :setlevel debug_channel level - Set debugging channel debug_channel to level (higher is more verbose, 1 to disable). The special channel \"all\" will set the level of all channels at once.\r\n", 1); irc_send("$foo :showlevels - List all debugging channels and their levels.\r\n", 1); irc_send("$foo :reload - Evaluates $0. This should let you make almost any change to IMIRC without having to do a full restart.\r\n", 1); irc_send("$foo :rehash - Reload /etc/imirc.conf and $home/.imirc .\r\n", 1); irc_send("$foo :raw who text - Send a raw IRC or AIM command (AIM commands are SFLAP-encoded but not quoted.) If who is irc, it will be sent as an IRC command. If who is the IRC nickname or AIM nickname of someone connected to this IMIRC server, text will be sent over that AIM connection.\r\n", 1); irc_send("$foo :inject text - Act as though we got text from the IRC server.\r\n", 1); irc_send("$foo :eval text - Evaluate text as Perl code. All exceptions will be trapped and displayed.\r\n", 1); irc_send("$foo :show text - Evaluate text as Perl code and display its output in the channel. All exceptions will be trapped and displayed.\r\n", 1); } else { irc_send("$foo :Debugging support is not enabled. Edit /etc/imirc.conf or $home/.imirc and send SIGHUP to PID $$.\r\n", 1); } } elsif($param eq "multinick") { irc_send("$foo :To sign on multiple AIM screennames under your current IRC connection, just use multiple signon commands.\r\n", 1); irc_send("$foo :The first screenname you sign on will be the \"default screenname\".\r\n", 1); irc_send("$foo :The default screenname is the screenname which outgoing IMs are sent to and which $usnick commands; such as add_buddy, remove_buddy, and signoff; effect.\r\n", 1); irc_send("$foo :Note that messages/whispers to chatrooms will always be sent with the screenname that joined the chatroom.\r\n", 1); irc_send("$foo :When you receive an incoming IM on a screenname other than the default one, {screenname} will be prepended to the IM.\t\n", 1); irc_send("$foo :multinick commands:\r\n", 1); irc_send("$foo :\tlistnames - list screennames that you are signed on as. Also tells you your default screenname.\r\n", 1); irc_send("$foo :\tswitchname screenname - switch to a new default screenname\r\n", 1); irc_send("$foo :\tsignoffall - sign off all screennames\r\n", 1); } elsif($param eq "intro") { irc_send("$foo :Remove all spaces from screennames (also referred to as nicknames or nicks) before using in any IMIRC command or operation. nick is the AIM nick, not the IRC one created by prepending $prefix.\r\n", 1); irc_send("$foo :AIM stands for AOL Instant Messenger.\r\n", 1); irc_send("$foo : \r\n", 1); irc_send("$foo :To send an IM to someone whose screenname is SomeDude, send an IRC message to ${prefix}SomeDude.\r\n", 1); irc_send("$foo :That person must be on your buddylist, have sent you an IM recently, or be added to IRC via the add command.\r\n", 1); irc_send("$foo : \r\n", 1); irc_send("$foo :You need an AOL Instant Messenger account to use IMIRC. Get one at http://aim.aol.com/aimnew/Aim/register.adp\r\n", 1); irc_send("$foo : \r\n", 1); irc_send("$foo :See 'help basics' for information on how to sign on to AIM.\r\n", 1); if($localhelp) { irc_send("$foo :Join $localhelp or visit the IMIRC web site for more help.\r\n", 1); } else { irc_send("$foo :Visit the IMIRC web site for more help.\r\n", 1); } } elsif($param eq "pounce") { irc_send("$foo :A pounce will automatically send an IM to a buddy when that buddy comes online.\r\n", 1); irc_send("$foo :Your pounces will be saved when you sign off but cannot trigger unless you are signed on.\r\n", 1); irc_send("$foo :When you sign on, you will be reminded if you have any untriggered pounces.\r\n", 1); irc_send("$foo :Each pounce is deleted after it is triggered, so it only will happen once.\r\n", 1); irc_send("$foo :You can have one pounce per buddy, and you can only hae pounces for people on your buddylist.\r\n", 1); irc_send("$foo :If you delete a buddy, its pounce goes with it.\r\n", 1); irc_send("$foo :\r\n", 1); irc_send("$foo :Pounce commands:\r\n", 1); irc_send("$foo :\tadd_pounce buddy text - Pounce on screenname with a message of text.\r\n", 1); irc_send("$foo :\tremove_pounce buddy - Remove pounce on buddy.\r\n", 1); irc_send("$foo :\tshow_pounce buddy - Shows the text of a pounce.\r\n", 1); } elsif($param eq "credits") { open(CREDITS, File::Spec->catfile(File::Basename::dirname($0), "CREDITS")) or do { irc_send("$foo :Couldn't open CREDITS: $!\r\n", 1); return; }; while() { chomp; irc_send("$foo :$_\r\n", 1); } close CREDITS; } elsif($param eq "legal") { irc_send("$foo :This program is licensed under Version 2 the GNU Public License.\r\n", 1); irc_send("$foo :A copy of the license is available at http://www.gnu.org/copyleft/gpl.txt\r\n", 1); irc_send("$foo :AOL and AMERICA ONLINE are registered trademarks owned by America Online,\r\n", 1); irc_send("$foo :Inc. The INSTANT MESSENGER mark is owned by America Online, Inc. This program\r\n", 1); irc_send("$foo :is not endorsed by, or affiliated with, America Online, Inc.\r\n", 1); } else { irc_send("$foo :IMIRC $version, (c)1999-2004 Matthew Sachs.\r\n", 1); irc_send("$foo :\x02IMIRC web site\x02: http://www.zevils.com/programs/imirc/\r\n", 1); irc_send("$foo :To see the commands available for a specific topic, use the command help topic. The following topics are available:\r\n", 1); irc_send("$foo :\t\x02basics\x02 - basic commands\r\n", 1); irc_send("$foo :\tbuddyinfo - get information about a buddy\r\n", 1); irc_send("$foo :\tbuddylist - buddylist manipulation\r\n", 1); irc_send("$foo :\tchat - chatroom commands\r\n", 1); irc_send("$foo :\tcredits - some of the many people who've helped with IMIRC\r\n", 1); irc_send("$foo :\tlegal - important legal notices\r\n", 1); irc_send("$foo :\tmisc - miscellaneous commands\r\n", 1); irc_send("$foo :\tmultinick - using IMIRC with multiple AIM screennames from one IRC connection.\r\n", 1); irc_send("$foo :\tpounce - pounce commands and overview\r\n", 1); irc_send("$foo :\tprivacy - control who is allowed to contact you\r\n", 1); irc_send("$foo :\tset - various settings you can change\r\n", 1); irc_send("$foo :\t\x02intro\x02 - introduction to IMIRC\r\n", 1); if($localhelp) { irc_send("$foo :Join $localhelp or visit the IMIRC web site for more help.\r\n", 1); } else { irc_send("$foo :Visit the IMIRC web site for more help.\r\n", 1); } } } elsif($cmd eq "switchname") { unless($param) { irc_send(irc_privmsg($usnick, $nick, "Usage: switchname screenname", "", "", $screenname)); } else { if(switchnick($nick, $param)) { irc_send(irc_privmsg($usnick, $nick, "You are not signed on under that screenname!", "", "", $screenname)); } else { irc_send(irc_privmsg($usnick, $nick, "Your default screenname is now $param.", "", "", $param)); } } } elsif($cmd eq "signoffall") { do_signoff_all($nick); } elsif($cmd eq "listnames") { irc_send(irc_privmsg($usnick, $nick, "Your default screenname is " . $sndata->{oscar}->screenname . ".", "", "", $screenname)); foreach my $tmpscreenname(keys %{$aim_connections->{$nick}->{screennames}}) { irc_send(irc_privmsg($usnick, $nick, $aim_connections->{$nick}->{screennames}->{$tmpscreenname}->{oscar}->screenname, "", "", $screenname)); } } elsif($cmd eq "set") { $cmd = $param; ($param, $extra) = split(/\s+/, $extra); if($cmd eq "imchan") { if($sndata->{inchan}) { if($param and $param ne "0" and $param ne "off" and $param ne "false" and $param ne "no" and $param ne "stop") { irc_send(irc_privmsg($usnick, $nick, "Incoming IMs for this screenname will now appear in this channel.", "", "", $screenname)); $sndata->{inchan} = 2; } else { irc_send(irc_privmsg($usnick, $nick, "Incoming IMs for this screenname will no longer appear in this channel, even if you send someone an IM through this channel.", "", "", $screenname)); $sndata->{inchan} = 3; } } else { irc_send(irc_privmsg($usnick, $nick, "You must join ".nickchan($screenname)." to use this feature.", "", "", $screenname)); } } elsif($cmd eq "nicklen") { if($param == 0) { delete $oscar->get_app_data()->{0x0201} if $oscar->get_app_data(); delete $sndata->{nicklen}; $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } else { my $appdata = $oscar->get_app_data(); if(!$appdata) { irc_send(irc_privmsg($usnick, $nick, "Appdata was undefined?", "", "", $screenname)); } else { $appdata->{0x0201} = $sndata->{nicklen} = $param; $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } } elsif($cmd eq "ctcp") { if($param and $param ne "0" and $param ne "off" and $param ne "false" and $param ne "no" and $param ne "stop") { irc_send(irc_privmsg($usnick, $nick, "You will now be able to receive CTCPs over AIM.", "", "", $screenname)); $oscar->get_app_data()->{0x0202} = 1 if $oscar->get_app_data(); $sndata->{ctcp} = 1; } else { irc_send(irc_privmsg($usnick, $nick, "You will no longer be able to receive CTCPs over AIM.", "", "", $screenname)); delete $oscar->get_app_data()->{0x0202} if $oscar->get_app_data(); $sndata->{ctcp} = 0; } $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } else { irc_send(irc_privmsg($usnick, $nick, "Unknown preference.", "", "", $screenname)); } } elsif($cmd eq "reorder_groups") { if(!$param) { irc_send(irc_privmsg($usnick, $nick, "Usage: reorder_groups group1, group2, group3, ...", "", "", $screenname)); } else { $oscar->reorder_groups($param, split(/(?:,|\s)\s*/, $extra)); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } elsif($cmd eq "reorder_buddies") { if(!$param and !$extra) { irc_send(irc_privmsg($usnick, $nick, "Usage: reorder_buddies group buddy1, buddy2, buddy3, ...", "", "", $screenname)); } else { $oscar->reorder_buddies($param, split(/(?:,|\s)\s*/, $extra)); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } } elsif($cmd eq "set_buddy_comment") { if(!$param and !$extra) { irc_send(irc_privmsg($usnick, $nick, "Usage: set_buddy_comment buddy comment", "", "", $screenname)); } else { my $group = $oscar->findbuddy($param); if($group) { $oscar->set_buddy_comment($group, $param, $extra); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } else { irc_send(irc_privmsg($usnick, $nick, "Couldn't find that buddy.", "", "", $screenname)); } } } elsif($cmd eq "loglevel") { if(!$param) { irc_send(irc_privmsg($usnick, $nick, "Usage: loglevel newlevel", "", "", $screenname)); } else { $oscar->loglevel($param); $sndata->{loglevel} = $param; } } elsif($cmd eq "decline") { if(!$param) { irc_send(irc_privmsg($usnick, $nick, "Usage: decline chat", "", "", $screenname)); } else { $param =~ /(\d+)/; $oscar->chat_decline($chats{$1}->{url}); delete $chats{$1}; irc_send(irc_privmsg($usnick, $nick, "Chat invitation declined.", "", "", $screenname)); } } elsif($cmd eq "clonebuddies") { local @ARGV = split(/\s+/, "$param $extra"); my $merge = 0; my $errors = &GetOptions( "merge|m" => \$merge ); ($param, $extra) = @ARGV; if(!$errors or @ARGV != 2) { irc_send(irc_privmsg($usnick, $nick, "Usage: clonebuddies [--merge] to|from screennam", "", "", $screenname)); } elsif($extra eq $aim_connections->{$nick}->{aimnick}) { irc_send(irc_privmsg($usnick, $nick, "Can't use clonebuddies on your default screenname.", "", "", $screenname)); } elsif(!exists($aim_connections->{$nick}->{screennames}->{$extra})) { irc_send(irc_privmsg($usnick, $nick, "You can only use clonebuddies with a screenname that you are currently signed on under.", "", "", $screenname)); } else { if($param eq "to") { my $xsndata = $aim_connections->{$nick}->{screennames}->{$extra}; $xsndata->{blmerge} = $merge; if(loadbuddies($xsndata->{oscar}, export_buddylist($oscar, 1), $xsndata)) { irc_send(irc_privmsg($usnick, $nick, "Buddylist cloned successfully.", "", "", $xsndata->{screenname})); } else { irc_send(irc_privmsg($usnick, $nick, "Couldn't clone buddylist.", "", "", $xsndata->{screenname})); } } elsif($param eq "from") { $sndata->{blmerge} = $merge; my $xsndata = $aim_connections->{$nick}->{screennames}->{$extra}; if(loadbuddies($sndata->{oscar}, export_buddylist($xsndata->{oscar}, 1), $sndata)) { irc_send(irc_privmsg($usnick, $nick, "Buddylist cloned successfully.", "", "", $screenname)); } else { irc_send(irc_privmsg($usnick, $nick, "Couldn't clone buddylist.", "", "", $screenname)); } } else { irc_send(irc_privmsg($usnick, $nick, "Direction for clonebuddies must be 'to' or 'from'.", "", "", $screenname)); } } } elsif($cmd eq "get_away") { if(!$param) { irc_send(irc_privmsg($usnick, $nick, "Usage: get_away screenname", "", "", $screenname)); } else { $sndata->{away_requested}->{$param} = 1; $oscar->get_away($param); } } elsif($cmd eq "relnotes") { $param =~ s/^\*//; if(!$param) { irc_send(irc_privmsg($usnick, $nick, "Available release notes (ones you haven't seen are marked with a *): ", "", "", $screenname)); map { irc_send(irc_privmsg($usnick, $nick, ($sndata->{relnotes}->{$_} ? "\t$_" : "\t*$_"), "", "", $screenname)); } keys %{RELNOTES()}; irc_send(irc_privmsg($usnick, $nick, "To view a release note, pass it as a parameter to the relnotes command (e.g. give $usnick the command relnotes 1.5", "", "", $screenname)); } elsif(RELNOTES()->{$param}) { irc_send(irc_privmsg($usnick, $nick, RELNOTES()->{$param}, "", "", $screenname)); $sndata->{relnotes}->{$param} = 1; $oscar->get_app_data()->{0x0203} = join(",", sort keys %{$sndata->{relnotes}}) if $oscar->get_app_data(); $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; } else { irc_send(irc_privmsg($usnick, $nick, "That release note does not exist. Use the relnotes command without any parameters to get a list of available release notes.", "", "", $screenname)); } } elsif($cmd eq "auth_response") { if(!$param) { irc_send(irc_privmsg($usnick, $nick, "Usage: auth_response Auth-Response", "", "", $screenname)); } else { irc_send(irc_privmsg($usnick, $nick, "Sending authentication response...", "", "", $screenname)); my $md5 = join("", map { chr(hex($_)) } $param =~ m/../g); $oscar->auth_response($md5); } } else { irc_send(irc_privmsg($usnick, $nick, "Unknown command - /msg $usnick help for help.", "", "", $screenname)); } } elsif(/^(PRIVMSG|NOTICE) +(\S+)(\@\S+)? +:?(.+)/i) { #$nick sent $3 to $1 (where $1 ne $usnick) $screenname = $aim_connections->{$nick}->{aimnick}; return if ignorenick($nick); my $notice = ($1 eq "NOTICE") ? 1 : 0; my $target = noprefix($longnicks->{$2}); my $msg = $4; my $recipient = $2; $msg = process_ctcp($nick, $recipient, $msg, $screenname, $notice); return if $msg eq ""; if($recipient eq "#imirc-debug" and $debug) { $msg =~ s/^($usnick)\S*\s+//i; if($msg eq "restart" and $1) { phoenix; } elsif($msg =~ /^newnick (.+)/ and $1) { irc_send(irc_newnick($1)); } elsif($msg =~ /^setlevel (\S+) (\S+)/) { if($1 eq "all") { foreach my $level(keys %debug) { $debug{$level} = $2; } } else { $debug{$1} = $2; } } elsif($msg =~ /^rehash/) { &rehash; } elsif($msg =~ /^reload/) { &reload; } elsif($msg =~ /^showlevels/) { foreach my $level(keys %debug) { irc_send(irc_privmsg($usnick, "#imirc-debug", "$level: $debug{$level}")); } } elsif($msg =~ /^inject (.+)/ and $1) { process_irc_message($1); } elsif($msg =~ /^raw (\S+) (.+)/ and $1 and $2) { if($1 eq "irc") { irc_send("$2\r\n"); } else { irc_send(irc_privmsg($usnick, "#imirc-debug", "Sorry, only raw irc is supported.")); } } elsif($msg =~ /^eval (.+)/ and $1) { eval $1; irc_send(irc_privmsg($usnick, "#imirc-debug", $@, "EVAL: ")); } elsif($msg =~ /^show (.+)/ and $1) { eval "irc_send(irc_privmsg(\$usnick, \"#imirc-debug\", $1));"; irc_send(irc_privmsg($usnick, "#imirc-debug", $@, "EVAL: ")); } elsif($msg =~ /#/) { # Do nothing } else { irc_send(irc_privmsg($usnick, "#imirc-debug", "Invalid debug command - /msg $usnick help debug for help)")); } } elsif ($recipient =~ /^$chatchan(\d+)$/) { if($chats{$1} and $chats{$1}->{obj}) { $chats{$1}->{obj}->chat_send($msg); } else { bounce_join($nick, chatchan($1)); } } elsif ($recipient !~ /^#/) { if($aim_connections->{$nick} and $oscar) { send_im($oscar, $target, $msg, $notice); } else { irc_send(irc_privmsg($usnick, $nick, "You must be signed onto AOL Instant Messenger via IMIRC to send messages to AIM users. /msg $usnick help for details.")); } } } elsif(/^AWAY *(.*)/) { my $message = $1; $message =~ s/^://; if($message) { $irc_away->{$nick} = $message; if($aim_connections->{$nick}) { $aim_connections->{$nick}->{away} = $message; foreach $screenname(keys %{$aim_connections->{$nick}->{screennames}}) { $aim_connections->{$nick}->{screennames}->{$screenname}->{oscar}->set_away($message); } } } else { delete $irc_away->{$nick}; if($aim_connections->{$nick}) { delete $aim_connections->{$nick}->{away}; foreach $screenname(keys %{$aim_connections->{$nick}->{screennames}}) { delete $aim_connections->{$nick}->{screennames}->{$screenname}->{away_buddies}; $aim_connections->{$nick}->{screennames}->{$screenname}->{oscar}->set_away(""); } } } } elsif(/^NICK +(\S+) *(.*)/) { #Nick change my $newnick = $1; my(@args) = split(/\s+/, $2); if($kill_impersonaters and $newnick =~ /^$prefix/i) { irc_send(irc_kill($usnick, $newnick, "Attempt to impersonate an AOL Instant Messenger user")); return; } if($aim_connections->{$nick}) { $newnick = new Net::OSCAR::Screenname $1; foreach $screenname(keys %{$aim_connections->{$nick}->{screennames}}) { $irc_connections->{$screenname} = $newnick; $aim_connections->{$nick}->{screennames}->{$screenname}->{oscar}->{__IMIRC_nick} = $newnick; } $aim_connections->{$newnick} = $aim_connections->{$nick}; $irc_away->{$newnick} = $irc_away->{$nick} if exists($irc_away->{$nick}); $aim_connections->{$newnick}->{nick} = $newnick; delete $aim_connections->{$nick}; delete $irc_away->{$nick}; my($dcc, $i); for($i = 0; $i <= $#dccqueue; $i++) { $dcc = $dccqueue[$i]; $dcc->{for} = $newnick; if($dcc->{state} & DCC_STATE_SEND and $dcc->{to} eq $nick) { $dccqueue[$i]->{to} = $newnick; } elsif($dcc->{from} eq $nick) { $dccqueue[$i]->{from} = $newnick; } } } elsif(@args > 1) { # Get server that nick is from my $template = $ircservers{$servermode}{nick}; my @targs; my $server = ""; # Ignore NICK TheNick (undef, undef, @targs) = split(/\s+/, $template); # Find template-arg that is $us - that is where server lies for(my $i = 0; $i < scalar @targs; $i++) { next unless $targs[$i] eq $us; $server = $args[$i]; last; } $nickservers->{$newnick} = lc($server); } else { $nickservers->{$newnick} = $nickservers->{$nick}; delete $nickservers->{$nick}; } } elsif(/^QUIT/) { did_quit($nick); } elsif(/^PING\s+:?(\S+)/) { irc_send(irc_pong($1)); } elsif(/^248 +$usnick +(?:U +)?(\S+)/) { # STATS U reply push @uhosts, $1; debug_print("Got U: host $1", "irc", 1); } elsif(/^217 +$usnick +(?:Q +)?(\S+) +(?:\S+)(?: +(\S+))?/) { # STATS Q reply my $qline = ($1 eq "*" or $1 eq "") ? $2 : $1; # Some IRC servers (*cough*Unreal3.2*cough*) have annoying 217 formats my($lasttok) = reverse split; $qline = $lasttok if globmatch($usnick, $lasttok) or globmatch($oldnick, $lasttok) or globmatch("${prefix}1234", $lasttok); push @qlines, $qline; debug_print("Got Q: line $qline", "irc", 1); } elsif(/^219 +$usnick +Q/) { # End of STATS Q my($qusnick, $qoldnick, $qprefix); $qusnick = grep { globmatch($usnick, $_) } @qlines; $qoldnick = grep { globmatch($oldnick, $_) } @qlines if $oldnick; # Make sure we've Q:'s $prefix*, not just $prefix $qprefix = grep { globmatch($prefix.$$, $_) } @qlines; my @needqs = (); push @needqs, $usnick if !$qusnick; push @needqs, $oldnick if $oldnick and !$qusnick; push @needqs, "$prefix*" if !$qprefix; my $needqs = join(", ", @needqs); if(@needqs) { print STDERR "You must add Q: lines for $needqs; see README for details.\n"; print STDERR "To disable this check, set the \$require_qlines parameter to 0 in your IMIRC configuration file.\n"; print STDERR "Doing this without having some other way of preventing people from using these nicks is a *SERIOUS SECURITY PROBLEM!*\n"; exit 255; } debug_print("All necessary Q: lines are in place.", "irc", 1); } elsif(/^SERVER +(\S+)/) { # If there was no prefix, this is name of upstream server. # Else, upstream is just informing us about one of its links if(!$nick) { $themname = $1; checkstats(); } } } sub callback_vars($) { my $oscar = shift; my $screenname = $oscar->screenname; my $nick = $oscar->{__IMIRC_nick}; my $sndata = $aim_connections->{$nick}->{screennames}->{$screenname} if exists($aim_connections->{$nick}) and exists($aim_connections->{$nick}->{screennames}); return () unless $nick; return($screenname, $nick, $sndata); } sub oscar_error($$$$$) { my($oscar, undef, $errno, $desc, $fatal) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; debug_print("Got oscar_error $errno: $desc ($fatal)", "irc", 2); irc_send(irc_privmsg($usnick, $nick, "Error $errno: $desc", "", "", $screenname)); do_signoff($nick, $oscar, 1) if $fatal; } sub oscar_rate_alert($$$$$) { my($oscar, $level, $clear, $window, $worrisome) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; return unless $worrisome; irc_send(irc_privmsg($usnick, $nick, "You're sending too fast! Slow down! We've been given a $level warning.", "", "", $screenname)); $clear = int($clear / 1000); irc_send(irc_privmsg($usnick, $nick, "Wait $clear seconds before sending anything.", "", "", $screenname)); } sub oscar_admin_error($$$$) { my($oscar, $reqtype, $error, $url) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; irc_send(irc_privmsg($usnick, $nick, "Your $reqtype request has failed: $error.", "", "", $screenname)); irc_send(irc_privmsg($usnick, $nick, "See $url for more information.", "", "", $screenname)) if $url; } sub oscar_admin_ok($$) { my($oscar, $reqtype) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; irc_send(irc_privmsg($usnick, $nick, "Your $reqtype request has succeeded.", "", "", $screenname)); } sub oscar_chat_closed($$$) { my($oscar, $chat, $error) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; my $chatid = $chat->{chat_id}; irc_send(irc_privmsg($usnick, $nick, "Your connection to chat ".$chat->name." was closed: $error", "", "", $screenname)); irc_send(irc_kick($usnick, chatchan($chatid), $nick, $error)); foreach my $who(keys %{$chats{$chatid}->{members}}) { irc_send(irc_part(aimnick($who, $screenname), chatchan($chatid))); } delete $chats{$chatid}; } sub oscar_buddy_in($$$$) { my($oscar, $buddy, $group, $buddat) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; irc_send(irc_newnick($prefix . $buddy)); my $inick = aimnick($buddy, $screenname); unless($nicks->{$buddy}->{$screenname} and $nicks->{$buddy}->{$screenname} == -1) { $nicks->{$buddy}->{$screenname} = -1; manglewarn($nick, $prefix.$buddy, $screenname); if($sndata->{inchan}) { irc_send(irc_join($inick, nickchan($screenname))); irc_send(irc_mode($usnick, nickchan($screenname), "+v $inick")); } else { irc_send(irc_privmsg($usnick, $nick, "$buddy has arrived", "", "", $screenname)); } if(exists $buddat->{data}->{0x0200}) { my($pounce) = $buddat->{data}->{0x0200}; my $tmp = ""; if($buddat->{aol}) { $tmp = "[automated pounce] "; } $tmp .= $pounce; $oscar->send_im($buddy, $tmp, 1); delete $buddat->{data}->{0x0200}; $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; irc_send(irc_privmsg($usnick, $nick, "Pounce to $buddy has been sent.", "", "", $screenname)); } } if($buddat->{away}) { if(!$sndata->{away}->{$buddy}) { irc_send(irc_privmsg($usnick, $nick, "$buddy has gone away. Use the IRC command /whois $inick to see the away message.", "", "", $screenname)); $sndata->{away}->{$buddy} = 1; } if(!$away->{$buddy}) { $oscar->get_away($buddy); $away->{$buddy} = 1; } } else { if($sndata->{away}->{$buddy}) { delete $sndata->{away}->{$buddy}; irc_send(irc_privmsg($usnick, $nick, "$buddy is no longer away.", "", "", $screenname)); } irc_send(irc_away($inick)) if delete $away->{$buddy}; } } sub oscar_chat_buddy_in($$$$) { my($oscar, $buddy, $chat, $buddat) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; return if $buddy eq $screenname; my($chatid) = grep { $chats{$_}->{url} eq $chat->url and $chats{$_}->{screenname} eq $oscar->screenname } keys %chats; if(!$chatid) { return oscar_error($oscar, undef, 0, "Couldn't find chat ". $chat->url. "/". $chat->name. ". Please email matthewg\@zevils.com.", 1); } irc_send(irc_newnick($prefix.$buddy)); my $inick = aimnick($buddy, $screenname); manglewarn($nick, $prefix.$buddy, $screenname) unless $nicks->{$buddy}->{$screenname}; irc_send(irc_join($inick, chatchan($chatid))); $nicks->{$buddy}->{$chatchan.$chatid} = -1; $chats{$chatid}->{members}->{$buddy} = 1; } sub oscar_buddy_out($$$) { my($oscar, $buddy, $group) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; delete $away->{$buddy}; my $inick = aimnick($buddy, $screenname); if($sndata->{inchan}) { irc_send(irc_part($inick, nickchan($screenname))); } else { irc_send(irc_privmsg($usnick, $nick, "$buddy has departed")); } rm_nick_user($buddy, $screenname); } sub oscar_chat_buddy_out($$$) { my($oscar, $buddy, $chat) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; my $inick = aimnick($buddy, $screenname); my $chatid = $chat->{chat_id}; irc_send(irc_part($inick, chatchan($chatid))); rm_nick_user($buddy, $chatchan.$chatid); delete $chats{$chatid}->{members}->{$buddy}; } sub oscar_im_in($$$$) { my($oscar, $from, $msg, $away) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; my $notice = 0; my $ctcp = 0; my $ar = ""; $notice = 1 if $msg =~ s///; $ctcp = 1 if $msg =~ s///; irc_send(irc_newnick($prefix.$from)); my $inick = aimnick($from, $screenname); unless($nicks->{$from}->{$screenname}) { manglewarn($nick, $prefix.$from, $screenname); $nicks->{$from}->{$screenname} = time; irc_send(irc_join($inick, nickchan($screenname))) if $sndata->{inchan}; } $ar = "[automatic response] " if $away; $msg = $ar . join("\n", html2txt($msg, $nick)); $msg =~ s/[\r\n]+$//; my $recipient = $nick; $recipient = nickchan($screenname) if $sndata->{inchan} == 2 and !$ctcp; if($ctcp) { if($sndata->{ctcp}) { irc_send(irc_ctcp($inick, $recipient, $msg, $notice)); } else { irc_send(irc_privmsg($usnick, $recipient, "$from tried to send you the CTCP command $msg.", "", 0, $screenname)); } } else { irc_send(irc_privmsg($inick, $recipient, $msg, "", $notice, $screenname)); } if(!$away and $irc_away->{$nick}) { if(time - $sndata->{away_buddies}->{$from} > $time) { my $tmp = ""; my $buddat = $oscar->buddy($from); $tmp = "[automated reply] " if $buddat and $buddat->{aol}; $tmp .= $irc_away->{$nick}; $oscar->send_im($from, $tmp, 1); } $sndata->{away_buddies}->{$from} = time; } $nicks->{$from}->{$screenname} = time if $nicks->{$from}->{$screenname} and $nicks->{$from}->{$screenname} != -1; } sub oscar_chat_im_in($$$$) { my($oscar, $from, $chat, $msg) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; my $inick = aimnick($from, $screenname); my $chatid = $chat->{chat_id}; if(normalize($from) ne normalize($screenname)) { $msg = join("\n", html2txt($msg, $nick)); unless($chats{$chatid}->{joined}) { $chats{$chatid}->{queue} .= irc_privmsg($inick, chatchan($chatid), $msg); } else { irc_send(irc_privmsg($inick, chatchan($chatid), $msg)); } } } sub oscar_chat_invite($$$$$) { my($oscar, $from, $msg, $chat, $chaturl) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; my $chatid = ++$chatseq; $chats{$chatid} = { screenname => $screenname, url => $chaturl, name => $chat, invited => 1, joined => 0, queue => "" }; my $chan = chatchan($chatid); irc_send(irc_privmsg($usnick, $nick, "$from has invited us to chatroom $chat for the following reason: " . html2txt($msg) . "To accept, join $chan. To decline, send $usnick the command 'decline $chatid'.", "", "", $screenname)); irc_send(irc_join($usnick, $chan)); irc_send(irc_mode($us, $chan, "+o $usnick")); irc_send(irc_mode($usnick, $chan, "+ints")); irc_send(irc_invite($usnick, $chan, $nick)); } sub oscar_chat_joined($$$) { my($oscar, $chatname, $chat) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; my($chatid) = grep { $chats{$_}->{url} eq $chat->url and $chats{$_}->{screenname} eq $oscar->screenname} keys %chats; $chatid ||= ++$chatseq; $chat->{chat_id} = $chatid; $chats{$chatid}->{screenname} = $screenname; $chats{$chatid}->{url} = $chat->url; $chats{$chatid}->{name} = $chat->name; $chats{$chatid}->{joined} = 1; $chats{$chatid}->{queue} = ""; $chats{$chatid}->{obj} = $chat; $chats{$chatid}->{members} = $oscar->buddyhash(); $chats{$chatid}->{joined} = 1; my $chan = chatchan($chatid); if(!$chats{$chatid}->{invited}) { irc_send(irc_join($usnick, $chan)); irc_send(irc_mode($us, $chan, "+o $usnick")); irc_send(irc_mode($usnick, $chan, "+sint")); irc_send(irc_topic($usnick, $chan, "{$screenname} ".$chat->name)); irc_send(irc_privmsg($usnick, $nick, "Join IRC channel $chan to join AIM chat ".$chats{$chatid}->{name}.".", "", "", $screenname)); irc_send(irc_invite($usnick, $chan, $nick)); } $longnicks->{$chan} = $chan; } sub oscar_evil($$$) { my($oscar, $evil, $from) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; $from ||= "Anonymous"; irc_send(irc_privmsg($usnick, $nick, "$from has warned you. Your new warn level is $evil%.", "", "", $screenname)); } sub printable_user_info($) { my $buddat = shift; my $msg = ""; $msg .= "Signon Time: \t" . localtime($buddat->{onsince}) . "\r\n"; if($buddat->{idle_since}) { my $idle_time = int((time() - $buddat->{idle_since})/60); my $idle_h = int($idle_time/60); my $idle_m = sprintf("%02d", $idle_time%60); $msg .= "Idle Time: \t${idle_h}h:${idle_m}m\r\n"; } $msg .= "Status: \t$buddat->{extended_status}\r\n" if $buddat->{extended_status}; $msg .= "Alias: \t$buddat->{alias}\r\n" if $buddat->{alias}; $msg .= "Comment: \t$buddat->{comment}\r\n" if $buddat->{comment}; $msg .= "Icon: \tPresent\r\n" if $buddat->{icon_md5sum}; $msg .= "User Class: \t"; $msg .= " TRIAL" if $buddat->{trial}; $msg .= " AOL" if $buddat->{aol}; $msg .= " AIM" if $buddat->{free}; $msg .= " ADMIN" if $buddat->{admin}; $msg .= " AWAY" if $buddat->{away}; $msg .= "\r\n"; $msg .= "Warning Level: $buddat->{evil}%\r\n"; return $msg; } sub oscar_buddy_info($$$) { my($oscar, $buddy, $buddat) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; if($buddat->{awaymsg}) { irc_send(irc_newnick($prefix.$buddy)); $away->{$buddy} = $buddat->{awaymsg}; my $awaymsg = html2txt($buddat->{awaymsg}); if($sndata->{away_requested}->{$buddy}) { irc_send(irc_privmsg(aimnick($buddy, $screenname), $nick, $awaymsg, "[AWAY] ", "", $screenname)); delete $sndata->{away_requested}->{$buddy}; } else { $awaymsg =~ tr/\r\n/ /; $awaymsg = "This away message is too long for the IRC server to handle. Use the get_away command to see it." if length($awaymsg) > 500; irc_send(irc_away(aimnick($buddy, $screenname), $awaymsg)); } } elsif($sndata->{away_requested}->{$buddy}) { irc_send(irc_privmsg($usnick, $nick, "$buddy is not away or has no away message set.", "", "", $screenname)); delete $sndata->{away_requested}->{$buddy}; } elsif($sndata->{info_requested}->{$buddy}) { delete $sndata->{info_requested}->{$buddy}; my $msg = "Info for $buddat->{screenname}\r\n"; $msg .= printable_user_info($buddat); if($buddat->{profile}) { $msg .= "---------------------\r\n"; $msg .= "Profile\r\n"; $msg .= "---------------------\r\n"; $msg .= join("\r\n", html2txt($buddat->{profile}, $nick)); } irc_send(irc_privmsg($usnick, $nick, $msg, "", "", $screenname)); } } sub oscar_signon_done($) { my($oscar) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; irc_send(irc_privmsg($usnick, $nick, "You are now connected to AOL Instant Messenger as $screenname.", "", "", $screenname)); irc_send(irc_privmsg($usnick, $nick, "The email address registered to this account is ".$oscar->email.". Use the change_email command if this is not your current email address.", "", "", $screenname)); my $chan = nickchan($screenname); irc_send(irc_privmsg($usnick, $nick, "You might want to join $chan.", "", "", $screenname)); irc_send(irc_join($usnick, $chan)); irc_send(irc_mode($us, $chan, "+o $usnick")); irc_send(irc_invite($usnick, $chan, $nick)); irc_send(irc_part($usnick, $chan)); $sndata->{ison} = time; update_usercount(); if($irc_away->{$nick}) { $oscar->set_away($irc_away->{$nick}); } my $pouncecount = 0; foreach my $group($oscar->groups) { foreach my $buddy($oscar->buddies($group)) { my $buddat = $oscar->get_app_data($group, $buddy); $pouncecount++ if $buddat and exists($buddat->{0x0200}); } } irc_send(irc_privmsg($usnick, $nick, "You have $pouncecount pounce" . ($pouncecount > 1 ? "s" : "") . ".", "", "", $screenname)) if $pouncecount > 0; if($oscar->get_app_data() and exists($oscar->get_app_data()->{0x0201})) { $sndata->{nicklen} = $oscar->get_app_data()->{0x0201}; irc_send(irc_privmsg($usnick, $nick, "Your maximum nick length has been set to $sndata->{nicklen}. Use the 'set nicklen' command to change it.", "", "", $screenname)); } if($oscar->get_app_data() and exists($oscar->get_app_data()->{0x0202})) { $sndata->{ctcp} = 1; irc_send(irc_privmsg($usnick, $nick, "You can receive CTCPs over AIM.")); } if($oscar->get_app_data() and exists($oscar->get_app_data()->{0x0203})) { map { $sndata->{relnotes}->{$_} = 1 } split(",", $oscar->get_app_data()->{0x0203}); } if(grep { !exists($sndata->{relnotes}->{$_}) } keys %{RELNOTES()}) { irc_send(irc_privmsg($usnick, $nick, "You have unseen release notes - use the $usnick relnotes command.", "", "", $screenname)); } if($oscar->profile) { irc_send(irc_privmsg($usnick, $nick, "You profile has been set.", "", "", $screenname)); } } sub oscar_buddylist_error($$$) { my($oscar, $error, $what) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; irc_send(irc_privmsg($usnick, $nick, "Error $error occured while $what on your buddylist.", "", "", $screenname)); if(--$oscar->{__IMIRC_blmod}) { $oscar->{__IMIRC_blmod} = 1; $oscar->commit_buddylist; } } sub oscar_buddylist_ok($) { my($oscar) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; if(--$oscar->{__IMIRC_blmod}) { $oscar->{__IMIRC_blmod} = 1; $oscar->commit_buddylist; } else { irc_send(irc_privmsg($usnick, $nick, "Your configuration (buddylist, etc.) was successfully modified.", "", "", $screenname)); } } sub oscar_connection_changed($$$) { my($oscar, $connection, $status) = @_; my $filehandle = $connection->get_filehandle; io_events($filehandle, $status, $connection); } sub oscar_auth_challenge($$$) { my($oscar, $challenge, $hashstr) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; irc_send(irc_ctcp($usnick, $nick, "OSCAR_AUTH $challenge $hashstr")); irc_send(irc_privmsg($usnick, $nick, "We received the authentication challenge: $challenge", "", "", $screenname)); irc_send(irc_privmsg($usnick, $nick, "Please send the MD5 digest of the challenge, your password, and the string \"$hashstr\" using the $usnick auth_response command.", "", "", $screenname)); irc_send(irc_privmsg($usnick, $nick, "For instance, if your password was \"password\", you would send the MD5 digest of \"${challenge}password${hashstr}\" (without the quotes.)", "", "", $screenname)); irc_send(irc_privmsg($usnick, $nick, "If you know how to script for your IRC client, $usnick sends you a CTCP OSCAR_AUTH with the challenge as the first parameter, followed by the extra string to hash with.", "", "", $screenname)); } sub oscar_log($$$) { my($oscar, $level, $msg) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; debug_print($msg, "oscar", 1) if $debug and $level <= $debuglevel{oscar}; irc_send(irc_privmsg($usnick, $nick, $msg, "", "", $screenname)) if $level <= $sndata->{loglevel}; } sub oscar_extended_status($$) { my($oscar, $status) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; irc_send(irc_privmsg($usnick, $nick, "Your extended status is now '$status'.", "", "", $screenname)) if $status; } sub oscar_new_buddy_icon($$$) { my($oscar, $budsn, $buddy) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; ##XXX do something else here? #oscar_log($oscar, 1, "$budsn has a new buddy icon."); } sub oscar_buddy_icon_uploaded($) { my($oscar) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; irc_send(irc_privmsg($usnick, $nick, "Your buddy icon has been uploaded successfully.", "", "", $screenname)); } sub oscar_buddy_icon_downloaded($$$) { my($oscar, $budsn, $icondata) = @_; my($screenname, $nick, $sndata) = callback_vars($oscar) or return; my $message = irc_dcc($usnick, $nick, $icondata, "icon", "$budsn.jpg", $screenname); if($message) { irc_send($message); irc_send(irc_ctcp($usnick, $nick, "get_icon")); irc_send(irc_privmsg($usnick, $nick, "Please accept the DCC SEND from $usnick. The file being sent is the buddy icon for $budsn.", "", "", $screenname)); } } sub debug_print($$$) { my($text, $type, $level) = @_; my($line, @lines); return if $text =~ m!401 $usnick #imirc-debug :No such nick/channel!i; return unless $debug; return if defined($debug{$type}) and $level > $debug{$type}; if($imircdebug and $debug < 2) { @lines = split(/[\r\n]+/, $text); foreach $line(@lines) { irc_send(":$usnick PRIVMSG #imirc-debug :($type, $level) $line\r\n", 1); } } else { chomp $text; print STDERR "$text\n"; } } # Convert HTML into text suitable for IRC sub html2txt($;$) { my ($msg, $nick, $parsetree, @lines, $formatter) = @_; my($linkct, $link, $elem, $node) = 0; $parsetree = HTML::TreeBuilder->new; $parsetree->{_ignore_unknown} = 0; $parsetree->parse($msg); $parsetree->eof; $formatter = new HTML::FormatIMIRC (leftmargin => 0, rightmargin => 4096); $formatter->{_original_html} = $msg; #We use this to determine whether to add a closing tag for "unknown tags" $msg = $formatter->format($parsetree); $parsetree->delete; return $msg; } # Send something to IRC sub irc_send($;$) { my ($msg, $flags, $nodbg, $rv) = @_; return unless $msg; $flags ||= 0; $nodbg = 1 if $flags & 1; debug_print("To IRC : $msg", "irc", 2) unless $nodbg; undef $rv; $! = EAGAIN; while(!defined($rv) && $! == EAGAIN) { $rv = $upstream->syswrite($msg, length $msg); if(defined $rv and $rv != length $msg) { substr($msg, 0, $rv) = ""; undef $rv; $! = EAGAIN; } elsif(!defined($rv) and $! != EAGAIN) { die "Couldn't write to IRC: $!"; } } return 1; } # Dereference a hashref sub deref($) { my $href = shift; return %$href if ref $href eq "HASH"; return (); } # Reload the configuration file sub rehash() { irc_send(irc_privmsg($usnick, "#imirc-debug", "Rehashing...")); if(-r "/etc/imirc.conf") { do "/etc/imirc.conf"; $@ =~ tr/\r//d; irc_send(irc_privmsg($usnick, "#imirc-debug", $@, "EVAL: ")); if($@) { irc_send(irc_privmsg($usnick, "#imirc-debug", "Couldn't reload /etc/imirc.conf - there were errors.")); } else { irc_send(irc_privmsg($usnick, "#imirc-debug", "Reloaded /etc/imirc.conf")) } } else { irc_send(irc_privmsg($usnick, "#imirc-debug", "Not loading /etc/imirc.conf - couldn't read")); } if(-r "$home/.imirc") { do "$home/.imirc" if -r "$home/.imirc"; irc_send(irc_privmsg($usnick, "#imirc-debug", $@, "EVAL: ")); if($@) { irc_send(irc_privmsg($usnick, "#imirc-debug", "Couldn't reload $home/.imirc - there were errors.")); } else { irc_send(irc_privmsg($usnick, "#imirc-debug", "Reloaded $home/.imirc")) } } else { irc_send(irc_privmsg($usnick, "#imirc-debug", "Not loading $home/.imirc - couldn't read")); } irc_send(irc_privmsg($usnick, "#imirc-debug", "Rehash complete!")); } # Re-eval IMIRC sub reload() { irc_send(irc_privmsg($usnick, "#imirc-debug", "Reloading $0...")); $reload = 1; local $SIG{__DIE__} = sub { $@ = shift; }; do $0; irc_send(irc_privmsg($usnick, "#imirc-debug", $@, "EVAL: ")); if($@) { irc_send(irc_privmsg($usnick, "#imirc-debug", "Couldn't reload $0 - there were errors.")); } else { irc_send(irc_privmsg($usnick, "#imirc-debug", "Reload complete!")); } } # Display version information sub dispver() { print "IMIRC: IRC <-> Instant Messenger gateway.\n"; print "AOL Instant Messenger, AOL, and America Online are trademarks of America Online, Inc.\n"; print "Version: $VERSION\n"; print "Use $0 --help for command-line options.\n"; print "Use $0 --license to see the license (GPL v2)\n"; exit 0; } # Dispaly licensing info sub license() { print $license; exit 0; } # Display commandline help sub help() { print < Instant Messenger gateway AOL Instant Messenger, AOL, and America Online are trademarks of America Online, Inc. Version $VERSION Usage: $0 [--version] [--license] [--help] [--config conffile] [--config conffile] ... You can use either the short or long forms with one or two dashes in whatever combination you want. However, you can't combine options as in $0 -VC. --version, -V: Display version information and exit --license: Display license information and exit --help, -h: Print this message and exit --config, -C: Specify configuration files to use. This option overrides the default configuration file locations. You may specify this option multiple times to use multiple configuration files. This is also an option for every directive in the configuration file. The options have the same names as the directives, but prefix them with two dashes (--) instead of the Perl variable type identifies (\$\@\%). See the included README file for more information. EOF ; exit 0; } # Sign on to AIM sub do_signon($$$$) { my($screenname, $password, $nick, $params) = @_; my $connection = $aim_connections->{$nick}; $connection->{screennames} = $oscarprime->buddyhash() unless tied(%{$connection->{screennames}}); my $oscar = $oscarprime->clone(); $oscar->{__IMIRC_nick} = $nick; my $loglevel = ($oscarprime->loglevel > $params->{loglevel}) ? $oscarprime->loglevel : $params->{loglevel}; $oscar->loglevel($loglevel); $oscar->signon( screenname => $screenname, password => $password, host => $oscarserver, port => $oscarport ); $screenname = new Net::OSCAR::Screenname $screenname; $aim_connections->{$nick}->{nick} = $nick; $connection->{screennames}->{$screenname}->{oscar} = $oscar; my $sndata = $connection->{screennames}->{$screenname}; $sndata->{loglevel} = $params->{loglevel}; $sndata->{report_idle} = $sendidle; $sndata->{idletime} = time; $sndata->{is_idle} = 0; $sndata->{signontime} = time; $sndata->{ison} = 0; $sndata->{inchan} = 0; $connection->{aimnick} ||= $screenname; $sndata->{away_buddies} = $oscar->buddyhash(); $sndata->{away_requested} = $oscar->buddyhash(); $sndata->{info_requested} = $oscar->buddyhash(); $sndata->{away} = $oscar->buddyhash(); $sndata->{ctcp} = 0; $sndata->{relnotes} = {}; $irc_connections->{$screenname} = $nick; switchnick($nick, $screenname) if $connection->{aimnick} eq $screenname; irc_send(irc_privmsg($usnick, $nick, "Sent signon attempt for $screenname...")); irc_send(irc_newnick($prefix.$screenname)); $nicks->{$screenname}->{$screenname} = -1; } # Signoff a particular screenname sub do_signoff($$;$) { my ($nick, $oscar, $already_off) = @_; my $screenname = $oscar->screenname if $oscar; for(my $i = $#dccqueue; $i >= 0; $i--) { my $dcc = $dccqueue[$i]; next unless $screenname and $dcc->{screenname} eq $screenname; io_events($dcc->{socket}, "deleted"); close $dcc->{socket} if $dcc->{socket}; debug_print("Closed DCC $dcc->{desc} for $screenname due to signoff", "DCC", 3); splice(@dccqueue, $i, 1); } foreach my $chat(keys %chats) { my $chan = chatchan($chat); next unless normalize($chats{$chat}->{screenname}) eq normalize($screenname) or not $screenname; foreach my $who(keys %{$chats{$chat}->{members}}) { delete $chats{$chat}->{members}{$who}; rm_nick_user($who, $chatchan.$chat); irc_send(irc_part(aimnick($who, $screenname), $chan)); } delete $chats{$chat}; irc_send(irc_kick($usnick, $chan, $nick, "The screenname you were using in this chatroom is no longer signed on to AOL Instant Messenger.")); irc_send(irc_part($usnick, $chan)); } delete $irc_connections->{$screenname} if $screenname; if($screenname and $aim_connections->{$nick}->{screennames}->{$screenname}->{inchan}) { irc_send(irc_kick($usnick, nickchan($screenname), $nick, "You have been signed off of AOL Instant Messenger.")); } rm_nick_user($screenname, $screenname) if $screenname; foreach my $xnick(keys %$nicks) { next if $xnick eq $usnick or not $screenname; rm_nick_user($xnick, $screenname); } irc_send(irc_part($usnick, nickchan($screenname))) if $screenname; $oscar->signoff() unless $already_off or !$oscar; if($aim_connections->{$nick}) { irc_send(irc_privmsg($usnick, $nick, "You have been signed off of AOL Instant Messenger as $screenname", "", "", $screenname)) unless $already_off or not $screenname; delete $aim_connections->{$nick}->{screennames}->{$screenname} if $screenname; if(haskeys $aim_connections->{$nick}->{screennames}) { my $xnick = (keys %{$aim_connections->{$nick}->{screennames}})[0]; switchnick($nick, $xnick); irc_send(irc_privmsg($usnick, $nick, "Your new default screenname is $xnick.", "", "", $xnick)); } else { delete $aim_connections->{$nick}; } } update_usercount(); } # Send mode as if it's coming from the server sub irc_mode($$$) { my($who, $chan, $modes, $modestr) = @_; return if $who eq $us and IsTS() and $modes eq "+o $usnick"; $modestr = ""; $modestr = ":$who " unless $who eq $us; $modestr .= "MODE $chan $modes"; $modestr .= " " . ($chants->{$chan} || time) if !IsTS() and $who eq $us; $modestr .= "\r\n"; return $modestr; } # Join a channel sub irc_join($$) { my($user, $channel, $ret) = @_; $ret = ""; if($user eq $usnick and exists($chantimer{$channel})) { #un-bounce_join delete $chantimer{$channel}; $ret = irc_part($usnick, $channel); } # Unless it's us that's joining, it's probably an AIM- nick coming # into a chatchan or nickchan. Some servers get pissed when they join # a +i chan w/o an invite, so send the invite. # # UPDATE: Some change somewhere made the same server that I added # this change for (hybrid-7beta9) start KILLing if I sent it an # invite for one of our local users - I think the thing that did it # was that we do SJOIN better now; we actually have the right timestamp, # for one. # #$ret .= irc_invite($usnick, $channel, $user) if $user ne $usnick; # TS requires we use SJOIN when creating a channel # $usnick will always be the first one in. if(IsTS()) { $chants->{$channel} ||= time; $user = "\@$user" if $user eq $usnick; $ret .= ":$us SJOIN $chants->{$channel} $channel + :$user\r\n"; } elsif($servermode eq "p0210") { $user = "\@$user" if $user eq $usnick; $ret .= ":$us NJOIN $channel :$user\r\n"; } else { $ret .= ":$user JOIN $channel\r\n"; if($servermode eq "unreal" and !$chants->{$channel}) { $chants->{$channel} = time; $ret .= "MODE $channel + $chants->{$channel}\r\n"; } } return $ret; } # Kick someone from a channel sub irc_kick($$$;$) { my($from, $channel, $nick, $reason) = @_; $nick =~ s/\@+//; return ":$from KICK $channel $nick" . ($reason ? " :$reason" : "") . "\r\n"; } # Leave a channel sub irc_part($$;$) { my($from, $channel, $reason) = @_; return ":$from PART $channel" . ($reason ? " :$reason" : "") . "\r\n"; } # Send a numeric IRC error sub irc_error($$$) { my($to, $number, $text) = @_; return "$number $to :$text\r\n"; } # Change the topic for a channel sub irc_topic($$$) { my($from, $channel, $topic) = @_; return ":$from TOPIC $channel :$topic\r\n"; } # Reply to a PING sub irc_pong($) { my $server = shift; return "PONG $us $server\r\n"; } # Leave IRC sub irc_quit($;$) { my($from, $reason) = @_; return ":$from QUIT" . ($reason ? " :$reason" : "") . "\r\n"; } # Do all these bloody IRC commands really need documentation? RTFRFC. sub irc_invite($$$) { my($from, $channel, $who) = @_; return "" if $servermode eq "bahamut" and $who =~ /^$prefix/; return ":$from INVITE $who :$channel\r\n"; } # Set an away message sub irc_away($;$) { my($nick, $awaymsg) = @_; return $awaymsg ? ":$nick AWAY :$awaymsg\r\n" : ":$nick AWAY\r\n"; } # Receive a message from IRC sub irc_recv(;$) { my($noblock, $rv, $buff, $idx, $ret) = ($_[0]); undef $rv; $! = EAGAIN; while(not $getbuff[0] and $! == EAGAIN and !defined($rv)) { $buff = ' ' x 512; $rv = $upstream->sysread($buff, 512); die "Couldn't read from IRC: $!" if !defined($rv) && $! != EAGAIN; if(defined($rv)) { if($incbuff) { $buff = $incbuff.$buff; undef $incbuff; } unless($buff =~ /[\r\n]{1,2}$/) { $idx = rindex($buff, "\n") + 1; $incbuff = substr($buff, $idx, length($buff) - $idx, ""); } push @getbuff, split(/[\r\n]{1,2}/, $buff) if $buff; #print STDERR "Getbuff is " . join("\n", @getbuff) . "\n"; } last if $noblock; } $ret = shift @getbuff; debug_print("From IRC: $ret", "irc", 2) if $ret; #print STDERR "Returning $ret\n"; return $ret; } sub irc_stats($$) { my($who, $what) = @_; return ":$who STATS $what $themname\r\n"; } sub irc_kill($$$) { my($sender, $target, $reason) = @_; do_signoff_all($target) if $aim_connections->{$target}; return ":$sender KILL $target :$reason\r\n"; } # Warn if a screenname is being mangled to work with IRC sub manglewarn($$$) { my($who, $what, $screenname) = @_; my $ircdude = $irc_connections->{$screenname}; my $sndata = $aim_connections->{$ircdude}->{screennames}->{$screenname}; if($shortnicks->{$what} ne $what) { irc_send(irc_privmsg($usnick, $who, "\02WARNING\02: Screenname ".noprefix($what)." has been mangled to IRC nickname " . $shortnicks->{$what}, "", "", $screenname)); } elsif($sndata->{nicklen} and length($shortnicks->{$what}) > $sndata->{nicklen}) { irc_send(irc_privmsg($usnick, $who, "\02WARNING\02: Nickname ".$shortnicks->{$what}." is longer than ".$sndata->{nicklen}." characters.", "", "", $screenname)); } } # Switch the default screenname for an IRCnick sub switchnick($$) { my($nick, $newname) = @_; my $oldnick = $aim_connections->{$nick}->{aimnick}; return 1 unless $aim_connections->{$nick}->{screennames}->{$newname}; $aim_connections->{$nick}->{aimnick} = $newname; $aim_connections->{$nick}->{oscar} = $aim_connections->{$nick}->{screennames}->{$newname}->{oscar}; return 0; } # Clean up nicknames, send keepalives/idle, etc. sub timestuff($) { my($currtime, $anick, $kill, $bnick, $chantimer, $cname, $connection, $screenname, $multinick, $sndata, $nick) = shift; debug_print("Reaping nicks...", "nicks", 3); ANICK: foreach $anick(keys %$nicks) { next if $anick eq $usnick or $anick eq $oldnick; next if exists $irc_connections->{noprefix($anick)}; next if $anick =~ /^chat-\d+/; $kill = 1; debug_print("\tSO WE MEET AGAIN, $anick.", "nicks", 3); foreach $bnick(keys %{$nicks->{$anick}}) { next if $bnick eq $usnick; debug_print("\t\t$bnick was using $anick...", "nicks", 3); next ANICK if $kill == 0; if($nicks->{$anick}->{$bnick} == -1) { $kill = 0; debug_print("\t\t\tpermenantly.", "nicks", 3); } elsif (($currtime - $nicks->{$anick}->{$bnick}) < 3600) { $kill = 0; debug_print("\t\t\tsince " . ($currtime - $nicks->{$anick}->{$bnick}) . " seconds ago.", "nicks", 3); } } if($kill == 1) { irc_send(irc_quit(aimnick($anick, $usnick), "Waah, nobody wants me (reaped)")); delete $nicks->{$anick}; debug_print("\t$anick, HAVE A NICE AFTERLIFE. ($anick reaped)", "nicks", 1); } else { debug_print("\t$anick, YOU LIVE FOR NOW.", "nicks", 3); } } #Part from the restricted that we joined in response to someone joining without my authoritay foreach $chantimer(keys %chantimer) { if(($currtime - $chantimer{$chantimer}) >= 60) { irc_send(irc_part($usnick, $chantimer)); delete $chantimer{$chantimer}; } } #Only send idle/keepalive packets every other time through the loop if($keepalive) { foreach $cname(keys %$aim_connections) { $connection = $aim_connections->{$cname}; foreach $screenname(keys %{$connection->{screennames}}) { next unless $screenname; $sndata = $connection->{screennames}->{$screenname}; $multinick = ""; $multinick = " for screenname $screenname" unless $screenname eq $connection->{aimnick} or $sndata->{inchan}; next unless $sndata->{ison}; if($sndata->{oscar}) { if($sndata->{report_idle} and not $sndata->{is_idle} and ($currtime - $sndata->{idletime}) >= 360) { $sndata->{oscar}->set_idle($currtime - $sndata->{idletime}); $sndata->{is_idle} = 1; } } } } $keepalive = 0; } else { $keepalive = 1; } kill_phantoms(); } # Signoff all screennames for a particular IRCnick sub do_signoff_all($) { my $nick = shift; foreach my $screenname(keys %{$aim_connections->{$nick}->{screennames}}) { do_signoff($nick, $aim_connections->{$nick}->{screennames}->{$screenname}->{oscar}); } irc_send(irc_privmsg($usnick, $nick, "All connections signed off of AOL Instant Messenger.")); delete $aim_connections->{$nick}; } # Notify signed-on users that we're going down sub going_down() { my ($user, @users) = (undef, keys %$aim_connections); foreach $user(@users) { next if $aim_connections->{$user}->{notified}++; irc_send(irc_privmsg($usnick, $user, "IMIRC is going down. You have been signed off of AOL Instant Messenger.")); } } # Encode a message for CTCPing - you must still irc_send(":$sender PRIVMSG $target :$this") sub irc_ctcp_quote($) { my($delim, $null) = (chr(001), chr(000)); my $message = shift; $message =~ s/\\/\\\\/g; $message =~ s/$delim/\\a/g; $message =~ s/\n/\\\n/g; $message =~ s/\r/\\\r/g; $message =~ s/$null/\\$null/g; $message =~ s/:/\\/g; return $message; } # Decode an incoming CTCP sub irc_ctcp_unquote($) { my($delim, $null) = (chr(001), chr(000)); my $message = shift; $message =~ s/\\\\/\\/g; $message =~ s/\\a/$delim/g; $message =~ s/\\\n/\n/g; $message =~ s/\\\r/\r/g; $message =~ s/\\$null/$null/g; return $message; } # Process an incoming IRC command for CTCPs sub process_ctcp($$$$$) { my($from, $to, $message, $screenname, $notice) = @_; my ($delim, @ctcp, $ctcp, $cmd, $args) = (chr(001)); my($filename, $ipaddr, $port, $filesize, $socket, $buff, $flags); return $message unless $message =~ /$delim/; $to = noprefix($longnicks->{$to}); @ctcp = map { $_ = irc_ctcp_unquote $_; debug_print("CTCP: $_", "ctcp", 2) if $_; $_; } split(/$delim+/, $message); shift @ctcp; $message =~ s/$delim.*//g; debug_print("After CTCP: $message", "ctcp", 2); CTCP: foreach $ctcp(@ctcp) { $ctcp =~ /^(\S+) ?(.*)$/; $cmd = $1; $args = $2; debug_print("Processing CTCP $ctcp: command $cmd", "irc", 2); if($to ne $usnick and $to ne $oldnick) { if($aim_connections->{$from} and $aim_connections->{$from}->{oscar}) { $aim_connections->{$from}->{oscar}->send_im($to, ($notice ? "" : "") . "$ctcp") if exists($aim_connections->{$from}); } else { irc_send(irc_privmsg($usnick, $from, "You must be signed onto AOL Instant Messenger via IMIRC to send CTCPs to AIM users. /msg $usnick help for details.")); } next; } if($cmd eq "PING") { irc_send(irc_ctcp($to, $from, $ctcp, 1)); } elsif($cmd eq "ACTION") { $message .= "\02ACTION\02 $args"; #If you "/me runs" an AIMer, it'll turn into "ACTION runs". Anyone got any better ideas? } elsif($cmd eq "DCC") { my @dccdata = ref($dccget{$from}) ? @{$dccget{$from}} : (); $screenname = $dccdata[0]; ($cmd, $args) = split(/ /, $args, 2); if($cmd eq "REJECT") { my($dcc, $i); for($i = $#dccqueue; $i >= 0; $i--) { $dcc = $dccqueue[$i]; next unless $dcc->{for} eq $from; debug_print("$from rejected our DCC.", "DCC", 1); io_events($dcc->{socket}, "deleted"); close $dcc->{socket} if $dcc->{socket}; splice(@dccqueue, $i, 1); } } elsif($cmd eq "SEND") { $args =~ /(.+)\s+(\d+)\s+(\d+)\s+(\d+)/; #Handles spaces in filename ($filename, $ipaddr, $port, $filesize) = ($1, $2, $3, $4); if(not $dccget{$from}) { irc_send(irc_privmsg($to, $from, "I'm not accepting DCCs from you at this time.", "", "", $screenname)); irc_send(irc_ctcp($to, $from, "DCC REJECT SEND $filename", 1)); next CTCP; } if($dccget{$from} and $filesize > 102400) { irc_send(irc_privmsg($to, $from, "Sorry, I won't accept more than 100k.", "", "", $screenname)); delete $dccget{$from}; irc_send(irc_ctcp($to, $from, "DCC REJECT SEND $filename")); next CTCP; } else { socket($socket, PF_INET, SOCK_STREAM, getprotobyname('tcp')); set_blocking($socket, 0); if(!connect($socket, sockaddr_in($port, inet_aton($ipaddr))) and $! != EINPROGRESS) { irc_send(irc_privmsg($to, $from, "Couldn't receive your DCC: $!")); next CTCP; } push @dccqueue, { screenname => $screenname, from => new Net::OSCAR::Screenname($from), to => new Net::OSCAR::Screenname($to), for => new Net::OSCAR::Screenname($from), socket => $socket, time => time, size => $filesize, what => "", desc => $dccdata[1], state => DCC_STATE_GET_CONNECT, sent => 0, received => 0, }; io_events($socket, dcc_state_io_events(DCC_STATE_GET_CONNECT)); delete $dccget{$from}; irc_send(irc_privmsg($to, $from, "Okay, I'll get your DCC of $filename.", "", "", $screenname)); } } } } return $message; } # Like irc_privmsg sub irc_ctcp($$$;$) { my($from, $to, $message, $reply) = @_; my $delim = chr(001); return ":$from " . ($reply ? "NOTICE" : "PRIVMSG") . " $to :$delim" . irc_ctcp_quote($message) . "$delim\r\n"; } #Someone's sending us a file: DCC SEND filename IPaddr port filesize sub loadbuddies($$$) { my($oscar, $buff, $sndata) = @_; my($line, $pmode, %buddies, @permit, @deny, %bnotes); my($merge) = delete $sndata->{blmerge}; my $profile = ""; if($buff !~ /{/) { #TOC-style my $group = ""; foreach $line(split(/[\r\n]+/, $buff)) { $line =~ s/(.) //; my $cmd = $1; if($cmd eq "m") { $pmode = $line; } elsif($cmd eq "g") { $group = $line; } elsif($cmd eq "b") { push @{$buddies{$group}}, $line; } elsif($cmd eq "p") { push @permit, $line; } elsif($cmd eq "d") { push @deny, $line; } } } else { my $data = oscar_cfgparse($buff); #irc_send(irc_privmsg($usnick, "matthewg", Data::Dumper::Dumper($data))); if($data->{Config}->{version}->[0] != 1) { irc_send(irc_privmsg($usnick, $irc_connections->{$oscar->screenname}, "That isn't a valid buddylist.", "", "", $oscar->screenname)); return 0; } my $privmode = $data->{Privacy}->{pref}->[0]; if(lc($privmode) eq "allowall") { $pmode = 1; } elsif(lc($privmode) eq "denyall") { $pmode = 2; } elsif(lc($privmode) eq "allowsome") { $pmode = 3; } elsif(lc($privmode) eq "denysome") { $pmode = 4; } elsif(lc($privmode) eq "permitbuddies") { $pmode = 5; } else { $pmode = 4; } @permit = @{$data->{Privacy}->{allowList}}; @deny = @{$data->{Privacy}->{blockList}}; $profile = join("", @{$data->{User}->{profile}->{dataBlob}}); foreach my $group(keys %{$data->{Buddy}->{list}}) { if(ref($data->{Buddy}->{list}->{$group})) { my $buddygroup = $data->{Buddy}->{list}->{$group}; my @buddies; if(ref($buddygroup) eq "HASH") { @buddies = keys %$buddygroup; } elsif(ref($buddygroup) eq "ARRAY") { @buddies = @$buddygroup; } else { next; } @{$buddies{$group}} = @buddies; foreach my $buddy(@buddies) { #irc_send(irc_privmsg($usnick, $irc_connections->{$oscar->screenname}, "Got $group/$buddy", "", "", $oscar->screenname)); next unless ref($data->{Buddy}->{list}->{$group}) eq "HASH"; next unless ref($data->{Buddy}->{list}->{$group}->{$buddy}) eq "HASH"; next unless $data->{Buddy}->{list}->{$group}->{$buddy}->{BuddyNote}; next unless $data->{Buddy}->{list}->{$group}->{$buddy}->{BuddyNote}->{NoteString}; $bnotes{$buddy} = join(" ", @{$data->{Buddy}->{list}->{$group}->{$buddy}->{BuddyNote}->{NoteString}}); } } else { @{$buddies{$group}} = (); } } } if(!$merge) { my @rmbuddies = (); foreach my $group($oscar->groups) { my @currbuddies = $oscar->buddies($group); $buddies{$group} ||= []; my @newbuddies = @{$buddies{$group}}; @rmbuddies = (); foreach my $buddy(@currbuddies) { push @rmbuddies, $buddy unless grep {$_ eq $buddy} @newbuddies; } next unless @rmbuddies; #irc_send(irc_privmsg($usnick, $irc_connections->{$oscar->screenname}, "Removing ".join(",",@currbuddies)." from $group.", "", "", $oscar->screenname)); $oscar->remove_buddy($group, @rmbuddies); } my @currbuddies = $oscar->get_permitlist; my @newbuddies = @permit; @rmbuddies = (); foreach my $buddy(@currbuddies) { push @rmbuddies, $buddy unless grep {$_ eq $buddy} @newbuddies; } $oscar->remove_permit(@rmbuddies) if @rmbuddies; @currbuddies = $oscar->get_denylist; @newbuddies = @deny; @rmbuddies = (); foreach my $buddy(@currbuddies) { push @rmbuddies, $buddy unless grep {$_ eq $buddy} @newbuddies; } $oscar->remove_deny(@rmbuddies) if @rmbuddies; } $oscar->set_info(decode_base64($profile)) if $profile; $oscar->set_visibility($pmode); foreach my $group(keys %buddies) { #irc_send(irc_privmsg($usnick, $irc_connections->{$oscar->screenname}, "Adding ".join(",",@{$buddies{$group}})." to $group.", "", "", $oscar->screenname)); $oscar->add_buddy($group, @{$buddies{$group}}) if @{$buddies{$group}}; foreach my $buddy(grep { $bnotes{$_} } @{$buddies{$group}}) { $oscar->set_buddy_comment($group, $buddy, $bnotes{$buddy}); } } $oscar->add_permit(@permit) if @permit; $oscar->add_deny(@deny) if @deny; $oscar->commit_buddylist unless $oscar->{__IMIRC_blmod}++; return 1; } # DCC send a file to someone - you must irc_send this! Returns the empty string on error. sub irc_dcc($$$$$$) { my($from, $to, $what, $why, $filename, $screenname, $msg, $flags, $socket) = @_; if(!$dccip) { irc_send(irc_privmsg($from, $to, "The administrator of this server has not configured an IP to use for DCC, so DCC SEND has been disabled.", "", "", $screenname)); return ""; } $socket = gensym; socket($socket, PF_INET, SOCK_STREAM, getprotobyname('tcp')); set_blocking($socket, 0); if(!setsockopt($socket, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))) { irc_send(irc_privmsg($from, $to, "Couldn't set sockopt for DCC socket: $!", "", "", $screenname)); return ""; } if(!bind($socket, sockaddr_in(0, inet_aton($dccip)))) { irc_send(irc_privmsg($from, $to, "Couldn't bind DCC socket: $!", "", "", $screenname)); return ""; } if(!listen($socket, SOMAXCONN)) { irc_send(irc_privmsg($from, $to, "Couldn't listen on DCC socket: $!", "", "", $screenname)); return ""; } my($port) = sockaddr_in(getsockname($socket)); $flags = 0; push @dccqueue, { screenname => new Net::OSCAR::Screenname($screenname), from => new Net::OSCAR::Screenname($from), to => new Net::OSCAR::Screenname($to), for => new Net::OSCAR::Screenname($to), socket => $socket, time => time, size => length($what), what => $what, desc => $why, state => DCC_STATE_SEND_LISTEN, sent => 0, received => 0 }; io_events($socket, dcc_state_io_events(DCC_STATE_SEND_LISTEN), $dccqueue[-1]); debug_print("DCC SEND (listening on $dccip:$p