bot.v3.1.2.pl

   1 ##!/usr/local/bin/perl
   2 # irpg bot v3.1.2 by jotun, jotun@idlerpg.net, et al. See http://idlerpg.net/
   3 #
   4 # Some code within this file was written by authors other than myself. As such,
   5 # distributing this code or distributing modified versions of this code is
   6 # strictly prohibited without written authorization from the authors. Contact
   7 # jotun@idlerpg.net. Please note that this may change (at any time, no less) if
   8 # authorization for distribution is given by patch submitters.
   9 #
  10 # As a side note, patches submitted for this project are automatically taken to
  11 # be freely distributable and modifiable for any use, public or private, though
  12 # I make no claim to ownership; original copyrights will be retained.. except as
  13 # I've just stated.
  14 #
  15 # Please mail bugs, etc. to me. Patches are welcome to fix bugs or clean up
  16 # the code, but please do not use a radically different coding style. Thanks
  17 # to everyone that's contributed!
  18 #
  19 # NOTE: This code should NOT be run as root. You deserve anything that happens
  20 #       to you if you run this code as a superuser. Also, note that giving a
  21 #       user admin access to the bot effectively gives them full access to the
  22 #       user under which your bot runs, as they can use the PEVAL command to
  23 #       execute any command, or possibly even change your password. I sincerely
  24 #       suggest that you exercise extreme caution when giving someone admin
  25 #       access to your bot, or that you disable the PEVAL command for non-owner
  26 #       accounts in your config file, .irpg.conf
  27
  28 use strict;
  29 use warnings;
  30 use IO::Socket;
  31 use IO::Select;
  32 use Data::Dumper;
  33 use Getopt::Long;
  34
  35 my %opts;
  36
  37 readconfig();
  38
  39 my $version = "3.1.2";
  40
  41 # command line overrides .irpg.conf
  42 GetOptions(\%opts,
  43     "help|h",
  44     "verbose|v",
  45     "debug",
  46     "debugfile=s",
  47     "server|s=s",
  48     "botnick|n=s",
  49     "botuser|u=s",
  50     "botrlnm|r=s",
  51     "botchan|c=s",
  52     "botident|p=s",
  53     "botmodes|m=s",
  54     "botopcmd|o=s",
  55     "localaddr=s",
  56     "botghostcmd|g=s",
  57     "helpurl=s",
  58     "admincommurl=s",
  59     "doban",
  60     "silentmode=i",
  61     "writequestfile",
  62     "questfilename=s",
  63     "voiceonlogin",
  64     "noccodes",
  65     "nononp",
  66     "mapurl=s",
  67     "statuscmd",
  68     "pidfile=s",
  69     "reconnect",
  70     "reconnect_wait=i",
  71     "self_clock=i",
  72     "modsfile=s",
  73     "casematters",
  74     "detectsplits",
  75     "splitwait=i",
  76     "allowuserinfo",
  77     "noscale",
  78     "phonehome",
  79     "owner=s",
  80     "owneraddonly",
  81     "ownerdelonly",
  82     "ownerpevalonly",
  83     "checkupdates",
  84     "senduserlist",
  85     "limitpen=i",
  86     "mapx=i",
  87     "mapy=i",
  88     "modesperline=i",
  89     "okurl|k=s@",
  90     "eventsfile=s",
  91     "rpstep=f",
  92     "rpbase=i",
  93     "rppenstep=f",
  94     "dbfile|irpgdb|db|d=s",
  95 ) or debug("Error: Could not parse command line. Try $0 --help\n",1);
  96
  97 $opts{help} and do { help(); exit 0; };
  98
  99 debug("Config: read $_: ".Dumper($opts{$_})) for keys(%opts);
 100
 101 my $outbytes = 0; # sent bytes
 102 my $primnick = $opts{botnick}; # for regain or register checks
 103 my $inbytes = 0; # received bytes
 104 my %onchan; # users on game channel
 105 my %rps; # role-players
 106 my %quest = (
 107     questers => [],
 108     p1 => [], # point 1 for q2
 109     p2 => [], # point 2 for q2
 110     qtime => time() + int(rand(21600)), # first quest starts in <=6 hours
 111     text => "",
 112     type => 1,
 113     stage => 1); # quest info
 114
 115 my $rpreport = 0; # constant for reporting top players
 116 my %prev_online; # user@hosts online on restart, die
 117 my %auto_login; # users to automatically log back on
 118 my @bans; # bans auto-set by the bot, saved to be removed after 1 hour
 119 my $pausemode = 0; # pausemode on/off flag
 120 my $silentmode = 0; # silent mode 0/1/2/3, see head of file
 121 my @queue; # outgoing message queue
 122 my $lastreg = 0; # holds the time of the last reg. cleared every second.
 123                  # prevents more than one account being registered / second
 124 my $registrations = 0; # count of registrations this period
 125 my $sel; # IO::Select object
 126 my $lasttime = 1; # last time that rpcheck() was run
 127 my $buffer; # buffer for socket stuff
 128 my $conn_tries = 0; # number of connection tries. gives up after trying each
 129                     # server twice
 130 my $sock; # IO::Socket::INET object
 131 my %split; # holds nick!user@hosts for clients that have been netsplit
 132 my $freemessages = 4; # number of "free" privmsgs we can send. 0..$freemessages
 133
 134 sub daemonize(); # prototype to avoid warnings
 135
 136 if (! -e $opts{dbfile}) {
 137     $|=1;
 138     %rps = ();
 139     print "$opts{dbfile} does not appear to exist. I'm guessing this is your ".
 140           "first time using IRPG. Please give an account name that you would ".
 141           "like to have admin access [$opts{owner}]: ";
 142     chomp(my $uname = <STDIN>);
 143     $uname =~ s/\s.*//g;
 144     $uname = length($uname)?$uname:$opts{owner};
 145     print "Enter a character class for this account: ";
 146     chomp(my $uclass = <STDIN>);
 147     $rps{$uname}{class} = substr($uclass,0,30);
 148     print "Enter a password for this account: ";
 149     if ($^O ne "MSWin32") {
 150         system("stty -echo");
 151     }
 152     chomp(my $upass = <STDIN>);
 153     if ($^O ne "MSWin32") {
 154         system("stty echo");
 155     }
 156     $rps{$uname}{pass} = crypt($upass,mksalt());
 157     $rps{$uname}{next} = $opts{rpbase};
 158     $rps{$uname}{nick} = "";
 159     $rps{$uname}{userhost} = "";
 160     $rps{$uname}{level} = 0;
 161     $rps{$uname}{online} = 0;
 162     $rps{$uname}{idled} = 0;
 163     $rps{$uname}{created} = time();
 164     $rps{$uname}{lastlogin} = time();
 165     $rps{$uname}{x} = int(rand($opts{mapx}));
 166     $rps{$uname}{y} = int(rand($opts{mapy}));
 167     $rps{$uname}{alignment}="n";
 168     $rps{$uname}{isadmin} = 1;
 169     for my $item ("ring","amulet","charm","weapon","helm",
 170                   "tunic","pair of gloves","shield",
 171                   "set of leggings","pair of boots") {
 172         $rps{$uname}{item}{$item} = 0;
 173     }
 174     for my $pen ("pen_mesg","pen_nick","pen_part",
 175                  "pen_kick","pen_quit","pen_quest",
 176                  "pen_logout","pen_logout") {
 177         $rps{$uname}{$pen} = 0;
 178     }
 179     writedb();
 180     print "OK, wrote you into $opts{dbfile}.\n";
 181 }
 182
 183 print "\n".debug("Becoming a daemon...")."\n";
 184 daemonize();
 185
 186 $SIG{HUP} = "readconfig"; # sighup = reread config file
 187
 188 CONNECT: # cheese.
 189
 190 loaddb();
 191
 192 while (!$sock && $conn_tries < 2*@{$opts{servers}}) {
 193     debug("Connecting to $opts{servers}->[0]...");
 194     my %sockinfo = (PeerAddr => $opts{servers}->[0],
 195                     PeerPort => 6667);
 196     if ($opts{localaddr}) { $sockinfo{LocalAddr} = $opts{localaddr}; }
 197     $sock = IO::Socket::INET->new(%sockinfo) or
 198         debug("Error: failed to connect: $!\n");
 199     ++$conn_tries;
 200     if (!$sock) {
 201         # cycle front server to back if connection failed
 202         push(@{$opts{servers}},shift(@{$opts{servers}}));
 203     }
 204     else { debug("Connected."); }
 205 }
 206
 207 if (!$sock) {
 208     debug("Error: Too many connection failures, exhausted server list.\n",1);
 209 }
 210
 211 $conn_tries=0;
 212
 213 $sel = IO::Select->new($sock);
 214
 215 sts("NICK $opts{botnick}");
 216 sts("USER $opts{botuser} 0 0 :$opts{botrlnm}");
 217
 218 while (1) {
 219     my($readable) = IO::Select->select($sel,undef,undef,0.5);
 220     if (defined($readable)) {
 221         my $fh = $readable->[0];
 222         my $buffer2;
 223         $fh->recv($buffer2,512,0);
 224         if (length($buffer2)) {
 225             $buffer .= $buffer2;
 226             while (index($buffer,"\n") != -1) {
 227                 my $line = substr($buffer,0,index($buffer,"\n")+1);
 228                 $buffer = substr($buffer,length($line));
 229                 parse($line);
 230             }
 231         }
 232         else {
 233             # uh oh, we've been disconnected from the server, possibly before
 234             # we've logged in the users in %auto_login. so, we'll set those
 235             # users' online flags to 1, rewrite db, and attempt to reconnect
 236             # (if that's wanted of us)
 237             $rps{$_}{online}=1 for keys(%auto_login);
 238             writedb();
 239
 240             close($fh);
 241             $sel->remove($fh);
 242
 243             if ($opts{reconnect}) {
 244                 undef(@queue);
 245                 undef($sock);
 246                 debug("Socket closed; disconnected. Cleared outgoing message ".
 247                       "queue. Waiting $opts{reconnect_wait}s before next ".
 248                       "connection attempt...");
 249                 sleep($opts{reconnect_wait});
 250                 goto CONNECT;
 251             }
 252             else { debug("Socket closed; disconnected.",1); }
 253         }
 254     }
 255     else { select(undef,undef,undef,1); }
 256     if ((time()-$lasttime) >= $opts{self_clock}) { rpcheck(); }
 257 }
 258
 259
 260 sub parse {
 261     my($in) = shift;
 262     $inbytes += length($in); # increase parsed byte count
 263     $in =~ s/[\r\n]//g; # strip all \r and \n
 264     debug("<- $in");
 265     my @arg = split(/\s/,$in); # split into "words"
 266     my $usernick = substr((split(/!/,$arg[0]))[0],1);
 267     # logged in char name of nickname, or undef if nickname is not online
 268     my $username = finduser($usernick);
 269     if (lc($arg[0]) eq 'ping') { sts("PONG $arg[1]",1); }
 270     elsif (lc($arg[0]) eq 'error') {
 271         # uh oh, we've been disconnected from the server, possibly before we've
 272         # logged in the users in %auto_login. so, we'll set those users' online
 273         # flags to 1, rewrite db, and attempt to reconnect (if that's wanted of
 274         # us)
 275         $rps{$_}{online}=1 for keys(%auto_login);
 276         writedb();
 277         return;
 278     }
 279     $arg[1] = lc($arg[1]); # original case no longer matters
 280     if ($arg[1] eq '433' && $opts{botnick} eq $arg[3]) {
 281         $opts{botnick} .= 0;
 282         sts("NICK $opts{botnick}");
 283     }
 284     elsif ($arg[1] eq 'join') {
 285         # %onchan holds time user joined channel. used for the advertisement ban
 286         $onchan{$usernick}=time();
 287         if ($opts{'detectsplits'} && exists($split{substr($arg[0],1)})) {
 288             delete($split{substr($arg[0],1)});
 289         }
 290         elsif ($opts{botnick} eq $usernick) {
 291             sts("WHO $opts{botchan}");
 292             (my $opcmd = $opts{botopcmd}) =~ s/%botnick%/$opts{botnick}/eg;
 293             sts($opcmd);
 294             $lasttime = time(); # start rpcheck()
 295         }
 296     }
 297     elsif ($arg[1] eq 'quit') {
 298         # if we see our nick come open, grab it (skipping queue)
 299         if ($usernick eq $primnick) { sts("NICK $primnick",1); }
 300         elsif ($opts{'detectsplits'} &&
 301                "@arg[2..$#arg]" =~ /^:\S+\.\S+ \S+\.\S+$/) {
 302             if (defined($username)) { # user was online
 303                 $split{substr($arg[0],1)}{time}=time();
 304                 $split{substr($arg[0],1)}{account}=$username;
 305             }
 306         }
 307         else {
 308             penalize($username,"quit");
 309         }
 310         delete($onchan{$usernick});
 311     }
 312     elsif ($arg[1] eq 'nick') {
 313         # if someone (nickserv) changes our nick for us, update $opts{botnick}
 314         if ($usernick eq $opts{botnick}) {
 315             $opts{botnick} = substr($arg[2],1);
 316         }
 317         # if we see our nick come open, grab it (skipping queue), unless it was
 318         # us who just lost it
 319         elsif ($usernick eq $primnick) { sts("NICK $primnick",1); }
 320         else {
 321             penalize($username,"nick",$arg[2]);
 322             $onchan{substr($arg[2],1)} = delete($onchan{$usernick});
 323         }
 324     }
 325     elsif ($arg[1] eq 'part') {
 326         penalize($username,"part");
 327         delete($onchan{$usernick});
 328     }
 329     elsif ($arg[1] eq 'kick') {
 330         $usernick = $arg[3];
 331         penalize(finduser($usernick),"kick");
 332         delete($onchan{$usernick});
 333     }
 334     # don't penalize /notices to the bot
 335     elsif ($arg[1] eq 'notice' && $arg[2] ne $opts{botnick}) {
 336         penalize($username,"notice",length("@arg[3..$#arg]")-1);
 337     }
 338     elsif ($arg[1] eq '001') {
 339         # send our identify command, set our usermode, join channel
 340         sts($opts{botident});
 341         sts("MODE $opts{botnick} :$opts{botmodes}");
 342         sts("JOIN $opts{botchan}");
 343         $opts{botchan} =~ s/ .*//; # strip channel key if present
 344     }
 345     elsif ($arg[1] eq '315') {
 346         # 315 is /WHO end. report who we automagically signed online iff it will
 347         # print < 1k of text
 348         if (keys(%auto_login)) {
 349             # not a true measure of size, but easy
 350             if (length("%auto_login") < 1024 && $opts{senduserlist}) {
 351                 chanmsg(scalar(keys(%auto_login))." users matching ".
 352                         scalar(keys(%prev_online))." hosts automatically ".
 353                         "logged in; accounts: ".join(", ",keys(%auto_login)));
 354             }
 355             else {
 356                 chanmsg(scalar(keys(%auto_login))." users matching ".
 357                         scalar(keys(%prev_online))." hosts automatically ".
 358                         "logged in.");
 359             }
 360             if ($opts{voiceonlogin}) {
 361                 my @vnicks = map { $rps{$_}{nick} } keys(%auto_login);
 362                 while (@vnicks) {
 363                     sts("MODE $opts{botchan} +".
 364                         ('v' x $opts{modesperline})." ".
 365                         join(" ",@vnicks[0..$opts{modesperline}-1]));
 366                     splice(@vnicks,0,$opts{modesperline});
 367                 }
 368             }
 369         }
 370         else { chanmsg("0 users qualified for auto login."); }
 371         undef(%prev_online);
 372         undef(%auto_login);
 373     }
 374     elsif ($arg[1] eq '005') {
 375         if ("@arg" =~ /MODES=(\d+)/) { $opts{modesperline}=$1; }
 376     }
 377     elsif ($arg[1] eq '352') {
 378         my $user;
 379         # 352 is one line of /WHO. check that the nick!user@host exists as a key
 380         # in %prev_online, the list generated in loaddb(). the value is the user
 381         # to login
 382         $onchan{$arg[7]}=time();
 383         if (exists($prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]})) {
 384             $rps{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}{online} = 1;
 385             $auto_login{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}=1;
 386         }
 387     }
 388     elsif ($arg[1] eq 'privmsg') {
 389         $arg[0] = substr($arg[0],1); # strip leading : from privmsgs
 390         if (lc($arg[2]) eq lc($opts{botnick})) { # to us, not channel
 391             $arg[3] = lc(substr($arg[3],1)); # lowercase, strip leading :
 392             if ($arg[3] eq "\1version\1") {
 393                 notice("\1VERSION IRPG bot v$version by jotun; ".
 394                        "http://idlerpg.net/\1",$usernick);
 395             }
 396             elsif ($arg[3] eq "peval") {
 397                 if (!ha($username) || ($opts{ownerpevalonly} &&
 398                     $opts{owner} ne $username)) {
 399                     privmsg("You don't have access to PEVAL.", $usernick);
 400                 }
 401                 else {
 402                     my @peval = eval "@arg[4..$#arg]";
 403                     if (@peval >= 4 || length("@peval") > 1024) {
 404                         privmsg("Command produced too much output to send ".
 405                                 "outright; queueing ".length("@peval").
 406                                 " bytes in ".scalar(@peval)." items. Use ".
 407                                 "CLEARQ to clear queue if needed.",$usernick,1);
 408                         privmsg($_,$usernick) for @peval;
 409                     }
 410                     else { privmsg($_,$usernick, 1) for @peval; }
 411                     privmsg("EVAL ERROR: $@", $usernick, 1) if $@;
 412                 }
 413             }
 414             elsif ($arg[3] eq "register") {
 415                 if (defined $username) {
 416                     privmsg("Sorry, you are already online as $username.",
 417                             $usernick);
 418                 }
 419                 else {
 420                     if ($#arg < 6 || $arg[6] eq "") {
 421                         privmsg("Try: REGISTER <char name> <password> <class>",
 422                                 $usernick);
 423                         privmsg("IE : REGISTER Poseidon MyPassword God of the ".
 424                                 "Sea",$usernick);
 425                     }
 426                     elsif ($pausemode) {
 427                         privmsg("Sorry, new accounts may not be registered ".
 428                                 "while the bot is in pause mode; please wait ".
 429                                 "a few minutes and try again.",$usernick);
 430                     }
 431                     elsif (exists $rps{$arg[4]} || ($opts{casematters} &&
 432                            scalar(grep { lc($arg[4]) eq lc($_) } keys(%rps)))) {
 433                         privmsg("Sorry, that character name is already in use.",
 434                                 $usernick);
 435                     }
 436                     elsif (lc($arg[4]) eq lc($opts{botnick}) ||
 437                            lc($arg[4]) eq lc($primnick)) {
 438                         privmsg("Sorry, that character name cannot be ".
 439                                 "registered.",$usernick);
 440                     }
 441                     elsif (!exists($onchan{$usernick})) {
 442                         privmsg("Sorry, you're not in $opts{botchan}.",
 443                                 $usernick);
 444                     }
 445                     elsif (length($arg[4]) > 16 || length($arg[4]) < 1) {
 446                         privmsg("Sorry, character names must be < 17 and > 0 ".
 447                                 "chars long.", $usernick);
 448                     }
 449                     elsif ($arg[4] =~ /^#/) {
 450                         privmsg("Sorry, character names may not begin with #.",
 451                                 $usernick);
 452                     }
 453                     elsif ($arg[4] =~ /\001/) {
 454                         privmsg("Sorry, character names may not include ".
 455                                 "character \\001.",$usernick);
 456                     }
 457                     elsif ($opts{noccodes} && ($arg[4] =~ /[[:cntrl:]]/ ||
 458                            "@arg[6..$#arg]" =~ /[[:cntrl:]]/)) {
 459                         privmsg("Sorry, neither character names nor classes ".
 460                                 "may include control codes.",$usernick);
 461                     }
 462                     elsif ($opts{nononp} && ($arg[4] =~ /[[:^print:]]/ ||
 463                            "@arg[6..$#arg]" =~ /[[:^print:]]/)) {
 464                         privmsg("Sorry, neither character names nor classes ".
 465                                 "may include non-printable chars.",$usernick);
 466                     }
 467                     elsif (length("@arg[6..$#arg]") > 30) {
 468                         privmsg("Sorry, character classes must be < 31 chars ".
 469                                 "long.",$usernick);
 470                     }
 471                     elsif (time() == $lastreg) {
 472                         privmsg("Wait 1 second and try again.",$usernick);
 473                     }
 474                     else {
 475                         if ($opts{voiceonlogin}) {
 476                             sts("MODE $opts{botchan} +v :$usernick");
 477                         }
 478                         ++$registrations;
 479                         $lastreg = time();
 480                         $rps{$arg[4]}{next} = $opts{rpbase};
 481                         $rps{$arg[4]}{class} = "@arg[6..$#arg]";
 482                         $rps{$arg[4]}{level} = 0;
 483                         $rps{$arg[4]}{online} = 1;
 484                         $rps{$arg[4]}{nick} = $usernick;
 485                         $rps{$arg[4]}{userhost} = $arg[0];
 486                         $rps{$arg[4]}{created} = time();
 487                         $rps{$arg[4]}{lastlogin} = time();
 488                         $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
 489                         $rps{$arg[4]}{x} = int(rand($opts{mapx}));
 490                         $rps{$arg[4]}{y} = int(rand($opts{mapy}));
 491                         $rps{$arg[4]}{alignment}="n";
 492                         $rps{$arg[4]}{isadmin} = 0;
 493                         for my $item ("ring","amulet","charm","weapon","helm",
 494                                       "tunic","pair of gloves","shield",
 495                                       "set of leggings","pair of boots") {
 496                             $rps{$arg[4]}{item}{$item} = 0;
 497                         }
 498                         for my $pen ("pen_mesg","pen_nick","pen_part",
 499                                      "pen_kick","pen_quit","pen_quest",
 500                                      "pen_logout","pen_logout") {
 501                             $rps{$arg[4]}{$pen} = 0;
 502                         }
 503                         chanmsg("Welcome $usernick\'s new player $arg[4], the ".
 504                                 "@arg[6..$#arg]! Next level in ".
 505                                 duration($opts{rpbase}).".");
 506                         privmsg("Success! Account $arg[4] created. You have ".
 507                                 "$opts{rpbase} seconds idleness until you ".
 508                                 "reach level 1. ", $usernick);
 509                         privmsg("NOTE: The point of the game is to see who ".
 510                                 "can idle the longest. As such, talking in ".
 511                                 "the channel, parting, quitting, and changing ".
 512                                 "nicks all penalize you.",$usernick);
 513                         if ($opts{phonehome}) {
 514                             my $tempsock = IO::Socket::INET->new(PeerAddr=>
 515                                 "jotun.ultrazone.org:80");
 516                             if ($tempsock) {
 517                                 print $tempsock
 518                                     "GET /g7/count.php?new=1 HTTP/1.1\r\n".
 519                                     "Host: jotun.ultrazone.org:80\r\n\r\n";
 520                                 sleep(1);
 521                                 close($tempsock);
 522                             }
 523                         }
 524                     }
 525                 }
 526             }
 527             elsif ($arg[3] eq "delold") {
 528                 if (!ha($username)) {
 529                     privmsg("You don't have access to DELOLD.", $usernick);
 530                 }
 531                 # insure it is a number
 532                 elsif ($arg[4] !~ /^[\d\.]+$/) {
 533                     privmsg("Try: DELOLD <# of days>", $usernick, 1);
 534                 }
 535                 else {
 536                     my @oldaccounts = grep { (time()-$rps{$_}{lastlogin}) >
 537                                              ($arg[4] * 86400) &&
 538                                              !$rps{$_}{online} } keys(%rps);
 539                     delete(@rps{@oldaccounts});
 540                     chanmsg(scalar(@oldaccounts)." accounts not accessed in ".
 541                             "the last $arg[4] days removed by $arg[0].");
 542                 }
 543             }
 544             elsif ($arg[3] eq "del") {
 545                 if (!ha($username)) {
 546                     privmsg("You don't have access to DEL.", $usernick);
 547                 }
 548                 elsif (!defined($arg[4])) {
 549                    privmsg("Try: DEL <char name>", $usernick, 1);
 550                 }
 551                 elsif (!exists($rps{$arg[4]})) {
 552                     privmsg("No such account $arg[4].", $usernick, 1);
 553                 }
 554                 else {
 555                     delete($rps{$arg[4]});
 556                     chanmsg("Account $arg[4] removed by $arg[0].");
 557                 }
 558             }
 559             elsif ($arg[3] eq "mkadmin") {
 560                 if (!ha($username) || ($opts{owneraddonly} &&
 561                     $opts{owner} ne $username)) {
 562                     privmsg("You don't have access to MKADMIN.", $usernick);
 563                 }
 564                 elsif (!defined($arg[4])) {
 565                     privmsg("Try: MKADMIN <char name>", $usernick, 1);
 566                 }
 567                 elsif (!exists($rps{$arg[4]})) {
 568                     privmsg("No such account $arg[4].", $usernick, 1);
 569                 }
 570                 else {
 571                     $rps{$arg[4]}{isadmin}=1;
 572                     privmsg("Account $arg[4] is now a bot admin.",$usernick, 1);
 573                     if ($opts{voiceonlogin}) {
 574                        sts("MODE $opts{botchan} +o :$usernick");
 575                     }
 576                 }
 577             }
 578             elsif ($arg[3] eq "deladmin") {
 579                 if (!ha($username) || ($opts{ownerdelonly} &&
 580                     $opts{owner} ne $username)) {
 581                     privmsg("You don't have access to DELADMIN.", $usernick);
 582                 }
 583                 elsif (!defined($arg[4])) {
 584                     privmsg("Try: DELADMIN <char name>", $usernick, 1);
 585                 }
 586                 elsif (!exists($rps{$arg[4]})) {
 587                     privmsg("No such account $arg[4].", $usernick, 1);
 588                 }
 589                 elsif ($arg[4] eq $opts{owner}) {
 590                     privmsg("Cannot DELADMIN owner account.", $usernick, 1);
 591                 }
 592                 else {
 593                     $rps{$arg[4]}{isadmin}=0;
 594                     privmsg("Account $arg[4] is no longer a bot admin.",
 595                             $usernick, 1);
 596                     if ($opts{voiceonlogin}) {
 597                        sts("MODE $opts{botchan} -o :$usernick");
 598                     }
 599                 }
 600             }
 601             elsif ($arg[3] eq "hog") {
 602                 if (!ha($username)) {
 603                     privmsg("You don't have access to HOG.", $usernick);
 604                 }
 605                 else {
 606                     chanmsg("$usernick has summoned the Hand of God.");
 607                     hog();
 608                 }
 609             }
 610             elsif ($arg[3] eq "rehash") {
 611                 if (!ha($username)) {
 612                     privmsg("You don't have access to REHASH.", $usernick);
 613                 }
 614                 else {
 615                     readconfig();
 616                     privmsg("Reread config file.",$usernick,1);
 617                     $opts{botchan} =~ s/ .*//; # strip channel key if present
 618                 }
 619             }
 620             elsif ($arg[3] eq "chpass") {
 621                 if (!ha($username)) {
 622                     privmsg("You don't have access to CHPASS.", $usernick);
 623                 }
 624                 elsif (!defined($arg[5])) {
 625                     privmsg("Try: CHPASS <char name> <new pass>", $usernick, 1);
 626                 }
 627                 elsif (!exists($rps{$arg[4]})) {
 628                     privmsg("No such username $arg[4].", $usernick, 1);
 629                 }
 630                 else {
 631                     $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
 632                     privmsg("Password for $arg[4] changed.", $usernick, 1);
 633                 }
 634             }
 635             elsif ($arg[3] eq "chuser") {
 636                 if (!ha($username)) {
 637                     privmsg("You don't have access to CHUSER.", $usernick);
 638                 }
 639                 elsif (!defined($arg[5])) {
 640                     privmsg("Try: CHUSER <char name> <new char name>",
 641                             $usernick, 1);
 642                 }
 643                 elsif (!exists($rps{$arg[4]})) {
 644                     privmsg("No such username $arg[4].", $usernick, 1);
 645                 }
 646                 elsif (exists($rps{$arg[5]})) {
 647                     privmsg("Username $arg[5] is already taken.", $usernick,1);
 648                 }
 649                 else {
 650                     $rps{$arg[5]} = delete($rps{$arg[4]});
 651                     privmsg("Username for $arg[4] changed to $arg[5].",
 652                             $usernick, 1);
 653                 }
 654             }
 655             elsif ($arg[3] eq "chclass") {
 656                 if (!ha($username)) {
 657                     privmsg("You don't have access to CHCLASS.", $usernick);
 658                 }
 659                 elsif (!defined($arg[5])) {
 660                     privmsg("Try: CHCLASS <char name> <new char class>",
 661                             $usernick, 1);
 662                 }
 663                 elsif (!exists($rps{$arg[4]})) {
 664                     privmsg("No such username $arg[4].", $usernick, 1);
 665                 }
 666                 else {
 667                     $rps{$arg[4]}{class} = "@arg[5..$#arg]";
 668                     privmsg("Class for $arg[4] changed to @arg[5..$#arg].",
 669                             $usernick, 1);
 670                 }
 671             }
 672             elsif ($arg[3] eq "push") {
 673                 if (!ha($username)) {
 674                     privmsg("You don't have access to PUSH.", $usernick);
 675                 }
 676                 # insure it's a positive or negative, integral number of seconds
 677                 elsif ($arg[5] !~ /^\-?\d+$/) {
 678                     privmsg("Try: PUSH <char name> <seconds>", $usernick, 1);
 679                 }
 680                 elsif (!exists($rps{$arg[4]})) {
 681                     privmsg("No such username $arg[4].", $usernick, 1);
 682                 }
 683                 elsif ($arg[5] > $rps{$arg[4]}{next}) {
 684                     privmsg("Time to level for $arg[4] ($rps{$arg[4]}{next}s) ".
 685                             "is lower than $arg[5]; setting TTL to 0.",
 686                             $usernick, 1);
 687                     chanmsg("$usernick has pushed $arg[4] $rps{$arg[4]}{next} ".
 688                             "seconds toward level ".($rps{$arg[4]}{level}+1));
 689                     $rps{$arg[4]}{next}=0;
 690                 }
 691                 else {
 692                     $rps{$arg[4]}{next} -= $arg[5];
 693                      chanmsg("$usernick has pushed $arg[4] $arg[5] seconds ".
 694                              "toward level ".($rps{$arg[4]}{level}+1).". ".
 695                              "$arg[4] reaches next level in ".
 696                              duration($rps{$arg[4]}{next}).".");
 697                 }
 698             }
 699             elsif ($arg[3] eq "logout") {
 700                 if (defined($username)) {
 701                     penalize($username,"logout");
 702                 }
 703                 else {
 704                     privmsg("You are not logged in.", $usernick);
 705                 }
 706             }
 707             elsif ($arg[3] eq "quest") {
 708                 if (!@{$quest{questers}}) {
 709                     privmsg("There is no active quest.",$usernick);
 710                 }
 711                 elsif ($quest{type} == 1) {
 712                     privmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
 713                             "$quest{questers}->[3] are on a quest to ".
 714                             "$quest{text}. Quest to complete in ".
 715                             duration($quest{qtime}-time()).".",$usernick);
 716                 }
 717                 elsif ($quest{type} == 2) {
 718                     privmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
 719                             "$quest{questers}->[3] are on a quest to ".
 720                             "$quest{text}. Participants must first reach ".
 721                             "[$quest{p1}->[0],$quest{p1}->[1]], then ".
 722                             "[$quest{p2}->[0],$quest{p2}->[1]].".
 723                             ($opts{mapurl}?" See $opts{mapurl} to monitor ".
 724                             "their journey's progress.":""),$usernick);
 725                 }
 726             }
 727             elsif ($arg[3] eq "status" && $opts{statuscmd}) {
 728                 if (!defined($username)) {
 729                     privmsg("You are not logged in.", $usernick);
 730                 }
 731                 # argument is optional
 732                 elsif ($arg[4] && !exists($rps{$arg[4]})) {
 733                     privmsg("No such user.",$usernick);
 734                 }
 735                 elsif ($arg[4]) { # optional 'user' argument
 736                     privmsg("$arg[4]: Level $rps{$arg[4]}{level} ".
 737                             "$rps{$arg[4]}{class}; Status: O".
 738                             ($rps{$arg[4]}{online}?"n":"ff")."line; ".
 739                             "TTL: ".duration($rps{$arg[4]}{next})."; ".
 740                             "Idled: ".duration($rps{$arg[4]}{idled}).
 741                             "; Item sum: ".itemsum($arg[4]),$usernick);
 742                 }
 743                 else { # no argument, look up this user
 744                     privmsg("$username: Level $rps{$username}{level} ".
 745                             "$rps{$username}{class}; Status: O".
 746                             ($rps{$username}{online}?"n":"ff")."line; ".
 747                             "TTL: ".duration($rps{$username}{next})."; ".
 748                             "Idled: ".duration($rps{$username}{idled})."; ".
 749                             "Item sum: ".itemsum($username),$usernick);
 750                 }
 751             }
 752             elsif ($arg[3] eq "whoami") {
 753                 if (!defined($username)) {
 754                     privmsg("You are not logged in.", $usernick);
 755                 }
 756                 else {
 757                     privmsg("You are $username, the level ".
 758                             $rps{$username}{level}." $rps{$username}{class}. ".
 759                             "Next level in ".duration($rps{$username}{next}),
 760                             $usernick);
 761                 }
 762             }
 763             elsif ($arg[3] eq "newpass") {
 764                 if (!defined($username)) {
 765                     privmsg("You are not logged in.", $usernick)
 766                 }
 767                 elsif (!defined($arg[4])) {
 768                     privmsg("Try: NEWPASS <new password>", $usernick);
 769                 }
 770                 else {
 771                     $rps{$username}{pass} = crypt($arg[4],mksalt());
 772                     privmsg("Your password was changed.",$usernick);
 773                 }
 774             }
 775             elsif ($arg[3] eq "align") {
 776                 if (!defined($username)) {
 777                     privmsg("You are not logged in.", $usernick)
 778                 }
 779                 elsif (!defined($arg[4]) || (lc($arg[4]) ne "good" &&
 780                        lc($arg[4]) ne "neutral" && lc($arg[4]) ne "evil")) {
 781                     privmsg("Try: ALIGN <good|neutral|evil>", $usernick);
 782                 }
 783                 else {
 784                     $rps{$username}{alignment} = substr(lc($arg[4]),0,1);
 785                     chanmsg("$username has changed alignment to: ".lc($arg[4]).
 786                             ".");
 787                     privmsg("Your alignment was changed to ".lc($arg[4]).".",
 788                             $usernick);
 789                 }
 790             }
 791             elsif ($arg[3] eq "removeme") {
 792                 if (!defined($username)) {
 793                     privmsg("You are not logged in.", $usernick)
 794                 }
 795                 else {
 796                     privmsg("Account $username removed.",$usernick);
 797                     chanmsg("$arg[0] removed his account, $username, the ".
 798                             $rps{$username}{class}.".");
 799                     delete($rps{$username});
 800                 }
 801             }
 802             elsif ($arg[3] eq "help") {
 803                 if (!ha($username)) {
 804                     privmsg("For information on IRPG bot commands, see ".
 805                             $opts{helpurl}, $usernick);
 806                 }
 807                 else {
 808                     privmsg("Help URL is $opts{helpurl}", $usernick, 1);
 809                     privmsg("Admin commands URL is $opts{admincommurl}",
 810                             $usernick, 1);
 811                 }
 812             }
 813             elsif ($arg[3] eq "die") {
 814                 if (!ha($username)) {
 815                     privmsg("You do not have access to DIE.", $usernick);
 816                 }
 817                 else {
 818                     $opts{reconnect} = 0;
 819                     writedb();
 820                     sts("QUIT :DIE from $arg[0]",1);
 821                 }
 822             }
 823             elsif ($arg[3] eq "reloaddb") {
 824                 if (!ha($username)) {
 825                     privmsg("You do not have access to RELOADDB.", $usernick);
 826                 }
 827                 elsif (!$pausemode) {
 828                     privmsg("ERROR: Can only use LOADDB while in PAUSE mode.",
 829                             $usernick, 1);
 830                 }
 831                 else {
 832                     loaddb();
 833                     privmsg("Reread player database file; ".scalar(keys(%rps)).
 834                             " accounts loaded.",$usernick,1);
 835                 }
 836             }
 837             elsif ($arg[3] eq "backup") {
 838                 if (!ha($username)) {
 839                     privmsg("You do not have access to BACKUP.", $usernick);
 840                 }
 841                 else {
 842                     backup();
 843                     privmsg("$opts{dbfile} copied to ".
 844                             ".dbbackup/$opts{dbfile}".time(),$usernick,1);
 845                 }
 846             }
 847             elsif ($arg[3] eq "pause") {
 848                 if (!ha($username)) {
 849                     privmsg("You do not have access to PAUSE.", $usernick);
 850                 }
 851                 else {
 852                     $pausemode = $pausemode ? 0 : 1;
 853                     privmsg("PAUSE_MODE set to $pausemode.",$usernick,1);
 854                 }
 855             }
 856             elsif ($arg[3] eq "silent") {
 857                 if (!ha($username)) {
 858                     privmsg("You do not have access to SILENT.", $usernick);
 859                 }
 860                 elsif (!defined($arg[4]) || $arg[4] < 0 || $arg[4] > 3) {
 861                     privmsg("Try: SILENT <mode>", $usernick,1);
 862                 }
 863                 else {
 864                     $silentmode = $arg[4];
 865                     privmsg("SILENT_MODE set to $silentmode.",$usernick,1);
 866                 }
 867             }
 868             elsif ($arg[3] eq "jump") {
 869                 if (!ha($username)) {
 870                     privmsg("You do not have access to JUMP.", $usernick);
 871                 }
 872                 elsif (!defined($arg[4])) {
 873                     privmsg("Try: JUMP <server[:port]>", $usernick, 1);
 874                 }
 875                 else {
 876                     writedb();
 877                     sts("QUIT :JUMP to $arg[4] from $arg[0]");
 878                     unshift(@{$opts{servers}},$arg[4]);
 879                     close($sock);
 880                     sleep(3);
 881                     goto CONNECT;
 882                 }
 883             }
 884             elsif ($arg[3] eq "restart") {
 885                 if (!ha($username)) {
 886                     privmsg("You do not have access to RESTART.", $usernick);
 887                 }
 888                 else {
 889                     writedb();
 890                     sts("QUIT :RESTART from $arg[0]",1);
 891                     close($sock);
 892                     exec("perl $0");
 893                 }
 894             }
 895             elsif ($arg[3] eq "clearq") {
 896                 if (!ha($username)) {
 897                     privmsg("You do not have access to CLEARQ.", $usernick);
 898                 }
 899                 else {
 900                     undef(@queue);
 901                     chanmsg("Outgoing message queue cleared by $arg[0].");
 902                     privmsg("Outgoing message queue cleared.",$usernick,1);
 903                 }
 904             }
 905             elsif ($arg[3] eq "info") {
 906                 my $info;
 907                 if (!ha($username) && $opts{allowuserinfo}) {
 908                     $info = "IRPG bot v$version by jotun, ".
 909                             "http://idlerpg.net/. On via server: ".
 910                             $opts{servers}->[0].". Admins online: ".
 911                             join(", ", map { $rps{$_}{nick} }
 912                                       grep { $rps{$_}{isadmin} &&
 913                                              $rps{$_}{online} } keys(%rps)).".";
 914                     privmsg($info, $usernick);
 915                 }
 916                 elsif (!ha($username) && !$opts{allowuserinfo}) {
 917                     privmsg("You do not have access to INFO.", $usernick);
 918                 }
 919                 else {
 920                     my $queuedbytes = 0;
 921                     $queuedbytes += (length($_)+2) for @queue; # +2 = \r\n
 922                     $info = sprintf(
 923                         "%.2fkb sent, %.2fkb received in %s. %d IRPG users ".
 924                         "online of %d total users. %d accounts created since ".
 925                         "startup. PAUSE_MODE is %d, SILENT_MODE is %d. ".
 926                         "Outgoing queue is %d bytes in %d items. On via: %s. ".
 927                         "Admins online: %s.",
 928                         $outbytes/1024,
 929                         $inbytes/1024,
 930                         duration(time()-$^T),
 931                         scalar(grep { $rps{$_}{online} } keys(%rps)),
 932                         scalar(keys(%rps)),
 933                         $registrations,
 934                         $pausemode,
 935                         $silentmode,
 936                         $queuedbytes,
 937                         scalar(@queue),
 938                         $opts{servers}->[0],
 939                         join(", ",map { $rps{$_}{nick} }
 940                                   grep { $rps{$_}{isadmin} && $rps{$_}{online} }
 941                                   keys(%rps)));
 942                     privmsg($info, $usernick, 1);
 943                 }
 944             }
 945             elsif ($arg[3] eq "login") {
 946                 if (defined($username)) {
 947                     notice("Sorry, you are already online as $username.",
 948                             $usernick);
 949                 }
 950                 else {
 951                     if ($#arg < 5 || $arg[5] eq "") {
 952                         notice("Try: LOGIN <username> <password>", $usernick);
 953                     }
 954                     elsif (!exists $rps{$arg[4]}) {
 955                         notice("Sorry, no such account name. Note that ".
 956                                 "account names are case sensitive.",$usernick);
 957                     }
 958                     elsif (!exists $onchan{$usernick}) {
 959                         notice("Sorry, you're not in $opts{botchan}.",
 960                                 $usernick);
 961                     }
 962                     elsif ($rps{$arg[4]}{pass} ne
 963                            crypt($arg[5],$rps{$arg[4]}{pass})) {
 964                         notice("Wrong password.", $usernick);
 965                     }
 966                     else {
 967                         if ($opts{voiceonlogin}) {
 968                             sts("MODE $opts{botchan} +v :$usernick");
 969                             if($rps{$arg[4]}{isadmin} > 0){
 970                                sts("MODE $opts{botchan} +o :$usernick");
 971                             }
 972
 973                         }
 974                         $rps{$arg[4]}{online} = 1;
 975                         $rps{$arg[4]}{nick} = $usernick;
 976                         $rps{$arg[4]}{userhost} = $arg[0];
 977                         $rps{$arg[4]}{lastlogin} = time();
 978                         chanmsg("$arg[4], the level $rps{$arg[4]}{level} ".
 979                                 "$rps{$arg[4]}{class}, is now online from ".
 980                                 "nickname $usernick. Next level in ".
 981                                 duration($rps{$arg[4]}{next}).".");
 982                         notice("Logon successful. Next level in ".
 983                                duration($rps{$arg[4]}{next}).".", $usernick);
 984                     }
 985                 }
 986             }
 987         }
 988         # penalize returns true if user was online and successfully penalized.
 989         # if the user is not logged in, then penalize() fails. so, if user is
 990         # offline, and they say something including "http:", and they've been on
 991         # the channel less than 90 seconds, and the http:-style ban is on, then
 992         # check to see if their url is in @{$opts{okurl}}. if not, kickban them
 993         elsif (!penalize($username,"privmsg",length("@arg[3..$#arg]")) &&
 994                index(lc("@arg[3..$#arg]"),"http:") != -1 &&
 995                (time()-$onchan{$usernick}) < 90 && $opts{doban}) {
 996             my $isokurl = 0;
 997             for (@{$opts{okurl}}) {
 998                 if (index(lc("@arg[3..$#arg]"),lc($_)) != -1) { $isokurl = 1; }
 999             }
1000             if (!$isokurl) {
1001                 sts("MODE $opts{botchan} +b $arg[0]");
1002                 sts("KICK $opts{botchan} $usernick :No advertising; ban will ".
1003                     "be lifted within the hour.");
1004                 push(@bans,$arg[0]) if @bans < 12;
1005             }
1006         }
1007     }
1008 }
1009
1010 sub sts { # send to server
1011     my($text,$skipq) = @_;
1012     if ($skipq) {
1013         if ($sock) {
1014             print $sock "$text\r\n";
1015             $outbytes += length($text) + 2;
1016             debug("-> $text");
1017         }
1018         else {
1019             # something is wrong. the socket is closed. clear the queue
1020             undef(@queue);
1021             debug("\$sock isn't writeable in sts(), cleared outgoing queue.\n");
1022             return;
1023         }
1024     }
1025     else {
1026         push(@queue,$text);
1027         debug(sprintf("(q%03d) = %s\n",$#queue,$text));
1028     }
1029 }
1030
1031 sub fq { # deliver message(s) from queue
1032     if (!@queue) {
1033         ++$freemessages if $freemessages < 4;
1034         return undef;
1035     }
1036     my $sentbytes = 0;
1037     for (0..$freemessages) {
1038         last() if !@queue; # no messages left to send
1039         # lower number of "free" messages we have left
1040         my $line=shift(@queue);
1041         # if we have already sent one message, and the next message to be sent
1042         # plus the previous messages we have sent this call to fq() > 768 bytes,
1043         # then requeue this message and return. we don't want to flood off,
1044         # after all
1045         if ($_ != 0 && (length($line)+$sentbytes) > 768) {
1046             unshift(@queue,$line);
1047             last();
1048         }
1049         if ($sock) {
1050             debug("(fm$freemessages) -> $line");
1051             --$freemessages if $freemessages > 0;
1052             print $sock "$line\r\n";
1053             $sentbytes += length($line) + 2;
1054         }
1055         else {
1056             undef(@queue);
1057             debug("Disconnected: cleared outgoing message queue.");
1058             last();
1059         }
1060         $outbytes += length($line) + 2;
1061     }
1062 }
1063
1064 sub duration { # return human duration of seconds
1065     my $s = shift;
1066     return "NA ($s)" if $s !~ /^\d+$/;
1067     return sprintf("%d day%s, %02d:%02d:%02d",$s/86400,int($s/86400)==1?"":"s",
1068                    ($s%86400)/3600,($s%3600)/60,($s%60));
1069 }
1070
1071 sub ts { # timestamp
1072     my @ts = localtime(time());
1073     return sprintf("[%02d/%02d/%02d %02d:%02d:%02d] ",
1074                    $ts[4]+1,$ts[3],$ts[5]%100,$ts[2],$ts[1],$ts[0]);
1075 }
1076
1077 sub hog { # summon the hand of god
1078     my @players = grep { $rps{$_}{online} } keys(%rps);
1079     my $player = $players[rand(@players)];
1080     my $win = int(rand(5));
1081     my $time = int(((5 + int(rand(71)))/100) * $rps{$player}{next});
1082     if ($win) {
1083         chanmsg(clog("Verily I say unto thee, the Heavens have burst forth, ".
1084                      "and the blessed hand of God carried $player ".
1085                      duration($time)." toward level ".($rps{$player}{level}+1).
1086                      "."));
1087         $rps{$player}{next} -= $time;
1088     }
1089     else {
1090         chanmsg(clog("Thereupon He stretched out His little finger among them ".
1091                      "and consumed $player with fire, slowing the heathen ".
1092                      duration($time)." from level ".($rps{$player}{level}+1).
1093                      "."));
1094         $rps{$player}{next} += $time;
1095     }
1096     chanmsg("$player reaches next level in ".duration($rps{$player}{next}).".");
1097 }
1098
1099 sub rpcheck { # check levels, update database
1100     # check splits hash to see if any split users have expired
1101     checksplits() if $opts{detectsplits};
1102     # send out $freemessages lines of text from the outgoing message queue
1103     fq();
1104     # clear registration limiting
1105     $lastreg = 0;
1106     my $online = scalar(grep { $rps{$_}{online} } keys(%rps));
1107     # there's really nothing to do here if there are no online users
1108     return unless $online;
1109     my $onlineevil = scalar(grep { $rps{$_}{online} &&
1110                                    $rps{$_}{alignment} eq "e" } keys(%rps));
1111     my $onlinegood = scalar(grep { $rps{$_}{online} &&
1112                                    $rps{$_}{alignment} eq "g" } keys(%rps));
1113     if (!$opts{noscale}) {
1114         if (rand((20*86400)/$opts{self_clock}) < $online) { hog(); }
1115         if (rand((24*86400)/$opts{self_clock}) < $online) { team_battle(); }
1116         if (rand((8*86400)/$opts{self_clock}) < $online) { calamity(); }
1117         if (rand((4*86400)/$opts{self_clock}) < $online) { godsend(); }
1118     }
1119     else {
1120         hog() if rand(4000) < 1;
1121         team_battle() if rand(4000) < 1;
1122         calamity() if rand(4000) < 1;
1123         godsend() if rand(2000) < 1;
1124     }
1125     if (rand((8*86400)/$opts{self_clock}) < $onlineevil) { evilness(); }
1126     if (rand((12*86400)/$opts{self_clock}) < $onlinegood) { goodness(); }
1127
1128     moveplayers();
1129
1130     # statements using $rpreport do not bother with scaling by the clock because
1131     # $rpreport is adjusted by the number of seconds since last rpcheck()
1132     if ($rpreport%120==0 && $opts{writequestfile}) { writequestfile(); }
1133     if (time() > $quest{qtime}) {
1134         if (!@{$quest{questers}}) { quest(); }
1135         elsif ($quest{type} == 1) {
1136             chanmsg(clog(join(", ",(@{$quest{questers}})[0..2]).", and ".
1137                          "$quest{questers}->[3] have blessed the realm by ".
1138                          "completing their quest! 25% of their burden is ".
1139                          "eliminated."));
1140             for (@{$quest{questers}}) {
1141                 $rps{$_}{next} = int($rps{$_}{next} * .75);
1142             }
1143             undef(@{$quest{questers}});
1144             $quest{qtime} = time() + 21600;
1145         }
1146         # quest type 2 awards are handled in moveplayers()
1147     }
1148     if ($rpreport && $rpreport%36000==0) { # 10 hours
1149         my @u = sort { $rps{$b}{level} <=> $rps{$a}{level} ||
1150                        $rps{$a}{next}  <=> $rps{$b}{next} } keys(%rps);
1151         chanmsg("Idle RPG Top Players:") if @u;
1152         for my $i (0..2) {
1153             $#u >= $i and
1154             chanmsg("$u[$i], the level $rps{$u[$i]}{level} ".
1155                     "$rps{$u[$i]}{class}, is #" . ($i + 1) . "! Next level in ".
1156                     (duration($rps{$u[$i]}{next})).".");
1157         }
1158         backup();
1159     }
1160     if ($rpreport%3600==0 && $rpreport) { # 1 hour
1161         my @players = grep { $rps{$_}{online} &&
1162                              $rps{$_}{level} > 44 } keys(%rps);
1163         # 20% of all players must be level 45+
1164         if ((scalar(@players)/scalar(grep { $rps{$_}{online} } keys(%rps))) > .15) {
1165             challenge_opp($players[int(rand(@players))]);
1166         }
1167         while (@bans) {
1168             sts("MODE $opts{botchan} -bbbb :@bans[0..3]");
1169             splice(@bans,0,4);
1170         }
1171     }
1172     if ($rpreport%1800==0) { # 30 mins
1173         if ($opts{botnick} ne $primnick) {
1174             sts($opts{botghostcmd}) if $opts{botghostcmd};
1175             sts("NICK $primnick");
1176         }
1177     }
1178     if ($rpreport%600==0 && $pausemode) { # warn every 10m
1179         chanmsg("WARNING: Cannot write database in PAUSE mode!");
1180     }
1181     # do not write in pause mode, and do not write if not yet connected. (would
1182     # log everyone out if the bot failed to connect. $lasttime = time() on
1183     # successful join to $opts{botchan}, initial value is 1). if fails to open
1184     # $opts{dbfile}, will not update $lasttime and so should have correct values
1185     # on next rpcheck().
1186     if ($lasttime != 1) {
1187         my $curtime=time();
1188         for my $k (keys(%rps)) {
1189             if ($rps{$k}{online} && exists $rps{$k}{nick} &&
1190                 $rps{$k}{nick} && exists $onchan{$rps{$k}{nick}}) {
1191                 $rps{$k}{next} -= ($curtime - $lasttime);
1192                 $rps{$k}{idled} += ($curtime - $lasttime);
1193                 if ($rps{$k}{next} < 1) {
1194                     $rps{$k}{level}++;
1195                     if ($rps{$k}{level} > 60) {
1196                         $rps{$k}{next} = int(($opts{rpbase} *
1197                                              ($opts{rpstep}**60)) +
1198                                              (86400*($rps{$k}{level} - 60)));
1199                     }
1200                     else {
1201                         $rps{$k}{next} = int($opts{rpbase} *
1202                                              ($opts{rpstep}**$rps{$k}{level}));
1203                     }
1204                     chanmsg("$k, the $rps{$k}{class}, has attained level ".
1205                             "$rps{$k}{level}! Next level in ".
1206                             duration($rps{$k}{next}).".");
1207                     find_item($k);
1208                     challenge_opp($k);
1209                 }
1210             }
1211             # attempt to make sure this is an actual user, and not just an
1212             # artifact of a bad PEVAL
1213         }
1214         if (!$pausemode && $rpreport%60==0) { writedb(); }
1215         $rpreport += $opts{self_clock};
1216         $lasttime = $curtime;
1217     }
1218 }
1219
1220 sub challenge_opp { # pit argument player against random player
1221     my $u = shift;
1222     if ($rps{$u}{level} < 25) { return unless rand(4) < 1; }
1223     my @opps = grep { $rps{$_}{online} && $u ne $_ } keys(%rps);
1224     return unless @opps;
1225     my $opp = $opps[int(rand(@opps))];
1226     $opp = $primnick if rand(@opps+1) < 1;
1227     my $mysum = itemsum($u,1);
1228     my $oppsum = itemsum($opp,1);
1229     my $myroll = int(rand($mysum));
1230     my $opproll = int(rand($oppsum));
1231     if ($myroll >= $opproll) {
1232         my $gain = ($opp eq $primnick)?20:int($rps{$opp}{level}/4);
1233         $gain = 7 if $gain < 7;
1234         $gain = int(($gain/100)*$rps{$u}{next});
1235         chanmsg(clog("$u [$myroll/$mysum] has challenged $opp [$opproll/".
1236                      "$oppsum] in combat and won! ".duration($gain)." is ".
1237                      "removed from $u\'s clock."));
1238         $rps{$u}{next} -= $gain;
1239         chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
1240         my $csfactor = $rps{$u}{alignment} eq "g" ? 50 :
1241                        $rps{$u}{alignment} eq "e" ? 20 :
1242                        35;
1243         if (rand($csfactor) < 1 && $opp ne $primnick) {
1244             $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
1245             chanmsg(clog("$u has dealt $opp a Critical Strike! ".
1246                          duration($gain)." is added to $opp\'s clock."));
1247             $rps{$opp}{next} += $gain;
1248             chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).
1249                     ".");
1250         }
1251         elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
1252             my @items = ("ring","amulet","charm","weapon","helm","tunic",
1253                          "pair of gloves","set of leggings","shield",
1254                          "pair of boots");
1255             my $type = $items[rand(@items)];
1256             if (int($rps{$opp}{item}{$type}) > int($rps{$u}{item}{$type})) {
1257                 chanmsg(clog("In the fierce battle, $opp dropped his level ".
1258                              int($rps{$opp}{item}{$type})." $type! $u picks ".
1259                              "it up, tossing his old level ".
1260                              int($rps{$u}{item}{$type})." $type to $opp."));
1261                 my $tempitem = $rps{$u}{item}{$type};
1262                 $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
1263                 $rps{$opp}{item}{$type} = $tempitem;
1264             }
1265         }
1266     }
1267     else {
1268         my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
1269         $gain = 7 if $gain < 7;
1270         $gain = int(($gain/100)*$rps{$u}{next});
1271         chanmsg(clog("$u [$myroll/$mysum] has challenged $opp [$opproll/".
1272                      "$oppsum] in combat and lost! ".duration($gain)." is ".
1273                      "added to $u\'s clock."));
1274         $rps{$u}{next} += $gain;
1275         chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
1276         #interrogation
1277         debug("interrogation");
1278         my $csfactor = $rps{$opp}{alignment} eq "g" ? 50 :
1279                        $rps{$opp}{alignment} eq "e" ? 20 :
1280                        35;
1281         if (rand($csfactor) < 1) {
1282             $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
1283             chanmsg(clog("$opp has captured and interrogated $u! ".
1284                          duration($gain)." is removed from $opp\'s clock."));
1285             $rps{$opp}{next} -= $gain;
1286             chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).".");
1287         }
1288     }
1289 }
1290
1291 sub team_battle { # pit three players against three other players
1292     my @opp = grep { $rps{$_}{online} } keys(%rps);
1293     return if @opp < 6;
1294     splice(@opp,int(rand(@opp)),1) while @opp > 6;
1295     fisher_yates_shuffle(\@opp);
1296     my $mysum = itemsum($opp[0],1) + itemsum($opp[1],1) + itemsum($opp[2],1);
1297     my $oppsum = itemsum($opp[3],1) + itemsum($opp[4],1) + itemsum($opp[5],1);
1298     my $gain = $rps{$opp[0]}{next};
1299     for my $p (1,2) {
1300         $gain = $rps{$opp[$p]}{next} if $gain > $rps{$opp[$p]}{next};
1301     }
1302     $gain = int($gain*.20);
1303     my $myroll = int(rand($mysum));
1304     my $opproll = int(rand($oppsum));
1305     if ($myroll >= $opproll) {
1306         chanmsg(clog("$opp[0], $opp[1], and $opp[2] [$myroll/$mysum] have ".
1307                      "team battled $opp[3], $opp[4], and $opp[5] [$opproll/".
1308                      "$oppsum] and won! ".duration($gain)." is removed from ".
1309                      "their clocks."));
1310         $rps{$opp[0]}{next} -= $gain;
1311         $rps{$opp[1]}{next} -= $gain;
1312         $rps{$opp[2]}{next} -= $gain;
1313     }
1314     else {
1315         chanmsg(clog("$opp[0], $opp[1], and $opp[2] [$myroll/$mysum] have ".
1316                      "team battled $opp[3], $opp[4], and $opp[5] [$opproll/".
1317                      "$oppsum] and lost! ".duration($gain)." is added to ".
1318                      "their clocks."));
1319         $rps{$opp[0]}{next} += $gain;
1320         $rps{$opp[1]}{next} += $gain;
1321         $rps{$opp[2]}{next} += $gain;
1322     }
1323 }
1324
1325 sub find_item { # find item for argument player
1326     my $u = shift;
1327     my @items = ("ring","amulet","charm","weapon","helm","tunic",
1328                  "pair of gloves","set of leggings","shield","pair of boots");
1329     my $type = $items[rand(@items)];
1330     my $level = 1;
1331     my $ulevel;
1332     for my $num (1 .. int($rps{$u}{level}*1.5)) {
1333         if (rand(1.4**($num/4)) < 1) {
1334             $level = $num;
1335         }
1336     }
1337     if ($rps{$u}{level} >= 25 && rand(40) < 1) {
1338         $ulevel = 50+int(rand(25));
1339         if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{helm})) {
1340             notice("The light of the gods shines down upon you! You have ".
1341                    "found the level $ulevel Mattt's Omniscience Grand Crown! ".
1342                    "Your enemies fall before you as you anticipate their ".
1343                    "every move.",$rps{$u}{nick});
1344             $rps{$u}{item}{helm} = $ulevel."a";
1345             return;
1346         }
1347     }
1348     elsif ($rps{$u}{level} >= 25 && rand(40) < 1) {
1349         $ulevel = 50+int(rand(25));
1350         if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{ring})) {
1351             notice("The light of the gods shines down upon you! You have ".
1352                    "found the level $ulevel Juliet's Glorious Ring of ".
1353                    "Sparkliness! You enemies are blinded by both its glory ".
1354                    "and their greed as you bring desolation upon them.",
1355                    $rps{$u}{nick});
1356             $rps{$u}{item}{ring} = $ulevel."h";
1357             return;
1358         }
1359     }
1360     elsif ($rps{$u}{level} >= 30 && rand(40) < 1) {
1361         $ulevel = 75+int(rand(25));
1362         if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{tunic})) {
1363             notice("The light of the gods shines down upon you! You have ".
1364                    "found the level $ulevel Res0's Protectorate Plate Mail! ".
1365                    "Your enemies cower in fear as their attacks have no ".
1366                    "effect on you.",$rps{$u}{nick});
1367             $rps{$u}{item}{tunic} = $ulevel."b";
1368             return;
1369         }
1370     }
1371     elsif ($rps{$u}{level} >= 35 && rand(40) < 1) {
1372         $ulevel = 100+int(rand(25));
1373         if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{amulet})) {
1374             notice("The light of the gods shines down upon you! You have ".
1375                    "found the level $ulevel Dwyn's Storm Magic Amulet! Your ".
1376                    "enemies are swept away by an elemental fury before the ".
1377                    "war has even begun",$rps{$u}{nick});
1378             $rps{$u}{item}{amulet} = $ulevel."c";
1379             return;
1380         }
1381     }
1382     elsif ($rps{$u}{level} >= 40 && rand(40) < 1) {
1383         $ulevel = 150+int(rand(25));
1384         if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
1385             notice("The light of the gods shines down upon you! You have ".
1386                    "found the level $ulevel Jotun's Fury Colossal Sword! Your ".
1387                    "enemies' hatred is brought to a quick end as you arc your ".
1388                    "wrist, dealing the crushing blow.",$rps{$u}{nick});
1389             $rps{$u}{item}{weapon} = $ulevel."d";
1390             return;
1391         }
1392     }
1393     elsif ($rps{$u}{level} >= 45 && rand(40) < 1) {
1394         $ulevel = 175+int(rand(26));
1395         if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
1396             notice("The light of the gods shines down upon you! You have ".
1397                    "found the level $ulevel Drdink's Cane of Blind Rage! Your ".
1398                    "enemies are tossed aside as you blindly swing your arm ".
1399                    "around hitting stuff.",$rps{$u}{nick});
1400             $rps{$u}{item}{weapon} = $ulevel."e";
1401             return;
1402         }
1403     }
1404     elsif ($rps{$u}{level} >= 48 && rand(40) < 1) {
1405         $ulevel = 250+int(rand(51));
1406         if ($ulevel >= $level && $ulevel >
1407             int($rps{$u}{item}{"pair of boots"})) {
1408             notice("The light of the gods shines down upon you! You have ".
1409                    "found the level $ulevel Mrquick's Magical Boots of ".
1410                    "Swiftness! Your enemies are left choking on your dust as ".
1411                    "you run from them very, very quickly.",$rps{$u}{nick});
1412             $rps{$u}{item}{"pair of boots"} = $ulevel."f";
1413             return;
1414         }
1415     }
1416     elsif ($rps{$u}{level} >= 52 && rand(40) < 1) {
1417         $ulevel = 300+int(rand(51));
1418         if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
1419             notice("The light of the gods shines down upon you! You have ".
1420                    "found the level $ulevel Jeff's Cluehammer of Doom! Your ".
1421                    "enemies are left with a sudden and intense clarity of ".
1422                    "mind... even as you relieve them of it.",$rps{$u}{nick});
1423             $rps{$u}{item}{weapon} = $ulevel."g";
1424             return;
1425         }
1426     }
1427     if ($level > int($rps{$u}{item}{$type})) {
1428         notice("You found a level $level $type! Your current $type is only ".
1429                "level ".int($rps{$u}{item}{$type}).", so it seems Luck is ".
1430                "with you!",$rps{$u}{nick});
1431         $rps{$u}{item}{$type} = $level;
1432     }
1433     else {
1434         notice("You found a level $level $type. Your current $type is level ".
1435                int($rps{$u}{item}{$type}).", so it seems Luck is against you. ".
1436                "You toss the $type.",$rps{$u}{nick});
1437     }
1438 }
1439
1440 sub loaddb { # load the players database
1441     backup();
1442     my $l;
1443     %rps = ();
1444     if (!open(RPS,$opts{dbfile}) && -e $opts{dbfile}) {
1445         sts("QUIT :loaddb() failed: $!");
1446     }
1447     while ($l=<RPS>) {
1448         chomp($l);
1449         next if $l =~ /^#/; # skip comments
1450         next if $l =~ /^\s*$/; # skip empty lines
1451         my @i = split("\t",$l);
1452         print Dumper(@i) if @i != 32;
1453         if (@i != 32) {
1454             sts("QUIT: Anomaly in loaddb(); line $. of $opts{dbfile} has ".
1455                 "wrong fields (".scalar(@i).")");
1456             debug("Anomaly in loaddb(); line $. of $opts{dbfile} has wrong ".
1457                 "fields (".scalar(@i).")",1);
1458         }
1459         if (!$sock) { # if not RELOADDB
1460             if ($i[8]) { $prev_online{$i[7]}=$i[0]; } # log back in
1461         }
1462         ($rps{$i[0]}{pass},
1463         $rps{$i[0]}{isadmin},
1464         $rps{$i[0]}{level},
1465         $rps{$i[0]}{class},
1466         $rps{$i[0]}{next},
1467         $rps{$i[0]}{nick},
1468         $rps{$i[0]}{userhost},
1469         $rps{$i[0]}{online},
1470         $rps{$i[0]}{idled},
1471         $rps{$i[0]}{x},
1472         $rps{$i[0]}{y},
1473         $rps{$i[0]}{pen_mesg},
1474         $rps{$i[0]}{pen_nick},
1475         $rps{$i[0]}{pen_part},
1476         $rps{$i[0]}{pen_kick},
1477         $rps{$i[0]}{pen_quit},
1478         $rps{$i[0]}{pen_quest},
1479         $rps{$i[0]}{pen_logout},
1480         $rps{$i[0]}{created},
1481         $rps{$i[0]}{lastlogin},
1482         $rps{$i[0]}{item}{amulet},
1483         $rps{$i[0]}{item}{charm},
1484         $rps{$i[0]}{item}{helm},
1485         $rps{$i[0]}{item}{"pair of boots"},
1486         $rps{$i[0]}{item}{"pair of gloves"},
1487         $rps{$i[0]}{item}{ring},
1488         $rps{$i[0]}{item}{"set of leggings"},
1489         $rps{$i[0]}{item}{shield},
1490         $rps{$i[0]}{item}{tunic},
1491         $rps{$i[0]}{item}{weapon},
1492         $rps{$i[0]}{alignment}) = (@i[1..7],($sock?$i[8]:0),@i[9..$#i]);
1493     }
1494     close(RPS);
1495     debug("loaddb(): loaded ".scalar(keys(%rps))." accounts, ".
1496           scalar(keys(%prev_online))." previously online.");
1497 }
1498
1499 sub moveplayers {
1500     return unless $lasttime > 1;
1501     my $onlinecount = grep { $rps{$_}{online} } keys %rps;
1502     return unless $onlinecount;
1503     for (my $i=0;$i<$opts{self_clock};++$i) {
1504         # temporary hash to hold player positions, detect collisions
1505         my %positions = ();
1506         if ($quest{type} == 2 && @{$quest{questers}}) {
1507             my $allgo = 1; # have all users reached <p1|p2>?
1508             for (@{$quest{questers}}) {
1509                 if ($quest{stage}==1) {
1510                     if ($rps{$_}{x} != $quest{p1}->[0] ||
1511                         $rps{$_}{y} != $quest{p1}->[1]) {
1512                         $allgo=0;
1513                         last();
1514                     }
1515                 }
1516                 else {
1517                     if ($rps{$_}{x} != $quest{p2}->[0] ||
1518                         $rps{$_}{y} != $quest{p2}->[1]) {
1519                         $allgo=0;
1520                         last();
1521                     }
1522                 }
1523             }
1524             # all participants have reached point 1, now point 2
1525             if ($quest{stage}==1 && $allgo) {
1526                 $quest{stage}=2;
1527                 $allgo=0; # have not all reached p2 yet
1528             }
1529             elsif ($quest{stage} == 2 && $allgo) {
1530                 chanmsg(clog(join(", ",(@{$quest{questers}})[0..2]).", ".
1531                              "and $quest{questers}->[3] have completed their ".
1532                              "journey! 25% of their burden is eliminated."));
1533                 for (@{$quest{questers}}) {
1534                     $rps{$_}{next} = int($rps{$_}{next} * .75);
1535                 }
1536                 undef(@{$quest{questers}});
1537                 $quest{qtime} = time() + 21600; # next quest starts in 6 hours
1538                 $quest{type} = 1; # probably not needed
1539                 writequestfile();
1540             }
1541             else {
1542                 my(%temp,$player);
1543                 # load keys of %temp with online users
1544                 ++@temp{grep { $rps{$_}{online} } keys(%rps)};
1545                 # delete questers from list
1546                 delete(@temp{@{$quest{questers}}});
1547                 while ($player = each(%temp)) {
1548                     $rps{$player}{x} += int(rand(3))-1;
1549                     $rps{$player}{y} += int(rand(3))-1;
1550                     # if player goes over edge, wrap them back around
1551                     if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x}=0; }
1552                     if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y}=0; }
1553                     if ($rps{$player}{x} < 0) { $rps{$player}{x}=$opts{mapx}; }
1554                     if ($rps{$player}{y} < 0) { $rps{$player}{y}=$opts{mapy}; }
1555
1556                     if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
1557                         !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
1558                         if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
1559                             !$rps{$player}{isadmin} && rand(100) < 1) {
1560                             chanmsg("$player encounters ".
1561                                $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}.
1562                                     " and bows humbly.");
1563                         }
1564                         if (rand($onlinecount) < 1) {
1565                             $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
1566                             collision_fight($player,
1567                                 $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
1568                         }
1569                     }
1570                     else {
1571                         $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
1572                         $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
1573                     }
1574                 }
1575                 for (@{$quest{questers}}) {
1576                     if ($quest{stage} == 1) {
1577                         if (rand(100) < 1) {
1578                             if ($rps{$_}{x} != $quest{p1}->[0]) {
1579                                 $rps{$_}{x} += ($rps{$_}{x} < $quest{p1}->[0] ?
1580                                                 1 : -1);
1581                             }
1582                             if ($rps{$_}{y} != $quest{p1}->[1]) {
1583                                 $rps{$_}{y} += ($rps{$_}{y} < $quest{p1}->[1] ?
1584                                                 1 : -1);
1585                             }
1586                         }
1587                     }
1588                     elsif ($quest{stage}==2) {
1589                         if (rand(100) < 1) {
1590                             if ($rps{$_}{x} != $quest{p2}->[0]) {
1591                                 $rps{$_}{x} += ($rps{$_}{x} < $quest{p2}->[0] ?
1592                                                 1 : -1);
1593                             }
1594                             if ($rps{$_}{y} != $quest{p2}->[1]) {
1595                                 $rps{$_}{y} += ($rps{$_}{y} < $quest{p2}->[1] ?
1596                                                 1 : -1);
1597                             }
1598                         }
1599                     }
1600                 }
1601             }
1602         }
1603         else {
1604             for my $player (keys(%rps)) {
1605                 next unless $rps{$player}{online};
1606                 $rps{$player}{x} += int(rand(3))-1;
1607                 $rps{$player}{y} += int(rand(3))-1;
1608                 # if player goes over edge, wrap them back around
1609                 if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x} = 0; }
1610                 if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y} = 0; }
1611                 if ($rps{$player}{x} < 0) { $rps{$player}{x} = $opts{mapx}; }
1612                 if ($rps{$player}{y} < 0) { $rps{$player}{y} = $opts{mapy}; }
1613                 if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
1614                     !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
1615                     if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
1616                         !$rps{$player}{isadmin} && rand(100) < 1) {
1617                         chanmsg("$player encounters ".
1618                            $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}.
1619                                 " and bows humbly.");
1620                     }
1621                     if (rand($onlinecount) < 1) {
1622                         $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
1623                         collision_fight($player,
1624                             $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
1625                     }
1626                 }
1627                 else {
1628                     $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
1629                     $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
1630                 }
1631             }
1632         }
1633     }
1634 }
1635
1636 sub mksalt { # generate a random salt for passwds
1637     join '',('a'..'z','A'..'Z','0'..'9','/','.')[rand(64), rand(64)];
1638 }
1639
1640 sub chanmsg { # send a message to the channel
1641     my $msg = shift or return undef;
1642     if ($silentmode & 1) { return undef; }
1643     privmsg($msg, $opts{botchan}, shift);
1644 }
1645
1646 sub privmsg { # send a message to an arbitrary entity
1647     my $msg = shift or return undef;
1648     my $target = shift or return undef;
1649     my $force = shift;
1650     if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
1651         && !$force) {
1652         return undef;
1653     }
1654     while (length($msg)) {
1655         sts("PRIVMSG $target :".substr($msg,0,450),$force);
1656         substr($msg,0,450)="";
1657     }
1658 }
1659
1660 sub notice { # send a notice to an arbitrary entity
1661     my $msg = shift or return undef;
1662     my $target = shift or return undef;
1663     my $force = shift;
1664     if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
1665         && !$force) {
1666         return undef;
1667     }
1668     while (length($msg)) {
1669         sts("NOTICE $target :".substr($msg,0,450),$force);
1670         substr($msg,0,450)="";
1671     }
1672 }
1673
1674 sub help { # print help message
1675     (my $prog = $0) =~ s/^.*\///;
1676
1677     print "
1678 usage: $prog [OPTIONS]
1679   --help, -h           Print this message
1680   --verbose, -v        Print verbose messages
1681   --server, -s         Specify IRC server:port to connect to
1682   --botnick, -n        Bot's IRC nick
1683   --botuser, -u        Bot's username
1684   --botrlnm, -r        Bot's real name
1685   --botchan, -c        IRC channel to join
1686   --botident, -p       Specify identify-to-services command
1687   --botmodes, -m       Specify usermodes for the bot to set upon connect
1688   --botopcmd, -o       Specify command to send to server on successful connect
1689   --botghostcmd, -g    Specify command to send to server to regain primary
1690                        nickname when in use
1691   --doban              Advertisement ban on/off flag
1692   --okurl, -k          Bot will not ban for web addresses that contain these
1693                        strings
1694   --debug              Debug on/off flag
1695   --helpurl            URL to refer new users to
1696   --admincommurl       URL to refer admins to
1697
1698   Timing parameters:
1699   --rpbase             Base time to level up
1700   --rpstep             Time to next level = rpbase * (rpstep ** CURRENT_LEVEL)
1701   --rppenstep          PENALTY_SECS=(PENALTY*(RPPENSTEP**CURRENT_LEVEL))
1702
1703 ";
1704 }
1705
1706 sub itemsum {
1707     my $user = shift;
1708     # is this for a battle? if so, good users get a 10% boost and evil users get
1709     # a 10% detriment
1710     my $battle = shift;
1711     return -1 unless defined $user;
1712     my $sum = 0;
1713     if ($user eq $primnick) {
1714         for my $u (keys(%rps)) {
1715             $sum = itemsum($u) if $sum < itemsum($u);
1716         }
1717         return $sum+1;
1718     }
1719     if (!exists($rps{$user})) { return -1; }
1720     $sum += int($rps{$user}{item}{$_}) for keys(%{$rps{$user}{item}});
1721     if ($battle) {
1722         return $rps{$user}{alignment} eq 'e' ? int($sum*.9) :
1723                $rps{$user}{alignment} eq 'g' ? int($sum*1.1) :
1724                $sum;
1725     }
1726     return $sum;
1727 }
1728
1729 sub daemonize() {
1730     # win32 doesn't daemonize (this way?)
1731     if ($^O eq "MSWin32") {
1732         print debug("Nevermind, this is Win32, no I'm not.")."\n";
1733         return;
1734     }
1735     use POSIX 'setsid';
1736     $SIG{CHLD} = sub { };
1737     fork() && exit(0); # kill parent
1738     POSIX::setsid() || debug("POSIX::setsid() failed: $!",1);
1739     $SIG{CHLD} = sub { };
1740     fork() && exit(0); # kill the parent as the process group leader
1741     $SIG{CHLD} = sub { };
1742     open(STDIN,'/dev/null') || debug("Cannot read /dev/null: $!",1);
1743     open(STDOUT,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
1744     open(STDERR,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
1745     # write our PID to $opts{pidfile}, or return semi-silently on failure
1746     open(PIDFILE,">$opts{pidfile}") || do {
1747         debug("Error: failed opening pid file: $!");
1748         return;
1749     };
1750     print PIDFILE $$;
1751     close(PIDFILE);
1752 }
1753
1754 sub calamity { # suffer a little one
1755     my @players = grep { $rps{$_}{online} } keys(%rps);
1756     return unless @players;
1757     my $player = $players[rand(@players)];
1758     if (rand(10) < 1) {
1759         my @items = ("amulet","charm","weapon","tunic","set of leggings",
1760                      "shield");
1761         my $type = $items[rand(@items)];
1762         if ($type eq "amulet") {
1763             chanmsg(clog("$player fell, chipping the stone in his amulet! ".
1764                          "$player\'s $type loses 10% of its effectiveness."));
1765         }
1766         elsif ($type eq "charm") {
1767             chanmsg(clog("$player slipped and dropped his charm in a dirty ".
1768                          "bog! $player\'s $type loses 10% of its ".
1769                          "effectiveness."));
1770         }
1771         elsif ($type eq "weapon") {
1772             chanmsg(clog("$player left his weapon out in the rain to rust! ".
1773                          "$player\'s $type loses 10% of its effectiveness."));
1774         }
1775         elsif ($type eq "tunic") {
1776             chanmsg(clog("$player spilled a level 7 shrinking potion on his ".
1777                          "tunic! $player\'s $type loses 10% of its ".
1778                          "effectiveness."));
1779         }
1780         elsif ($type eq "shield") {
1781             chanmsg(clog("$player\'s shield was damaged by a dragon's fiery ".
1782                          "breath! $player\'s $type loses 10% of its ".
1783                          "effectiveness."));
1784         }
1785         else {
1786             chanmsg(clog("$player burned a hole through his leggings while ".
1787                          "ironing them! $player\'s $type loses 10% of its ".
1788                          "effectiveness."));
1789         }
1790         my $suffix="";
1791         if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
1792         $rps{$player}{item}{$type} = int(int($rps{$player}{item}{$type}) * .9);
1793         $rps{$player}{item}{$type}.=$suffix;
1794     }
1795     else {
1796         my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
1797         if (!open(Q,$opts{eventsfile})) {
1798             return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1799         }
1800         my($i,$actioned);
1801         while (my $line = <Q>) {
1802             chomp($line);
1803             if ($line =~ /^C (.*)/ && rand(++$i) < 1) { $actioned = $1; }
1804         }
1805         chanmsg(clog("$player $actioned. This terrible calamity has slowed ".
1806                      "them ".duration($time)." from level ".
1807                      ($rps{$player}{level}+1)."."));
1808         $rps{$player}{next} += $time;
1809         chanmsg("$player reaches next level in ".duration($rps{$player}{next}).
1810                 ".");
1811     }
1812 }
1813
1814 sub godsend { # bless the unworthy
1815     my @players = grep { $rps{$_}{online} } keys(%rps);
1816     return unless @players;
1817     my $player = $players[rand(@players)];
1818     if (rand(10) < 1) {
1819         my @items = ("amulet","charm","weapon","tunic","set of leggings",
1820                      "shield");
1821         my $type = $items[rand(@items)];
1822         if ($type eq "amulet") {
1823             chanmsg(clog("$player\'s amulet was blessed by a passing cleric! ".
1824                          "$player\'s $type gains 10% effectiveness."));
1825         }
1826         elsif ($type eq "charm") {
1827             chanmsg(clog("$player\'s charm ate a bolt of lightning! ".
1828                          "$player\'s $type gains 10% effectiveness."));
1829         }
1830         elsif ($type eq "weapon") {
1831             chanmsg(clog("$player sharpened the edge of his weapon! ".
1832                          "$player\'s $type gains 10% effectiveness."));
1833         }
1834         elsif ($type eq "tunic") {
1835             chanmsg(clog("A magician cast a spell of Rigidity on $player\'s ".
1836                          "tunic! $player\'s $type gains 10% effectiveness."));
1837         }
1838         elsif ($type eq "shield") {
1839             chanmsg(clog("$player reinforced his shield with a dragon's ".
1840                          "scales! $player\'s $type gains 10% effectiveness."));
1841         }
1842         else {
1843             chanmsg(clog("The local wizard imbued $player\'s pants with a ".
1844                          "Spirit of Fortitude! $player\'s $type gains 10% ".
1845                          "effectiveness."));
1846         }
1847         my $suffix="";
1848         if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
1849         $rps{$player}{item}{$type} = int(int($rps{$player}{item}{$type}) * 1.1);
1850         $rps{$player}{item}{$type}.=$suffix;
1851     }
1852     else {
1853         my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
1854         my $actioned;
1855         if (!open(Q,$opts{eventsfile})) {
1856             return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1857         }
1858         my $i;
1859         while (my $line = <Q>) {
1860             chomp($line);
1861             if ($line =~ /^G (.*)/ && rand(++$i) < 1) {
1862                 $actioned = $1;
1863             }
1864         }
1865         chanmsg(clog("$player $actioned! This wondrous godsend has ".
1866                      "accelerated them ".duration($time)." towards level ".
1867                      ($rps{$player}{level}+1)."."));
1868         $rps{$player}{next} -= $time;
1869         chanmsg("$player reaches next level in ".duration($rps{$player}{next}).
1870                 ".");
1871     }
1872 }
1873
1874 sub quest {
1875     @{$quest{questers}} = grep { $rps{$_}{online} && $rps{$_}{level} > 39 &&
1876                                  time()-$rps{$_}{lastlogin}>36000 } keys(%rps);
1877     if (@{$quest{questers}} < 4) { return undef(@{$quest{questers}}); }
1878     while (@{$quest{questers}} > 4) {
1879         splice(@{$quest{questers}},int(rand(@{$quest{questers}})),1);
1880     }
1881     if (!open(Q,$opts{eventsfile})) {
1882         return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1883     }
1884     my $i;
1885     while (my $line = <Q>) {
1886         chomp($line);
1887         if ($line =~ /^Q/ && rand(++$i) < 1) {
1888             if ($line =~ /^Q1 (.*)/) {
1889                 $quest{text} = $1;
1890                 $quest{type} = 1;
1891                 $quest{qtime} = time() + 43200 + int(rand(43201)); # 12-24 hours
1892             }
1893             elsif ($line =~ /^Q2 (\d+) (\d+) (\d+) (\d+) (.*)/) {
1894                 $quest{p1} = [$1,$2];
1895                 $quest{p2} = [$3,$4];
1896                 $quest{text} = $5;
1897                 $quest{type} = 2;
1898                 $quest{stage} = 1;
1899             }
1900         }
1901     }
1902     close(Q);
1903     if ($quest{type} == 1) {
1904         chanmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
1905                 "$quest{questers}->[3] have been chosen by the gods to ".
1906                 "$quest{text}. Quest to end in ".duration($quest{qtime}-time()).
1907                 ".");
1908     }
1909     elsif ($quest{type} == 2) {
1910         chanmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
1911                 "$quest{questers}->[3] have been chosen by the gods to ".
1912                 "$quest{text}. Participants must first reach [$quest{p1}->[0],".
1913                 "$quest{p1}->[1]], then [$quest{p2}->[0],$quest{p2}->[1]].".
1914                 ($opts{mapurl}?" See $opts{mapurl} to monitor their journey's ".
1915                 "progress.":""));
1916     }
1917     writequestfile();
1918 }
1919
1920 sub questpencheck {
1921     my $k = shift;
1922     my ($quester,$player);
1923     for $quester (@{$quest{questers}}) {
1924         if ($quester eq $k) {
1925             chanmsg(clog("$k\'s prudence and self-regard has brought the ".
1926                          "wrath of the gods upon the realm. All your great ".
1927                          "wickedness makes you as it were heavy with lead, ".
1928                          "and to tend downwards with great weight and ".
1929                          "pressure towards hell. Therefore have you drawn ".
1930                          "yourselves 15 steps closer to that gaping maw."));
1931             for $player (grep { $rps{$_}{online} } keys %rps) {
1932                 my $gain = int(15 * ($opts{rppenstep}**$rps{$player}{level}));
1933                 $rps{$player}{pen_quest} += $gain;
1934                 $rps{$player}{next} += $gain;
1935             }
1936             undef(@{$quest{questers}});
1937             $quest{qtime} = time() + 43200; # 12 hours
1938         }
1939     }
1940 }
1941
1942 sub clog {
1943     my $mesg = shift;
1944     open(B,">>$opts{modsfile}") or do {
1945         debug("Error: Cannot open $opts{modsfile}: $!");
1946         chanmsg("Error: Cannot open $opts{modsfile}: $!");
1947         return $mesg;
1948     };
1949     print B ts()."$mesg\n";
1950     close(B);
1951     return $mesg;
1952 }
1953
1954 sub backup() {
1955     if (! -d ".dbbackup/") { mkdir(".dbbackup",0700); }
1956     if ($^O ne "MSWin32") {
1957         system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time());
1958     }
1959     else {
1960         system("copy $opts{dbfile} .dbbackup\\$opts{dbfile}".time());
1961     }
1962 }
1963
1964 sub penalize {
1965     my $username = shift;
1966     return 0 if !defined($username);
1967     return 0 if !exists($rps{$username});
1968     my $type = shift;
1969     my $pen = 0;
1970     questpencheck($username);
1971     if ($type eq "quit") {
1972         $pen = int(20 * ($opts{rppenstep}**$rps{$username}{level}));
1973         if ($opts{limitpen} && $pen > $opts{limitpen}) {
1974             $pen = $opts{limitpen};
1975         }
1976         $rps{$username}{pen_quit}+=$pen;
1977         $rps{$username}{online}=0;
1978     }
1979     elsif ($type eq "nick") {
1980         my $newnick = shift;
1981         $pen = int(30 * ($opts{rppenstep}**$rps{$username}{level}));
1982         if ($opts{limitpen} && $pen > $opts{limitpen}) {
1983             $pen = $opts{limitpen};
1984         }
1985         $rps{$username}{pen_nick}+=$pen;
1986         $rps{$username}{nick} = substr($newnick,1);
1987         substr($rps{$username}{userhost},0,length($rps{$username}{nick})) =
1988             substr($newnick,1);
1989         notice("Penalty of ".duration($pen)." added to your timer for ".
1990                "nick change.",$rps{$username}{nick});
1991     }
1992     elsif ($type eq "privmsg" || $type eq "notice") {
1993         $pen = int(shift(@_) * ($opts{rppenstep}**$rps{$username}{level}));
1994         if ($opts{limitpen} && $pen > $opts{limitpen}) {
1995             $pen = $opts{limitpen};
1996         }
1997         $rps{$username}{pen_mesg}+=$pen;
1998         notice("Penalty of ".duration($pen)." added to your timer for ".
1999                $type.".",$rps{$username}{nick});
2000     }
2001     elsif ($type eq "part") {
2002         $pen = int(200 * ($opts{rppenstep}**$rps{$username}{level}));
2003         if ($opts{limitpen} && $pen > $opts{limitpen}) {
2004             $pen = $opts{limitpen};
2005         }
2006         $rps{$username}{pen_part}+=$pen;
2007         notice("Penalty of ".duration($pen)." added to your timer for ".
2008                "parting.",$rps{$username}{nick});
2009         $rps{$username}{online}=0;
2010     }
2011     elsif ($type eq "kick") {
2012         $pen = int(250 * ($opts{rppenstep}**$rps{$username}{level}));
2013         if ($opts{limitpen} && $pen > $opts{limitpen}) {
2014             $pen = $opts{limitpen};
2015         }
2016         $rps{$username}{pen_kick}+=$pen;
2017         notice("Penalty of ".duration($pen)." added to your timer for ".
2018                "being kicked.",$rps{$username}{nick});
2019         $rps{$username}{online}=0;
2020     }
2021     elsif ($type eq "logout") {
2022         $pen = int(20 * ($opts{rppenstep}**$rps{$username}{level}));
2023         if ($opts{limitpen} && $pen > $opts{limitpen}) {
2024             $pen = $opts{limitpen};
2025         }
2026         $rps{$username}{pen_logout} += $pen;
2027         notice("Penalty of ".duration($pen)." added to your timer for ".
2028                "LOGOUT command.",$rps{$username}{nick});
2029         $rps{$username}{online}=0;
2030     }
2031     $rps{$username}{next} += $pen;
2032     return 1; # successfully penalized a user! woohoo!
2033 }
2034
2035 sub debug {
2036     (my $text = shift) =~ s/[\r\n]//g;
2037     my $die = shift;
2038     if ($opts{debug} || $opts{verbose}) {
2039         open(DBG,">>$opts{debugfile}") or do {
2040             chanmsg("Error: Cannot open debug file: $!");
2041             return;
2042         };
2043         print DBG ts()."$text\n";
2044         close(DBG);
2045     }
2046     if ($die) { die("$text\n"); }
2047     return $text;
2048 }
2049
2050 sub finduser {
2051     my $nick = shift;
2052     return undef if !defined($nick);
2053     for my $user (keys(%rps)) {
2054         next unless $rps{$user}{online};
2055         if ($rps{$user}{nick} eq $nick) { return $user; }
2056     }
2057     return undef;
2058 }
2059
2060 sub ha { # return 0/1 if username has access
2061     my $user = shift;
2062     if (!defined($user) || !exists($rps{$user})) {
2063         debug("Error: Attempted ha() for invalid username \"$user\"");
2064         return 0;
2065     }
2066     return $rps{$user}{isadmin};
2067 }
2068
2069 sub checksplits { # removed expired split hosts from the hash
2070     my $host;
2071     while ($host = each(%split)) {
2072         if (time()-$split{$host}{time} > $opts{splitwait}) {
2073             $rps{$split{$host}{account}}{online} = 0;
2074             delete($split{$host});
2075         }
2076     }
2077 }
2078
2079 sub collision_fight {
2080     my($u,$opp) = @_;
2081     my $mysum = itemsum($u,1);
2082     my $oppsum = itemsum($opp,1);
2083     my $myroll = int(rand($mysum));
2084     my $opproll = int(rand($oppsum));
2085     if ($myroll >= $opproll) {
2086         my $gain = int($rps{$opp}{level}/4);
2087         $gain = 7 if $gain < 7;
2088         $gain = int(($gain/100)*$rps{$u}{next});
2089         chanmsg(clog("$u [$myroll/$mysum] has come upon $opp [$opproll/$oppsum".
2090                      "] and taken them in combat! ".duration($gain)." is ".
2091                      "removed from $u\'s clock."));
2092         $rps{$u}{next} -= $gain;
2093         chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
2094         if (rand(35) < 1 && $opp ne $primnick) {
2095             $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
2096             chanmsg(clog("$u has dealt $opp a Critical Strike! ".
2097                          duration($gain)." is added to $opp\'s clock."));
2098             $rps{$opp}{next} += $gain;
2099             chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).
2100                     ".");
2101         }
2102         elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
2103             my @items = ("ring","amulet","charm","weapon","helm","tunic",
2104                          "pair of gloves","set of leggings","shield",
2105                          "pair of boots");
2106             my $type = $items[rand(@items)];
2107             if (int($rps{$opp}{item}{$type}) > int($rps{$u}{item}{$type})) {
2108                 chanmsg("In the fierce battle, $opp dropped his level ".
2109                         int($rps{$opp}{item}{$type})." $type! $u picks it up, ".
2110                         "tossing his old level ".int($rps{$u}{item}{$type}).
2111                         " $type to $opp.");
2112                 my $tempitem = $rps{$u}{item}{$type};
2113                 $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
2114                 $rps{$opp}{item}{$type} = $tempitem;
2115             }
2116         }
2117     }
2118     else {
2119         my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
2120         $gain = 7 if $gain < 7;
2121         $gain = int(($gain/100)*$rps{$u}{next});
2122         chanmsg(clog("$u [$myroll/$mysum] has come upon $opp [$opproll/$oppsum".
2123                      "] and been defeated in combat! ".duration($gain)." is ".
2124                      "added to $u\'s clock."));
2125         $rps{$u}{next} += $gain;
2126         chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
2127         #interrogation
2128         debug("interrogation");
2129         my $csfactor = $rps{$opp}{alignment} eq "g" ? 50 :
2130                        $rps{$opp}{alignment} eq "e" ? 20 :
2131                        35;
2132         if (rand($csfactor) < 1) {
2133             $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
2134             chanmsg(clog("$opp has captured and interrogated $u! ".
2135                          duration($gain)." is removed from $opp\'s clock."));
2136             $rps{$opp}{next} -= $gain;
2137             chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).".");
2138         }
2139     }
2140 }
2141
2142 sub writequestfile {
2143     return unless $opts{writequestfile};
2144     open(QF,">$opts{questfilename}") or do {
2145         chanmsg("Error: Cannot open $opts{questfilename}: $!");
2146         return;
2147     };
2148     # if no active quest, just empty questfile. otherwise, write it
2149     if (@{$quest{questers}}) {
2150         if ($quest{type}==1) {
2151             print QF "T $quest{text}\n".
2152                      "Y 1\n".
2153                      "S $quest{qtime}\n".
2154                      "P1 $quest{questers}->[0]\n".
2155                      "P2 $quest{questers}->[1]\n".
2156                      "P3 $quest{questers}->[2]\n".
2157                      "P4 $quest{questers}->[3]\n";
2158         }
2159         elsif ($quest{type}==2) {
2160             print QF "T $quest{text}\n".
2161                      "Y 2\n".
2162                      "S $quest{stage}\n".
2163                      "P $quest{p1}->[0] $quest{p1}->[1] $quest{p2}->[0] ".
2164                         "$quest{p2}->[1]\n".
2165                      "P1 $quest{questers}->[0] $rps{$quest{questers}->[0]}{x} ".
2166                          "$rps{$quest{questers}->[0]}{y}\n".
2167                      "P2 $quest{questers}->[1] $rps{$quest{questers}->[1]}{x} ".
2168                          "$rps{$quest{questers}->[1]}{y}\n".
2169                      "P3 $quest{questers}->[2] $rps{$quest{questers}->[2]}{x} ".
2170                          "$rps{$quest{questers}->[2]}{y}\n".
2171                      "P4 $quest{questers}->[3] $rps{$quest{questers}->[3]}{x} ".
2172                          "$rps{$quest{questers}->[3]}{y}\n";
2173         }
2174     }
2175     close(QF);
2176 }
2177
2178 sub goodness {
2179     my @players = grep { $rps{$_}{alignment} eq "g" &&
2180                          $rps{$_}{online} } keys(%rps);
2181     return unless @players > 1;
2182     splice(@players,int(rand(@players)),1) while @players > 2;
2183     my $gain = 5 + int(rand(8));
2184     chanmsg(clog("$players[0] and $players[1] have not let the iniquities of ".
2185                  "evil men poison them. Together have they prayed to their ".
2186                  "god, and it is his light that now shines upon them. $gain\% ".
2187                  "of their time is removed from their clocks."));
2188     $rps{$players[0]}{next} = int($rps{$players[0]}{next}*(1 - ($gain/100)));
2189     $rps{$players[1]}{next} = int($rps{$players[1]}{next}*(1 - ($gain/100)));
2190     chanmsg("$players[0] reaches next level in ".
2191             duration($rps{$players[0]}{next}).".");
2192     chanmsg("$players[1] reaches next level in ".
2193             duration($rps{$players[1]}{next}).".");
2194 }
2195
2196 sub evilness {
2197     my @evil = grep { $rps{$_}{alignment} eq "e" &&
2198                       $rps{$_}{online} } keys(%rps);
2199     return unless @evil;
2200     my $me = $evil[rand(@evil)];
2201     if (int(rand(2)) < 1) {
2202         # evil only steals from good :^(
2203         my @good = grep { $rps{$_}{alignment} eq "g" &&
2204                           $rps{$_}{online} } keys(%rps);
2205         my $target = $good[rand(@good)];
2206         my @items = ("ring","amulet","charm","weapon","helm","tunic",
2207                      "pair of gloves","set of leggings","shield",
2208                      "pair of boots");
2209         my $type = $items[rand(@items)];
2210         if (int($rps{$target}{item}{$type}) > int($rps{$me}{item}{$type})) {
2211             my $tempitem = $rps{$me}{item}{$type};
2212             $rps{$me}{item}{$type} = $rps{$target}{item}{$type};
2213             $rps{$target}{item}{$type} = $tempitem;
2214             chanmsg(clog("$me stole $target\'s level ".
2215                          int($rps{$me}{item}{$type})." $type while they were ".
2216                          "sleeping! $me leaves his old level ".
2217                          int($rps{$target}{item}{$type})." $type behind, ".
2218                          "which $target then takes."));
2219         }
2220         else {
2221             notice("You made to steal $target\'s $type, but realized it was ".
2222                    "lower level than your own. You creep back into the ".
2223                    "shadows.",$rps{$me}{nick});
2224         }
2225     }
2226     else { # being evil only pays about half of the time...
2227         my $gain = 1 + int(rand(5));
2228         chanmsg(clog("$me is forsaken by his evil god. ".
2229                      duration(int($rps{$me}{next} * ($gain/100)))." is added ".
2230                      "to his clock."));
2231         $rps{$me}{next} = int($rps{$me}{next} * (1 + ($gain/100)));
2232         chanmsg("$me reaches next level in ".duration($rps{$me}{next}).".");
2233     }
2234 }
2235
2236 sub fisher_yates_shuffle {
2237     my $array = shift;
2238     my $i;
2239     for ($i = @$array; --$i; ) {
2240         my $j = int rand ($i+1);
2241         next if $i == $j;
2242         @$array[$i,$j] = @$array[$j,$i];
2243     }
2244 }
2245
2246 sub writedb {
2247     open(RPS,">$opts{dbfile}") or do {
2248         chanmsg("ERROR: Cannot write $opts{dbfile}: $!");
2249         return 0;
2250     };
2251     print RPS join("\t","# username",
2252                         "pass",
2253                         "is admin",
2254                         "level",
2255                         "class",
2256                         "next ttl",
2257                         "nick",
2258                         "userhost",
2259                         "online",
2260                         "idled",
2261                         "x pos",
2262                         "y pos",
2263                         "pen_mesg",
2264                         "pen_nick",
2265                         "pen_part",
2266                         "pen_kick",
2267                         "pen_quit",
2268                         "pen_quest",
2269                         "pen_logout",
2270                         "created",
2271                         "last login",
2272                         "amulet",
2273                         "charm",
2274                         "helm",
2275                         "boots",
2276                         "gloves",
2277                         "ring",
2278                         "leggings",
2279                         "shield",
2280                         "tunic",
2281                         "weapon",
2282                         "alignment")."\n";
2283     my $k;
2284     keys(%rps); # reset internal pointer
2285     while ($k=each(%rps)) {
2286         if (exists($rps{$k}{next}) && defined($rps{$k}{next})) {
2287             print RPS join("\t",$k,
2288                                 $rps{$k}{pass},
2289                                 $rps{$k}{isadmin},
2290                                 $rps{$k}{level},
2291                                 $rps{$k}{class},
2292                                 $rps{$k}{next},
2293                                 $rps{$k}{nick},
2294                                 $rps{$k}{userhost},
2295                                 $rps{$k}{online},
2296                                 $rps{$k}{idled},
2297                                 $rps{$k}{x},
2298                                 $rps{$k}{y},
2299                                 $rps{$k}{pen_mesg},
2300                                 $rps{$k}{pen_nick},
2301                                 $rps{$k}{pen_part},
2302                                 $rps{$k}{pen_kick},
2303                                 $rps{$k}{pen_quit},
2304                                 $rps{$k}{pen_quest},
2305                                 $rps{$k}{pen_logout},
2306                                 $rps{$k}{created},
2307                                 $rps{$k}{lastlogin},
2308                                 $rps{$k}{item}{amulet},
2309                                 $rps{$k}{item}{charm},
2310                                 $rps{$k}{item}{helm},
2311                                 $rps{$k}{item}{"pair of boots"},
2312                                 $rps{$k}{item}{"pair of gloves"},
2313                                 $rps{$k}{item}{ring},
2314                                 $rps{$k}{item}{"set of leggings"},
2315                                 $rps{$k}{item}{shield},
2316                                 $rps{$k}{item}{tunic},
2317                                 $rps{$k}{item}{weapon},
2318                                 $rps{$k}{alignment})."\n";
2319         }
2320     }
2321     close(RPS);
2322 }
2323
2324 sub readconfig {
2325     if (! -e ".irpg.conf") {
2326         debug("Error: Cannot find .irpg.conf. Copy it to this directory, ".
2327               "please.",1);
2328     }
2329     else {
2330         open(CONF,"<.irpg.conf") or do {
2331             debug("Failed to open config file .irpg.conf: $!",1);
2332         };
2333         my($line,$key,$val);
2334         while ($line=<CONF>) {
2335             next() if $line =~ /^#/; # skip comments
2336             $line =~ s/[\r\n]//g;
2337             $line =~ s/^\s+//g;
2338             next() if !length($line); # skip blank lines
2339             ($key,$val) = split(/\s+/,$line,2);
2340             $key = lc($key);
2341             if (lc($val) eq "on" || lc($val) eq "yes") { $val = 1; }
2342             elsif (lc($val) eq "off" || lc($val) eq "no") { $val = 0; }
2343             if ($key eq "die") {
2344                 die("Please edit the file .irpg.conf to setup your bot's ".
2345                     "options. Also, read the README file if you haven't ".
2346                     "yet.\n");
2347             }
2348             elsif ($key eq "server") { push(@{$opts{servers}},$val); }
2349             elsif ($key eq "okurl") { push(@{$opts{okurl}},$val); }
2350             else { $opts{$key} = $val; }
2351         }
2352     }
2353 }