bot.pl

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