#!/usr/local/bin/perl -w # irpg bot v2.2.2 (schmolli) by jotun, fakeusername@fakedomainname.com # # Some code within this file was written by authors other than myself. As such, # please contact me before distributing or modifying and distributing this # source code. # # Please mail bugs, etc. to me. There is no help available for this code; just # ask if you need an explanation of my sloppy code. Patches are welcome to # fix bugs or clean up the code, but please do not use a radically different # coding style. Thanks to everyone that's contributed! # # v2.2.2 (schmolli) # * The changes in this version are based almost completely on a patch sent # to me by Ed Schmollinger, schmolli@IRC. Many thanks to him for his help! # Here are his changes: # - SECURITY: added subroutine mksalt to generate random salt for passwds # - CLEANUP: added subroutines chanmsg and privmsg to send messages to # bot's channel and to a specified user, respectively # - FEATURE: added command line argument processing and removed TEST_MODE # (TEST_MODE is no longer necessary.) Part of this includes moving most # of the variables into %opts. # - CLEANUP: renamed botidentify to botpw, changed option to just store pw # instead of entire identify string # - CLEANUP: changed option botopcmd to just store the message to send # instead of entire PRIVMSG command (is this a bad idea?) # - FIX: added check for number of existing players when printing top 3 # - CLEANUP: changed "in:" and "out:" debug message to "<-" and "->" # - CLEANUP: indented concatenated lines # v2.2.1 # - fixed a bug in item finding; if unique item was better than helm, not # better than its class, you would get the item (emad) # v2.2 # - added 1/20000 chance of 'team battle' every 5 seconds. team battle is # 3 players versus 3 other players. if the first three players win, their # time is lowered by 20% of the lowest of the three's TTL. if they lose, # no time is removed from any players. there is no chance for critical # strike in a team battle (Asterax) # - max level of Jotun's Fury Colossal Sword changed to 175 # - fixed 'kick' bug; users that were kicked were not logged out # - kick added as a p250 # - b0t now only bans those non-logged in users that say 'http:' that've # been in the channel < 90 seconds # - b0t won't ban for #G7-type URLs # - b0t now shows nick of user when new account is registered # - forgot to close filehandle in loaddb(); fixed # - added a db backup every 6 hours # v2.1.3 # - fixed bug where users changing their nick would not be candidates for # auto-login on a bot restart # - changed some messages to make them more friendly to female # players (LapCat) # v2.1.2 # - HoG can now carry or displace a player 5 - 75% toward the next level # - fixed CTCP version bug # - battling was changed from all users within 7 levels of you to # all online users # - added "unique" items, or a chance starting at level 25 to roll # higher-than-normal items # v2.1.1 # - DIE, JUMP, RESTART, INFO, and PEVAL now send warnings to users that # don't have access to tell them so. they are still penalized # - b0t will now penalize users without the proper access that try to use an # admin command # - add commands CHCLASS, CHUSER, and PUSH to adjust class names, usernames, # and next time to level, respectively # - HoG could occur for offline users; this is no longer the case # - b0t now responds to CTCP version requests (drdink) # v2.1 # - b0t bans non-logged-in users that say 'http:' # - INFO did not check ha(); fixed # - b0t will automagically log you back in if you were logged in before # a b0t restart, and if you haven't changed your nick!user@host since then # - removed logging # - dropped functions relating to old database in favor of the new one # - changed level up report from seconds to duration() # - changed item/userinfo db's to one file; battles still in battles.txt # - changed challenge report from seconds to duration() # - changed penalty text to display duration() instead of seconds # - added critical strike, 1/35 chance upon winning battle to cause opponent # to lose time (dwyn) # - changed summon text for HoG (res0) # - changed access to base off of irpg username in lieu of host # - changed top player report to every 6 hours # - changed positive HoG text (res0) # - changed random HoG chance to 1/20000 every 5 seconds # v2.0.3 # - dropped top players back to 3 # - removed STATUS; TTL available through website. # - battle history added to website; added logging of battles to battles.txt # - peval did not next(); fixed. # - added HOG command, randomly chooses someone, then randomly raises/lowers # their TTL (20% raise, 80% lower). HOG is, of course, an abbreviation for # Hand of God # - added a 1/7500 random HoG into rpcheck() # v2.0.2 # - STATUS would log you out; fixed. # - could STATUS if not online; fixed. # - added DEL command to remove accounts # - added ALERT command to make channel alerts # - changed admin HELP command text to display website # v2.0.1 # - fixed self-battle bug # - changed chance to battle from 20% to 25% if level < 25, 100% if >= 25 # - setup companion website # - updated HELP command to reflect website # - changed battle gain to (max(7,opplevel/4)/100)*your_next_ttl # - added battle loss of (max(7,opplevel/7)/100)*your_next_ttl # v2.0 # - added item finding and battling # - added penalties for QUIT, PART, instead of resetting time to the # beginning of that level # v1.0 # - initial version use strict; use IO::Socket; use Data::Dumper; use Getopt::Long; my $version = "2.2.2 (schmolli)"; (my $prog = $0) =~ s/^.*\///; my %opts = ( 'server' => 'area51.slashnet.org:6667', 'botnick' => 'b0t', 'botuser' => 'bot', 'botrlnm' => 'http://www.slashnet.org/~b0t/', 'botchan' => '#g7', 'botpw' => 'g7_rocks!!', 'botopcmd' => "PRIVMSG #G7 :opz plzkthx!!1 :)))", 'helpurl' => 'http://jotun.ultrazone.org/g7/', 'admincommurl' => 'http://jotun.ultrazone.org/g7/admincomms.txt', 'access' => [ 'yawnwraith', 'jotun', 'drdink' ], 'rpstep' => 1.16, 'rpbase' => 600, 'rppenstep' => 1.14, 'dbfile' => 'irpg.db', ); GetOptions(\%opts, "help|h", "verbose|v", "debug", "server|s=s", "botnick|n=s", "botuser|u=s", "botrlnm|r=s", "botchan|c=s", "botpw|p=s", "botopcmd|o=s", "helpurl=s", "admincommurl=s", "access=s@", "rpstep=f", "rpbase=i", "rppenstep=f", "dbfile|irpgdb|db|d=s", ) or die "error parsing command line\n"; $opts{'help'} and do { help(); exit 0; }; my $debug = $opts{'debug'} || 0; my $v = $opts{'verbose'} || $debug; my $outbytes = 0; # sent bytes my $inbytes = 0; # received bytes my %onchan; # users on game channel my %rps; # role-players my $rpreport = 0; # constant for reporting top players my $alrmint = 5; # secs between database rewrites my @prev_online; # user@hosts online on restart, die my @auto_login; # users to automatically log back on $SIG{'HUP'} = 0; # ignore sighup CONNECT: # cheese. loaddb(); my $sock = IO::Socket::INET->new(PeerAddr=>$opts{'server'},PeerPort=>6667); die "Could not build socket; $!" unless $sock; sts("NICK $opts{botnick}"); sts("USER $opts{botuser} 0 0 :$opts{botrlnm}"); while (<$sock>) { $inbytes += length; s/[\r\n]//g; print "<- $_\n" if $debug; my @arg = split/ /; if (lc $arg[0] eq 'ping') { sts("PONG $arg[1]"); } if ($arg[1] eq '433') { $opts{'botnick'} .= 0; sts("NICK $opts{botnick}"); } if (lc $arg[1] eq 'join') { my $usernick = (split(/!/,$arg[0]))[0]; $usernick = substr($usernick,1); $onchan{$usernick}=time(); } if (lc $arg[1] eq 'quit') { my $usernick = (split(/!/,$arg[0]))[0]; $usernick = substr($usernick,1); for my $k (keys %rps) { if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick && $rps{$k}{online}) { $rps{$k}{online}=0; $rps{$k}{next}+=int(20 * ($opts{'rppenstep'}**$rps{$k}{level})); } } delete $onchan{$usernick}; } if (lc $arg[1] eq 'nick') { my $usernick = (split(/!/,$arg[0]))[0]; $usernick = substr($usernick,1); for my $k (keys %rps) { if ($rps{$k}{nick} eq $usernick && $rps{$k}{online}) { $rps{$k}{nick}=substr($arg[2],1); $rps{$k}{userhost}=substr($arg[0],1); $rps{$k}{next} += int(30 * ($opts{'rppenstep'}**$rps{$k}{level})); sts("NOTICE $rps{$k}{nick} :Penalty of ". duration(int(30 * ($opts{'rppenstep'}**$rps{$k}{level}))). " added to your timer for changing nicks."); } } $onchan{substr($arg[2],1)} = delete $onchan{$usernick}; } if (lc $arg[1] eq 'part') { my $usernick = (split(/!/,$arg[0]))[0]; $usernick = substr($usernick,1); for my $k (keys %rps) { if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick && $rps{$k}{online}) { $rps{$k}{online}=0; $rps{$k}{next}+=int(200 * ($opts{'rppenstep'}**$rps{$k}{level})); sts("NOTICE $rps{$k}{nick} :Penalty of ". duration(int(200 * ($opts{'rppenstep'}**$rps{$k}{level}))). " added to your timer for parting."); } } delete $onchan{$usernick}; } if (lc $arg[1] eq 'kick') { my $usernick = $arg[3]; for my $k (keys %rps) { if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick && $rps{$k}{online}) { $rps{$k}{online}=0; $rps{$k}{next}+=int(250 * ($opts{'rppenstep'}**$rps{$k}{level})); sts("NOTICE $rps{$k}{nick} :Penalty of ". duration(int(250 * ($opts{'rppenstep'}**$rps{$k}{level}))). " added to your timer for getting kicked."); } } delete $onchan{$usernick}; } if (lc $arg[1] eq '315') { if (@auto_login) { chanmsg(scalar @auto_login . " users matching " . scalar @prev_online." hosts automatically logged in; accounts: ". join(", ",@auto_login)); } else { chanmsg("0 users qualified for auto login."); } undef @prev_online; undef @auto_login; } if (lc $arg[1] eq '352') { $onchan{$arg[7]}=time(); for my $k (keys %rps) { for my $host (@prev_online) { if ($rps{$k}{userhost} eq $arg[7]."!".$arg[4]."\@".$arg[5] && $rps{$k}{userhost} eq $host) { $rps{$k}{online} = 1; $rps{$k}{lastlogin} = localtime(time()); if (!scalar(grep { $_ eq $k } @auto_login)) { push(@auto_login,$k); } } } } } if ($arg[1] eq '001') { sts("identify $opts{botpw}"); sts("JOIN $opts{botchan}"); sts("MODE $opts{botchan}"); sts($opts{'botopcmd'}); sts("WHO $opts{botchan}"); $SIG{ALRM} = \&rpcheck; alarm(5); } if (lc $arg[1] eq 'notice') { my $usernick = (split(/!/,$arg[0]))[0]; $usernick = substr($usernick,1); for my $k (keys %rps) { if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick && $rps{$k}{online}) { $rps{$k}{next} += int((length("@arg[3..$#arg]")-1) * ($opts{'rppenstep'}**$rps{$k}{level})); sts("NOTICE $rps{$k}{nick} :Penalty of ". duration(int((length("@arg[3..$#arg]")-1) * ($opts{'rppenstep'}**$rps{$k}{level}))). " added to your timer for notice."); } } } if (lc $arg[1] eq 'privmsg') { $arg[0] = substr($arg[0],1); my $usernick = (split/!/,$arg[0])[0]; if (lc $arg[2] eq lc $opts{'botnick'}) { if (lc $arg[3] eq ":\1version\1") { sts("NOTICE $usernick :\1VERSION IRPG bot v$version by jotun; ". "$opts{helpurl}\1"); } if (lc $arg[3] eq ":calc" && ha($usernick)) { my $eq = "@arg[4..$#arg]"; $eq =~ s/[^\d\.\+\-\(\)\*\&\^\%\~\!\/]//g; chanmsg($_) for eval $eq; if ($@) { privmsg("EVAL ERROR : $@", $usernick); privmsg("In expression: $eq", $usernick); } next; } if (lc $arg[3] eq ":peval") { if (!ha($usernick)) { privmsg("You don't have access to PEVAL.", $usernick); } else { privmsg($_, $usernick) for eval "@arg[4..$#arg]"; privmsg("EVAL ERROR: $@", $usernick) if $@; next; } } if (lc $arg[3] eq ":register") { if ($#arg < 6 || $arg[6] eq "") { privmsg("Try: REGISTER ", $usernick); privmsg("IE : REGISTER Poseidon MyPassword ". "God of the Sea", $usernick); } elsif (exists $rps{$arg[4]}) { privmsg("Sorry, that charname is already in use.", $usernick); } elsif (!exists $onchan{$usernick}) { privmsg("Sorry, you're not in $opts{botchan}.", $usernick); } elsif (length $arg[4] > 16) { privmsg("Sorry, charnames must be < 17 chars long.", $usernick); } elsif (length "@arg[6..$#arg]" > 30) { privmsg("Sorry, char classes must be < 31 chars long.", $usernick); } else { $rps{$arg[4]}{next} = $opts{'rpbase'}; $rps{$arg[4]}{class} = "@arg[6..$#arg]"; $rps{$arg[4]}{level} = 0; $rps{$arg[4]}{online} = 1; $rps{$arg[4]}{nick} = $usernick; $rps{$arg[4]}{userhost} = $arg[0]; $rps{$arg[4]}{lastlogin} = localtime(time()); $rps{$arg[4]}{pass} = crypt($arg[5],mksalt()); chanmsg("Welcome $usernick"."'s new player $arg[4], the " . "@arg[6..$#arg]! Next level in ".duration($opts{'rpbase'})."."); privmsg("Success! Account $arg[4] created. You have $opts{rpbase} " . "seconds idleness until you reach level 1. ", $usernick); privmsg("NOTE: The point of the game is to see who can idle the " . "longest. As such, talking (to channel or the bot), parting, ". "quitting, and changing nicks penalize you.", $usernick); next; } } if (lc $arg[3] eq ":del") { if (!ha($usernick)) { privmsg("You don't have access to del.", $usernick); } else { if (!defined $arg[4]) { privmsg("Try: DEL ", $usernick); } else { if (exists $rps{$arg[4]}) { delete $rps{$arg[4]}; chanmsg("Account $arg[4] removed by $arg[0]."); } else { privmsg("No such account $arg[4].", $usernick); } } next; } } if (lc $arg[3] eq ":alert") { if (!ha($usernick)) { privmsg("You don't have access to ALERT.", $usernick); } else { if (!defined $arg[4]) { privmsg("Try: ALERT ", $usernick); } else { chanmsg("ALERT from $usernick: @arg[4..$#arg]"); } next; } } if (lc $arg[3] eq ":hog") { if (!ha($usernick)) { privmsg("You don't have access to HOG.", $usernick); } else { chanmsg("$usernick has summoned the Hand of God."); hog(); next; } } if (lc $arg[3] eq ":chpass") { if (!ha($usernick)) { privmsg("You don't have access to CHPASS.", $usernick); } else { if (!defined $arg[5]) { privmsg("Try: CHPASS ", $usernick); } else { if (exists $rps{$arg[4]}) { $rps{$arg[4]}{pass} = crypt($arg[5],mksalt()); privmsg("Password for $arg[4] changed.", $usernick); } else { privmsg("No such username $arg[4].", $usernick); } } next; } } if (lc $arg[3] eq ":chuser") { if (!ha($usernick)) { privmsg("You don't have access to CHUSER.", $usernick); } else { if (!defined $arg[5]) { privmsg("Try: CHUSER ", $usernick); } elsif (!exists $rps{$arg[4]}) { privmsg("No such username $arg[4].", $usernick); } elsif (exists $rps{$arg[5]}) { privmsg("Username $arg[5] is already taken.", $usernick); } else { $rps{$arg[5]} = delete $rps{$arg[4]}; privmsg("Username for $arg[4] changed to $arg[5].", $usernick); } next; } } if (lc $arg[3] eq ":chclass") { if (!ha($usernick)) { privmsg("You don't have access to CHCLASS.", $usernick); } else { if (!defined $arg[5]) { privmsg("Try: CHCLASS ", $usernick); } else { if (exists $rps{$arg[4]}) { $rps{$arg[4]}{class} = "@arg[5..$#arg]"; privmsg("Class for $arg[4] changed to @arg[5..$#arg].", $usernick); } else { privmsg("No such username $arg[4].", $usernick); } } next; } } if (lc $arg[3] eq ":push") { if (!ha($usernick)) { privmsg("You don't have access to PUSH.", $usernick); } else { if (!defined $arg[5]) { privmsg("Try: PUSH ", $usernick); } else { if (exists $rps{$arg[4]}) { $rps{$arg[4]}{next} -= $arg[5]; privmsg("Time to level for $arg[4] pushed ahead ". "$arg[5] seconds. $arg[4] reaches next level in ". duration($rps{$arg[4]}{next}).".", $usernick); chanmsg("$usernick has pushed $arg[4] $arg[5] ". "seconds toward level ".($rps{$arg[4]}{level}+1). ". $arg[4] reaches next level in ". duration($rps{$arg[4]}{next})."."); } else { privmsg("No such username $arg[4].", $usernick); } } next; } } if (lc $arg[3] eq ":whoami") { my $f=0; for (keys %rps) { if (exists $rps{$_}{nick} && $rps{$_}{nick} eq $usernick && $rps{$_}{online}) { privmsg("You are logged in as $_.", $usernick); $f=1; } } privmsg("You are not logged in.", $usernick) if !$f; next; } if (lc $arg[3] eq ":help") { if (!ha($usernick)) { privmsg("To register a new account: ". "/msg $opts{botnick} REGISTER", $usernick); privmsg("To login to an account: ". "/msg $opts{botnick} LOGIN", $usernick); privmsg("If you forget your password, ask for help ". "in the channel.", $usernick); privmsg("For more info, see $opts{helpurl}", $usernick); } else { privmsg("Help URL is $opts{helpurl}", $usernick); privmsg("Admin commands URL is $opts{admincommurl}", $usernick); } next; } if (lc $arg[3] eq ":die") { if (!ha($usernick)) { privmsg("You do not have access to DIE.", $usernick); } else { sts("QUIT :DIE from $arg[0]"); next; } } if (lc $arg[3] eq ":jump") { if (!ha($usernick)) { privmsg("You do not have access to JUMP.", $usernick); } elsif (!defined $arg[4]) { privmsg("Try JUMP ", $usernick); } else { sts("QUIT :JUMP to $arg[4] from $arg[0]"); $opts{'server'} = $arg[4]; close $sock; sleep 3; goto CONNECT; } } if (lc $arg[3] eq ":restart") { if (!ha($usernick)) { privmsg("You do not have access to RESTART.", $usernick); } else { sts("QUIT :RESTART from $arg[0]"); exec("perl $0"); } } if (lc $arg[3] eq ":info") { if (!ha($usernick)) { privmsg("You do not have access to INFO.", $usernick); } else { my $info = sprintf("%.2fkb sent, %.2fkb received in %s. ". "%d IRPG users online.", $outbytes/1024,$inbytes/1024,duration(time-$^T), scalar(grep { $rps{$_}{online} } keys %rps)); privmsg($info, $usernick); next; } } if (lc $arg[3] eq ":login") { if ($#arg < 5 || $arg[5] eq "") { privmsg("Try: LOGIN ", $usernick); } elsif (!exists $rps{$arg[4]}) { privmsg("Sorry, no such account name. Note ". "that account names are case sensitive.", $usernick); } elsif (!exists $onchan{$usernick}) { privmsg("Sorry, you're not in $opts{botchan}.", $usernick); } elsif ($rps{$arg[4]}{pass} ne crypt($arg[5],$rps{$arg[4]}{pass})) { privmsg("Wrong password.", $usernick); } else { $rps{$arg[4]}{online} = 1; $rps{$arg[4]}{nick} = $usernick; $rps{$arg[4]}{userhost} = $arg[0]; $rps{$arg[4]}{lastlogin} = localtime(time()); chanmsg("$arg[4], the level $rps{$arg[4]}{level} ". "$rps{$arg[4]}{class}, is now online from nickname ". "$usernick. Next level in ".duration($rps{$arg[4]}{next}). "."); privmsg("Logon successful. Next level in ". duration($rps{$arg[4]}{next}).".", $usernick); } next; } } my $found = 0; for my $k (keys %rps) { if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick && $rps{$k}{online}) { $rps{$k}{next} += int((length("@arg[3..$#arg]")-1) * ($opts{'rppenstep'}**$rps{$k}{level})); sts("NOTICE $rps{$k}{nick} :Penalty of ". duration(int((length("@arg[3..$#arg]")-1) * ($opts{'rppenstep'}**$rps{$k}{level}))). " added to your timer for privmsg."); $found=1; } } if (!$found && "@arg" =~ /http:/i && (time()-$onchan{$usernick}) < 90 && "@arg" !~ /ultrazone/i) { sts("MODE $opts{botchan} +b $arg[0]"); } } } print "Disconnected.\n" if $v || $debug; sub sts { # send to server my $text = shift; print $sock "$text\r\n"; print "-> $text\n" if $debug; $outbytes += length($text) + 2; } sub ha { # return 0/1 if username has access my $nick = shift; for my $k (keys %rps) { if ($rps{$k}{nick} eq $nick && $rps{$k}{online}) { for my $l (@{$opts{'access'}}) { return 1 if $l eq $k; } } } return 0; } sub duration { # return human duration of seconds my $s = shift; return "NA ($s)" if $s !~ /^\d+$/; sprintf("%d days, %02d:%02d:%02d",$s/84600, ($s%84600)/3600,($s%3600)/60,$s%60); } sub ts { # timestamp my @ts = localtime(time); sprintf("[%02d:%02d:%02d] ",$ts[2],$ts[1],$ts[0]); } sub hog { # summon the hand of god my @players = grep { $rps{$_}{online} } keys %rps; my $player = $players[rand @players]; my $win = int(rand(5)); my $time = int(((5 + int(rand(70)))/100) * $rps{$player}{next}); if ($win) { chanmsg("Verily I say unto thee, the Heavens have burst forth, and the ". "blessed hand of God carried $player ".duration($time). " toward level ".($rps{$player}{level}+1)."."); $rps{$player}{next} -= $time; } else { chanmsg("Thereupon He stretched out His little finger ". "among them and consumed $player with fire, slowing the heathen ". duration($time)." from level ".($rps{$player}{level}+1)."."); $rps{$player}{next} += $time; } chanmsg("$player reaches next level in ".duration($rps{$player}{next})."."); } sub rpcheck { # check levels, update database hog() if rand(20000) < 1; team_battle() if rand(20000) < 1; if ($rpreport%4320==0) { # 4320 = six hours, if $alrmint is 5 seconds my @u = sort { $rps{$b}{level} <=> $rps{$a}{level} || $rps{$a}{next} <=> $rps{$b}{next} } keys %rps; chanmsg("#G7 Idle RPG Top Players:"); for my $i (0..2) { $#u >= $i and chanmsg("$u[$i], the level $rps{$u[$i]}{level} ". "$rps{$u[$i]}{class}, is #" . ($i + 1) . "! Next level in ". (duration($rps{$u[$i]}{next}))."."); } system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time()); } open(RPS,">$opts{dbfile}") or die "$opts{dbfile}: $!"; print RPS "# username\tpass\tlevel\tclass\tnext\tnick\tuserhost\tonline 0/1". "\tlast login time\tamulet\tcharm\thelm\tboots\tgloves\tring\t". "leggings\tshield\ttunic\tweapon\n"; for my $k (keys %rps) { if ($rps{$k}{online} && exists $rps{$k}{nick} && $rps{$k}{nick} && exists $onchan{$rps{$k}{nick}}) { $rps{$k}{next}-=$alrmint; if ($rps{$k}{next} < 1) { $rps{$k}{level}++; $rps{$k}{next} = int($opts{'rpbase'}*($opts{'rpstep'}**$rps{$k}{level})); sts("PRIVMSG $opts{botchan} :$k, the $rps{$k}{class}, has attained level ". "$rps{$k}{level}! Next level in ".duration($rps{$k}{next})."."); find_item($k); challenge_opp($k); } } print RPS join("\t", $k, $rps{$k}{pass}, $rps{$k}{level}, $rps{$k}{class}, $rps{$k}{next}, $rps{$k}{nick}||"", $rps{$k}{userhost}||"", $rps{$k}{online}||0, $rps{$k}{lastlogin}, $rps{$k}{item}{amulet}||0, $rps{$k}{item}{charm}||0, $rps{$k}{item}{helm}||0, $rps{$k}{item}{"pair of boots"}||0, $rps{$k}{item}{"pair of gloves"}||0, $rps{$k}{item}{ring}||0, $rps{$k}{item}{"set of leggings"}||0, $rps{$k}{item}{shield}||0, $rps{$k}{item}{tunic}||0, $rps{$k}{item}{weapon}||0)."\n"; } close RPS; ++$rpreport; $SIG{ALRM} = \&rpcheck; alarm($alrmint); } sub challenge_opp { # pit argument player against random player my $u = shift; if ($rps{$u}{level} < 25) { return unless rand(4) < 1; } my @opps = grep { $rps{$_}{online} && $u ne $_ } keys %rps; return unless @opps; my $opp = $opps[int rand @opps]; my($mysum,$oppsum); $mysum += $rps{$u}{item}{$_} for keys %{$rps{$u}{item}}; $oppsum += $rps{$opp}{item}{$_} for keys %{$rps{$opp}{item}}; if (rand($mysum) > rand($oppsum)) { my $gain = int($rps{$opp}{level}/4); $gain = 7 if $gain < 7; $gain = int(($gain/100)*$rps{$u}{next}); sts("PRIVMSG $opts{botchan} :$u has challenged $opp in combat and won! ". duration($gain)." is removed from $u"."'s clock."); open(B,">>battles.txt"); print B "$u has challenged $opp in combat and won! ".duration($gain). " is removed from $u"."'s clock.\n"; close B; $rps{$u}{next} -= $gain; if (rand(35) < 1) { $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next}); open(B,">>battles.txt"); print B "$u has dealt $opp a Critical Strike! ".duration($gain). " is added to $opp"."'s clock.\n"; close B; sts("PRIVMSG $opts{botchan} :$u has dealt $opp a Critical Strike! ". duration($gain)." is added to $opp"."'s clock."); $rps{$opp}{next} += $gain; } } else { my $gain = int($rps{$opp}{level}/7); $gain = 7 if $gain < 7; $gain = int(($gain/100)*$rps{$u}{next}); sts("PRIVMSG $opts{botchan} :$u has challenged $opp in combat and lost! ". duration($gain)." is added to $u"."'s clock."); open(B,">>battles.txt"); print B "$u has challenged $opp in combat and lost! ".duration($gain). " is added to $u"."'s clock.\n"; close B; $rps{$u}{next} += $gain; } } sub team_battle { # pit three players against three other players my @opp = grep { $rps{$_}{online} } keys %rps; return if @opp < 6; splice(@opp,int rand @opp,1) while @opp > 6; my($mysum,$oppsum); $mysum += $rps{$opp[0]}{item}{$_} for keys %{$rps{$opp[0]}{item}}; $mysum += $rps{$opp[1]}{item}{$_} for keys %{$rps{$opp[1]}{item}}; $mysum += $rps{$opp[2]}{item}{$_} for keys %{$rps{$opp[2]}{item}}; $oppsum += $rps{$opp[3]}{item}{$_} for keys %{$rps{$opp[3]}{item}}; $oppsum += $rps{$opp[4]}{item}{$_} for keys %{$rps{$opp[4]}{item}}; $oppsum += $rps{$opp[5]}{item}{$_} for keys %{$rps{$opp[5]}{item}}; if (rand($mysum) > rand($oppsum)) { my $gain = $rps{$opp[0]}{next}; for my $p (1,2) { $gain = $rps{$opp[$p]}{next} if $gain > $rps{$opp[$p]}{next}; } $gain = int($gain*.20); sts("PRIVMSG $opts{botchan} :$opp[0], $opp[1], and $opp[2] have team battled ". "$opp[3], $opp[4], and $opp[5] and won! ".duration($gain). " is removed from their clocks."); open(B,">>battles.txt"); print B "$opp[0], $opp[1], and $opp[2] have team battled $opp[3], ". "$opp[4], and $opp[5] and won! ".duration($gain)." is removed ". "from their clocks.\n"; close B; $rps{$opp[0]}{next} -= $gain; $rps{$opp[1]}{next} -= $gain; $rps{$opp[2]}{next} -= $gain; } else { sts("PRIVMSG $opts{botchan} :$opp[0], $opp[1], and $opp[2] have team battled ". "$opp[3], $opp[4], and $opp[5] and lost! No time is awarded."); open(B,">>battles.txt"); print B "$opp[0], $opp[1], and $opp[2] have team battled $opp[3], ". "$opp[4], and $opp[5] and lost! No time is awarded.\n"; close B; } } sub find_item { # find item for argument player my $u = shift; my @items = ("ring","amulet","charm","weapon","helm","tunic", "pair of gloves","set of leggings","shield","pair of boots"); my $type = $items[rand @items]; my $level = 1; for my $num (1 .. int($rps{$u}{level}*1.5)) { if (rand(1.4**($num/4)) < 1) { $level = $num; } } if ($rps{$u}{level} >= 25 && rand(40) < 1) { my $ulevel = 50+int(rand(25)); if ($ulevel >= $level && $ulevel > $rps{$u}{item}{helm}) { sts("NOTICE $rps{$u}{nick} :The light of the gods shines upon you! ". "You have found the level $ulevel Mattt's Omniscience Grand Crown! ". "Your enemies fall before you as you anticipate their every move."); $rps{$u}{item}{helm} = $ulevel; } } elsif ($rps{$u}{level} >= 30 && rand(40) < 1) { my $ulevel = 75+int(rand(25)); if ($ulevel >= $level && $ulevel > $rps{$u}{item}{tunic}) { sts("NOTICE $rps{$u}{nick} :The light of the gods shines upon you! ". "You have found the level $ulevel Res0's Protectorate Plate Mail! ". "Your enemies cower in fear as their attacks have no effect on ". "you."); $rps{$u}{item}{tunic} = $ulevel; } } elsif ($rps{$u}{level} >= 35 && rand(40) < 1) { my $ulevel = 100+int(rand(25)); if ($ulevel >= $level && $ulevel > $rps{$u}{item}{amulet}) { sts("NOTICE $rps{$u}{nick} :The light of the gods shines upon you! ". "You have found the level $ulevel Dwyn's Storm Magic Amulet! ". "Your enemies are swept away by an elemental fury before the war ". "has even begun."); $rps{$u}{item}{amulet} = $ulevel; } } elsif ($rps{$u}{level} >= 40 && rand(40) < 1) { my $ulevel = 150+int(rand(26)); if ($ulevel >= $level && $ulevel > $rps{$u}{item}{weapon}) { sts("NOTICE $rps{$u}{nick} :The light of the gods shines upon you! ". "You have found the level $ulevel Jotun's Fury Colossal Sword! ". "Your enemies' hatred is brought to a quick end as you arc ". "your wrist, dealing the crushing blow."); $rps{$u}{item}{weapon} = $ulevel; } } elsif ($level > $rps{$u}{item}{$type}) { sts("NOTICE $rps{$u}{nick} :You found a level $level $type! Your ". "current $type is only level ".(0+$rps{$u}{item}{$type})." so ". "it seems Luck is with you."); $rps{$u}{item}{$type} = $level; } else { sts("NOTICE $rps{$u}{nick} :You found a level $level $type. Your ". "current $type is level ".(0+$rps{$u}{item}{$type})." so ". "it seems Luck is against you. You toss the $type."); } } sub loaddb { # load the players database undef %rps; %rps = (); # redundant? (open(RPS,"<$opts{dbfile}") || ! -e $opts{dbfile}) or die "loaddb() failed; $!"; while (my $l=) { chomp $l; next if $l =~ /^#/; # skip comments my @i = split("\t",$l); print Dumper @i if @i != 19; die "Anomaly in loaddb(); line $. of $opts{dbfile} has wrong fields (". scalar @i.")" if @i != 19; if ($i[7]) { push(@prev_online,$i[6]); } # log back in $rps{$i[0]}{pass} = $i[1]; $rps{$i[0]}{level} = $i[2]; $rps{$i[0]}{class} = $i[3]; $rps{$i[0]}{next} = $i[4]; $rps{$i[0]}{nick} = $i[5]; $rps{$i[0]}{userhost} = $i[6]; $rps{$i[0]}{online} = 0; $rps{$i[0]}{lastlogin} = $i[8]; $rps{$i[0]}{item}{amulet} = $i[9]; $rps{$i[0]}{item}{charm} = $i[10]; $rps{$i[0]}{item}{helm} = $i[11]; $rps{$i[0]}{item}{"pair of boots"} = $i[12]; $rps{$i[0]}{item}{"pair of gloves"} = $i[13]; $rps{$i[0]}{item}{ring} = $i[14]; $rps{$i[0]}{item}{"set of leggings"} = $i[15]; $rps{$i[0]}{item}{shield} = $i[16]; $rps{$i[0]}{item}{tunic} = $i[17]; $rps{$i[0]}{item}{weapon} = $i[18]; } close RPS; } sub mksalt { # generate a random salt for passwds join '',('a'..'z','A'..'Z','0'..'9','/','.')[rand 64, rand 64]; } sub chanmsg { # send a message to the channel my $msg = shift or return undef; privmsg($msg, $opts{'botchan'}); } sub privmsg { # send a message to an arbitrary entity my $msg = shift or return undef; my $target = shift or return undef; sts("PRIVMSG $target :$msg"); } sub help { # print help message print " usage: $prog [OPTIONS] --help, -h Print this message --verbose, -v Print verbose messages --server, -s Specify IRC server:port to connect to --botnick, -n Bot's IRC nick --botuser, -u Bot's local username --botrlnm, -r Bot's real name --botchan, -c IRC channel to join --botpw, -p Specify passwd to identify with --botopcmd, -o Specify text to send to server on successful connect --helpurl URL to refer new users to --admincommurl URL to refer admins to --access Usernames allowed to issue admin commands Timing parameters: --rpbase Base time to level up --rpstep Time to next level = rpbase * (rpstep ** CURRENT_LEVEL) --rppenstep PENALTY_SECS=(PENALTY*(RPPENSTEP**CURRENT_LEVEL)) "; }