#!/usr/bin/perl -w
########################################
# bot.pl: put Frotz on the AIM network #
########################################

	$screenname = "";
	$password = "";
	$admin = "you-would-be-wise-to-change-this";

# Use the module File-Basename so that the script can be called from anywhere.
use File::Basename;
chdir(dirname($0));

use Net::AIM;		# obvious
use LWP::Simple;	# Use LWP-Simple for retreival of text files.
use IO::Handle;		# autoflush
use FileHandle;		
use IPC::Open2;

print STDERR "$0: starting up...\n";

# Create a new Net-AIM instance.
my $aim = new Net::AIM;
$aim->newconn( Screenname => $screenname,
               Password   => $password )
                or die "Error: Cannot connect to the AIM server!";
$conn = $aim->getconn();

print STDERR "$0: connected to aim server as '$screenname'.\n";

# Set up the handlers for commands issued by the server.
$conn->set_handler('im_in', \&on_im);
$conn->set_handler('error', \&on_error);
$conn->set_handler('eviled', \&on_evil);
$conn->set_handler('config', \&on_config);

##############################################
# CONFIG VARS

my %filemark;		# how many bytes of output file already seen
my %writer;		# output handles
my %game;		# what game user is playing
my %idle;		# how long user is idle

my $maxconn = 10;	# max connections
my $maxidle = 1000;	# how long before we disconnect idle user
my $waitcount = 999;
my $bar = "----------------------------------------\n";

##############################################
# MAIN LOOP

$msg2 = "";
$message_received = 0;

while (uc($msg2) ne "HALT")
{
	$aim->do_one_loop();

	$waitcount++;
	if ($waitcount > 100) 
	{
		print STDERR "$0: waiting patiently...\n";
		$waitcount = 0;
	}

	# kick idle users

	while(($key,$value) = each %idle)
	{
		$idle{$key}++;
		if ($idle{$key} > $maxidle)
		{ 
			disconnect($key); 
			print STDERR "$0: kicked idle user \"$key\"\n";
		}
	}

	# handle incoming messages

	if ($message_received == 1)
	{
		# admin function?
		if (substr($msg, 0, length($admin)) eq $admin)
		{ 
			admin(substr($msg, length($admin))); 
		}
		else
		{

		if (!exists($writer{$victim}))
		{
			# new connection

			if (keys(%writer) >= $maxconn)
			{
				$aim->send_im($victim, "Sorry, all slots are full. Try again later! :)"); 
			}
			else
			{
				$gamefile = lc($msg); # lowercase for convenience
				$gamefile = alphanum($gamefile); # remove symbols
				if ( -e "games/$gamefile" && $gamefile ne "")
				{
					print STDERR $bar;
					print STDERR "$0: starting '$gamefile' for '$victim'...\n";
					$game{$victim} = $gamefile;
					$idle{$victim} = 0;
	
					# this forks a new process! we talk to it with pipes

					open($writer{$victim}, "| dfrotz -w 40 games/$gamefile > $victim.out");
					$writer{$victim}->autoflush();
					sleep 3; 	# let dfrotz start up

					$filemark{$victim} = 0;
					$greeting = tail();
					$aim->send_im($victim, $greeting); 

					print STDERR "$greeting\n$bar";
				}
				else
				{
					print STDERR "$0: '$victim'> \"$msg\"\n";
					$greeting = `cat motd` . `ls -C games`;
					$aim->send_im($victim, $greeting);
					print STDERR "$0: gave '$victim' list of games.\n";
				}
			}
		}
		else
		{
			# existing connection

			if (uc($msg) eq "QUIT" || uc($msg) eq "Q")
			{
				disconnect($victim);
			}
			else
			{
				# write user command to output file
				#$f = new FileHandle;
				#open ($f, ">>$victim.log");

				$tmp = $writer{$victim};
				print $tmp "$msg\n";
				sleep 1;	# give dfrotz time to respond

				$response = "$victim> $msg\n" . tail();
				#print $f $response;
				#close($f);
				$aim->send_im($victim, $response); 

				print STDERR $bar;
				print STDERR "$0: $response$bar";
			}
		}
		$msg2 = $msg;
		$idle{$victim} = 0;

		}
		$message_received = 0;
	}
	sleep 1;   # check for new aim activity every second
}


########################################################
# SUBROUTINES
########################################################


################################
sub admin
{
	$command = shift;
	$response = "";

	if ($command eq " who")
	{
		$response = "Users online:\n"; 
		while(($key,$value) = each %game)
		{
			$response .= "$key is playing \"$value\"";
			$response .= ", idle for $idle{$key}.\n";
		}
	}



	if ($response eq "")
	{
		$response = "Admin commands: who"
	}

	$aim->send_im($victim, $response);
	print STDERR "$0: admin($victim) used \"$command\".\n";
}


