#!/usr/bin/perl -s

# AOL Instant Mooer
# (C) 2005, Midgard Systems Group
# All rights reserved.

use Net::AIM;
use Net::Telnet;
use POSIX 'setsid';

$debug = $d;

my $screenname = shift;
my $password = shift;
my $admin = shift;
my $moohost = shift;
my $mooport = shift;

my $aim = new Net::AIM;
$aim->timeout(0.01);
$aim->debug(0);
$aim->newconn(
              Screenname => $screenname,
              Password   => $password,
             ) or die "unable to connect";
my $conn = $aim->getconn;
die unless $conn;

$conn->set_handler('error', \&on_error);
$conn->set_handler('im_in', \&on_im);

my %connections;

&daemonize unless $n || $d;

&doloops;
$aim->send_im($admin, "Starting up.");
my %throttle;
while(1) {
  last unless $aim->do_one_loop();
  my $now = time();
  my $tnow = int($now / 3);
  %throttle = {t => $tnow, c => 0} if $throttle{t} != $tnow;
  my $idletime = $now - 300;
  my $killtime = $now - 600;
  foreach my $user (keys %connections) {
    next unless $user && $connections{$user} && $connections{$user}->{connection};
    $t = $connections{$user}->{connection};
    if(my $line = $t->getline(Timeout => 0, Errmode => "return")) {
      chomp $line;
      print STDERR "[$now] Got line for $user: [$line]\n" if $debug;
      $line = &encode($line);
      push @{$connections{$user}->{buffer}}, $line;
      $connections{$user}->{last_output} = $now;
    }
    if($throttle{t} != $tnow || $throttle{c} < 2) {
     if(@{$connections{$user}->{buffer}}) {
      if($connections{$user}->{throttle}->{time} != $now || $connections{$user}->{throttle}->{count} < 4) {
        my $line;
        for(my $l = 0; $l < 5 && @{$connections{$user}->{buffer}}; $l++) {
          $line .= "\n" if $line;
          $line .= shift @{$connections{$user}->{buffer}};
        }
        $connections{$user}->{throttle}->{count} = 0 if $connections{$user}->{throttle}->{time} != $now;
        $connections{$user}->{throttle}->{time} = $now;
        $connections{$user}->{throttle}->{count}++;
        $throttle{c}++;
print STDERR "Sending [$line] to $from\n" if $debug;
        $aim->send_im($user, $line);
      } else {
        print STDERR "Output to $user throttled\n" if $debug;
        $connections{$user}->{throttle}->{count}--;
      }
     }
    } else {
      print STDERR "All output throttled.\n";
    }
    if($connections{$user}->{last_output} < $killtime || $connections{$user}->{last_input} < $idletime) {
      print STDERR "Killing idle connection for $user.\n" if $debug;
      $connections{$user}->{connection}->print('@quit') if $connections{$user}->{connection};
      delete $connections{$user};
      $aim->send_im($user, "Disconnected");
    }
  }
#  select undef, undef, undef, 0.05 if $throttle{c};
}

use Data::Dumper;
sub on_error {
  my($aim,$event,$from,$to) = @_;
  print STDERR "on_error: ", Data::Dumper->Dump(\@_),"\n\n" if $debug > 1;
  my $errcode = $event->args->[0];
  my $errstr = $event->trans($errcode);
  print STDERR "ERROR: ", $errstr, "\n";
  &disconnect;
}
sub on_im {
  my($aim,$event,$from,$to) = @_;
  print STDERR "on_im: ", Data::Dumper->Dump([@_]),"\n\n" if $debug > 1;
  if($event->type eq 'im_in') {
    my($name, $format, $text) = @{$event->args};
    $text =~ s/<[^>]+>//gs;

    $text =~ s/^\s*//s; $text =~ s/\s*$//s;
    if($text =~ /^co(?:nnect)? (\S+) (\S+)$/i) {
      my($user,$pass) = ($1,$2);
      my $t = Net::Telnet->new(Timeout => 1, errmode => [\&telnet_error, $from]);
print STDERR "t: $t\n" if $debug;
      $t->open(Host => $moohost, Port => $mooport) or return &fail($from,$text);
      $t->print($user,"\n", $pass);
      $connections{$from} = {username => $user, password => $pass, connection => $t, last_input => time(), last_output => time()};
    } elsif($connections{$from} && $text eq 'quit') {
print STDERR "Closing connection for $from\n" if $debug;
      $connections{$from}->{connection}->print('@quit');
      delete $connections{$from};
      $aim->send_im($from, "Disconnected");
    } elsif($from eq $admin && $text =~ /dump/) {
      my $d = Data::Dumper->new([\%connections],['connections'])->Indent(0);
      $aim->send_im($from, $d->Dump);
    } elsif($from eq $admin && $text eq 'shutdown') {
      &disconnect;
    } elsif($connections{$from}) {
print STDERR "Sending [$text] from $from\n" if $debug;
      $connections{$from}->{connection}->print($text);
      $connections{$from}->{last_input} = time();
    }
  }
}

sub disconnect {
print STDERR "disconnect()\n" if $debug;
  foreach my $user (keys %connections) {
    $aim->send_im($user, "Proxy shutting down.");
    print STDERR "Killing connection for $user.\n" if $debug;
    $connections{$user}->{connection}->print('@quit');
  }
  $aim->send_im($admin, "Proxy shutting down.") unless exists $connections{$admin};
  &doloops;
  $conn->disconnect;
  exit;
}
sub fail {
print STDERR "fail: ", Data::Dumper->Dump(\@_),"\n\n" if $debug;
  my($who,$what) = @_;
  $aim->send_im($who, $what);
  &doloops;
}

sub doloops {
  for(my $i=0;$i<25;$i++) {
    $aim->do_one_loop();
    select undef,undef,undef,0.01;
  }
}

sub decode {
  my $line = shift;
  $line =~ s/^\s*//s;
  $line =~ s/\s*$//s;
  $line =~ s/&quot;/"/gs;
  $line =~ s/&gt;/>/gs;
  $line =~ s/&lt;/</gs;
  $line =~ s/&amp;/&/gs;
  return $line;
}
sub encode {
  my $line = shift;
  $line =~ s/\27[0-9;]*.//gs;
  return $line;
}

sub daemonize {
  chdir '/' or die "Can't chdir to /: $!";
  open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
  open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
  defined(my $pid = fork) or die "Can't fork: $!";
  exit if $pid;
  setsid or die "Can't start a new session: $!";
  open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}

sub telnet_error {
  print STDERR "telnet_error: ", Data::Dumper->Dump(\@_),"\n\n" if $debug;
  my($user) = @_;
}