2 # irpg bot v3.1.3 by someone, someone@somenet.org, et al. See http://idlerpg.somenet.org/
3 # irpg bot v3.1.2 by jotun, jotun@idlerpg.net, et al. See http://idlerpg.net/
5 # Some code within this file was written by authors other than myself. As such,
6 # distributing this code or distributing modified versions of this code is
7 # strictly prohibited without written authorization from the authors. Contact
8 # jotun@idlerpg.net. Please note that this may change (at any time, no less) if
9 # authorization for distribution is given by patch submitters.
11 # As a side note, patches submitted for this project are automatically taken to
12 # be freely distributable and modifiable for any use, public or private, though
13 # I make no claim to ownership; original copyrights will be retained.. except as
16 # Please mail bugs, etc. to me. Patches are welcome to fix bugs or clean up
17 # the code, but please do not use a radically different coding style. Thanks
18 # to everyone that's contributed!
20 # NOTE: This code should NOT be run as root. You deserve anything that happens
21 # to you if you run this code as a superuser. Also, note that giving a
22 # user admin access to the bot effectively gives them full access to the
23 # user under which your bot runs, as they can use the PEVAL command to
24 # execute any command, or possibly even change your password. I sincerely
25 # suggest that you exercise extreme caution when giving someone admin
26 # access to your bot, or that you disable the PEVAL command for non-owner
27 # accounts in your config file, .irpg.conf
40 my $version = "3.1.3";
42 # command line overrides .irpg.conf
95 "dbfile|irpgdb|db|d=s",
96 ) or debug("Error: Could not parse command line. Try $0 --help\n",1);
98 $opts{help} and do { help(); exit 0; };
100 debug("Config: read $_: ".Dumper($opts{$_})) for keys(%opts);
102 my $outbytes = 0; # sent bytes
103 my $primnick = $opts{botnick}; # for regain or register checks
104 my $inbytes = 0; # received bytes
105 my %onchan; # users on game channel
106 my %rps; # role-players
109 p1 => [], # point 1 for q2
110 p2 => [], # point 2 for q2
111 qtime => time() + int(rand(21600)), # first quest starts in <=6 hours
114 stage => 1); # quest info
116 my $rpreport = 0; # constant for reporting top players
117 my %prev_online; # user@hosts online on restart, die
118 my %auto_login; # users to automatically log back on
119 my @bans; # bans auto-set by the bot, saved to be removed after 1 hour
120 my $pausemode = 0; # pausemode on/off flag
121 my $silentmode = 0; # silent mode 0/1/2/3, see head of file
122 my @queue; # outgoing message queue
123 my $lastreg = 0; # holds the time of the last reg. cleared every second.
124 # prevents more than one account being registered / second
125 my $registrations = 0; # count of registrations this period
126 my $sel; # IO::Select object
127 my $lasttime = 1; # last time that rpcheck() was run
128 my $buffer; # buffer for socket stuff
129 my $conn_tries = 0; # number of connection tries. gives up after trying each
131 my $sock; # IO::Socket::INET object
132 my %split; # holds nick!user@hosts for clients that have been netsplit
133 my $freemessages = 4; # number of "free" privmsgs we can send. 0..$freemessages
135 sub daemonize(); # prototype to avoid warnings
137 if (! -e $opts{dbfile}) {
140 print "$opts{dbfile} does not appear to exist. I'm guessing this is your ".
141 "first time using IRPG. Please give an account name that you would ".
142 "like to have admin access [$opts{owner}]: ";
143 chomp(my $uname = <STDIN>);
145 $uname = length($uname)?$uname:$opts{owner};
146 print "Enter a character class for this account: ";
147 chomp(my $uclass = <STDIN>);
148 $rps{$uname}{class} = substr($uclass,0,30);
149 print "Enter a password for this account: ";
150 if ($^O ne "MSWin32") {
151 system("stty -echo");
153 chomp(my $upass = <STDIN>);
154 if ($^O ne "MSWin32") {
157 $rps{$uname}{pass} = crypt($upass,mksalt());
158 $rps{$uname}{next} = $opts{rpbase};
159 $rps{$uname}{nick} = "";
160 $rps{$uname}{userhost} = "";
161 $rps{$uname}{level} = 0;
162 $rps{$uname}{online} = 0;
163 $rps{$uname}{idled} = 0;
164 $rps{$uname}{created} = time();
165 $rps{$uname}{lastlogin} = time();
166 $rps{$uname}{x} = int(rand($opts{mapx}));
167 $rps{$uname}{y} = int(rand($opts{mapy}));
168 $rps{$uname}{alignment}="n";
169 $rps{$uname}{isadmin} = 1;
170 for my $item ("ring","amulet","charm","weapon","helm",
171 "tunic","pair of gloves","shield",
172 "set of leggings","pair of boots") {
173 $rps{$uname}{item}{$item} = 0;
175 for my $pen ("pen_mesg","pen_nick","pen_part",
176 "pen_kick","pen_quit","pen_quest",
177 "pen_logout","pen_logout") {
178 $rps{$uname}{$pen} = 0;
181 print "OK, wrote you into $opts{dbfile}.\n";
186 $SIG{HUP} = "readconfig"; # sighup = reread config file
192 while (!$sock && $conn_tries < 2*@{$opts{servers}}) {
193 debug("Connecting to $opts{servers}->[0]...");
194 my %sockinfo = (PeerAddr => $opts{servers}->[0],
196 if ($opts{localaddr}) { $sockinfo{LocalAddr} = $opts{localaddr}; }
197 $sock = IO::Socket::INET->new(%sockinfo) or
198 debug("Error: failed to connect: $!\n");
201 # cycle front server to back if connection failed
202 push(@{$opts{servers}},shift(@{$opts{servers}}));
204 else { debug("Connected."); }
208 debug("Error: Too many connection failures, exhausted server list.\n",1);
213 $sel = IO::Select->new($sock);
215 sts("NICK $opts{botnick}");
216 sts("USER $opts{botuser} 0 0 :$opts{botrlnm}");
219 my($readable) = IO::Select->select($sel,undef,undef,0.5);
220 if (defined($readable)) {
221 my $fh = $readable->[0];
223 $fh->recv($buffer2,512,0);
224 if (length($buffer2)) {
226 while (index($buffer,"\n") != -1) {
227 my $line = substr($buffer,0,index($buffer,"\n")+1);
228 $buffer = substr($buffer,length($line));
233 # uh oh, we've been disconnected from the server, possibly before
234 # we've logged in the users in %auto_login. so, we'll set those
235 # users' online flags to 1, rewrite db, and attempt to reconnect
236 # (if that's wanted of us)
237 $rps{$_}{online}=1 for keys(%auto_login);
243 if ($opts{reconnect}) {
246 debug("Socket closed; disconnected. Cleared outgoing message ".
247 "queue. Waiting $opts{reconnect_wait}s before next ".
248 "connection attempt...");
249 sleep($opts{reconnect_wait});
252 else { debug("Socket closed; disconnected.",1); }
255 else { select(undef,undef,undef,1); }
256 if ((time()-$lasttime) >= $opts{self_clock}) { rpcheck(); }
262 $inbytes += length($in); # increase parsed byte count
263 $in =~ s/[\r\n]//g; # strip all \r and \n
265 my @arg = split(/\s/,$in); # split into "words"
266 my $usernick = substr((split(/!/,$arg[0]))[0],1);
267 # logged in char name of nickname, or undef if nickname is not online
268 my $username = finduser($usernick);
269 if (lc($arg[0]) eq 'ping') { sts("PONG $arg[1]",1); }
270 elsif (lc($arg[0]) eq 'error') {
271 # uh oh, we've been disconnected from the server, possibly before we've
272 # logged in the users in %auto_login. so, we'll set those users' online
273 # flags to 1, rewrite db, and attempt to reconnect (if that's wanted of
275 $rps{$_}{online}=1 for keys(%auto_login);
279 $arg[1] = lc($arg[1]); # original case no longer matters
280 if ($arg[1] eq '433' && $opts{botnick} eq $arg[3]) {
282 sts("NICK $opts{botnick}");
284 elsif ($arg[1] eq 'join') {
285 # %onchan holds time user joined channel. used for the advertisement ban
286 $onchan{$usernick}=time();
287 if ($opts{'detectsplits'} && exists($split{substr($arg[0],1)})) {
288 delete($split{substr($arg[0],1)});
290 elsif ($opts{botnick} eq $usernick) {
291 sts("WHO $opts{botchan}");
292 (my $opcmd = $opts{botopcmd}) =~ s/%botnick%/$opts{botnick}/eg;
294 $lasttime = time(); # start rpcheck()
297 elsif ($arg[1] eq 'quit') {
298 # if we see our nick come open, grab it (skipping queue)
299 if ($usernick eq $primnick) { sts("NICK $primnick",1); }
300 elsif ($opts{'detectsplits'} &&
301 "@arg[2..$#arg]" =~ /^:\S+\.\S+ \S+\.\S+$/) {
302 if (defined($username)) { # user was online
303 $split{substr($arg[0],1)}{time}=time();
304 $split{substr($arg[0],1)}{account}=$username;
308 penalize($username,"quit");
310 delete($onchan{$usernick});
312 elsif ($arg[1] eq 'nick') {
313 # if someone (nickserv) changes our nick for us, update $opts{botnick}
314 if ($usernick eq $opts{botnick}) {
315 $opts{botnick} = substr($arg[2],1);
317 # if we see our nick come open, grab it (skipping queue), unless it was
318 # us who just lost it
319 elsif ($usernick eq $primnick) { sts("NICK $primnick",1); }
321 penalize($username,"nick",$arg[2]);
322 $onchan{substr($arg[2],1)} = delete($onchan{$usernick});
325 elsif ($arg[1] eq 'part') {
326 penalize($username,"part");
327 delete($onchan{$usernick});
329 elsif ($arg[1] eq 'kick') {
331 penalize(finduser($usernick),"kick");
332 delete($onchan{$usernick});
334 # don't penalize /notices to the bot
335 elsif ($arg[1] eq 'notice' && $arg[2] ne $opts{botnick}) {
336 penalize($username,"notice",length("@arg[3..$#arg]")-1);
338 elsif ($arg[1] eq '001') {
339 # send our identify command, set our usermode, join channel
340 sts($opts{botident});
341 sts("MODE $opts{botnick} :$opts{botmodes}");
342 sts("JOIN $opts{botchan}");
343 $opts{botchan} =~ s/ .*//; # strip channel key if present
345 elsif ($arg[1] eq '315') {
346 # 315 is /WHO end. report who we automagically signed online iff it will
348 if (keys(%auto_login)) {
349 # not a true measure of size, but easy
350 if (length("%auto_login") < 1024 && $opts{senduserlist}) {
351 chanmsg(scalar(keys(%auto_login))." users matching ".
352 scalar(keys(%prev_online))." hosts automatically ".
353 "logged in; accounts: ".join(", ",keys(%auto_login)));
356 chanmsg(scalar(keys(%auto_login))." users matching ".
357 scalar(keys(%prev_online))." hosts automatically ".
360 if ($opts{voiceonlogin}) {
361 my @vnicks = map { $rps{$_}{nick} } keys(%auto_login);
363 sts("MODE $opts{botchan} +".('v' x $opts{modesperline})." ".join(" ",@vnicks[0..$opts{modesperline}-1]));
364 splice(@vnicks,0,$opts{modesperline}-1);
366 my @onicks = map { $rps{$_}{nick} } grep { $rps{$_}{isadmin} == 1 } keys(%auto_login);
368 sts("MODE $opts{botchan} +".('o' x $opts{modesperline})." ".join(" ",@onicks[0..$opts{modesperline}-1]));
369 splice(@onicks,0,$opts{modesperline}-1);
373 else { chanmsg("0 users qualified for auto login."); }
377 elsif ($arg[1] eq '005') {
378 if ("@arg" =~ /MODES=(\d+)/) { $opts{modesperline}=$1; }
380 elsif ($arg[1] eq '352') {
382 # 352 is one line of /WHO. check that the nick!user@host exists as a key
383 # in %prev_online, the list generated in loaddb(). the value is the user
385 $onchan{$arg[7]}=time();
386 if (exists($prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]})) {
387 $rps{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}{online} = 1;
388 $auto_login{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}=1;
391 elsif ($arg[1] eq 'privmsg') {
392 $arg[0] = substr($arg[0],1); # strip leading : from privmsgs
393 if (lc($arg[2]) eq lc($opts{botnick})) { # to us, not channel
394 $arg[3] = lc(substr($arg[3],1)); # lowercase, strip leading :
395 if ($arg[3] eq "\1version\1") {
396 notice("\1VERSION IRPG bot v$version by jotun; ".
397 "http://idlerpg.net/\1",$usernick);
399 elsif ($arg[3] eq "peval") {
400 if (!ha($username) || ($opts{ownerpevalonly} &&
401 $opts{owner} ne $username)) {
402 privmsg("You don't have access to PEVAL.", $usernick);
405 my @peval = eval "@arg[4..$#arg]";
406 if (@peval >= 4 || length("@peval") > 1024) {
407 privmsg("Command produced too much output to send ".
408 "outright; queueing ".length("@peval").
409 " bytes in ".scalar(@peval)." items. Use ".
410 "CLEARQ to clear queue if needed.",$usernick,1);
411 privmsg($_,$usernick) for @peval;
413 else { privmsg($_,$usernick, 1) for @peval; }
414 privmsg("EVAL ERROR: $@", $usernick, 1) if $@;
417 elsif ($arg[3] eq "register") {
418 if (defined $username) {
419 privmsg("Sorry, you are already online as $username.",
423 if ($#arg < 6 || $arg[6] eq "") {
424 privmsg("Try: REGISTER <char name> <password> <class>",
426 privmsg("IE : REGISTER Poseidon MyPassword God of the ".
430 privmsg("Sorry, new accounts may not be registered ".
431 "while the bot is in pause mode; please wait ".
432 "a few minutes and try again.",$usernick);
434 elsif (exists $rps{$arg[4]} || ($opts{casematters} &&
435 scalar(grep { lc($arg[4]) eq lc($_) } keys(%rps)))) {
436 privmsg("Sorry, that character name is already in use.",
439 elsif (lc($arg[4]) eq lc($opts{botnick}) ||
440 lc($arg[4]) eq lc($primnick)) {
441 privmsg("Sorry, that character name cannot be ".
442 "registered.",$usernick);
444 elsif (!exists($onchan{$usernick})) {
445 privmsg("Sorry, you're not in $opts{botchan}.",
448 elsif (length($arg[4]) > 16 || length($arg[4]) < 1) {
449 privmsg("Sorry, character names must be < 17 and > 0 ".
450 "chars long.", $usernick);
452 elsif ($arg[4] =~ /^#/) {
453 privmsg("Sorry, character names may not begin with #.",
456 elsif ($arg[4] =~ /\001/) {
457 privmsg("Sorry, character names may not include ".
458 "character \\001.",$usernick);
460 elsif ($opts{noccodes} && ($arg[4] =~ /[[:cntrl:]]/ ||
461 "@arg[6..$#arg]" =~ /[[:cntrl:]]/)) {
462 privmsg("Sorry, neither character names nor classes ".
463 "may include control codes.",$usernick);
465 elsif ($opts{nononp} && ($arg[4] =~ /[[:^print:]]/ ||
466 "@arg[6..$#arg]" =~ /[[:^print:]]/)) {
467 privmsg("Sorry, neither character names nor classes ".
468 "may include non-printable chars.",$usernick);
470 elsif (length("@arg[6..$#arg]") > 30) {
471 privmsg("Sorry, character classes must be < 31 chars ".
474 elsif (time() == $lastreg) {
475 privmsg("Wait 1 second and try again.",$usernick);
478 if ($opts{voiceonlogin}) {
479 sts("MODE $opts{botchan} +v :$usernick");
483 $rps{$arg[4]}{next} = $opts{rpbase};
484 $rps{$arg[4]}{class} = "@arg[6..$#arg]";
485 $rps{$arg[4]}{level} = 0;
486 $rps{$arg[4]}{online} = 1;
487 $rps{$arg[4]}{nick} = $usernick;
488 $rps{$arg[4]}{userhost} = $arg[0];
489 $rps{$arg[4]}{created} = time();
490 $rps{$arg[4]}{lastlogin} = time();
491 $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
492 $rps{$arg[4]}{x} = int(rand($opts{mapx}));
493 $rps{$arg[4]}{y} = int(rand($opts{mapy}));
494 $rps{$arg[4]}{alignment}="n";
495 $rps{$arg[4]}{isadmin} = 0;
496 for my $item ("ring","amulet","charm","weapon","helm",
497 "tunic","pair of gloves","shield",
498 "set of leggings","pair of boots") {
499 $rps{$arg[4]}{item}{$item} = 0;
501 for my $pen ("pen_mesg","pen_nick","pen_part",
502 "pen_kick","pen_quit","pen_quest",
503 "pen_logout","pen_logout") {
504 $rps{$arg[4]}{$pen} = 0;
506 chanmsg("Welcome $usernick\'s new player $arg[4], the ".
507 "@arg[6..$#arg]! Next level in ".
508 duration($opts{rpbase}).".");
509 privmsg("Success! Account $arg[4] created. You have ".
510 "$opts{rpbase} seconds idleness until you ".
511 "reach level 1. ", $usernick);
512 privmsg("NOTE: The point of the game is to see who ".
513 "can idle the longest. As such, talking in ".
514 "the channel, parting, quitting, and changing ".
515 "nicks all penalize you.",$usernick);
516 if ($opts{phonehome}) {
517 my $tempsock = IO::Socket::INET->new(PeerAddr=>
518 "jotun.ultrazone.org:80");
521 "GET /g7/count.php?new=1 HTTP/1.1\r\n".
522 "Host: jotun.ultrazone.org:80\r\n\r\n";
530 elsif ($arg[3] eq "delold") {
531 if (!ha($username)) {
532 privmsg("You don't have access to DELOLD.", $usernick);
534 # insure it is a number
535 elsif ($arg[4] !~ /^[\d\.]+$/) {
536 privmsg("Try: DELOLD <# of days>", $usernick, 1);
539 my @oldaccounts = grep { (time()-$rps{$_}{lastlogin}) >
541 !$rps{$_}{online} } keys(%rps);
542 delete(@rps{@oldaccounts});
543 chanmsg(scalar(@oldaccounts)." accounts not accessed in ".
544 "the last $arg[4] days removed by $arg[0].");
547 elsif ($arg[3] eq "del") {
548 if (!ha($username)) {
549 privmsg("You don't have access to DEL.", $usernick);
551 elsif (!defined($arg[4])) {
552 privmsg("Try: DEL <char name>", $usernick, 1);
554 elsif (!exists($rps{$arg[4]})) {
555 privmsg("No such account $arg[4].", $usernick, 1);
558 delete($rps{$arg[4]});
559 chanmsg("Account $arg[4] removed by $arg[0].");
562 elsif ($arg[3] eq "mkadmin") {
563 if (!ha($username) || ($opts{owneraddonly} &&
564 $opts{owner} ne $username)) {
565 privmsg("You don't have access to MKADMIN.", $usernick);
567 elsif (!defined($arg[4])) {
568 privmsg("Try: MKADMIN <char name>", $usernick, 1);
570 elsif (!exists($rps{$arg[4]})) {
571 privmsg("No such account $arg[4].", $usernick, 1);
574 $rps{$arg[4]}{isadmin}=1;
575 privmsg("Account $arg[4] is now a bot admin.",$usernick, 1);
576 if ($opts{voiceonlogin}) {
577 sts("MODE $opts{botchan} +o :$usernick");
581 elsif ($arg[3] eq "deladmin") {
582 if (!ha($username) || ($opts{ownerdelonly} &&
583 $opts{owner} ne $username)) {
584 privmsg("You don't have access to DELADMIN.", $usernick);
586 elsif (!defined($arg[4])) {
587 privmsg("Try: DELADMIN <char name>", $usernick, 1);
589 elsif (!exists($rps{$arg[4]})) {
590 privmsg("No such account $arg[4].", $usernick, 1);
592 elsif ($arg[4] eq $opts{owner}) {
593 privmsg("Cannot DELADMIN owner account.", $usernick, 1);
596 $rps{$arg[4]}{isadmin}=0;
597 privmsg("Account $arg[4] is no longer a bot admin.",
599 if ($opts{voiceonlogin}) {
600 sts("MODE $opts{botchan} -o :$usernick");
604 elsif ($arg[3] eq "hog") {
605 if (!ha($username)) {
606 privmsg("You don't have access to HOG.", $usernick);
609 chanmsg("$usernick has summoned the Hand of God.");
613 elsif ($arg[3] eq "rehash") {
614 if (!ha($username)) {
615 privmsg("You don't have access to REHASH.", $usernick);
619 privmsg("Reread config file.",$usernick,1);
620 $opts{botchan} =~ s/ .*//; # strip channel key if present
623 elsif ($arg[3] eq "chpass") {
624 if (!ha($username)) {
625 privmsg("You don't have access to CHPASS.", $usernick);
627 elsif (!defined($arg[5])) {
628 privmsg("Try: CHPASS <char name> <new pass>", $usernick, 1);
630 elsif (!exists($rps{$arg[4]})) {
631 privmsg("No such username $arg[4].", $usernick, 1);
634 $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
635 privmsg("Password for $arg[4] changed.", $usernick, 1);
638 elsif ($arg[3] eq "chuser") {
639 if (!ha($username)) {
640 privmsg("You don't have access to CHUSER.", $usernick);
642 elsif (!defined($arg[5])) {
643 privmsg("Try: CHUSER <char name> <new char name>",
646 elsif (!exists($rps{$arg[4]})) {
647 privmsg("No such username $arg[4].", $usernick, 1);
649 elsif (exists($rps{$arg[5]})) {
650 privmsg("Username $arg[5] is already taken.", $usernick,1);
653 $rps{$arg[5]} = delete($rps{$arg[4]});
654 privmsg("Username for $arg[4] changed to $arg[5].",
658 elsif ($arg[3] eq "chclass") {
659 if (!ha($username)) {
660 privmsg("You don't have access to CHCLASS.", $usernick);
662 elsif (!defined($arg[5])) {
663 privmsg("Try: CHCLASS <char name> <new char class>",
666 elsif (!exists($rps{$arg[4]})) {
667 privmsg("No such username $arg[4].", $usernick, 1);
670 $rps{$arg[4]}{class} = "@arg[5..$#arg]";
671 privmsg("Class for $arg[4] changed to @arg[5..$#arg].",
675 elsif ($arg[3] eq "push") {
676 if (!ha($username)) {
677 privmsg("You don't have access to PUSH.", $usernick);
679 # insure it's a positive or negative, integral number of seconds
680 elsif ($arg[5] !~ /^\-?\d+$/) {
681 privmsg("Try: PUSH <char name> <seconds>", $usernick, 1);
683 elsif (!exists($rps{$arg[4]})) {
684 privmsg("No such username $arg[4].", $usernick, 1);
686 elsif ($arg[5] > $rps{$arg[4]}{next}) {
687 privmsg("Time to level for $arg[4] ($rps{$arg[4]}{next}s) ".
688 "is lower than $arg[5]; setting TTL to 0.",
690 chanmsg("$usernick has pushed $arg[4] $rps{$arg[4]}{next} ".
691 "seconds toward level ".($rps{$arg[4]}{level}+1));
692 $rps{$arg[4]}{next}=0;
695 $rps{$arg[4]}{next} -= $arg[5];
696 chanmsg("$usernick has pushed $arg[4] $arg[5] seconds ".
697 "toward level ".($rps{$arg[4]}{level}+1).". ".
698 "$arg[4] reaches next level in ".
699 duration($rps{$arg[4]}{next}).".");
702 elsif ($arg[3] eq "logout") {
703 if (defined($username)) {
704 penalize($username,"logout");
707 privmsg("You are not logged in.", $usernick);
710 elsif ($arg[3] eq "quest") {
711 if (!@{$quest{questers}}) {
712 privmsg("There is no active quest.",$usernick);
714 elsif ($quest{type} == 1) {
715 privmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
716 "$quest{questers}->[3] are on a quest to ".
717 "$quest{text}. Quest to complete in ".
718 duration($quest{qtime}-time()).".",$usernick);
720 elsif ($quest{type} == 2) {
721 privmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
722 "$quest{questers}->[3] are on a quest to ".
723 "$quest{text}. Participants must first reach ".
724 "[$quest{p1}->[0],$quest{p1}->[1]], then ".
725 "[$quest{p2}->[0],$quest{p2}->[1]].".
726 ($opts{mapurl}?" See $opts{mapurl} to monitor ".
727 "their journey's progress.":""),$usernick);
730 elsif ($arg[3] eq "status" && $opts{statuscmd}) {
731 if (!defined($username)) {
732 privmsg("You are not logged in.", $usernick);
734 # argument is optional
735 elsif ($arg[4] && !exists($rps{$arg[4]})) {
736 privmsg("No such user.",$usernick);
738 elsif ($arg[4]) { # optional 'user' argument
739 privmsg("$arg[4]: Level $rps{$arg[4]}{level} ".
740 "$rps{$arg[4]}{class}; Status: O".
741 ($rps{$arg[4]}{online}?"n":"ff")."line; ".
742 "TTL: ".duration($rps{$arg[4]}{next})."; ".
743 "Idled: ".duration($rps{$arg[4]}{idled}).
744 "; Item sum: ".itemsum($arg[4]),$usernick);
746 else { # no argument, look up this user
747 privmsg("$username: Level $rps{$username}{level} ".
748 "$rps{$username}{class}; Status: O".
749 ($rps{$username}{online}?"n":"ff")."line; ".
750 "TTL: ".duration($rps{$username}{next})."; ".
751 "Idled: ".duration($rps{$username}{idled})."; ".
752 "Item sum: ".itemsum($username),$usernick);
755 elsif ($arg[3] eq "whoami") {
756 if (!defined($username)) {
757 privmsg("You are not logged in.", $usernick);
760 privmsg("You are $username, the level ".
761 $rps{$username}{level}." $rps{$username}{class}. ".
762 "Next level in ".duration($rps{$username}{next}),
766 elsif ($arg[3] eq "newpass") {
767 if (!defined($username)) {
768 privmsg("You are not logged in.", $usernick)
770 elsif (!defined($arg[4])) {
771 privmsg("Try: NEWPASS <new password>", $usernick);
774 $rps{$username}{pass} = crypt($arg[4],mksalt());
775 privmsg("Your password was changed.",$usernick);
778 elsif ($arg[3] eq "align") {
779 if (!defined($username)) {
780 privmsg("You are not logged in.", $usernick)
782 elsif (!defined($arg[4]) || (lc($arg[4]) ne "good" &&
783 lc($arg[4]) ne "neutral" && lc($arg[4]) ne "evil")) {
784 privmsg("Try: ALIGN <good|neutral|evil>", $usernick);
787 $rps{$username}{alignment} = substr(lc($arg[4]),0,1);
788 chanmsg("$username has changed alignment to: ".lc($arg[4]).
790 privmsg("Your alignment was changed to ".lc($arg[4]).".",
794 elsif ($arg[3] eq "removeme") {
795 if (!defined($username)) {
796 privmsg("You are not logged in.", $usernick)
799 privmsg("Account $username removed.",$usernick);
800 chanmsg("$arg[0] removed his account, $username, the ".
801 $rps{$username}{class}.".");
802 delete($rps{$username});
805 elsif ($arg[3] eq "help") {
806 if (!ha($username)) {
807 privmsg("For information on IRPG bot commands, see ".
808 $opts{helpurl}, $usernick);
811 privmsg("Help URL is $opts{helpurl}", $usernick, 1);
812 privmsg("Admin commands URL is $opts{admincommurl}",
816 elsif ($arg[3] eq "die") {
817 if (!ha($username)) {
818 privmsg("You do not have access to DIE.", $usernick);
821 $opts{reconnect} = 0;
823 sts("QUIT :DIE from $arg[0]",1);
826 elsif ($arg[3] eq "reloaddb") {
827 if (!ha($username)) {
828 privmsg("You do not have access to RELOADDB.", $usernick);
830 elsif (!$pausemode) {
831 privmsg("ERROR: Can only use LOADDB while in PAUSE mode.",
836 privmsg("Reread player database file; ".scalar(keys(%rps)).
837 " accounts loaded.",$usernick,1);
840 elsif ($arg[3] eq "backup") {
841 if (!ha($username)) {
842 privmsg("You do not have access to BACKUP.", $usernick);
846 privmsg("$opts{dbfile} copied to ".
847 ".dbbackup/$opts{dbfile}".time(),$usernick,1);
850 elsif ($arg[3] eq "pause") {
851 if (!ha($username)) {
852 privmsg("You do not have access to PAUSE.", $usernick);
855 $pausemode = $pausemode ? 0 : 1;
856 privmsg("PAUSE_MODE set to $pausemode.",$usernick,1);
859 elsif ($arg[3] eq "silent") {
860 if (!ha($username)) {
861 privmsg("You do not have access to SILENT.", $usernick);
863 elsif (!defined($arg[4]) || $arg[4] < 0 || $arg[4] > 3) {
864 privmsg("Try: SILENT <mode>", $usernick,1);
867 $silentmode = $arg[4];
868 privmsg("SILENT_MODE set to $silentmode.",$usernick,1);
871 elsif ($arg[3] eq "jump") {
872 if (!ha($username)) {
873 privmsg("You do not have access to JUMP.", $usernick);
875 elsif (!defined($arg[4])) {
876 privmsg("Try: JUMP <server[:port]>", $usernick, 1);
880 sts("QUIT :JUMP to $arg[4] from $arg[0]");
881 unshift(@{$opts{servers}},$arg[4]);
887 elsif ($arg[3] eq "restart") {
888 if (!ha($username)) {
889 privmsg("You do not have access to RESTART.", $usernick);
893 sts("QUIT :RESTART from $arg[0]",1);
898 elsif ($arg[3] eq "clearq") {
899 if (!ha($username)) {
900 privmsg("You do not have access to CLEARQ.", $usernick);
904 chanmsg("Outgoing message queue cleared by $arg[0].");
905 privmsg("Outgoing message queue cleared.",$usernick,1);
908 elsif ($arg[3] eq "info") {
910 if (!ha($username) && $opts{allowuserinfo}) {
911 $info = "IRPG bot v$version by jotun, ".
912 "http://idlerpg.net/. On via server: ".
913 $opts{servers}->[0].". Admins online: ".
914 join(", ", map { $rps{$_}{nick} }
915 grep { $rps{$_}{isadmin} &&
916 $rps{$_}{online} } keys(%rps)).".";
917 privmsg($info, $usernick);
919 elsif (!ha($username) && !$opts{allowuserinfo}) {
920 privmsg("You do not have access to INFO.", $usernick);
924 $queuedbytes += (length($_)+2) for @queue; # +2 = \r\n
926 "%.2fkb sent, %.2fkb received in %s. %d IRPG users ".
927 "online of %d total users. %d accounts created since ".
928 "startup. PAUSE_MODE is %d, SILENT_MODE is %d. ".
929 "Outgoing queue is %d bytes in %d items. On via: %s. ".
930 "Admins online: %s.",
933 duration(time()-$^T),
934 scalar(grep { $rps{$_}{online} } keys(%rps)),
942 join(", ",map { $rps{$_}{nick} }
943 grep { $rps{$_}{isadmin} && $rps{$_}{online} }
945 privmsg($info, $usernick, 1);
948 elsif ($arg[3] eq "login") {
949 if (defined($username)) {
950 notice("Sorry, you are already online as $username.",
954 if ($#arg < 5 || $arg[5] eq "") {
955 notice("Try: LOGIN <username> <password>", $usernick);
957 elsif (!exists $rps{$arg[4]}) {
958 notice("Sorry, no such account name. Note that ".
959 "account names are case sensitive.",$usernick);
961 elsif (!exists $onchan{$usernick}) {
962 notice("Sorry, you're not in $opts{botchan}.",
965 elsif ($rps{$arg[4]}{pass} ne
966 crypt($arg[5],$rps{$arg[4]}{pass})) {
967 notice("Wrong password.", $usernick);
970 if ($opts{voiceonlogin}) {
971 sts("MODE $opts{botchan} +v :$usernick");
972 if($rps{$arg[4]}{isadmin} > 0){
973 sts("MODE $opts{botchan} +o :$usernick");
977 $rps{$arg[4]}{online} = 1;
978 $rps{$arg[4]}{nick} = $usernick;
979 $rps{$arg[4]}{userhost} = $arg[0];
980 $rps{$arg[4]}{lastlogin} = time();
981 chanmsg("$arg[4], the level $rps{$arg[4]}{level} ".
982 "$rps{$arg[4]}{class}, is now online from ".
983 "nickname $usernick. Next level in ".
984 duration($rps{$arg[4]}{next}).".");
985 notice("Logon successful. Next level in ".
986 duration($rps{$arg[4]}{next}).".", $usernick);
991 # penalize returns true if user was online and successfully penalized.
992 # if the user is not logged in, then penalize() fails. so, if user is
993 # offline, and they say something including "http:", and they've been on
994 # the channel less than 90 seconds, and the http:-style ban is on, then
995 # check to see if their url is in @{$opts{okurl}}. if not, kickban them
996 elsif (!penalize($username,"privmsg",length("@arg[3..$#arg]")) &&
997 index(lc("@arg[3..$#arg]"),"http:") != -1 &&
998 (time()-$onchan{$usernick}) < 90 && $opts{doban}) {
1000 for (@{$opts{okurl}}) {
1001 if (index(lc("@arg[3..$#arg]"),lc($_)) != -1) { $isokurl = 1; }
1004 sts("MODE $opts{botchan} +b $arg[0]");
1005 sts("KICK $opts{botchan} $usernick :No advertising; ban will ".
1006 "be lifted within the hour.");
1007 push(@bans,$arg[0]) if @bans < 12;
1013 sub sts { # send to server
1014 my($text,$skipq) = @_;
1017 print $sock "$text\r\n";
1018 $outbytes += length($text) + 2;
1022 # something is wrong. the socket is closed. clear the queue
1024 debug("\$sock isn't writeable in sts(), cleared outgoing queue.\n");
1030 debug(sprintf("(q%03d) = %s\n",$#queue,$text));
1034 sub fq { # deliver message(s) from queue
1036 ++$freemessages if $freemessages < 4;
1040 for (0..$freemessages) {
1041 last() if !@queue; # no messages left to send
1042 # lower number of "free" messages we have left
1043 my $line=shift(@queue);
1044 # if we have already sent one message, and the next message to be sent
1045 # plus the previous messages we have sent this call to fq() > 768 bytes,
1046 # then requeue this message and return. we don't want to flood off,
1048 if ($_ != 0 && (length($line)+$sentbytes) > 768) {
1049 unshift(@queue,$line);
1053 debug("(fm$freemessages) -> $line");
1054 --$freemessages if $freemessages > 0;
1055 print $sock "$line\r\n";
1056 $sentbytes += length($line) + 2;
1060 debug("Disconnected: cleared outgoing message queue.");
1063 $outbytes += length($line) + 2;
1067 sub duration { # return human duration of seconds
1069 return "NA ($s)" if $s !~ /^\d+$/;
1070 return sprintf("%d day%s, %02d:%02d:%02d",$s/86400,int($s/86400)==1?"":"s",
1071 ($s%86400)/3600,($s%3600)/60,($s%60));
1074 sub ts { # timestamp
1075 my @ts = localtime(time());
1076 return sprintf("[%02d/%02d/%02d %02d:%02d:%02d] ",
1077 $ts[4]+1,$ts[3],$ts[5]%100,$ts[2],$ts[1],$ts[0]);
1080 sub hog { # summon the hand of god
1081 my @players = grep { $rps{$_}{online} } keys(%rps);
1082 my $player = $players[rand(@players)];
1083 my $win = int(rand(5));
1084 my $time = int(((5 + int(rand(71)))/100) * $rps{$player}{next});
1086 chanmsg(clog("Verily I say unto thee, the Heavens have burst forth, ".
1087 "and the blessed hand of God carried $player ".
1088 duration($time)." toward level ".($rps{$player}{level}+1).
1090 $rps{$player}{next} -= $time;
1093 chanmsg(clog("Thereupon He stretched out His little finger among them ".
1094 "and consumed $player with fire, slowing the heathen ".
1095 duration($time)." from level ".($rps{$player}{level}+1).
1097 $rps{$player}{next} += $time;
1099 chanmsg("$player reaches next level in ".duration($rps{$player}{next}).".");
1102 sub rpcheck { # check levels, update database
1103 # check splits hash to see if any split users have expired
1104 checksplits() if $opts{detectsplits};
1105 # send out $freemessages lines of text from the outgoing message queue
1107 # clear registration limiting
1109 my $online = scalar(grep { $rps{$_}{online} } keys(%rps));
1110 # there's really nothing to do here if there are no online users
1111 return unless $online;
1112 my $onlineevil = scalar(grep { $rps{$_}{online} &&
1113 $rps{$_}{alignment} eq "e" } keys(%rps));
1114 my $onlinegood = scalar(grep { $rps{$_}{online} &&
1115 $rps{$_}{alignment} eq "g" } keys(%rps));
1116 if (!$opts{noscale}) {
1117 if (rand((20*86400)/$opts{self_clock}) < $online) { hog(); }
1118 if (rand((24*86400)/$opts{self_clock}) < $online) { team_battle(); }
1119 if (rand((8*86400)/$opts{self_clock}) < $online) { calamity(); }
1120 if (rand((4*86400)/$opts{self_clock}) < $online) { godsend(); }
1123 hog() if rand(4000) < 1;
1124 team_battle() if rand(4000) < 1;
1125 calamity() if rand(4000) < 1;
1126 godsend() if rand(2000) < 1;
1128 if (rand((8*86400)/$opts{self_clock}) < $onlineevil) { evilness(); }
1129 if (rand((12*86400)/$opts{self_clock}) < $onlinegood) { goodness(); }
1133 # statements using $rpreport do not bother with scaling by the clock because
1134 # $rpreport is adjusted by the number of seconds since last rpcheck()
1135 if ($rpreport%120==0 && $opts{writequestfile}) { writequestfile(); }
1136 if (time() > $quest{qtime}) {
1137 if (!@{$quest{questers}}) { quest(); }
1138 elsif ($quest{type} == 1) {
1139 chanmsg(clog(join(", ",(@{$quest{questers}})[0..2]).", and ".
1140 "$quest{questers}->[3] have blessed the realm by ".
1141 "completing their quest! 25% of their burden is ".
1143 for (@{$quest{questers}}) {
1144 $rps{$_}{next} = int($rps{$_}{next} * .75);
1146 undef(@{$quest{questers}});
1147 $quest{qtime} = time() + 21600;
1149 # quest type 2 awards are handled in moveplayers()
1151 if ($rpreport && $rpreport%36000==0) { # 10 hours
1152 my @u = sort { $rps{$b}{level} <=> $rps{$a}{level} ||
1153 $rps{$a}{next} <=> $rps{$b}{next} } keys(%rps);
1154 chanmsg("Idle RPG Top Players:") if @u;
1157 chanmsg("$u[$i], the level $rps{$u[$i]}{level} ".
1158 "$rps{$u[$i]}{class}, is #" . ($i + 1) . "! Next level in ".
1159 (duration($rps{$u[$i]}{next})).".");
1163 if ($rpreport%3600==0 && $rpreport) { # 1 hour
1164 my @players = grep { $rps{$_}{online} &&
1165 $rps{$_}{level} > 44 } keys(%rps);
1166 # 20% of all players must be level 45+
1167 if ((scalar(@players)/scalar(grep { $rps{$_}{online} } keys(%rps))) > .15) {
1168 challenge_opp($players[int(rand(@players))]);
1171 sts("MODE $opts{botchan} -bbbb :@bans[0..3]");
1175 if ($rpreport%1800==0) { # 30 mins
1176 if ($opts{botnick} ne $primnick) {
1177 sts($opts{botghostcmd}) if $opts{botghostcmd};
1178 sts("NICK $primnick");
1181 if ($rpreport%600==0 && $pausemode) { # warn every 10m
1182 chanmsg("WARNING: Cannot write database in PAUSE mode!");
1184 # do not write in pause mode, and do not write if not yet connected. (would
1185 # log everyone out if the bot failed to connect. $lasttime = time() on
1186 # successful join to $opts{botchan}, initial value is 1). if fails to open
1187 # $opts{dbfile}, will not update $lasttime and so should have correct values
1188 # on next rpcheck().
1189 if ($lasttime != 1) {
1191 for my $k (keys(%rps)) {
1192 if ($rps{$k}{online} && exists $rps{$k}{nick} &&
1193 $rps{$k}{nick} && exists $onchan{$rps{$k}{nick}}) {
1194 $rps{$k}{next} -= ($curtime - $lasttime);
1195 $rps{$k}{idled} += ($curtime - $lasttime);
1196 if ($rps{$k}{next} < 1) {
1198 if ($rps{$k}{level} > 60) {
1199 $rps{$k}{next} = int(($opts{rpbase} *
1200 ($opts{rpstep}**60)) +
1201 (86400*($rps{$k}{level} - 60)));
1204 $rps{$k}{next} = int($opts{rpbase} *
1205 ($opts{rpstep}**$rps{$k}{level}));
1207 chanmsg("$k, the $rps{$k}{class}, has attained level ".
1208 "$rps{$k}{level}! Next level in ".
1209 duration($rps{$k}{next}).".");
1214 # attempt to make sure this is an actual user, and not just an
1215 # artifact of a bad PEVAL
1217 if (!$pausemode && $rpreport%60==0) { writedb(); }
1218 $rpreport += $opts{self_clock};
1219 $lasttime = $curtime;
1223 sub challenge_opp { # pit argument player against random player
1225 if ($rps{$u}{level} < 25) { return unless rand(4) < 1; }
1226 my @opps = grep { $rps{$_}{online} && $u ne $_ } keys(%rps);
1227 return unless @opps;
1228 my $opp = $opps[int(rand(@opps))];
1229 $opp = $primnick if rand(@opps+1) < 1;
1230 my $mysum = itemsum($u,1);
1231 my $oppsum = itemsum($opp,1);
1232 my $myroll = int(rand($mysum));
1233 my $opproll = int(rand($oppsum));
1234 if ($myroll >= $opproll) {
1235 my $gain = ($opp eq $primnick)?20:int($rps{$opp}{level}/4);
1236 $gain = 7 if $gain < 7;
1237 $gain = int(($gain/100)*$rps{$u}{next});
1238 chanmsg(clog("$u [$myroll/$mysum] has challenged $opp [$opproll/".
1239 "$oppsum] in combat and won! ".duration($gain)." is ".
1240 "removed from $u\'s clock."));
1241 $rps{$u}{next} -= $gain;
1242 chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
1243 my $csfactor = $rps{$u}{alignment} eq "g" ? 50 :
1244 $rps{$u}{alignment} eq "e" ? 20 :
1246 if (rand($csfactor) < 1 && $opp ne $primnick) {
1247 $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
1248 chanmsg(clog("$u has dealt $opp a Critical Strike! ".
1249 duration($gain)." is added to $opp\'s clock."));
1250 $rps{$opp}{next} += $gain;
1251 chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).
1254 elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
1255 my @items = ("ring","amulet","charm","weapon","helm","tunic",
1256 "pair of gloves","set of leggings","shield",
1258 my $type = $items[rand(@items)];
1259 if (int($rps{$opp}{item}{$type}) > int($rps{$u}{item}{$type})) {
1260 chanmsg(clog("In the fierce battle, $opp dropped his level ".
1261 int($rps{$opp}{item}{$type})." $type! $u picks ".
1262 "it up, tossing his old level ".
1263 int($rps{$u}{item}{$type})." $type to $opp."));
1264 my $tempitem = $rps{$u}{item}{$type};
1265 $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
1266 $rps{$opp}{item}{$type} = $tempitem;
1271 my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
1272 $gain = 7 if $gain < 7;
1273 $gain = int(($gain/100)*$rps{$u}{next});
1274 chanmsg(clog("$u [$myroll/$mysum] has challenged $opp [$opproll/".
1275 "$oppsum] in combat and lost! ".duration($gain)." is ".
1276 "added to $u\'s clock."));
1277 $rps{$u}{next} += $gain;
1278 chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
1280 if ($opp ne $primnick) {
1281 debug("interrogation");
1282 my $csfactor = $rps{$opp}{alignment} eq "g" ? 50 :
1283 $rps{$opp}{alignment} eq "e" ? 20 :
1285 if (rand($csfactor) < 1) {
1286 $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
1287 chanmsg(clog("$opp has captured and interrogated $u! ".
1288 duration($gain)." is removed from $opp\'s clock."));
1289 $rps{$opp}{next} -= $gain;
1290 chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).".");
1296 sub team_battle { # pit three players against three other players
1297 my @opp = grep { $rps{$_}{online} } keys(%rps);
1299 splice(@opp,int(rand(@opp)),1) while @opp > 6;
1300 fisher_yates_shuffle(\@opp);
1301 my $mysum = itemsum($opp[0],1) + itemsum($opp[1],1) + itemsum($opp[2],1);
1302 my $oppsum = itemsum($opp[3],1) + itemsum($opp[4],1) + itemsum($opp[5],1);
1303 my $gain = $rps{$opp[0]}{next};
1305 $gain = $rps{$opp[$p]}{next} if $gain > $rps{$opp[$p]}{next};
1307 $gain = int($gain*.20);
1308 my $myroll = int(rand($mysum));
1309 my $opproll = int(rand($oppsum));
1310 if ($myroll >= $opproll) {
1311 chanmsg(clog("$opp[0], $opp[1], and $opp[2] [$myroll/$mysum] have ".
1312 "team battled $opp[3], $opp[4], and $opp[5] [$opproll/".
1313 "$oppsum] and won! ".duration($gain)." is removed from ".
1315 $rps{$opp[0]}{next} -= $gain;
1316 $rps{$opp[1]}{next} -= $gain;
1317 $rps{$opp[2]}{next} -= $gain;
1320 chanmsg(clog("$opp[0], $opp[1], and $opp[2] [$myroll/$mysum] have ".
1321 "team battled $opp[3], $opp[4], and $opp[5] [$opproll/".
1322 "$oppsum] and lost! ".duration($gain)." is added to ".
1324 $rps{$opp[0]}{next} += $gain;
1325 $rps{$opp[1]}{next} += $gain;
1326 $rps{$opp[2]}{next} += $gain;
1330 sub find_item { # find item for argument player
1332 my @items = ("ring","amulet","charm","weapon","helm","tunic",
1333 "pair of gloves","set of leggings","shield","pair of boots");
1334 my $type = $items[rand(@items)];
1337 for my $num (1 .. int($rps{$u}{level}*1.5)) {
1338 if (rand(1.4**($num/4)) < 1) {
1342 if ($rps{$u}{level} >= 25 && rand(40) < 1) {
1343 $ulevel = 50+int(rand(25));
1344 if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{helm})) {
1345 notice("The light of the gods shines down upon you! You have ".
1346 "found the level $ulevel Mattt's Omniscience Grand Crown! ".
1347 "Your enemies fall before you as you anticipate their ".
1348 "every move.",$rps{$u}{nick});
1349 $rps{$u}{item}{helm} = $ulevel."a";
1353 elsif ($rps{$u}{level} >= 25 && rand(40) < 1) {
1354 $ulevel = 50+int(rand(25));
1355 if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{ring})) {
1356 notice("The light of the gods shines down upon you! You have ".
1357 "found the level $ulevel Juliet's Glorious Ring of ".
1358 "Sparkliness! You enemies are blinded by both its glory ".
1359 "and their greed as you bring desolation upon them.",
1361 $rps{$u}{item}{ring} = $ulevel."h";
1365 elsif ($rps{$u}{level} >= 30 && rand(40) < 1) {
1366 $ulevel = 75+int(rand(25));
1367 if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{tunic})) {
1368 notice("The light of the gods shines down upon you! You have ".
1369 "found the level $ulevel Res0's Protectorate Plate Mail! ".
1370 "Your enemies cower in fear as their attacks have no ".
1371 "effect on you.",$rps{$u}{nick});
1372 $rps{$u}{item}{tunic} = $ulevel."b";
1376 elsif ($rps{$u}{level} >= 35 && rand(40) < 1) {
1377 $ulevel = 100+int(rand(25));
1378 if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{amulet})) {
1379 notice("The light of the gods shines down upon you! You have ".
1380 "found the level $ulevel Dwyn's Storm Magic Amulet! Your ".
1381 "enemies are swept away by an elemental fury before the ".
1382 "war has even begun",$rps{$u}{nick});
1383 $rps{$u}{item}{amulet} = $ulevel."c";
1387 elsif ($rps{$u}{level} >= 40 && rand(40) < 1) {
1388 $ulevel = 150+int(rand(25));
1389 if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
1390 notice("The light of the gods shines down upon you! You have ".
1391 "found the level $ulevel Jotun's Fury Colossal Sword! Your ".
1392 "enemies' hatred is brought to a quick end as you arc your ".
1393 "wrist, dealing the crushing blow.",$rps{$u}{nick});
1394 $rps{$u}{item}{weapon} = $ulevel."d";
1398 elsif ($rps{$u}{level} >= 45 && rand(40) < 1) {
1399 $ulevel = 175+int(rand(26));
1400 if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
1401 notice("The light of the gods shines down upon you! You have ".
1402 "found the level $ulevel Drdink's Cane of Blind Rage! Your ".
1403 "enemies are tossed aside as you blindly swing your arm ".
1404 "around hitting stuff.",$rps{$u}{nick});
1405 $rps{$u}{item}{weapon} = $ulevel."e";
1409 elsif ($rps{$u}{level} >= 48 && rand(40) < 1) {
1410 $ulevel = 250+int(rand(51));
1411 if ($ulevel >= $level && $ulevel >
1412 int($rps{$u}{item}{"pair of boots"})) {
1413 notice("The light of the gods shines down upon you! You have ".
1414 "found the level $ulevel Mrquick's Magical Boots of ".
1415 "Swiftness! Your enemies are left choking on your dust as ".
1416 "you run from them very, very quickly.",$rps{$u}{nick});
1417 $rps{$u}{item}{"pair of boots"} = $ulevel."f";
1421 elsif ($rps{$u}{level} >= 52 && rand(40) < 1) {
1422 $ulevel = 300+int(rand(51));
1423 if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
1424 notice("The light of the gods shines down upon you! You have ".
1425 "found the level $ulevel Jeff's Cluehammer of Doom! Your ".
1426 "enemies are left with a sudden and intense clarity of ".
1427 "mind... even as you relieve them of it.",$rps{$u}{nick});
1428 $rps{$u}{item}{weapon} = $ulevel."g";
1432 if ($level > int($rps{$u}{item}{$type})) {
1433 notice("You found a level $level $type! Your current $type is only ".
1434 "level ".int($rps{$u}{item}{$type}).", so it seems Luck is ".
1435 "with you!",$rps{$u}{nick});
1436 $rps{$u}{item}{$type} = $level;
1439 notice("You found a level $level $type. Your current $type is level ".
1440 int($rps{$u}{item}{$type}).", so it seems Luck is against you. ".
1441 "You toss the $type.",$rps{$u}{nick});
1445 sub loaddb { # load the players database
1449 if (!open(RPS,$opts{dbfile}) && -e $opts{dbfile}) {
1450 sts("QUIT :loaddb() failed: $!");
1454 next if $l =~ /^#/; # skip comments
1455 next if $l =~ /^\s*$/; # skip empty lines
1456 my @i = split("\t",$l);
1457 print Dumper(@i) if @i != 32;
1459 sts("QUIT: Anomaly in loaddb(); line $. of $opts{dbfile} has ".
1460 "wrong fields (".scalar(@i).")");
1461 debug("Anomaly in loaddb(); line $. of $opts{dbfile} has wrong ".
1462 "fields (".scalar(@i).")",1);
1464 if (!$sock) { # if not RELOADDB
1465 if ($i[8]) { $prev_online{$i[7]}=$i[0]; } # log back in
1468 $rps{$i[0]}{isadmin},
1473 $rps{$i[0]}{userhost},
1474 $rps{$i[0]}{online},
1478 $rps{$i[0]}{pen_mesg},
1479 $rps{$i[0]}{pen_nick},
1480 $rps{$i[0]}{pen_part},
1481 $rps{$i[0]}{pen_kick},
1482 $rps{$i[0]}{pen_quit},
1483 $rps{$i[0]}{pen_quest},
1484 $rps{$i[0]}{pen_logout},
1485 $rps{$i[0]}{created},
1486 $rps{$i[0]}{lastlogin},
1487 $rps{$i[0]}{item}{amulet},
1488 $rps{$i[0]}{item}{charm},
1489 $rps{$i[0]}{item}{helm},
1490 $rps{$i[0]}{item}{"pair of boots"},
1491 $rps{$i[0]}{item}{"pair of gloves"},
1492 $rps{$i[0]}{item}{ring},
1493 $rps{$i[0]}{item}{"set of leggings"},
1494 $rps{$i[0]}{item}{shield},
1495 $rps{$i[0]}{item}{tunic},
1496 $rps{$i[0]}{item}{weapon},
1497 $rps{$i[0]}{alignment}) = (@i[1..7],($sock?$i[8]:0),@i[9..$#i]);
1500 debug("loaddb(): loaded ".scalar(keys(%rps))." accounts, ".
1501 scalar(keys(%prev_online))." previously online.");
1505 return unless $lasttime > 1;
1506 my $onlinecount = grep { $rps{$_}{online} } keys %rps;
1507 return unless $onlinecount;
1508 for (my $i=0;$i<$opts{self_clock};++$i) {
1509 # temporary hash to hold player positions, detect collisions
1511 if ($quest{type} == 2 && @{$quest{questers}}) {
1512 my $allgo = 1; # have all users reached <p1|p2>?
1513 for (@{$quest{questers}}) {
1514 if ($quest{stage}==1) {
1515 if ($rps{$_}{x} != $quest{p1}->[0] ||
1516 $rps{$_}{y} != $quest{p1}->[1]) {
1522 if ($rps{$_}{x} != $quest{p2}->[0] ||
1523 $rps{$_}{y} != $quest{p2}->[1]) {
1529 # all participants have reached point 1, now point 2
1530 if ($quest{stage}==1 && $allgo) {
1532 $allgo=0; # have not all reached p2 yet
1534 elsif ($quest{stage} == 2 && $allgo) {
1535 chanmsg(clog(join(", ",(@{$quest{questers}})[0..2]).", ".
1536 "and $quest{questers}->[3] have completed their ".
1537 "journey! 25% of their burden is eliminated."));
1538 for (@{$quest{questers}}) {
1539 $rps{$_}{next} = int($rps{$_}{next} * .75);
1541 undef(@{$quest{questers}});
1542 $quest{qtime} = time() + 21600; # next quest starts in 6 hours
1543 $quest{type} = 1; # probably not needed
1548 # load keys of %temp with online users
1549 ++@temp{grep { $rps{$_}{online} } keys(%rps)};
1550 # delete questers from list
1551 delete(@temp{@{$quest{questers}}});
1552 while ($player = each(%temp)) {
1553 $rps{$player}{x} += int(rand(3))-1;
1554 $rps{$player}{y} += int(rand(3))-1;
1555 # if player goes over edge, wrap them back around
1556 if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x}=0; }
1557 if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y}=0; }
1558 if ($rps{$player}{x} < 0) { $rps{$player}{x}=$opts{mapx}; }
1559 if ($rps{$player}{y} < 0) { $rps{$player}{y}=$opts{mapy}; }
1561 if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
1562 !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
1563 if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
1564 !$rps{$player}{isadmin} && rand(100) < 1) {
1565 chanmsg("$player encounters ".
1566 $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}.
1567 " and bows humbly.");
1569 if (rand($onlinecount) < 1) {
1570 $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
1571 collision_fight($player,
1572 $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
1576 $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
1577 $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
1580 for (@{$quest{questers}}) {
1581 if ($quest{stage} == 1) {
1582 if (rand(100) < 1) {
1583 if ($rps{$_}{x} != $quest{p1}->[0]) {
1584 $rps{$_}{x} += ($rps{$_}{x} < $quest{p1}->[0] ?
1587 if ($rps{$_}{y} != $quest{p1}->[1]) {
1588 $rps{$_}{y} += ($rps{$_}{y} < $quest{p1}->[1] ?
1593 elsif ($quest{stage}==2) {
1594 if (rand(100) < 1) {
1595 if ($rps{$_}{x} != $quest{p2}->[0]) {
1596 $rps{$_}{x} += ($rps{$_}{x} < $quest{p2}->[0] ?
1599 if ($rps{$_}{y} != $quest{p2}->[1]) {
1600 $rps{$_}{y} += ($rps{$_}{y} < $quest{p2}->[1] ?
1609 for my $player (keys(%rps)) {
1610 next unless $rps{$player}{online};
1611 $rps{$player}{x} += int(rand(3))-1;
1612 $rps{$player}{y} += int(rand(3))-1;
1613 # if player goes over edge, wrap them back around
1614 if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x} = 0; }
1615 if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y} = 0; }
1616 if ($rps{$player}{x} < 0) { $rps{$player}{x} = $opts{mapx}; }
1617 if ($rps{$player}{y} < 0) { $rps{$player}{y} = $opts{mapy}; }
1618 if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
1619 !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
1620 if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
1621 !$rps{$player}{isadmin} && rand(100) < 1) {
1622 chanmsg("$player encounters ".
1623 $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}.
1624 " and bows humbly.");
1626 if (rand($onlinecount) < 1) {
1627 $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
1628 collision_fight($player,
1629 $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
1633 $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
1634 $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
1641 sub mksalt { # generate a random salt for passwds
1642 join '',('a'..'z','A'..'Z','0'..'9','/','.')[rand(64), rand(64)];
1645 sub chanmsg { # send a message to the channel
1646 my $msg = shift or return undef;
1647 if ($silentmode & 1) { return undef; }
1648 privmsg($msg, $opts{botchan}, shift);
1651 sub privmsg { # send a message to an arbitrary entity
1652 my $msg = shift or return undef;
1653 my $target = shift or return undef;
1655 if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
1659 while (length($msg)) {
1660 sts("PRIVMSG $target :".substr($msg,0,450),$force);
1661 substr($msg,0,450)="";
1665 sub notice { # send a notice to an arbitrary entity
1666 my $msg = shift or return undef;
1667 my $target = shift or return undef;
1669 if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
1673 while (length($msg)) {
1674 sts("NOTICE $target :".substr($msg,0,450),$force);
1675 substr($msg,0,450)="";
1679 sub help { # print help message
1680 (my $prog = $0) =~ s/^.*\///;
1683 usage: $prog [OPTIONS]
1684 --help, -h Print this message
1685 --verbose, -v Print verbose messages
1686 --server, -s Specify IRC server:port to connect to
1687 --botnick, -n Bot's IRC nick
1688 --botuser, -u Bot's username
1689 --botrlnm, -r Bot's real name
1690 --botchan, -c IRC channel to join
1691 --botident, -p Specify identify-to-services command
1692 --botmodes, -m Specify usermodes for the bot to set upon connect
1693 --botopcmd, -o Specify command to send to server on successful connect
1694 --botghostcmd, -g Specify command to send to server to regain primary
1695 nickname when in use
1696 --doban Advertisement ban on/off flag
1697 --okurl, -k Bot will not ban for web addresses that contain these
1699 --debug Debug on/off flag
1700 --helpurl URL to refer new users to
1701 --admincommurl URL to refer admins to
1704 --rpbase Base time to level up
1705 --rpstep Time to next level = rpbase * (rpstep ** CURRENT_LEVEL)
1706 --rppenstep PENALTY_SECS=(PENALTY*(RPPENSTEP**CURRENT_LEVEL))
1713 # is this for a battle? if so, good users get a 10% boost and evil users get
1716 return -1 unless defined $user;
1718 if ($user eq $primnick) {
1719 for my $u (keys(%rps)) {
1720 $sum = itemsum($u) if $sum < itemsum($u);
1724 if (!exists($rps{$user})) { return -1; }
1725 $sum += int($rps{$user}{item}{$_}) for keys(%{$rps{$user}{item}});
1727 return $rps{$user}{alignment} eq 'e' ? int($sum*.9) :
1728 $rps{$user}{alignment} eq 'g' ? int($sum*1.1) :
1735 if ($opts{daemonize}){
1736 print "\n".debug("Becoming a daemon...")."\n";
1737 # win32 doesn't daemonize (this way?)
1738 if ($^O eq "MSWin32") {
1739 print debug("Nevermind, this is Win32, no I'm not.")."\n";
1743 $SIG{CHLD} = sub { };
1744 fork() && exit(0); # kill parent
1745 POSIX::setsid() || debug("POSIX::setsid() failed: $!",1);
1746 $SIG{CHLD} = sub { };
1747 fork() && exit(0); # kill the parent as the process group leader
1748 $SIG{CHLD} = sub { };
1749 open(STDIN,'/dev/null') || debug("Cannot read /dev/null: $!",1);
1750 open(STDOUT,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
1751 open(STDERR,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
1752 # write our PID to $opts{pidfile}, or return semi-silently on failure
1753 open(PIDFILE,">$opts{pidfile}") || do {
1754 debug("Error: failed opening pid file: $!");
1760 print "\n".debug("NOT Becoming a daemon...")."\n";
1764 sub calamity { # suffer a little one
1765 my @players = grep { $rps{$_}{online} } keys(%rps);
1766 return unless @players;
1767 my $player = $players[rand(@players)];
1769 my @items = ("amulet","charm","weapon","tunic","set of leggings",
1770 "shield","pair of boots");
1771 my $type = $items[rand(@items)];
1773 if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
1774 $rps{$player}{item}{$type} = int(int($rps{$player}{item}{$type}) * .9);
1775 $rps{$player}{item}{$type}.=$suffix;
1776 if ($type eq "amulet") {
1777 chanmsg(clog("$player fell, chipping the stone in his amulet! ".
1778 "$player\'s $type loses 10% of its effectiveness: ".$rps{$player}{item}{$type}));
1780 elsif ($type eq "pair of boots") {
1781 chanmsg(clog("$player stepped in dog poop! ".
1782 "$player\'s $type loses 10% of its effectiveness: ".$rps{$player}{item}{$type}));
1784 elsif ($type eq "charm") {
1785 chanmsg(clog("$player slipped and dropped his charm in a dirty ".
1786 "bog! $player\'s $type loses 10% of its ".
1787 "effectiveness: ".$rps{$player}{item}{$type}));
1789 elsif ($type eq "weapon") {
1790 chanmsg(clog("$player left his weapon out in the rain to rust! ".
1791 "$player\'s $type loses 10% of its effectiveness: ".$rps{$player}{item}{$type}));
1793 elsif ($type eq "tunic") {
1794 chanmsg(clog("$player spilled a level 7 shrinking potion on his ".
1795 "tunic! $player\'s $type loses 10% of its ".
1796 "effectiveness: ".$rps{$player}{item}{$type}));
1798 elsif ($type eq "shield") {
1799 chanmsg(clog("$player\'s shield was damaged by a dragon's fiery ".
1800 "breath! $player\'s $type loses 10% of its ".
1801 "effectiveness: ".$rps{$player}{item}{$type}));
1804 chanmsg(clog("$player burned a hole through his leggings while ".
1805 "ironing them! $player\'s $type loses 10% of its ".
1806 "effectiveness: ".$rps{$player}{item}{$type}));
1810 my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
1811 if (!open(Q,$opts{eventsfile})) {
1812 return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1815 while (my $line = <Q>) {
1817 if ($line =~ /^C (.*)/ && rand(++$i) < 1) { $actioned = $1; }
1819 chanmsg(clog("$player $actioned. This terrible calamity has slowed ".
1820 "them ".duration($time)." from level ".
1821 ($rps{$player}{level}+1)."."));
1822 $rps{$player}{next} += $time;
1823 chanmsg("$player reaches next level in ".duration($rps{$player}{next}).
1828 sub godsend { # bless the unworthy
1829 my @players = grep { $rps{$_}{online} } keys(%rps);
1830 return unless @players;
1831 my $player = $players[rand(@players)];
1833 my @items = ("amulet","charm","weapon","tunic","set of leggings",
1834 "shield","pair of boots");
1835 my $type = $items[rand(@items)];
1837 if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
1838 $rps{$player}{item}{$type} = int(int($rps{$player}{item}{$type}) * 1.1);
1839 $rps{$player}{item}{$type}.=$suffix;
1840 if ($type eq "amulet") {
1841 chanmsg(clog("$player\'s amulet was blessed by a passing cleric! ".
1842 "$player\'s $type gains 10% effectiveness: ".$rps{$player}{item}{$type}));
1844 elsif ($type eq "pair of boots") {
1845 chanmsg(clog("A wandring cobbler refit $player\'s boots! ".
1846 "$player\'s $type gains 10% effectiveness: ".$rps{$player}{item}{$type}));
1848 elsif ($type eq "charm") {
1849 chanmsg(clog("$player\'s charm ate a bolt of lightning! ".
1850 "$player\'s $type gains 10% effectiveness: ".$rps{$player}{item}{$type}));
1852 elsif ($type eq "weapon") {
1853 chanmsg(clog("$player sharpened the edge of his weapon! ".
1854 "$player\'s $type gains 10% effectiveness: ".$rps{$player}{item}{$type}));
1856 elsif ($type eq "tunic") {
1857 chanmsg(clog("A magician cast a spell of Rigidity on $player\'s ".
1858 "tunic! $player\'s $type gains 10% effectiveness: ".$rps{$player}{item}{$type}));
1860 elsif ($type eq "shield") {
1861 chanmsg(clog("$player reinforced his shield with a dragon's ".
1862 "scales! $player\'s $type gains 10% effectiveness: ".$rps{$player}{item}{$type}));
1865 chanmsg(clog("The local wizard imbued $player\'s pants with a ".
1866 "Spirit of Fortitude! $player\'s $type gains 10% ".
1867 "effectiveness: ".$rps{$player}{item}{$type}));
1871 my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
1873 if (!open(Q,$opts{eventsfile})) {
1874 return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1877 while (my $line = <Q>) {
1879 if ($line =~ /^G (.*)/ && rand(++$i) < 1) {
1883 chanmsg(clog("$player $actioned! This wondrous godsend has ".
1884 "accelerated them ".duration($time)." towards level ".
1885 ($rps{$player}{level}+1)."."));
1886 $rps{$player}{next} -= $time;
1887 chanmsg("$player reaches next level in ".duration($rps{$player}{next}).
1893 @{$quest{questers}} = grep { $rps{$_}{online} && $rps{$_}{level} > 39 &&
1894 time()-$rps{$_}{lastlogin}>36000 } keys(%rps);
1895 if (@{$quest{questers}} < 4) { return undef(@{$quest{questers}}); }
1896 while (@{$quest{questers}} > 4) {
1897 splice(@{$quest{questers}},int(rand(@{$quest{questers}})),1);
1899 if (!open(Q,$opts{eventsfile})) {
1900 return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
1903 while (my $line = <Q>) {
1905 if ($line =~ /^Q/ && rand(++$i) < 1) {
1906 if ($line =~ /^Q1 (.*)/) {
1909 $quest{qtime} = time() + 43200 + int(rand(43201)); # 12-24 hours
1911 elsif ($line =~ /^Q2 (\d+) (\d+) (\d+) (\d+) (.*)/) {
1912 $quest{p1} = [$1,$2];
1913 $quest{p2} = [$3,$4];
1921 if ($quest{type} == 1) {
1922 chanmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
1923 "$quest{questers}->[3] have been chosen by the gods to ".
1924 "$quest{text}. Quest to end in ".duration($quest{qtime}-time()).
1927 elsif ($quest{type} == 2) {
1928 chanmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
1929 "$quest{questers}->[3] have been chosen by the gods to ".
1930 "$quest{text}. Participants must first reach [$quest{p1}->[0],".
1931 "$quest{p1}->[1]], then [$quest{p2}->[0],$quest{p2}->[1]].".
1932 ($opts{mapurl}?" See $opts{mapurl} to monitor their journey's ".
1940 my ($quester,$player);
1941 for $quester (@{$quest{questers}}) {
1942 if ($quester eq $k) {
1943 chanmsg(clog("$k\'s prudence and self-regard has brought the ".
1944 "wrath of the gods upon the realm. All your great ".
1945 "wickedness makes you as it were heavy with lead, ".
1946 "and to tend downwards with great weight and ".
1947 "pressure towards hell. Therefore have you drawn ".
1948 "yourselves 15 steps closer to that gaping maw."));
1949 for $player (grep { $rps{$_}{online} } keys %rps) {
1950 my $gain = int(15 * ($opts{rppenstep}**$rps{$player}{level}));
1951 $rps{$player}{pen_quest} += $gain;
1952 $rps{$player}{next} += $gain;
1954 undef(@{$quest{questers}});
1955 $quest{qtime} = time() + 43200; # 12 hours
1962 open(B,">>$opts{modsfile}") or do {
1963 debug("Error: Cannot open $opts{modsfile}: $!");
1964 chanmsg("Error: Cannot open $opts{modsfile}: $!");
1967 print B ts()."$mesg\n";
1973 if (! -d ".dbbackup/") { mkdir(".dbbackup",0700); }
1974 if ($^O ne "MSWin32") {
1975 system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time());
1978 system("copy $opts{dbfile} .dbbackup\\$opts{dbfile}".time());
1983 my $username = shift;
1984 return 0 if !defined($username);
1985 return 0 if !exists($rps{$username});
1988 questpencheck($username);
1989 if ($type eq "quit") {
1990 $pen = int(20 * ($opts{rppenstep}**$rps{$username}{level}));
1991 if ($opts{limitpen} && $pen > $opts{limitpen}) {
1992 $pen = $opts{limitpen};
1994 $rps{$username}{pen_quit}+=$pen;
1995 $rps{$username}{online}=0;
1997 elsif ($type eq "nick") {
1998 my $newnick = shift;
1999 $pen = int(30 * ($opts{rppenstep}**$rps{$username}{level}));
2000 if ($opts{limitpen} && $pen > $opts{limitpen}) {
2001 $pen = $opts{limitpen};
2003 $rps{$username}{pen_nick}+=$pen;
2004 $rps{$username}{nick} = substr($newnick,1);
2005 substr($rps{$username}{userhost},0,length($rps{$username}{nick})) =
2007 notice("Penalty of ".duration($pen)." added to your timer for ".
2008 "nick change.",$rps{$username}{nick});
2010 elsif ($type eq "privmsg" || $type eq "notice") {
2011 $pen = int(shift(@_) * ($opts{rppenstep}**$rps{$username}{level}));
2012 if ($opts{limitpen} && $pen > $opts{limitpen}) {
2013 $pen = $opts{limitpen};
2015 $rps{$username}{pen_mesg}+=$pen;
2016 notice("Penalty of ".duration($pen)." added to your timer for ".
2017 $type.".",$rps{$username}{nick});
2019 elsif ($type eq "part") {
2020 $pen = int(200 * ($opts{rppenstep}**$rps{$username}{level}));
2021 if ($opts{limitpen} && $pen > $opts{limitpen}) {
2022 $pen = $opts{limitpen};
2024 $rps{$username}{pen_part}+=$pen;
2025 notice("Penalty of ".duration($pen)." added to your timer for ".
2026 "parting.",$rps{$username}{nick});
2027 $rps{$username}{online}=0;
2029 elsif ($type eq "kick") {
2030 $pen = int(250 * ($opts{rppenstep}**$rps{$username}{level}));
2031 if ($opts{limitpen} && $pen > $opts{limitpen}) {
2032 $pen = $opts{limitpen};
2034 $rps{$username}{pen_kick}+=$pen;
2035 notice("Penalty of ".duration($pen)." added to your timer for ".
2036 "being kicked.",$rps{$username}{nick});
2037 $rps{$username}{online}=0;
2039 elsif ($type eq "logout") {
2040 $pen = int(20 * ($opts{rppenstep}**$rps{$username}{level}));
2041 if ($opts{limitpen} && $pen > $opts{limitpen}) {
2042 $pen = $opts{limitpen};
2044 $rps{$username}{pen_logout} += $pen;
2045 notice("Penalty of ".duration($pen)." added to your timer for ".
2046 "LOGOUT command.",$rps{$username}{nick});
2047 $rps{$username}{online}=0;
2049 $rps{$username}{next} += $pen;
2050 return 1; # successfully penalized a user! woohoo!
2054 (my $text = shift) =~ s/[\r\n]//g;
2056 if ($opts{debug} || $opts{verbose}) {
2057 open(DBG,">>$opts{debugfile}") or do {
2058 chanmsg("Error: Cannot open debug file: $!");
2061 print DBG ts()."$text\n";
2064 if ($die) { die("$text\n"); }
2070 return undef if !defined($nick);
2071 for my $user (keys(%rps)) {
2072 next unless $rps{$user}{online};
2073 if ($rps{$user}{nick} eq $nick) { return $user; }
2078 sub ha { # return 0/1 if username has access
2080 if (!defined($user) || !exists($rps{$user})) {
2081 debug("Error: Attempted ha() for invalid username \"$user\"");
2084 return $rps{$user}{isadmin};
2087 sub checksplits { # removed expired split hosts from the hash
2089 while ($host = each(%split)) {
2090 if (time()-$split{$host}{time} > $opts{splitwait}) {
2091 $rps{$split{$host}{account}}{online} = 0;
2092 delete($split{$host});
2097 sub collision_fight {
2099 my $mysum = itemsum($u,1);
2100 my $oppsum = itemsum($opp,1);
2101 my $myroll = int(rand($mysum));
2102 my $opproll = int(rand($oppsum));
2103 if ($myroll >= $opproll) {
2104 my $gain = int($rps{$opp}{level}/4);
2105 $gain = 7 if $gain < 7;
2106 $gain = int(($gain/100)*$rps{$u}{next});
2107 chanmsg(clog("$u [$myroll/$mysum] has come upon $opp [$opproll/$oppsum".
2108 "] and taken them in combat! ".duration($gain)." is ".
2109 "removed from $u\'s clock."));
2110 $rps{$u}{next} -= $gain;
2111 chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
2112 if (rand(35) < 1 && $opp ne $primnick) {
2113 $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
2114 chanmsg(clog("$u has dealt $opp a Critical Strike! ".
2115 duration($gain)." is added to $opp\'s clock."));
2116 $rps{$opp}{next} += $gain;
2117 chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).
2120 elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
2121 my @items = ("ring","amulet","charm","weapon","helm","tunic",
2122 "pair of gloves","set of leggings","shield",
2124 my $type = $items[rand(@items)];
2125 if (int($rps{$opp}{item}{$type}) > int($rps{$u}{item}{$type})) {
2126 chanmsg("In the fierce battle, $opp dropped his level ".
2127 int($rps{$opp}{item}{$type})." $type! $u picks it up, ".
2128 "tossing his old level ".int($rps{$u}{item}{$type}).
2130 my $tempitem = $rps{$u}{item}{$type};
2131 $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
2132 $rps{$opp}{item}{$type} = $tempitem;
2137 my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
2138 $gain = 7 if $gain < 7;
2139 $gain = int(($gain/100)*$rps{$u}{next});
2140 chanmsg(clog("$u [$myroll/$mysum] has come upon $opp [$opproll/$oppsum".
2141 "] and been defeated in combat! ".duration($gain)." is ".
2142 "added to $u\'s clock."));
2143 $rps{$u}{next} += $gain;
2144 chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
2146 if ($opp ne $primnick) {
2147 debug("interrogation");
2148 my $csfactor = $rps{$opp}{alignment} eq "g" ? 50 :
2149 $rps{$opp}{alignment} eq "e" ? 20 :
2151 if (rand($csfactor) < 1) {
2152 $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
2153 chanmsg(clog("$opp has captured and interrogated $u! ".
2154 duration($gain)." is removed from $opp\'s clock."));
2155 $rps{$opp}{next} -= $gain;
2156 chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).".");
2162 sub writequestfile {
2163 return unless $opts{writequestfile};
2164 open(QF,">$opts{questfilename}") or do {
2165 chanmsg("Error: Cannot open $opts{questfilename}: $!");
2168 # if no active quest, just empty questfile. otherwise, write it
2169 if (@{$quest{questers}}) {
2170 if ($quest{type}==1) {
2171 print QF "T $quest{text}\n".
2173 "S $quest{qtime}\n".
2174 "P1 $quest{questers}->[0]\n".
2175 "P2 $quest{questers}->[1]\n".
2176 "P3 $quest{questers}->[2]\n".
2177 "P4 $quest{questers}->[3]\n";
2179 elsif ($quest{type}==2) {
2180 print QF "T $quest{text}\n".
2182 "S $quest{stage}\n".
2183 "P $quest{p1}->[0] $quest{p1}->[1] $quest{p2}->[0] ".
2184 "$quest{p2}->[1]\n".
2185 "P1 $quest{questers}->[0] $rps{$quest{questers}->[0]}{x} ".
2186 "$rps{$quest{questers}->[0]}{y}\n".
2187 "P2 $quest{questers}->[1] $rps{$quest{questers}->[1]}{x} ".
2188 "$rps{$quest{questers}->[1]}{y}\n".
2189 "P3 $quest{questers}->[2] $rps{$quest{questers}->[2]}{x} ".
2190 "$rps{$quest{questers}->[2]}{y}\n".
2191 "P4 $quest{questers}->[3] $rps{$quest{questers}->[3]}{x} ".
2192 "$rps{$quest{questers}->[3]}{y}\n";
2199 my @players = grep { $rps{$_}{alignment} eq "g" &&
2200 $rps{$_}{online} } keys(%rps);
2201 return unless @players > 1;
2202 splice(@players,int(rand(@players)),1) while @players > 2;
2203 my $gain = 5 + int(rand(8));
2204 chanmsg(clog("$players[0] and $players[1] have not let the iniquities of ".
2205 "evil men poison them. Together have they prayed to their ".
2206 "god, and it is his light that now shines upon them. $gain\% ".
2207 "of their time is removed from their clocks."));
2208 $rps{$players[0]}{next} = int($rps{$players[0]}{next}*(1 - ($gain/100)));
2209 $rps{$players[1]}{next} = int($rps{$players[1]}{next}*(1 - ($gain/100)));
2210 chanmsg("$players[0] reaches next level in ".
2211 duration($rps{$players[0]}{next}).".");
2212 chanmsg("$players[1] reaches next level in ".
2213 duration($rps{$players[1]}{next}).".");
2217 my @evil = grep { $rps{$_}{alignment} eq "e" &&
2218 $rps{$_}{online} } keys(%rps);
2219 return unless @evil;
2220 my $me = $evil[rand(@evil)];
2221 if (int(rand(2)) < 1) {
2222 # evil only steals from good :^(
2223 my @good = grep { $rps{$_}{alignment} eq "g" &&
2224 $rps{$_}{online} } keys(%rps);
2225 my $target = $good[rand(@good)];
2226 my @items = ("ring","amulet","charm","weapon","helm","tunic",
2227 "pair of gloves","set of leggings","shield",
2229 my $type = $items[rand(@items)];
2230 if (int($rps{$target}{item}{$type}) > int($rps{$me}{item}{$type})) {
2231 my $tempitem = $rps{$me}{item}{$type};
2232 $rps{$me}{item}{$type} = $rps{$target}{item}{$type};
2233 $rps{$target}{item}{$type} = $tempitem;
2234 chanmsg(clog("$me stole $target\'s level ".
2235 int($rps{$me}{item}{$type})." $type while they were ".
2236 "sleeping! $me leaves his old level ".
2237 int($rps{$target}{item}{$type})." $type behind, ".
2238 "which $target then takes."));
2241 notice("You made to steal $target\'s $type, but realized it was ".
2242 "lower level than your own. You creep back into the ".
2243 "shadows.",$rps{$me}{nick});
2246 else { # being evil only pays about half of the time...
2247 my $gain = 1 + int(rand(5));
2248 chanmsg(clog("$me is forsaken by his evil god. ".
2249 duration(int($rps{$me}{next} * ($gain/100)))." is added ".
2251 $rps{$me}{next} = int($rps{$me}{next} * (1 + ($gain/100)));
2252 chanmsg("$me reaches next level in ".duration($rps{$me}{next}).".");
2256 sub fisher_yates_shuffle {
2259 for ($i = @$array; --$i; ) {
2260 my $j = int rand ($i+1);
2262 @$array[$i,$j] = @$array[$j,$i];
2267 open(RPS,">$opts{dbfile}") or do {
2268 chanmsg("ERROR: Cannot write $opts{dbfile}: $!");
2271 print RPS join("\t","# username",
2304 keys(%rps); # reset internal pointer
2305 while ($k=each(%rps)) {
2306 if (exists($rps{$k}{next}) && defined($rps{$k}{next})) {
2307 print RPS join("\t",$k,
2324 $rps{$k}{pen_quest},
2325 $rps{$k}{pen_logout},
2327 $rps{$k}{lastlogin},
2328 $rps{$k}{item}{amulet},
2329 $rps{$k}{item}{charm},
2330 $rps{$k}{item}{helm},
2331 $rps{$k}{item}{"pair of boots"},
2332 $rps{$k}{item}{"pair of gloves"},
2333 $rps{$k}{item}{ring},
2334 $rps{$k}{item}{"set of leggings"},
2335 $rps{$k}{item}{shield},
2336 $rps{$k}{item}{tunic},
2337 $rps{$k}{item}{weapon},
2338 $rps{$k}{alignment})."\n";
2345 if (! -e ".irpg.conf") {
2346 debug("Error: Cannot find .irpg.conf. Copy it to this directory, ".
2350 open(CONF,"<.irpg.conf") or do {
2351 debug("Failed to open config file .irpg.conf: $!",1);
2353 my($line,$key,$val);
2354 while ($line=<CONF>) {
2355 next() if $line =~ /^#/; # skip comments
2356 $line =~ s/[\r\n]//g;
2358 next() if !length($line); # skip blank lines
2359 ($key,$val) = split(/\s+/,$line,2);
2361 if (lc($val) eq "on" || lc($val) eq "yes") { $val = 1; }
2362 elsif (lc($val) eq "off" || lc($val) eq "no") { $val = 0; }
2363 if ($key eq "die") {
2364 die("Please edit the file .irpg.conf to setup your bot's ".
2365 "options. Also, read the README file if you haven't ".
2368 elsif ($key eq "server") { push(@{$opts{servers}},$val); }
2369 elsif ($key eq "okurl") { push(@{$opts{okurl}},$val); }
2370 else { $opts{$key} = $val; }