################################
# pass this function a username
# to disconnect.

sub disconnect
{
	$v = shift;
	print STDERR "$0: saying goodbye to '$v'...\n";
	if ($idle{$v} > $maxidle)
		{ $aim->send_im($v, "---(((IDLE)))---\n"); }
	else
		{ $aim->send_im($v, "---GAME OVER---\n"); }

	close $writer{$v};
	delete $writer{$v};
	delete $filemark{$v};
	delete $game{$v};
	delete $idle{$v};

	print STDERR "$0: '$v' is gone.\n";
}

################################
# return the latest changes
# to output file

sub tail
{
	$f = new FileHandle;
	open($f, "$victim.out");
	$f->autoflush();
	seek($f, $filemark{$victim}, 0);
	$text="";
	while (!eof($f))
	{
		$one = getc($f);
		$filemark{$victim}++;
		$text = $text . $one;
	}
	close($f);
	return $text;	
}




################################
# pass this function a string
# and it returns only the
# alphanumeric parts, stripping
# out any symbols etc.
# example:
# alphanum("/usr/bin/perl.sh")
# returns "usrbinperlsh"

sub alphanum{
	$tmp = shift;
	$tmp =~ y/[\041-\100]?[\133-\140]?[\173-\176]//d;
	return($tmp);
}



################################
# WIRED BOTS
#
# sendim($victim‚$msg);
#
#  desc: This sub tells the bot to send an IM to a specific user.
#        For this, $msg should be formatted as "/sendim screenname->what";
#	 It grabs 
#  recv: $victim‚$msg
# sends: $reply, an IM.
################################

sub sendim {
    
    #Is this an admin-only command?  (1 for yes, 0 for no).
    $adminonly = 1;


    #Get the admin's screenname.
    open (FILE, "admin.txt");
    $admin = <FILE>;
    close(FILE);

    #Get the message and the victim.
    $victim = shift;
    $msg = shift;

    #Make a new variable to work with containing the message.
    $message = $msg;    

    #Take the prefix off of the message.
    $message =~ s/\/sendim //ig;

    #Split the message
    ($sn,$what) = split(/->/,$message);

    #If the message is in an improper format...
    if ($sn eq "" || $what eq "") {
	
    #Tell them.
    $reply = "Your command was in an improper format. The proper format is:"
		. " /sendim username->message to send";

    }

    #If the command is admin-only and the victim is not the admin...
    elsif($adminonly == 1 && $victim ne "$admin") {

    #Return an error message.
    $reply = "Sorry, This is an Admin-only command.";

    #Otherwise, continue.
    } else {

    #Send the IM.
    $aim->send_im($sn, "$what");

    #Return the confirmation message.
    $reply = "Message sent!";

    }

    #Return the reply.
    return $reply;

}

################################
# WIRED BOTS
#
# log_im($victim‚$msg,$screenname,$reply);
#
#  desc: This sub logs the IM..
#	 It grabs $victim, $msg, $screenname, and $reply
#	 Then prints them
#	 And adds them to $victim's log.
#  recv: $victim‚$msg,$screenname,$reply
# sends: nothing
################################

sub log_im {

    #Get the victim, message, the bot's screenname, and the bot's reply.
    $victim = shift;
    $msg = shift;
    $screenname = shift;
    $reply = shift;

    #Print it to the DOS window.
    #print "<$victim> $msg\n<$screenname> $reply\n\n";

    #Write it to a log in the logs folder.
    open (DATA, ">>logs/$victim.txt");
    print DATA "<$victim> $msg\n<$screenname> $reply\n";
    close(DATA);

}

################################
# WIRED BOTS
#
# warners($victim);
#
#  desc: This sub decides whether a $victim is an warner or not.
#	 It grabs $victim.
#	 Then it opens the list, and foreach person on the list, see's if
#	 $victim is one of them. 
#	 If so, he's an warner. 
#  recv: $victim
# sends: $warner
################################

sub warners {

    my $victim = shift;

    #Initially, he's not a warner.
    $warner = 0;

    #If the warner list exists already...
    if (-e "list.txt") {

    #Open it and read it.
    open (FILE, "list.txt");
    $list = <FILE>;
    close(FILE);

    #Split the list into each warner.
    @list = split(",",$list);

    #Check each item in the list.
    foreach $item (@list) {
   
    #Make sure each one is lowercase and has no spaces.
    $item =~ s/ //g;
    $item = lc ($item);
  			
    #If they match up...
    if ($victim eq "$item") {

    #Then they must be a warner.
    $warner = 1;
    
    #Warn them back.
    $aim->evil($victim, 0);
    
    #Block them.
    $aim->add_deny(1, 'Buddies', $victim);
    
    } 

    }

    }

    #Return whether the victim is a warner.
    return $warner;

}

