diff --git a/Irpg/Irc.pm b/Irpg/Irc.pm index 3dab3beac98dbbdc5d8930f9a61070c54e4d22f4..795372cfc9680b91c2a90f1c67db78690cca7fdf 100644 --- a/Irpg/Irc.pm +++ b/Irpg/Irc.pm @@ -20,6 +20,7 @@ use warnings; use IO::Socket; use IO::Select; use Irpg::Utils; +use Irpg::Main qw($silentmode); use Exporter qw(import); our @EXPORT_OK = qw($sock @queue &irc_connect &irc_clean &checkmsg &fq &sts &privmsg &chanmsg ¬ice $inbytes); our %EXPORT_TAGS = (connection=>[qw($sock &irc_connect &irc_clean &checkmsg &fq)], @@ -197,14 +198,12 @@ sub sts { # send to server =over =item SCALAR (string) - message to send =item SCALAR (string) - target -=item SCALAR (int) - silentmode =item SCALAR (bool) - force (default false) =back =cut sub privmsg { # send a message to an arbitrary entity my $msg = shift or return undef; my $target = shift or return undef; - my $silentmode = shift; my $force = shift; if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2)) && !$force) { diff --git a/Irpg/Main.pm b/Irpg/Main.pm index adde6ab9e55a009ea0a898b10362543f7fe0a907..c7e7dab9a8f650d5f62bab5c5b3828b04e2f405e 100644 --- a/Irpg/Main.pm +++ b/Irpg/Main.pm @@ -13,13 +13,14 @@ use strict; use warnings; use Irpg::Utils qw(&checksplits &duration &backup &writedb); use Irpg::Irc qw(:interaction $inbytes); -use Irpg::Example; use Irpg::Quest; use Irpg::Fight; use Irpg::Event; use Irpg::Admin; +use Irpg::Users; use Exporter qw(import); -our @EXPORT = qw(&init_hashes &rpcheck &parse); +our @EXPORT = qw(&init_hashes &rpcheck &parse &penalize &ha); +our @EXPORT_OK = qw($pausemode $silentmode $primnick $lastreg); my %commands; # filling at the very bottom @@ -27,7 +28,6 @@ my %commands; # filling at the very bottom my $rpreport = 0; # constant for reporting top players my $lastreg = 0; # holds the time of the last reg. cleared every second. # prevents more than one account being registered / second -my $registrations = 0; # count of registrations this period my $lasttime = 1; # last time that rpcheck() was run my %split; # holds nick!user@hosts for clients that have been netsplit my %onchan; # users on game channel @@ -65,6 +65,7 @@ sub reloaddb { } +my $primnick; my $opts; my $rps; my $prev_online; @@ -80,9 +81,12 @@ my $auto_login; =cut sub init_hashes { ($opts, $rps, $prev_online, $auto_login) = @_; + $primnick = $opts->{botnick}; # for regain or register checks Irpg::Quest::init_hashes($opts, $rps); Irpg::Fight::init_hashes($opts, $rps); Irpg::Event::init_hashes($opts, $rps); + Irpg::Admin::init_hashes($opts, $rps); + Irpg::Users::init_hashes($opts, $rps); } @@ -170,7 +174,6 @@ sub penalize { } elsif ($type eq "logout") { $pen = int(20 * ($opts->{rppenstep}**$rps->{$username}{level})); - $rps->{$username}{online}=0; $reason = 'LOGOUT command'; $pen_key = 'pen_logout';; } @@ -509,11 +512,11 @@ sub parse { } -while (my ($k,$v) (each %$Irpg::Example::commands)) {$commands{$k} = $v;} while (my ($k,$v) (each %$Irpg::Quest::commands)) {$commands{$k} = $v;} while (my ($k,$v) (each %$Irpg::Fight::commands)) {$commands{$k} = $v;} while (my ($k,$v) (each %$Irpg::Event::commands)) {$commands{$k} = $v;} while (my ($k,$v) (each %$Irpg::Admin::commands)) {$commands{$k} = $v;} +while (my ($k,$v) (each %$Irpg::Users::commands)) {$commands{$k} = $v;} $commands{pause} = {ref => \&spause_mode, adm => 1, prv => 1, pub => 0} $commands{silent} = {ref => \&silent_mode, adm => 1, prv => 1, pub => 0} diff --git a/Irpg/Users.pm b/Irpg/Users.pm new file mode 100644 index 0000000000000000000000000000000000000000..25abf8a534331e4cb906baccbe52936baa604fa6 --- /dev/null +++ b/Irpg/Users.pm @@ -0,0 +1,376 @@ +package Irpg::User; + +use strict; +use warnings; +use Irpg::Utils qw(:data :text); +use Irpg::Irc qw(:interaction @queue); +use Irpg::Main qw($pausemode $silentmode $primnick $lastreg); + + +my $opts; +my $rps; +=head1 FUNCTION init_hashes + This function sets the references to + options and players hashes. +=over +=item SCALAR (ref) - reference to the options hash +=item SCALAR (ref) - reference to the players hash +=cut +sub init_hashes { ($opts, $rps) = @_; } + +sub register { + my ($usernick, $username, $source, @arg) = @_; + + if (defined $username) { + privmsg("Sorry, you are already online as $username.", + $usernick); + } + else { + if ($#arg < 3 || $arg[2] eq "") { + privmsg("Try: REGISTER <char name> <password> <class>", + $usernick); + privmsg("IE : REGISTER Poseidon MyPassword M God of the ". + "Sea",$usernick); + } + elsif ($pausemode) { + privmsg("Sorry, new accounts may not be registered ". + "while the bot is in pause mode; please wait ". + "a few minutes and try again.",$usernick); + } + elsif (exists $rps->{$arg[0]} || ($opts->{casematters} && + scalar(grep { lc($arg[0]) eq lc($_) } keys(%$rps)))) { + privmsg("Sorry, that character name is already in use.", + $usernick); + } + elsif (lc($arg[0]) eq lc($opts->{botnick}) || + lc($arg[0]) eq lc($primnick)) { + privmsg("Sorry, that character name cannot be ". + "registered.",$usernick); + } + elsif (!exists($onchan{$usernick})) { + privmsg("Sorry, you're not in $opts->{botchan}.", + $usernick); + } + elsif (length($arg[0]) > 16 || length($arg[0]) < 1) { + privmsg("Sorry, character names must be < 17 and > 0 ". + "chars long.", $usernick); + } + elsif ($arg[0] =~ /^#/) { + privmsg("Sorry, character names may not begin with #.", + $usernick); + } + elsif ($arg[0] =~ /\001/) { + privmsg("Sorry, character names may not include ". + "character \\001.",$usernick); + } + elsif ($opts->{noccodes} && ($arg[0] =~ /[[:cntrl:]]/ || + "@arg[2..$#arg]" =~ /[[:cntrl:]]/)) { + privmsg("Sorry, neither character names nor classes ". + "may include control codes.",$usernick); + } + elsif ($opts->{nononp} && ($arg[0] =~ /[[:^print:]]/ || + "@arg[2..$#arg]" =~ /[[:^print:]]/)) { + privmsg("Sorry, neither character names nor classes ". + "may include non-printable chars.",$usernick); + } + elsif (length("@arg[3..$#arg]") > 30) { + privmsg("Sorry, character classes must be < 31 chars ". + "long.",$usernick); + } + elsif (time() == $lastreg) { + privmsg("Wait 1 second and try again.",$usernick); + } + else { + if ($opts->{voiceonlogin}) { + sts("MODE $opts->{botchan} +v :$usernick"); + } + $lastreg = time(); + $rps->{$arg[0]}{next} = $opts->{rpbase}; + $rps->{$arg[0]}{class} = "@arg[6..$#arg]"; + $rps->{$arg[0]}{level} = 0; + $rps->{$arg[0]}{online} = 1; + $rps->{$arg[0]}{nick} = $usernick; + $rps->{$arg[0]}{userhost} = $arg[0]; + $rps->{$arg[0]}{created} = time(); + $rps->{$arg[0]}{lastlogin} = time(); + $rps->{$arg[0]}{pass} = crypt($arg[1],mksalt()); + $rps->{$arg[0]}{x} = int(rand($opts->{mapx})); + $rps->{$arg[0]}{y} = int(rand($opts->{mapy})); + $rps->{$arg[0]}{alignment}="n"; + $rps->{$arg[0]}{gender}="n"; + $rps->{$arg[0]}{isadmin} = 0; + for my $item ("ring","amulet","charm","weapon","helm", + "tunic","pair of gloves","shield", + "set of leggings","pair of boots") { + $rps->{$arg[0]}{item}{$item} = 0; + } + for my $pen ("pen_mesg","pen_nick","pen_part", + "pen_kick","pen_quit","pen_quest", + "pen_logout","pen_logout","pen_class") { + $rps->{$arg[0]}{$pen} = 0; + } + chanmsg("Welcome $usernick\'s new player $arg[0], the ". + "@arg[6..$#arg]! Next level in ". + duration($opts->{rpbase})."."); + privmsg("Success! Account $arg[0] created. You have ". + "$opts->{rpbase} seconds idleness until you ". + "reach level 1. ", $usernick); + privmsg("NOTE: The point of the game is to see who ". + "can idle the longest. As such, ". + "parting, quitting, and changing ". + "nicks all penalize you.",$usernick); + } + } +} + + +sub chclass { + my ($usernick, $username, $source, @arg) = @_; + if ($#arg < 3) { + privmsg("Try: CHCLASS <char name> <passwd> <new char class>", + $usernick, 1); + } + elsif (!exists($rps->{$arg[0]})) { + privmsg("No such username $arg[0].", $usernick, 1); + } + elsif ($rps->{$arg[0]}{pass} ne + crypt($arg[1],$rps->{$arg[0]}{pass})) { + notice("Wrong password.", $usernick); + } + else { + $rps->{$arg[0]}{class} = "@arg[2..$#arg]"; + privmsg("Class for $arg[0] changed to @arg[2..$#arg].", + $usernick, 1); + chanmsg("Class for $arg[0] changed to @arg[2..$#arg]."); + penalize($username,"chclass"); + } +} + + +sub login { + my ($usernick, $username, $source, @arg) = @_; + if (defined($username)) { + notice("Sorry, you are already online as $username.", + $usernick); + } + else { + if ($#arg < 2 || $arg[1] eq "") { + notice("Try: LOGIN <username> <password>", $usernick); + } + elsif (!exists $rps->{$arg[0]}) { + notice("Sorry, no such account name. Note that ". + "account names are case sensitive.",$usernick); + } + elsif (!exists $onchan{$opts->{botchan}}{$usernick}) { + notice("Sorry, you're not in $opts->{botchan}.", + $usernick); + } + elsif ($rps->{$arg[0]}{pass} ne + crypt($arg[1],$rps->{$arg[0]}{pass})) { + notice("Wrong password.", $usernick); + } + else { + if ($opts->{voiceonlogin}) { + sts("MODE $opts->{botchan} +v :$usernick"); + } + $rps->{$arg[0]}{online} = 1; + $rps->{$arg[0]}{nick} = $usernick; + $rps->{$arg[0]}{userhost} = $arg[0]; + $rps->{$arg[0]}{lastlogin} = time(); + chanmsg("$arg[0], the level $rps->{$arg[0]}{level} ". + "$rps->{$arg[0]}{class}, is now online from ". + "nickname $usernick. Next level in ". + duration($rps->{$arg[0]}{next})."."); + notice("Logon successful. Next level in ". + duration($rps->{$arg[0]}{next}).".", $usernick); + } + } +} + +sub logout { + my ($usernick, $username, $source, @arg) = @_; + if (defined($username)) { + $rps->{$username}{online}=0; + penalize($username,"logout"); + } + else { + privmsg("You are not logged in.", $usernick); + } +} + +sub status { + return unless ($opts->{statuscmd}) + my ($usernick, $username, $source, @arg) = @_; + if (!defined($username)) { + privmsg("You are not logged in.", $usernick); + } + # argument is optional + elsif ($arg[0] && !exists($rps->{$arg[0]})) { + privmsg("No such user.",$usernick); + } + elsif ($arg[0]) { # optional 'user' argument + privmsg("$arg[0]: Level $rps->{$arg[0]}{level} ". + "$rps->{$arg[0]}{class}; Status: O". + ($rps->{$arg[0]}{online}?"n":"ff")."line; ". + "TTL: ".duration($rps->{$arg[0]}{next})."; ". + "Idled: ".duration($rps->{$arg[0]}{idled}). + "; Item sum: ".itemsum($arg[0]). + "; More details at ".$opts->{playerurl}.$arg[0] + ,$usernick); + } + else { # no argument, look up this user + privmsg("$username: Level $rps->{$username}{level} ". + "$rps->{$username}{class}; Status: O". + ($rps->{$username}{online}?"n":"ff")."line; ". + "TTL: ".duration($rps->{$username}{next})."; ". + "Idled: ".duration($rps->{$username}{idled})."; ". + "Item sum: ".itemsum($username). + "; More details at ".$opts->{playerurl}.$username + ,$usernick); + } +} + +sub whoami { + my ($usernick, $username, $source, @arg) = @_; + if (!defined($username)) { + privmsg("You are not logged in.", $usernick); + } + else { + privmsg("You are $username, the level ". + $rps->{$username}{level}." $rps->{$username}{class}. ". + "Next level in ".duration($rps->{$username}{next}), + $usernick); + } +} + +sub newpass { + my ($usernick, $username, $source, @arg) = @_; + if (!defined($username)) { + privmsg("You are not logged in.", $usernick) + } + elsif (!defined($arg[0])) { + privmsg("Try: NEWPASS <new password>", $usernick); + } + else { + $rps->{$username}{pass} = crypt($arg[0],mksalt()); + privmsg("Your password was changed.",$usernick); + } +} + +sub align { + my ($usernick, $username, $source, @arg) = @_; + if (!defined($username)) { + privmsg("You are not logged in.", $usernick) + } + elsif (!defined($arg[0]) || (lc($arg[0]) ne "good" && + lc($arg[0]) ne "neutral" && lc($arg[0]) ne "evil")) { + privmsg("Try: ALIGN <good|neutral|evil>", $usernick); + } + else { + $rps->{$username}{alignment} = substr(lc($arg[0]),0,1); + chanmsg("$username has changed alignment to: ".lc($arg[0]). + "."); + privmsg("Your alignment was changed to ".lc($arg[0]).".", + $usernick); + } +} + +sub gender { + my ($usernick, $username, $source, @arg) = @_; + if (!defined($username)) { + privmsg("You are not logged in.", $usernick) + } + elsif (!defined($arg[0]) || $arg[0] =~ /[^MFN]/) { + privmsg("Try: GENDER <M|F|N>",$usernick); + } + else { + $rps->{$username}{gender} = substr(lc($arg[0]),0,1); + chanmsg("$username has changed gender to: ".lc($arg[0]). + "."); + privmsg("Your gender was changed to ".lc($arg[0]).".", + $usernick); + } +} + +sub rmplayer { + my ($usernick, $username, $source, @arg) = @_; + if (!defined($username)) { + privmsg("You are not logged in.", $usernick) + } + else { + privmsg("Account $username removed.",$usernick); + chanmsg("$usernick removed his account, $username, the ". + $rps->{$username}{class}."."); + delete($rps->{$username}); + } +} + +sub help { + my ($usernick, $username, $source, @arg) = @_; + if (!ha($username) || $source !~ /^#/) { + privmsg("For information on IRPG bot commands, see ". + $opts->{helpurl}, $source); + } + else { + privmsg("Help URL is $opts->{helpurl}", $usernick, 1); + privmsg("Admin commands URL is $opts->{admincommurl}", + $usernick, 1); + } +} + +sub info { + my ($usernick, $username, $source, @arg) = @_; + if (!ha($username)) { + $info = "IRPG bot v$version by ElTata, ". + "based on jotun's initial work.". + "https://gennuso.iiens.net/irpg. On via server: ". + $opts->{servers}->[0].". Admins online: ". + join(", ", map { $rps->{$_}{nick} } + grep { $rps->{$_}{isadmin} && + $rps->{$_}{online} } keys(%$rps))."."; + privmsg($info, $usernick); + } + else { + my $queuedbytes = 0; + $queuedbytes += (length($_)+2) for @queue; # +2 = \r\n + $info = sprintf( + "%.2fkb sent, %.2fkb received in %s. %d IRPG users ". + "online of %d total users. PAUSE_MODE is %d, ". + "SILENT_MODE is %d. Outgoing queue is %d bytes ". + "in %d items. On via: %s. Admins online: %s.", + $outbytes/1024, + $inbytes/1024, + duration(time()-$^T), + scalar(grep { $rps->{$_}{online} } keys(%$rps)), + scalar(keys(%$rps)), + $pausemode, + $silentmode, + $queuedbytes, + scalar(@queue), + $opts->{servers}->[0], + join(", ",map { $rps->{$_}{nick} } + grep { $rps->{$_}{isadmin} && $rps->{$_}{online} } + keys(%$rps))); + privmsg($info, $usernick, 1); + } +} + + + my ($usernick, $username, $source, @arg) = @_; + +our $commands = { + register => {ref => \®ister, adm => 0, prv => 1, pub => 0}, + chclass => {ref => \&chclass, adm => 0, prv => 1, pub => 0}, + login => {ref => \&login, adm => 0, prv => 1, pub => 0}, + logout => {ref => \&logout, adm => 0, prv => 1, pub => 0}, + status => {ref => \&status, adm => 0, prv => 1, pub => 1}, + whoami => {ref => \&whoami, adm => 0, prv => 1, pub => 1}, + newpass => {ref => \&newpass, adm => 0, prv => 1, pub => 0}, + align => {ref => \&align, adm => 0, prv => 1, pub => 1}, + gender => {ref => \&gender, adm => 0, prv => 1, pub => 1}, + removeme => {ref => \&rmplayer, adm => 0, prv => 1, pub => 1}, + help => {ref => \&help, adm => 0, prv => 1, pub => 1}, + info => {ref => \&info, adm => 0, prv => 1, pub => 0} +} + +1; diff --git a/Irpg/Utils.pm b/Irpg/Utils.pm index 655c1cda227e70e56fa876d9fb50371c712f3228..7499db5fd4194c10101cfd3c12e4c7e5b31cd4ed 100644 --- a/Irpg/Utils.pm +++ b/Irpg/Utils.pm @@ -25,7 +25,7 @@ our @EXPORT_OK = qw(&set_debug_status &daemonize &ts &mksalt &checksplits &duration &pronoun &readconfig &createdb &loaddb &backup &writedb); -our %EXPORT_TAGS = (text=>[qw(&duration &pronoun)], +our %EXPORT_TAGS = (text=>[qw(&duration &pronoun &mksalt)], data=>[qw(&readconfig &createdb &loaddb &backup &writedb)]); diff --git a/irpg_bot.pl b/irpg_bot.pl index 9901bec3ba72dbcbf160ead86330a7e3368b1e6f..33095039fc3b00d7e27aaccc8a57063ce69fe736 100644 --- a/irpg_bot.pl +++ b/irpg_bot.pl @@ -135,14 +135,10 @@ $opts{help} and do { help(); exit 0; }; debug("Config: read $_: ".Dumper($opts{$_})) for keys(%opts); -my $primnick = $opts{botnick}; # for regain or register checks my $rps = {}; # role-players my $prev_online = {}; # user@hosts online on restart, die my $auto_login = {}; # users to automatically log back on -my $pausemode = 0; # pausemode on/off flag -my $silentmode = 0; # silent mode 0/1/2/3, see head of file - $rps = createdb(\%opts) unless -e $opts{dbfile}; print "\n".debug("Becoming a daemon...")."\n";