#join this room after signing on
sub join_room {
$oscar->chat_join("words", 5);
}
#need the chat variable to invite people
sub set_chat{
$chat = @_[2];
&execute;
}
#cause the bugger prints really fast
sub pause {
my $pauseStartTime;
$oscar->do_one_loop();
$pauseStartTime = int(time());
while (int(time()) < ($pauseStartTime + 2)) {
}
}
sub pause1 {
my $pauseStartTime;
$oscar->do_one_loop();
$pauseStartTime = int(time());
while (int(time()) < ($pauseStartTime + 1)) {
}
}
if($teamFound) {
$oscar->send_im($sender, "$beginningHTML Sorry, team $2 already exists!");
}
else {
$team_scores{$2} = 0;
$team_password{$2} = $teamPassword;
delete $team_players{$nameToSearch};
$team_players{$nameToSearch} = $2;
$oscar->send_im($sender, "$beginningHTML Team \"$2\" has been successfully created with password \"$teamPassword\"");
}
}
### Load Arbiters ###
$arbiterFile = "./arbiters.txt";
open ARBITER, $arbiterFile or die "Cannot open $arbiter for read :$!";;
while (<ARBITER>) {
if($_ ne "") {
chomp($arbiterPlayer = $_);
$arbiter{$arbiterPlayer} = 1;
undef $arbiterPlayer;
}
}
close ARBITER;
###########################
### load banned players ###
###########################
$bannedFile = "./banned.txt";
open BANNED, $bannedFile or die "Cannot open $banned for read :$!";;
while (<BANNED>) {
if($_ ne "") {
chomp($bannedPlayer = $_);
$banned{$bannedPlayer} = 1;
undef $bannedPlayer;
}
}
close BANNED;
open(ALOG, $alogFile);
$alog= <ALOG>;
$alogs =read(ALOG, $buffer, 1088888);
$oscar->send_im($sender, "$beginningHTML Here is who the trial arbiters banned: $buffer." );
close (BANLIST);
}
else{
$oscar->send_im($sender, "$beginningHTML You can not use this command because you are not an arbiter." );
}
}
### !invite SN ###
if(lc $message =~ /(!invite) (.*)/i) {
if ($arbiter{lc $sender} == 1) {
$IMed = 1;
$chat->invite($2, "Come and play");
$oscar->send_im($sender, "$beginningHTML $2 has been invited.");
}
else{
$oscar->send_im($sender, "$beginningHTML Only arbiters may use this command.");
}
}
### !banlist ###
if(lc $message eq "!banlist") {
if ($arbiter{lc $sender} == 1) {
$IMed = 1;
$banlistFile="./banned.txt";
open(BANLIST, $banlistFile);
$banlist= <BANLIST>;
$banlists =read(BANLIST, $buffer, 256);
$oscar->send_im($sender, "$beginningHTML Banned are: $banlist $buffer" );
close (BANLIST);
}
else{
$oscar->send_im($sender, "$beginningHTML You can not use this command because you are not an arbiter." );
}
}
#$allPlayers{$screename} += $theScore;
#&pause1;
#$chat->chat_send ("$beginningHTML $player got: $correctAnswers (+$theScore | total $allPlayers{$screename})", NOREFLECT);
}
undef @$player; #remove the player for the next round
}
### find the winner -- this is probably the worst implementation but w/e ###
foreach (sort { $scoresThisRound{$b} <=> $scoresThisRound{$a} } keys %scoresThisRound) {
$winner = $_;
last;
}
if ($winner ne "") {
$allPlayers{$winner} += $bonus;
&pause;
$chat->chat_send ("$beginningHTML Well done $winner, you get the round bonus of $bonus points. Your score is now $allPlayers{$winner}.", NOREFLECT);
}
undef $winner;
######################################
### Post Question Messages Go Here ###
######################################
$messageNumber = int(rand 10);
if ($messageNumber == 0) {
&pause;
&topTen;
&pause;
}
if ($messageNumber == 1) {
&pause;
$chat->chat_send ("$beginningHTML The scores had to be reset because of technical difficulties. ", NOREFLECT);
&pause;
}
if ($messageNumber == 2) {
&pause;
$chat->chat_send ("$beginningHTML To suggest a word to be added to the dictionary, or anything else, type !suggest MESSAGE", NOREFLECT);
&pause;
}
if ($messageNumber == 3) {
&pause;
$chat->chat_send ("$beginningHTML Please do not cheat (if you are clever enough to figure out a way to). Cheaters will be banned!", NOREFLECT);
&pause;
}
if ($messageNumber == 4) {
&pause;
$chat->chat_send ("$beginningHTML Please resolve all issues with the arbiters. ", NOREFLECT);
&pause;
}
if ($messageNumber == 5) {
&pause;
$chat->chat_send("$beginningHTML $commands", NOREFLECT);
}
if ($messageNumber == 6) {
&pause;
$chat->chat_send("$beginningHTML You can guess UP TO 3 words per line. Hopefully. If I'm working right.", NOREFLECT);
&pause;
}
if ($messageNumber == 7) {
&pause;
$chat->chat_send("$beginningHTML There was a problem with the teams. Please rejoin the team you were previously on. The password should be the same..", NOREFLECT);
&pause;
}
if ($messageNumber == 8) {
&pause;
&topTenTeams;
&pause;
}
if ($messageNumber == 9) {
&pause;
$chat->chat_send("$beginningHTML First Place = $numberOne", NOREFLECT);
&pause;
}
$updateInfoCounter++;
if ($updateInfoCounter == 2) { #store scores every 2 rounds
&updateScores;
$updateInfoCounter = 0;
}
}
}
#if someone says something during a question, push it on their stack
sub push {
my($oscar, $from, $chat, $message) = @_;
my($teamName, $teamPassword, $teamFound);
$oscar->do_one_loop();
$message =~ s/<(.|\n)+?>//g; #remove HTML junk
$from =~ s/ //g; #remove whitespace from name
##########################################################
$person_banned = 0;
foreach (keys %banned) {
if($from =~ /$_/i) {
if ($banned{$_} == 1) {
$person_banned = 1;
last;
}
}
}
$difference = $allPlayers{$ahead} - $allPlayers{$screename};
$sum = $allPlayers{$screename} - $allPlayers{$behind};
$oscar->send_im($from, "$beginningHTML $from: You are ranked $currentRank with a score of $allPlayers{$screename}. You need $difference points to catch up to $ahead, who has $allPlayers{$ahead} points. You are $sum points ahead of $behind, who has $allPlayers{$behind} points");
}
### !rank SCREENAME ###
if(lc $message =~ /(!rank) (.*)/i) {
&Sort;
$screename = "";
foreach (keys %sortedScores) {
if (lc $_ eq lc $2) {
$screename = $_;
last;
}
}
$oscar->send_im($from, "$beginningHTML $from: $2 is ranked $sortedScores{$screename} with a score of $allPlayers{$screename}");
}
### !repeat ###
if(lc $message eq "!repeat") {
if ($questionCategory == 1 || $questionCategory == 6) {
$chat->chat_send ("$beginningHTML List words containing the following letters: @char", NOREFLECT);
}
elsif($questionCategory == 2) {
$chat->chat_send ("$beginningHTML Rearrange any number of the letters of the following to form a real word: $questionMessage", NOREFLECT);
}
elsif($questionCategory == 3) {
$chat->chat_send ("$beginningHTML List words that start with '$char[0]' and end with '$char[1]'", NOREFLECT);
}
elsif($questionCategory == 4) {
$chat->chat_send ("$beginningHTML List words that have the following sequence: $char[0]$char[1]$char[2]$char[3]$char[4]" , NOREFLECT);
}
elsif($questionCategory == 5) {
$chat->chat_send ("$beginningHTML List any $wordLength letter words that have the letter '$char'", NOREFLECT);
}
}
### !suggest MESSAGE ###
if(lc $message =~ /(!suggest) (.*)/i) {
$myfile = "suggestions.txt";
open (MYFILE, ">>$myfile");
print MYFILE "$from: $2\n";
close (MYFILE);
$oscar->send_im($from, "$beginningHTML $from: Thank you for your suggestion: $2");
}
### !banlist ###
if(lc $message eq "!banlist") {
if ($arbiter{lc $from} == 1) {
$banlistFile="./banned.txt";
open(BANLIST, $banlistFile);
$banlist= <BANLIST>;
$banlists =read(BANLIST, $buffer, 256);
$oscar->send_im($from, "$beginningHTML Banned are: $banlist $buffer" );
close (BANLIST);
}
else{
$oscar->send_im($from, "$beginningHTML You can not use this command because you are not an arbiter." );
}
}
$myfile = "./trialarbiterlog.txt";
open (MYFILE, ">>$myfile");
print MYFILE "$from: $2 was banned by $from\n";
close (MYFILE);
$chat->chat_send("$beginningHTML Sorry $2, but you are now banned." , NOREFLECT);
}
}
### trial arbiter !unban SN ###
if(lc $message =~ /(!unban) (.*)/i) {
if (lc $from eq "megamatrixman2"|| lc $from eq lc "ichrist7" || lc $from eq lc "drummerdude2368") {
$chat->chat_send("$beginningHTML $2 has been unbanned." , NOREFLECT);
}
}
### !triallog ###
if(lc $message eq "!triallog") {
if (lc $from eq "calverthalldrum") {
$alogFile="./trialarbiterlog.txt";
open(ALOG, $alogFile);
$alog= <ALOG>;
$alogs =read(ALOG, $buffer, 1088888);
$oscar->send_im($from, "$beginningHTML Here is who the trial arbiters banned: $buffer." );
close (BANLIST);
}
else{
$oscar->send_im($from, "$beginningHTML You can not use this command because you are not an arbiter." );
}
}
### !arbiter SN ###
if(lc $message =~ /(!arbiter) (.*)/i) {
if (lc $from eq "calverthalldrum") {
$myfile = "./arbiters.txt";
open (MYFILE, ">>$myfile");
print MYFILE "$2\n" if $arbiter{$2} == 0;
close (MYFILE);
$chat->chat_send("$beginningHTML $2 is now an arbiter." , NOREFLECT);
}
}
### Load Arbiters ###
$arbiterFile = "./arbiters.txt";
open ARBITER, $arbiterFile or die "Cannot open $arbiter for read :$!";;
while (<ARBITER>) {
if($_ ne "") {
chomp($arbiterPlayer = $_);
$arbiter{$arbiterPlayer} = 1;
undef $arbiterPlayer;
}
}
close ARBITER;
open(ARBITER, $arbiterFile);
$arbiter= <ARBITER>;
$arbiters =read(ARBITER, $buffer, 1088888);
$chat->chat_send("$beginningHTML The arbiters are: $arbiter $buffer." );
close (ARBITER);
}
### !invite SN ###
if(lc $message =~ /(!invite) (.*)/i) {
if ($arbiter{lc $from} == 1) {
$chat->invite($2, "Come and play");
$oscar->send_im($from, "$beginningHTML $2 has been invited.");
}
else{
$oscar->send_im($from, "$beginningHTML Only arbiters may use this command.");
}
}
foreach (keys %team_players) {
if (lc $team_players{$_} eq lc $2) {
$members .= "$_ ";
}
}
if ($members ne "") {
&SortTeams;
foreach (keys %sortedTeamScores) {
if (lc $_ eq lc $2) {
$teamName = $_;
last;
}
}
$currentRank = $sortedTeamScores{$teamName};
foreach (keys %sortedTeamScores) {
if ($sortedTeamScores{$_} == ($currentRank-1)) {
$ahead = $_;
last;
}
}
$difference = $team_scores{$ahead} - $team_scores{$teamName};
if ($currentRank != 1) {
$chat->chat_send("$beginningHTML Team $teamName is ranked $currentRank with a score of $team_scores{$teamName}, and is $difference points behind team $ahead. The members are: $members");
}
else {
$chat->chat_send("$beginningHTML Team $teamName is ranked $currentRank with a score of $team_scores{$teamName}. The members are: $members");
}
}
}
# if ($members ne "") {
# $chat->chat_send ("$beginningHTML Team $2: $output" , NOREFLECT);
# }
if ($bonus ne 50) {
$chat->chat_send ("$beginningHTML This round has a bonus of $bonus points!", NOREFLECT);
&pause1;
}
if ($questionCategory == 1) {
&check_vowel_round;
if (!$vowelRound) {
$chat->chat_send ("QUESTION #$questionNumber($multiplier): List words containing the following letters: @char", NOREFLECT);
}
else {
$chat->chat_send ("VOWEL ROUND #$questionNumber($multiplier): List words containing the following letters: @char", NOREFLECT);
}
}
elsif($questionCategory == 2) {
$chat->chat_send ("ANAGRAM #$questionNumber($multiplier): Rearrange any number of the letters of the following to form a real word: $questionMessage", NOREFLECT);
}
elsif($questionCategory == 3) {
$chat->chat_send ("START\/END #$questionNumber($multiplier): List words that start with '$char[0]' and end with '$char[1]'", NOREFLECT);
}
elsif($questionCategory == 4) {
$chat->chat_send ("GROUP #$questionNumber($multiplier): List words that have the following sequence: $char[0]$char[1]$char[2]$char[3]$char[4]" , NOREFLECT);
}
elsif($questionCategory == 5) {
$chat->chat_send ("WORD LENGTH #$questionNumber($multiplier): List any $wordLength letter words that have the letter '$char'" , NOREFLECT);
}
elsif ($questionCategory == 6) {
&check_vowel_round;
if (!$vowelRound) {
$chat->chat_send ("QUESTION ($multiplier): List words containing the following letters: @char", NOREFLECT);
}
else {
$chat->chat_send ("VOWEL ROUND ($multiplier): List words containing the following letters: @char", NOREFLECT);
}
}
}
#check if a guess is valid and is a real word
sub check_output_string {
@words = split /\s+/,$outputString;
foreach $guess (@words) {
if($guess ne "") {
if($questionCategory == 1 || $questionCategory == 6) {
foreach $character (@characters) {
#$chat->chat_send ("checking to see if - $character - in word - $guess - matches a letter", NOREFLECT);
for ($ii=0; $ii <= $#duplicate; $ii++) {
chomp($temporary = $duplicate[$ii]);
if (lc $character eq lc $temporary) {
$numberMatched++;
$duplicate[$ii] = "";
}
}
}
if ($numberMatched == ($#char+1)) {
$valid = 1;
}
else {
$valid = 0;
}
}
elsif($questionCategory == 2) {
$valid = 1;
foreach $character (@characters) {
#$chat->chat_send ("checking to see if - $character - in word - $guess - matches a letter", NOREFLECT);
$matchedLetter = 0;
for($ii = 0; $ii <= $#duplicate; $ii++) {
if (lc $character eq $duplicate[$ii]) {
$matchedLetter = 1;
$duplicate[$ii] = "";
last;
}
}
if (!$matchedLetter) {
$valid = 0;
last;
}
}
}
elsif($questionCategory == 3) {
#$chat->chat_send("check to see if $characters[0] is equal to $char[0] and $characters[$#characters] is equal to $char[1]", NOREFLECT);
if (lc $characters[0] eq $char[0] & lc $characters[$#characters] eq $char[1]) {
$valid = 1;
}
else {
$valid = 0;
}
}
if ($valid) { #if this is a valid word
$stop = 0;
undef $dictionary;
if (-e "./words/new/$characters[0]$characters[1].txt") {
$dictionary="./words/new/$characters[0]$characters[1].txt";
#$chat->chat_send ("looking in $dictionary", NOREFLECT);
open DICTIONARY, $dictionary or die "Cannot open $dictionary for read :$!";;
while (<DICTIONARY>) {
@line = split //, $_;
@currentLine = split /\s+/,$_;
foreach $word (@currentLine) {
if (lc $word eq lc $guess) {
#$chat->chat_send ("Found word in dictionary", NOREFLECT);
push(@validString, $guess);
$stop = 1;
last;
}
}
if ($stop) {
$. = 1;
last; #no need to continue the search if we've already found the word
}
}
close(DICTIONARY);
}
}
}
}
}
How would I post this on an apache server so that it would work?
I know that this server has perl and has Net-Oscar installed.
I just need help getting it to work.
Thanks
Last edited by jman27 on Thu Jun 12, 2008 1:10 am; edited 2 times in total
First of all, you'd need to run it as a cron job. I'm assuming that you have it set up like a CGI, to where you'd go to "http://your-site/aimbot.cgi" and it would run the bot. It might sign the bot on to do that, but it's probably not doing it the way you wanted.
Perl run as CGI (via HTTP request from a browser) expects the Perl script to run through its whole program, produce some output for your browser, and quit. A script like for an AIM bot never quits. The server or your browser will give up on it because it's taking too long to complete, and kill the process, probably returning a 500 Internal Server Error.
If you have shell access to your web host, use that to log in and run Perl for your bot in a new process:
Code:
perl aimbot.pl &
If not, you might be able to use a CGI to *start* the bot. In this case, your CGI would probably be something simple:
Code:
#!/usr/bin/perl -w
# Start the bot
system ("perl aimbot.pl &");
print qq~Content-Type: text/html
AIM bot started!~;
After looking at your code, the first thing I said about running your bot through CGI probably doesn't work anyway because you don't have a proper shebang line (#!/usr/bin/perl) that Apache requires of all CGI scripts, among other things, that would cause a 500 Internal Server Error.
Hope that will help you.
Also, I hope that that wasn't your bot's real password you included in your code. _________________ Current Site (2008) http://www.cuvou.com/