################################
# WIRED BOTS
#
# on_config();
#
#  desc: This sub is called when the bot is being loaded.
#	 It grabs the default AIM vars,
#	 Then sets the bots profile,
#	 Then sends the config.
#  recv: AIM's default vars.
# sends: Nothing.
################################
sub on_config {
   my ($self, $evt, $from, $to) = @_;
	
   my $str = shift @{$evt->args()};
   $self->set_config_str($str, 1);


#Set up the bot's profile.
#Split it up so we can avoid the 80 character limit.

	$self->set_info("This bot is running code developed by " 
		     . "<a href=\"http://www.wiredbots.com\">"
	             . "Wired Bots</a>");

#Send the config.
$self->send_config();

}

################################
# WIRED BOTS
#
# on_error();
#
#  desc: This sub is called when an error occurs while communicating w/ TOC.
#	 It grabs the default AIM vars
#	 Grabs the error number
#	 Translates that number, and prints result.
#  recv: AIM's default vars.
# sends: nothing.
################################


sub on_error {
	my ($self, $evt) = @_;
	my ($error, @stuff) = @{$evt->args()};

#Translate the error number into plain English.
	my $errstr = $evt->trans($error);

#Filter the error string for the content we need.
	$errstr =~ s/\$(\d+)/$stuff[$1]/ge;

#Print the error to the DOS window.
	print "$0: AIM ERROR: $errstr\n";

#If the error says that the bot is talking too fast, we'll sleep some.
if ($errstr eq "A message has been dropped, you are exceeding the server speed limit") {
sleep(dosleep(5,10));
#print "Compensated for Flood..\n\n";
}

}

################################
# WIRED BOTS
#
# on_evil();
#
#  desc: This sub is called when the bot recieves a warning.
#	 It says it was warned
#	 Then grabs default AIM vars.
#	 Checks to see by whom it was warned
#	 If not anonymous, warn and block them
#	 If anonymous, can't do anything.
#  recv: AIM's default vars and $level, $culprit args.
# sends: nothing.
################################

sub on_evil {
   my ($self, $evt, $from, $to) = @_;
   my ($level, $culprit) = @{$evt->args};

   #Print to the DOS window the warn notification.
   print STDERR "My warning level changed to $level %.";

   #If there is no culprit, make it 'anon'.
   $culprit = 'anon' if ($culprit =~ /^\s*$/);
   
   #Remove spaces from $culprit; make it lowercase.
   $culprit = lc ($culprit);
   $culprit =~ s/ //g;

   #If not anonymously warned...
   if ($culprit ne 'anon') {
   
   #Warn the culprit and block him/her.
	$aim->evil($culprit, 0);
	$aim->add_deny(1, 'Buddies', $culprit);

   #Add to warner list.

   #If the warner list doesn't exist yet...
   if (-e "list.txt" ne 1) {
	
 	#Then create it.
	open (DATA, ">list.txt");
	print DATA "$culprit";
	close(DATA);


   } else {
   #Otherwise, the list already exists.  We'll append to it.
	open (DATA, ">>list.txt");
	print DATA ",$culprit";
	close(DATA);
   }

   #If anonymously warned
   }  else {
   #print " by an anonymous user.\n\n";
   }
}

################################
# WIRED BOTS
#
# on_im();
#
#  desc: This sub is called when the bot recieves an IM.
#	 It first grabs AIM default vars.
#	 Then filters those vars
#	 Then checks to see if $victim is an warner
#	 Then Checks to see if $msg is a command
#	 If not a command && not an warner:
#	 It replies via the custom code (or command sub)
#	 Then logs the IM
#	 Then sleeps and sends
#
#  recv: AIM's vars w/ $victim, $friend, and $msg as args.
# sends: either a warning, or a message.
################################

sub on_im {
    ($aim, $evt, $from, $to) = @_;
    $args = $evt->args();
    ($victim, $friend, $msg) = @$args;

    #Filter the victim's screenname (Make it lowercase; remove spaces).
    $victim = lc($victim);
    $victim =~ s/ //g;

    #Format the message the way you (should) want it, without HTML.
    $msg =~ s/<(.|\n)+?>//g;

    #Check the victim against the warner list.
    my $warner = warners("$victim");
    #If the victim is a warner, warn him and block him.

    #Otherwise, continue.
    if ($warner != 1) {

    STDOUT->autoflush();
    $message_received = 1;
    
    } 
}