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