bot.v3.1.2.pl

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