#!/usr/local/bin/perl # irpg bot v2.4 by jotun, jotun@ultrazone.org, et al # # Some code within this file was written by authors other than myself. As such, # distributing this code or distributing modified versions of this code is # strictly prohibited without written authorization from the authors. Contact # jotun@ultrazone.org. # # Because of its use of SIGALRM, the IRPG code cannot be used on Windows # systems. There are other, better ways to write this code to avoid the use # of SIGALRM. I simply did not choose to use them. If you would like to code # a patch to mirror the functionality of bot while also supporting the Win32 # platform, it would be appreciated by myself and others. # # Please mail bugs, etc. to me. There is no help available for this code; just # ask if you need an explanation. 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! # # TODO: # - battle steals item? (Afbc0m) # - higher level = higher chance random battle? (Afbc0m) # - time lost in battle is "recovery time"; no battles may occur during this # time (mumkin) # # v2.4 # - updated privmsg() function to avoid annoying substr()/uninitialized # value warnings # - few small bugs in battling bot fixed. a win against bot awards you # with 20% of your TTL removed. a loss to bot adds 10% of your TTL to your # clock. # - bot's item sum is now the highest item sum of all users + 1 (mumkin) # - fixed RESTART command to clear alarm() before trying to exec() # - WHOAMI displays class, TTL (Minhiriath) # - CALC command removed # - added notice() function which mirrors the operation of privmsg() # - SILENT command allows admin to switch bot between 4 modes of silence. # in mode 0, bot sends all privmsgs. in mode 1, only chanmsg() is disabled. # in mode 2, only privmsg()/notice() to non-channels is disabled. in mode 3, # privmsgs/notices to users and channels are disabled. silent mode is also # configurable as $opts{'silentmode'}, so you can setup a bot in any # channel without it interrupting the channel with its privmsgs (???) # - third parameter added to privmsg()/notice(); force flag ignores # $silentmode # - hard-coded check for OKish URLs to bot's 'http:'-style banning now # configurable (sean) # - JUMP command no longer penalizes if required argument is left blank # - BACKUP admin command tells bot to copy $opts{'dbfile'} to # .dbbackup/$opts{'dbfile'}TIMESTAMP; added backup() function to handle # this # - RELOADDB command allows admin to force bot to reload player database # file, rewriting all memory. RELOADDB can only be used while in pause mode. # - PAUSE command allows admin to place bot into pause mode. in pause mode, # bot will update player stats, but will not write database. combined with # RELOADDB, very effective for updating all players stats through external # script without taking bot offline. new accounts cannot be registered # while in pause mode # - QUEST command (p0) tells the active quest, its participants, and its time # left to completion # - ban message for 'http:'-type bans now makes unban-time more clear # - things have been sped up a bit. random battles for users level 45+ now # occur every hour. random chance for HOG, Godsends, Calamities, and Team # Battles were increased by a factor of 5 # - time between quests upped to 12 hours. level requirement for quests # upped to 40+. in addition, must have been online for at least 10 hours # to be selected for quests. number of persons on quest lowered to 4. # quest penalty is now a p15 instead of 2% of your TTL. this makes more # sense, as users who were very close to leveling were penalized almost # nothing (inkblot et al) # - fixed spelling of 'caffeinated' (sean) # - botchan variable now shows how to join channel with key (Dan) # v2.3.1 # - fixed bug with item finding; bad logic sometimes resulted in user not # finding any item (thanks mumkin!) # v2.3 # - Jotun's Fury max level dropped back to 174 # - added the Drdink's Cane of Blind Rage with item level 175-200 # - all time modifiers (battles, HoG, etc) are now written to modifiers.txt # - function tlog() logs a string to modifiers.txt and returns the string # - changed WHOAMI to not use $_ # - fixed another bug where changing your nick would prevent you from being # a candidate for auto-login # - LOGOUT command added as a p20 # - you may now only be logged in under one character at a time. this will # help protect the bot from being flooded when a single user signs on # under 10 accounts, then is penalized and warned 10 times. attempts to # login under two names are not penalized # - fixed a bug where all of your accounts were automatically logged on so # long as they shared the same host as you, regardless of whether they # were online before (on bot restart) # - there is a 1/20,000 chance of a calamity occuring every 5 seconds. the # calamity() function chooses a random user, then smites them with bad # luck. the penalty for a calamity is a random 5-12% of next TTL. users are # only chosen from the pool of online players # - there is a 1/10,000 chance of a godsend occuring every 5 seconds. the # godsend() function chooses a random user, then betters their luck. the # award for a godsend is a random 5-12% of next TTL. users are only chosen # from the pool of online players # - there are now 'quests' -- six level 30+ users are chosen to go on a quest # at a time. if all six users make it to the quest's end, all questers are # awarded by removing 25% of their TTL (ie, their TTL at quest's end). to # complete a quest, no user can be penalized until the quest's end. quests # last a random time between 12 and 24 hours. if the quest is not # completed, ALL online users are penalized 2% of their time as punishment. # users are only chosen from the pool of online players (original idea from # Nerje; quest ideas from Tristan, brt) # - quests are read from file 'quests.txt' every time quest() is called. this # allows you to add or remove quests while the bot is still running. quests # are not picked in order, but chosen at random from the file # - fixed bug in PUSH, allowing to push into negative TTL # - db times changed to ctime format in lieu of scalar localtime() (now # sortable) # - added db fields for total time idled; total times penalized for # privmsg, nick change, part, kick, LOGOUT, quest, and quit; and time # account created # - REGISTER no longer penalizes if you are already logged in and the # command fails # - fixed 'http:' checking to only look at message text, not entire string # - messages passed through privmsg() are split into 450-byte chunks and # then passed to their target # - bans put into place by the 'http:' method are now removed after 1 hour # to prevent filling the banlist. bans are stored in @bans, which will # hold at most 12 bans to prevent the bot from flooding on unban. after # 12, bans are still set, but not stored # - 'license' in header slightly changed # - battle results now include item sums and the random number rolled for # each player. format is [roll/sum] # - bot will try to regain his nickname every 30 mins if it is in use at # sign-on. added vars $primnick and $opts{'botghostcmd'}. $primnick is set # to $opts{'botnick'} (which may change) on load, and $opts{'botghostcmd'} # is a nickserv ghost command string # - the bot's nick ($opts{'botnick'} and $primnick) cannot be registered as # character names # - bot is now a fightable player. his item sum is random 250-650. (someone; # mail me if this was your idea). chances of fighting him are equal to # fighting any other player # - bot now daemonizes when starting (jwbozzy) # - fixed duration code to use the correct secs/day (drdink/inkblot) # - added a penalty to Team Battle. players will now receive or lose 20% of # the lowest team member's TTL (drdink) # - changed battling to award tie to challenger, not challengee. random # number is also, now, an integer, not a float # - every 3.5 hours, a level 45+, online player will battle; this will make # it easier for high-level users to level # - added function itemsum() to return item sum for supplied username # - battle results written to battles.txt are now timestamped (Juliet) # 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. # - 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 # - bot now only bans those non-logged in users that say 'http:' that've # been in the channel < 90 seconds # - bot won't ban for #G7-type URLs # - bot 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 # - bot 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 # - bot now responds to CTCP version requests (drdink) # v2.1 # - bot bans non-logged-in users that say 'http:' # - INFO did not check ha(); fixed # - bot will automagically log you back in if you were logged in before # a bot 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 warnings; use IO::Socket; use Data::Dumper; use Getopt::Long; my $version = "2.4"; (my $prog = $0) =~ s/^.*\///; my %opts = ( 'server' => 'area51.slashnet.org:6667', # server name[:port] 'botnick' => 'bot', # nickname 'botuser' => 'bot', # username 'botrlnm' => 'http://www.slashnet.org/~bot/', # real name field 'botchan' => '#g7 MyChannelKey', # channel name [key] 'botident' => 'identify ilovedink', # command to send upon successful connect 'botopcmd' => 'chanserv op #g7 bot', # command to send upon joining channel 'botghostcmd' => 'nickserv ghost bot ilovedink', # command sent to recover nick 'helpurl' => 'http://jotun.ultrazone.org/g7/', # URL to send users to 'admincommurl' => 'http://jotun.ultrazone.org/g7/admincomms.txt', # ^ admin commands list 'access' => [ 'yawnwraith', 'jotun', 'drdink' ], # ^ irpg accounts with admin access 'rpbase' => 600, # base time to level up 'rpstep' => 1.16, # Time to next level = rpbase * (rpstep ** CURRENT_LEVEL) 'rppenstep' => 1.14, # penalty time = penalty * (rppenstep ** CURRENT_LEVEL) 'dbfile' => 'irpg.db', # player database file 'debug' => 1, # debug mode on/off flag 'okurl' => "ultrazone", # URLs containing this term will not be banned by # the 'http:' advertisement ban 'silentmode' => 0, # Modes of silence. in mode 0, bot sends all privmsgs. # in mode 1, only chanmsg() is disabled. in mode 2, only # privmsg() to non-channels is disabled. in mode 3, # privmsgs to users and channels are disabled ); GetOptions(\%opts, "help|h", "verbose|v", "debug", "server|s=s", "botnick|n=s", "botuser|u=s", "botrlnm|r=s", "botchan|c=s", "botident|p=s", "botopcmd|o=s", "botghostcmd|g=s", "helpurl=s", "admincommurl=s", "access=s@", "okurl|k=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 $primnick = $opts{'botnick'}; # for regain or register checks 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 my @bans; # bans auto-set by the bot, saved to be removed after 1 hour my @questers; # accounts currently in a quest my $questtime = time() + int(rand(21600)); # time to end quest, or start one my $quest; # hold active quest text my $pausemode = 0; # pausemode on/off flag my $silentmode = 0; # silent mode 0/1/2/3, see head of file sub daemonize(); # prototype to avoid warnings sub backup(); # prototype to avoid warnings daemonize(); $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'} eq $arg[3]) { $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}{next}+=int(20 * ($opts{'rppenstep'}**$rps{$k}{level})); $rps{$k}{pen_quit}+=int(20 * ($opts{'rppenstep'}**$rps{$k}{level})); questpencheck($k); $rps{$k}{online}=0; } } 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 (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick && $rps{$k}{online}) { my $pen = int(30 * ($opts{'rppenstep'}**$rps{$k}{level})); $rps{$k}{next}+=$pen; $rps{$k}{pen_nick}+=$pen; $rps{$k}{nick} = substr($arg[2],1); substr($rps{$k}{userhost},0,length $usernick) = substr($arg[2],1); questpencheck($k); notice("Penalty of ".duration($pen)." added to your timer for nick ". "change.",$rps{$k}{nick}); } } $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}) { my $pen = int(200 * ($opts{'rppenstep'}**$rps{$k}{level})); $rps{$k}{next}+=$pen; $rps{$k}{pen_part}+=$pen; questpencheck($k); notice("Penalty of ".duration($pen)." added to your timer for parting.", $rps{$k}{nick}); $rps{$k}{online}=0; } } 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}) { my $pen = int(250 * ($opts{'rppenstep'}**$rps{$k}{level})); $rps{$k}{next}+=$pen; $rps{$k}{pen_kick}+=$pen; questpencheck($k); notice("Penalty of ".duration($pen)." added to your timer for being ". "kicked.",$rps{$k}{nick}); $rps{$k}{online}=0; } } 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] && "$k!$rps{$k}{userhost}" eq $host) { $rps{$k}{online} = 1; $rps{$k}{lastlogin} = time(); if (!scalar(grep { $_ eq $k } @auto_login)) { push(@auto_login,$k); } } } } } if ($arg[1] eq '001') { sts($opts{'botident'}); sts("JOIN $opts{'botchan'}"); $opts{'botchan'} =~ s/ .*//g; 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}) { my $pen = int((length("@arg[3..$#arg]")-1) * ($opts{'rppenstep'}**$rps{$k}{level})); $rps{$k}{next}+=$pen; $rps{$k}{pen_mesg}+=$pen; questpencheck($k); notice("Penalty of ".duration($pen)." added to your timer for notice.", $rps{$k}{nick}); } } } 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") { notice("\1VERSION IRPG bot v$version by jotun; $opts{helpurl}\1", $usernick); } if (lc($arg[3]) eq ":peval") { if (!ha($usernick)) { privmsg("You don't have access to PEVAL.", $usernick); } else { privmsg($_, $usernick, 1) for eval "@arg[4..$#arg]"; privmsg("EVAL ERROR: $@", $usernick, 1) if $@; next(); } } if (lc($arg[3]) eq ":register") { my $onflag=0; for my $k (keys %rps) { if ($rps{$k}{nick} eq $usernick && $rps{$k}{online}) { privmsg("Sorry, you are already online as $k.",$usernick); $onflag=1; last(); } } next() if $onflag; if ($#arg < 6 || $arg[6] eq "") { privmsg("Try: REGISTER ", $usernick); privmsg("IE : REGISTER Poseidon MyPassword God of the Sea", $usernick); } elsif ($pausemode) { privmsg("Sorry, new accounts may not be registered while bot is in ". "pause mode; please wait a few minutes and try again.", $usernick); } elsif (exists $rps{$arg[4]}) { privmsg("Sorry, that character name is already in use.", $usernick); } elsif (lc($arg[4]) eq lc($opts{'botnick'}) || lc($arg[4]) eq lc($primnick)) { privmsg("Sorry, that character name cannot be registered.", $usernick); } elsif (!exists($onchan{$usernick})) { privmsg("Sorry, you're not in $opts{botchan}.", $usernick); } elsif (length($arg[4]) > 16) { privmsg("Sorry, character names must be < 17 chars long.", $usernick); } elsif ($arg[4] =~ /^#/) { privmsg("Sorry, character names may not begin with #.", $usernick); } elsif (length("@arg[6..$#arg]") > 30) { privmsg("Sorry, character 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]}{created} = time(); $rps{$arg[4]}{lastlogin} = 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, 1); } 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, 1); } } 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, 1); } 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, 1); } else { if (exists $rps{$arg[4]}) { $rps{$arg[4]}{pass} = crypt($arg[5],mksalt()); privmsg("Password for $arg[4] changed.", $usernick, 1); } else { privmsg("No such username $arg[4].", $usernick, 1); } } 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, 1); } elsif (!exists $rps{$arg[4]}) { privmsg("No such username $arg[4].", $usernick, 1); } elsif (exists $rps{$arg[5]}) { privmsg("Username $arg[5] is already taken.", $usernick, 1); } else { $rps{$arg[5]} = delete $rps{$arg[4]}; privmsg("Username for $arg[4] changed to $arg[5].", $usernick, 1); } 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, 1); } else { if (exists $rps{$arg[4]}) { $rps{$arg[4]}{class} = "@arg[5..$#arg]"; privmsg("Class for $arg[4] changed to @arg[5..$#arg].", $usernick, 1); } else { privmsg("No such username $arg[4].", $usernick, 1); } } next(); } } if (lc($arg[3]) eq ":push") { if (!ha($usernick)) { privmsg("You don't have access to PUSH.", $usernick); } elsif (!defined $arg[5]) { privmsg("Try: PUSH ", $usernick, 1); } elsif (exists $rps{$arg[4]}) { if ($arg[5] > $rps{$arg[4]}{next}) { privmsg("Time to level for $arg[4] ($rps{$arg[4]}{next}s) is ". "lower than $arg[5].", $usernick, 1); } else { $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, 1); 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})."."); } next(); } else { privmsg("No such username $arg[4].", $usernick, 1); next(); } } if (lc($arg[3]) eq ":logout") { my $f = 0; for my $k (keys %rps) { if ($rps{$k}{nick} eq $usernick && $rps{$k}{online}) { my $pen = int(20 * ($opts{'rppenstep'}**$rps{$k}{level})); $rps{$k}{next} += $pen; $rps{$k}{pen_logout} += $pen; questpencheck($k); notice("Penalty of ".duration($pen)." added to your timer for ". "LOGOUT command.",$usernick); $rps{$k}{online}=0; $f=1; } } privmsg("You are not logged in.", $usernick) if !$f; next(); } if (lc($arg[3]) eq ":quest") { if (@questers) { privmsg(join(", ",@questers)." are on a quest to $quest. Quest to ". "complete in ".duration($questtime-time()).".",$usernick); } privmsg("There is no active quest.",$usernick); next(); } if (lc($arg[3]) eq ":whoami") { my $f=0; for my $k (keys %rps) { if (exists $rps{$k}{nick} && $rps{$k}{nick} eq $usernick && $rps{$k}{online}) { privmsg("You are $k, the level $rps{$k}{level} $rps{$k}{class}. ". "Next level in ".duration($rps{$k}{next}), $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, 1); privmsg("Admin commands URL is $opts{admincommurl}", $usernick, 1); } 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 ":reloaddb") { if (!ha($usernick)) { privmsg("You do not have access to RELOADDB.", $usernick); } elsif (!$pausemode) { privmsg("ERROR: Can only use LOADDB while in PAUSE mode.", $usernick, 1); next(); } else { loaddb(); privmsg("Reread player database file; ".scalar(keys %rps). " accounts loaded.",$usernick,1); next(); } } if (lc($arg[3]) eq ":backup") { if (!ha($usernick)) { privmsg("You do not have access to BACKUP.", $usernick); } else { backup(); privmsg("$opts{'dbfile'} copied to ". ".dbbackup/$opts{'dbfile'}".time(),$usernick,1); next(); } } if (lc($arg[3]) eq ":pause") { if (!ha($usernick)) { privmsg("You do not have access to PAUSE.", $usernick); } else { $pausemode = $pausemode?0:1; privmsg("PAUSE_MODE set to $pausemode.",$usernick,1); next(); } } if (lc($arg[3]) eq ":silent") { if (!ha($usernick)) { privmsg("You do not have access to SILENT.", $usernick); } elsif (!defined $arg[4] || $arg[4] < 0 || $arg[4] > 3) { privmsg("Try SILENT ", $usernick,1); next(); } else { $silentmode = $arg[4]; privmsg("SILENT_MODE set to $silentmode.",$usernick,1); 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, 1); next(); } 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 { local($SIG{ALRM})=0; alarm(0); 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. PAUSE_MODE is %d, ". "SILENT_MODE is %d.", $outbytes/1024,$inbytes/1024,duration(time-$^T), scalar(grep { $rps{$_}{online} } keys %rps), $pausemode,$silentmode); privmsg($info, $usernick); next(); } } if (lc($arg[3]) eq ":login") { my $onflag=0; for my $k (keys %rps) { if ($rps{$k}{nick} eq $usernick && $rps{$k}{online}) { privmsg("Sorry, you are already online as $k.",$usernick); $onflag=1; last(); } } next() if $onflag; 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} = 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}) { my $pen = int((length("@arg[3..$#arg]")-1) * ($opts{'rppenstep'}**$rps{$k}{level})); $rps{$k}{next}+=$pen; $rps{$k}{pen_mesg}+=$pen; questpencheck($k); notice("Penalty of ".duration($pen)." added to your timer for ". "privmsg.",$rps{$k}{nick}); $found=1; } } if (!$found && index(lc("@arg[3..$#arg]"),"http:") != -1 && (time()-$onchan{$usernick}) < 90 && index(lc("@arg[3..$#arg]"),lc($opts{'$okurl'})) != -1) { sts("MODE $opts{botchan} +b $arg[0]"); sts("KICK $opts{botchan} $usernick :No advertising; ban will be ". "lifted within the hour."); push(@bans,$arg[0]) if @bans < 12; } } } 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+$/; return sprintf("%d day%s, %02d:%02d:%02d",$s/86400,($s/86400)==1?"":"s", ($s%86400)/3600,($s%3600)/60,($s%60)); } sub ts { # timestamp my @ts = localtime(time); return sprintf("[%02d/%02d/%02d %02d:%02d:%02d] ", $ts[4]+1,$ts[3],$ts[5]%100,$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(tlog("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(tlog("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(4000) < 1; team_battle() if rand(4000) < 1; calamity() if rand(4000) < 1; godsend() if rand(2000) < 1; if (time() > $questtime) { if (!@questers) { quest(); } else { chanmsg(tlog(join(", ",@questers)." have blessed the realm by ". "completing their quest! 25% of their burden is eliminated.")); $rps{$_}{next} = int($rps{$_}{next} * .75) for @questers; undef @questers; $questtime = time() + 21600; } } 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:") if @u; 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}))."."); } backup(); } if ($rpreport%720==0 && $rpreport) { # 720 = 1 hour if $alrmint is 5s my @players = grep { $rps{$_}{online} && $rps{$_}{level} > 44 } keys %rps; if (@players) { challenge_opp($players[int rand @players]); } } if ($rpreport%720==0 && $rpreport) { while (@bans) { sts("MODE $opts{'botchan'} -bbbb :@bans[0..3]"); splice(@bans,0,4); } } if ($rpreport%360==0) { # 360=30 mins. also, try on first go. if ($opts{'botnick'} ne $primnick) { sts($opts{'botghostcmd'}) if $opts{'botghostcmd'}; sts("NICK $primnick"); } } if ($rpreport%120==0 && $pausemode) { chanmsg("WARNING: Cannot write database in PAUSE mode!"); } if (!$pausemode) { open(RPS,">$opts{dbfile}") or die("Cannot write $opts{dbfile}: $!"); print RPS "# username\tpass\tlevel\tclass\tnext\tnick\tuserhost\tonline\t". "idled\tpen_mesg\tpen_nick\tpen_part\tpen_kick\tpen_quit\t". "pen_quest\tpen_logout\tcreated\tlast login\tamulet\tcharm\t". "helm\tboots\tgloves\tring\tleggings\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; $rps{$k}{idled}+=$alrmint; if ($rps{$k}{next} < 1) { $rps{$k}{level}++; $rps{$k}{next} = int($opts{'rpbase'}* ($opts{'rpstep'}**$rps{$k}{level})); chanmsg("$k, the $rps{$k}{class}, has attained level ". "$rps{$k}{level}! Next level in ". duration($rps{$k}{next})."."); find_item($k); challenge_opp($k); } } if (exists $rps{$k}{next} && defined $rps{$k}{next}) { # not db anomaly 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}{idled}||0, $rps{$k}{pen_mesg}||0, $rps{$k}{pen_nick}||0, $rps{$k}{pen_part}||0, $rps{$k}{pen_kick}||0, $rps{$k}{pen_quit}||0, $rps{$k}{pen_quest}||0, $rps{$k}{pen_logout}||0, $rps{$k}{created}, $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]; $opp = $primnick if rand(@opps+1) < 1; my $mysum = itemsum($u); my $oppsum = itemsum($opp); my $myroll = int(rand($mysum)); my $opproll = int(rand($oppsum)); if ($myroll >= $opproll) { my $gain = ($opp eq $primnick)?20:int($rps{$opp}{level}/4); $gain = 7 if $gain < 7; $gain = int(($gain/100)*$rps{$u}{next}); chanmsg(tlog("$u [$myroll/$mysum] has challenged $opp [$opproll/$oppsum] ". "in combat and won! ".duration($gain)." is removed from $u". "'s clock.")); $rps{$u}{next} -= $gain; if (rand(35) < 1 && $opp ne $primnick) { $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next}); chanmsg(tlog("$u has dealt $opp a Critical Strike! ".duration($gain). " is added to $opp"."'s clock.")); $rps{$opp}{next} += $gain; } } else { my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7); $gain = 7 if $gain < 7; $gain = int(($gain/100)*$rps{$u}{next}); chanmsg(tlog("$u [$myroll/$mysum] has challenged $opp [$opproll/$oppsum] ". "in combat and lost! ".duration($gain)." is added to $u". "'s clock.")); $rps{$u}{next} += $gain; } delete $rps{$primnick}; # cheap hack } 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 = itemsum($opp[0]) + itemsum($opp[1]) + itemsum($opp[2]); my $oppsum = itemsum($opp[3]) + itemsum($opp[4]) + itemsum($opp[5]); 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); if (rand($mysum) >= rand($oppsum)) { chanmsg(tlog("$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.")); $rps{$opp[0]}{next} -= $gain; $rps{$opp[1]}{next} -= $gain; $rps{$opp[2]}{next} -= $gain; } else { chanmsg(tlog("$opp[0], $opp[1], and $opp[2] have team battled $opp[3], ". "$opp[4], and $opp[5] and lost! ".duration($gain)." is added to ". "their clocks.")); $rps{$opp[0]}{next} += $gain; $rps{$opp[1]}{next} += $gain; $rps{$opp[2]}{next} += $gain; } } 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}) { notice("The light of the gods shines down 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}{nick}); $rps{$u}{item}{helm} = $ulevel; return; } } elsif ($rps{$u}{level} >= 30 && rand(40) < 1) { my $ulevel = 75+int(rand(25)); if ($ulevel >= $level && $ulevel > $rps{$u}{item}{tunic}) { notice("The light of the gods shines down 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}{nick}); $rps{$u}{item}{tunic} = $ulevel; return; } } elsif ($rps{$u}{level} >= 35 && rand(40) < 1) { my $ulevel = 100+int(rand(25)); if ($ulevel >= $level && $ulevel > $rps{$u}{item}{amulet}) { notice("The light of the gods shines down 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 have even begun", $rps{$u}{nick}); $rps{$u}{item}{amulet} = $ulevel; return; } } elsif ($rps{$u}{level} >= 40 && rand(40) < 1) { my $ulevel = 150+int(rand(25)); if ($ulevel >= $level && $ulevel > $rps{$u}{item}{weapon}) { notice("The light of the gods shines down 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}{nick}); $rps{$u}{item}{weapon} = $ulevel; return; } } elsif ($rps{$u}{level} >= 45 && rand(40) < 1) { my $ulevel = 175+int(rand(26)); if ($ulevel >= $level && $ulevel > $rps{$u}{item}{weapon}) { notice("The light of the gods shines down upon you! You have found the ". "level $ulevel Drdink's Cane of Blind Rage! Your enemies are ". "tossed aside as you blindly swing your arm around hitting stuff.", $rps{$u}{nick}); $rps{$u}{item}{weapon} = $ulevel; return; } } if ($level > $rps{$u}{item}{$type}) { notice("You found a level $level $type! Your current $type is only level ". "$rps{$u}{item}{$type}, so it seems Luck is with you.", $rps{$u}{nick}); $rps{$u}{item}{$type} = $level; } else { notice("You found a level $level $type. Your current $type is level ". "$rps{$u}{item}{$type}, so it seems Luck is against you. You ". "toss the $type.",$rps{$u}{nick}); } } sub loaddb { # load the players database undef %rps; %rps = (); # redundant? if (!open(RPS,$opts{dbfile}) && -e $opts{dbfile}) { die("loaddb() failed: $!"); } while (my $l=) { chomp $l; next if $l =~ /^#/; # skip comments my @i = split("\t",$l); print Dumper @i if @i != 28; die("Anomaly in loaddb(); line $. of $opts{dbfile} has wrong fields (". scalar @i.")") if @i != 28; if (!$sock) { # if not RELOADDB if ($i[7]) { push(@prev_online,"$i[0]!$i[6]"); } # log back in } ($rps{$i[0]}{pass}, $rps{$i[0]}{level}, $rps{$i[0]}{class}, $rps{$i[0]}{next}, $rps{$i[0]}{nick}, $rps{$i[0]}{userhost}, $rps{$i[0]}{online}, $rps{$i[0]}{idled}, $rps{$i[0]}{pen_mesg}, $rps{$i[0]}{pen_nick}, $rps{$i[0]}{pen_part}, $rps{$i[0]}{pen_kick}, $rps{$i[0]}{pen_quit}, $rps{$i[0]}{pen_quest}, $rps{$i[0]}{pen_logout}, $rps{$i[0]}{created}, $rps{$i[0]}{lastlogin}, $rps{$i[0]}{item}{amulet}, $rps{$i[0]}{item}{charm}, $rps{$i[0]}{item}{helm}, $rps{$i[0]}{item}{"pair of boots"}, $rps{$i[0]}{item}{"pair of gloves"}, $rps{$i[0]}{item}{ring}, $rps{$i[0]}{item}{"set of leggings"}, $rps{$i[0]}{item}{shield}, $rps{$i[0]}{item}{tunic}, $rps{$i[0]}{item}{weapon}) = (@i[1..6],0,@i[8..$#i]); } 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; if ($silentmode & 1) { return undef; } privmsg($msg, $opts{'botchan'}, shift); } sub privmsg { # send a message to an arbitrary entity my $msg = shift or return undef; my $target = shift or return undef; my $force = shift; if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2)) && !$force) { return undef; } while (length($msg)) { sts("PRIVMSG $target :".substr($msg,0,450)); substr($msg,0,450)=""; } } sub notice { # send a message to an arbitrary entity my $msg = shift or return undef; my $target = shift or return undef; my $force = shift; if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2)) && !$force) { return undef; } while (length($msg)) { sts("NOTICE $target :".substr($msg,0,450)); substr($msg,0,450)=""; } } 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 username --botrlnm, -r Bot's real name --botchan, -c IRC channel to join --botident, -p Specify identify-to-services command --botopcmd, -o Specify command to send to server on successful connect --botghostcmd, -g Specify command to send to server to regain primary nickname when in use --okurl, -k Bot will not ban for web addresses that contain this string --debug Debug flag --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)) "; } sub itemsum { my $user = shift; if ($user eq $primnick) { my $sum = 0; for my $u (keys %rps) { $sum = itemsum($u) if $sum < itemsum($u); } return $sum+1; } if (not exists $rps{$user}) { return -1; } my $sum = 0; $sum += $rps{$user}{item}{$_} for keys %{$rps{$user}{item}}; return $sum; } sub daemonize() { if ($v || $debug) { return; } # don't lose valuable messages use POSIX 'setsid'; $SIG{CHLD} = 0; fork() && exit(0); # kill parent POSIX::setsid() || die("POSIX::setsid() failed: $!"); $SIG{CHLD} = 0; fork() && exit(0); # kill the parent as the process group leader $SIG{CHLD} = 0; open(STDIN,'/dev/null') || die("Cannot read /dev/null: $!"); open(STDOUT,'>/dev/null') || die("Cannot write to /dev/null: $!"); open(STDERR,'>/dev/null') || die("Cannot write to /dev/null: $!"); $0 = $opts{'botnick'}; } sub calamity { # suffer a little one my @players = grep { $rps{$_}{online} } keys %rps; return unless @players; my $player = $players[rand @players]; my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next}); my @actions = ("was bitten by drdink","fell into a hole", "bit their tongue","set themself on fire", "ate a poisonous fruit","lost their mind", "died, temporarily..","was caught in a terrible snowstorm", "EXPLODED, somewhat..","got knifed in a dark alley", "saw an episode of Ally McBeal", "got turned INSIDE OUT, practically"); my $actioned = $actions[rand @actions]; chanmsg(tlog("$player $actioned. This terrible calamity has slowed them ". duration($time)." from level ".($rps{$player}{level}+1).".")); $rps{$player}{next} += $time; chanmsg("$player reaches next level in ".duration($rps{$player}{next})."."); } sub godsend { # bless the unworthy my @players = grep { $rps{$_}{online} } keys %rps; return unless @players; my $player = $players[rand @players]; my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next}); my @actions = ("found a pair of Nikes","caught a unicorn", "discovered a secret, underground passage", "was taught to quicken his pace by a secret tribe of ". "pygmies that know how to run fast", "discovered caffeinated coffee","grew an extra leg"); my $actioned = $actions[rand @actions]; chanmsg(tlog("$player $actioned. This wondrous godsend has accelerated them ". duration($time)." towards level ".($rps{$player}{level}+1).".")); $rps{$player}{next} -= $time; chanmsg("$player reaches next level in ".duration($rps{$player}{next})."."); } sub quest { @questers = grep { $rps{$_}{online} && $rps{$_}{level} > 39 && time()-$rps{$_}{lastlogin} > 36000 } keys %rps; if (@questers < 4) { return undef @questers; } splice(@questers,int rand @questers,1) while @questers > 4; $questtime = time() + int(43200 + rand(43201)); open(Q,"quests.txt") or return 0; while (chomp(my $line = )) { $quest = $line if rand $. < 1; } close Q; chanmsg(join(", ",@questers)." have been chosen by the gods to $quest. ". "Quest to end in ".duration($questtime-time())."."); } sub questpencheck { my $k = shift; for my $quester (@questers) { if ($quester eq $k) { chanmsg(tlog($k."'s prudence and self-regard has brought the wrath of ". "the gods upon the realm. All your great wickedness makes ". "you as it were heavy with lead, and to tend downwards ". "with great weight and pressure towards hell. Therefore ". "have you drawn yourselves 15 steps closer to that gaping ". "maw.")); for my $player (grep { $rps{$_}{online} } keys %rps) { my $gain = int(15 * ($opts{'rppenstep'}**$rps{$player}{level})); $rps{$player}{pen_quest} += $gain; $rps{$player}{next} += $gain; } undef @questers; $questtime = time() + 43200; # 12 hours } } } sub tlog { my $mesg = shift; open(B,">>modifiers.txt"); print B ts()."$mesg\n"; close B; return $mesg; } sub backup() { if (! -d ".dbbackup/") { mkdir(".dbbackup",0755); } system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time()); }