bot.pl

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