diff --git a/lib/PBot/AntiFlood.pm b/lib/PBot/AntiFlood.pm index 8cce5d44..b1536482 100644 --- a/lib/PBot/AntiFlood.pm +++ b/lib/PBot/AntiFlood.pm @@ -14,6 +14,8 @@ use parent 'PBot::Class'; use PBot::Imports; +use PBot::MessageHistory::Constants ':all'; + use Time::HiRes qw(gettimeofday tv_interval); use Time::Duration; use POSIX qw/strftime/; @@ -32,7 +34,7 @@ sub initialize { $self->{changinghost} = {}; # tracks nicks changing hosts/identifying to strongly link them my $filename = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/ban-exemptions'; - $self->{'ban-exemptions'} = PBot::DualIndexHashObject->new(name => 'Ban exemptions', filename => $filename, pbot => $self->{pbot}); + $self->{'ban-exemptions'} = PBot::Storage::DualIndexHashObject->new(name => 'Ban exemptions', filename => $filename, pbot => $self->{pbot}); $self->{'ban-exemptions'}->load; $self->{pbot}->{event_queue}->enqueue(sub { $self->adjust_offenses }, 60 * 60 * 1, 'Adjust anti-flood offenses'); @@ -237,10 +239,10 @@ sub update_join_watch { my $channel_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $channel, 'join_watch'); - if ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN}) { + if ($mode == MSG_JOIN) { $channel_data->{join_watch}++; $self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $channel, $channel_data); - } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) { + } elsif ($mode == MSG_DEPARTURE) { # PART or QUIT # check QUIT message for netsplits, and decrement joinwatch to allow a free rejoin if ($text =~ /^QUIT .*\.net .*\.split/) { @@ -258,7 +260,7 @@ sub update_join_watch { } else { # some other type of QUIT or PART } - } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}) { + } elsif ($mode == MSG_CHAT) { # reset joinwatch if they send a message if ($channel_data->{join_watch} > 0) { $channel_data->{join_watch} = 0; @@ -267,6 +269,8 @@ sub update_join_watch { } } +# TODO: break this gigantic function up into simple plugins +# e.g. PBot::Plugin::AntiAbuse::ChatFlood, ::JoinFlood, ::EnterAbuse, etc. sub check_flood { my ($self, $channel, $nick, $user, $host, $text, $max_messages, $max_time, $mode, $context) = @_; $channel = lc $channel; @@ -275,7 +279,7 @@ sub check_flood { my $oldnick = $nick; my $account; - if ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN} and exists $self->{changinghost}->{$nick}) { + if ($mode == MSG_JOIN and exists $self->{changinghost}->{$nick}) { $self->{pbot}->{logger}->log("Finalizing host change for $nick.\n"); $account = delete $self->{changinghost}->{$nick}; @@ -306,7 +310,7 @@ sub check_flood { $self->{pbot}->{messagehistory}->{database}->update_hostmask_data($mask, {last_seen => scalar gettimeofday}); - if ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { + if ($mode == MSG_NICKCHANGE) { $self->{pbot}->{logger}->log(sprintf("%-18s | %-65s | %s\n", "NICKCHANGE", $mask, $text)); my ($newnick) = $text =~ m/NICKCHANGE (.*)/; @@ -330,7 +334,7 @@ sub check_flood { $self->{pbot}->{logger}->log("Processing anti-flood account $account " . ($ancestor != $account ? "[ancestor $ancestor] " : '') . "for mask $mask\n") if $self->{pbot}->{registry}->get_value('antiflood', 'debug_account'); - if ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { + if ($mode == MSG_NICKCHANGE) { $self->{nickflood}->{$ancestor}->{changes}++; $self->{pbot}->{logger}->log("account $ancestor has $self->{nickflood}->{$ancestor}->{changes} nickchanges\n"); } @@ -338,8 +342,9 @@ sub check_flood { # handle QUIT events # (these events come from $channel nick!user@host, not a specific channel or nick, # so they need to be dispatched to all channels the nick has been seen on) - if ($mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE} and $text =~ /^QUIT/) { + if ($mode == MSG_DEPARTURE and $text =~ /^QUIT/) { my $channels = $self->{pbot}->{nicklist}->get_channels($nick); + foreach my $chan (@$channels) { next if $chan !~ m/^#/; $self->update_join_watch($account, $chan, $text, $mode); @@ -356,7 +361,7 @@ sub check_flood { } my $channels; - if ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { + if ($mode == MSG_NICKCHANGE) { $channels = $self->{pbot}->{nicklist}->get_channels($oldnick); } else { $self->update_join_watch($account, $channel, $text, $mode); @@ -369,7 +374,7 @@ sub check_flood { next if $chan =~ /^#/ and not $self->{pbot}->{chanops}->can_gain_ops($chan); my $u = $self->{pbot}->{users}->loggedin($chan, "$nick!$user\@$host"); - if ($chan =~ /^#/ and $mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) { + if ($chan =~ /^#/ and $mode == MSG_DEPARTURE) { # remove validation on PART or KICK so we check for ban-evasion when user returns at a later time my $chan_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $chan, 'validated'); if ($chan_data->{validated} & $self->{NICKSERV_VALIDATED}) { @@ -391,16 +396,16 @@ sub check_flood { my $validated = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $chan, 'validated')->{'validated'}; if ($validated & $self->{NEEDS_CHECKBAN} or not $validated & $self->{NICKSERV_VALIDATED}) { - if ($mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) { + if ($mode == MSG_DEPARTURE) { # don't check for evasion on PART/KICK - } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { + } elsif ($mode == MSG_NICKCHANGE) { if (not exists $self->{whois_pending}->{$nick}) { $self->{pbot}->{messagehistory}->{database}->set_current_nickserv_account($account, ''); $self->{pbot}->{conn}->whois($nick); $self->{whois_pending}->{$nick} = gettimeofday; } } else { - if ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN} && exists $self->{pbot}->{irc_capabilities}->{'extended-join'}) { + if ($mode == MSG_JOIN && exists $self->{pbot}->{irc_capabilities}->{'extended-join'}) { # don't WHOIS joins if extended-join capability is active } elsif (not exists $self->{pbot}->{irc_capabilities}->{'account-notify'}) { if (not exists $self->{whois_pending}->{$nick}) { @@ -436,20 +441,20 @@ sub check_flood { # check for chat/join/private message flooding if ( $max_messages > 0 - and $self->{pbot}->{messagehistory}->{database}->get_max_messages($account, $chan, $mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE} ? $nick : undef) >= + and $self->{pbot}->{messagehistory}->{database}->get_max_messages($account, $chan, $mode == MSG_NICKCHANGE ? $nick : undef) >= $max_messages) { my $msg; - if ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}) { + if ($mode == MSG_CHAT) { $msg = $self->{pbot}->{messagehistory}->{database}->recall_message_by_count($account, $chan, $max_messages - 1); - } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN}) { - my $joins = $self->{pbot}->{messagehistory}->{database}->get_recent_messages($account, $chan, $max_messages, $self->{pbot}->{messagehistory}->{MSG_JOIN}); + } elsif ($mode == MSG_JOIN) { + my $joins = $self->{pbot}->{messagehistory}->{database}->get_recent_messages($account, $chan, $max_messages, MSG_JOIN); $msg = $joins->[0]; - } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { + } elsif ($mode == MSG_NICKCHANGE) { my $nickchanges = - $self->{pbot}->{messagehistory}->{database}->get_recent_messages($ancestor, $chan, $max_messages, $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}, $nick); + $self->{pbot}->{messagehistory}->{database}->get_recent_messages($ancestor, $chan, $max_messages, MSG_NICKCHANGE, $nick); $msg = $nickchanges->[0]; - } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}) { + } elsif ($mode == MSG_DEPARTURE) { # no flood checks to be done for departure events next; } else { @@ -458,17 +463,17 @@ sub check_flood { } my $last; - if ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { + if ($mode == MSG_NICKCHANGE) { $last = $self->{pbot}->{messagehistory}->{database}->recall_message_by_count($ancestor, $chan, 0, undef, $nick); } else { $last = $self->{pbot}->{messagehistory}->{database}->recall_message_by_count($account, $chan, 0); } if ($last->{timestamp} - $msg->{timestamp} <= $max_time) { - if ($mode == $self->{pbot}->{messagehistory}->{MSG_JOIN}) { + if ($mode == MSG_JOIN) { my $chan_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $chan, 'offenses', 'last_offense', 'join_watch'); - #$self->{pbot}->{logger}->log("$account offenses $chan_data->{offenses}, join watch $chan_data->{join_watch}, max messages $max_messages\n"); + $self->{pbot}->{logger}->log("$account offenses $chan_data->{offenses}, join watch $chan_data->{join_watch}, max messages $max_messages\n"); if ($chan_data->{join_watch} >= $max_messages) { $chan_data->{offenses}++; $chan_data->{last_offense} = gettimeofday; @@ -502,7 +507,7 @@ sub check_flood { $chan_data->{join_watch} = $max_messages - 2; # give them a chance to rejoin $self->{pbot}->{messagehistory}->{database}->update_channel_data($account, $chan, $chan_data); } - } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}) { + } elsif ($mode == MSG_CHAT) { if ($chan =~ /^#/) { #channel flood (opposed to private message or otherwise) # don't increment offenses again if already banned if ($self->{pbot}->{banlist}->has_ban_timeout($chan, "*!$user\@" . $self->address_to_mask($host))) { @@ -563,7 +568,7 @@ sub check_flood { $self->{pbot}->{conn}->privmsg($nick, "You have used too many commands in too short a time period, you have been ignored for $length."); } next; - } elsif ($mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE} and $self->{nickflood}->{$ancestor}->{changes} >= $max_messages) { + } elsif ($mode == MSG_NICKCHANGE and $self->{nickflood}->{$ancestor}->{changes} >= $max_messages) { next if $chan !~ /^#/; ($nick) = $text =~ m/NICKCHANGE (.*)/; @@ -602,13 +607,13 @@ sub check_flood { } # check for enter abuse - if ($mode == $self->{pbot}->{messagehistory}->{MSG_CHAT} and $chan =~ m/^#/) { + if ($mode == MSG_CHAT and $chan =~ m/^#/) { my $chan_data = $self->{pbot}->{messagehistory}->{database}->get_channel_data($account, $chan, 'enter_abuse', 'enter_abuses', 'offenses'); my $other_offenses = delete $chan_data->{offenses}; my $debug_enter_abuse = $self->{pbot}->{registry}->get_value('antiflood', 'debug_enter_abuse'); if (defined $self->{channels}->{$chan}->{last_spoken_nick} and $nick eq $self->{channels}->{$chan}->{last_spoken_nick}) { - my $messages = $self->{pbot}->{messagehistory}->{database}->get_recent_messages($account, $chan, 2, $self->{pbot}->{messagehistory}->{MSG_CHAT}); + my $messages = $self->{pbot}->{messagehistory}->{database}->get_recent_messages($account, $chan, 2, MSG_CHAT); my $enter_abuse_threshold = $self->{pbot}->{registry}->get_value($chan, 'enter_abuse_threshold'); my $enter_abuse_time_threshold = $self->{pbot}->{registry}->get_value($chan, 'enter_abuse_time_threshold'); @@ -697,7 +702,7 @@ sub check_flood { } } - $self->{channels}->{$channel}->{last_spoken_nick} = $nick if $mode == $self->{pbot}->{messagehistory}->{MSG_CHAT}; + $self->{channels}->{$channel}->{last_spoken_nick} = $nick if $mode == MSG_CHAT; } sub address_to_mask { diff --git a/lib/PBot/AntiSpam.pm b/lib/PBot/AntiSpam.pm index 86b4212d..b4e39249 100644 --- a/lib/PBot/AntiSpam.pm +++ b/lib/PBot/AntiSpam.pm @@ -16,7 +16,7 @@ use POSIX qw/strftime/; sub initialize { my ($self, %conf) = @_; my $filename = $conf{spamkeywords_file} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spam_keywords'; - $self->{keywords} = PBot::DualIndexHashObject->new(name => 'SpamKeywords', filename => $filename, pbot => $self->{pbot}); + $self->{keywords} = PBot::Storage::DualIndexHashObject->new(name => 'SpamKeywords', filename => $filename, pbot => $self->{pbot}); $self->{keywords}->load; $self->{pbot}->{registry}->add_default('text', 'antispam', 'enforce', $conf{enforce_antispam} // 1); diff --git a/lib/PBot/BanList.pm b/lib/PBot/BanList.pm index ee0e023c..cfdf2ee8 100644 --- a/lib/PBot/BanList.pm +++ b/lib/PBot/BanList.pm @@ -35,14 +35,14 @@ sub initialize { $self->{pbot}->{event_dispatcher}->register_handler('irc.endofbanlist', sub { $self->compare_banlist(@_) }); $self->{pbot}->{event_dispatcher}->register_handler('irc.endofquietlist', sub { $self->compare_quietlist(@_) }); - $self->{banlist} = PBot::DualIndexHashObject->new( + $self->{banlist} = PBot::Storage::DualIndexHashObject->new( pbot => $self->{pbot}, name => 'Ban List', filename => $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/banlist', save_queue_timeout => 15, ); - $self->{quietlist} = PBot::DualIndexHashObject->new( + $self->{quietlist} = PBot::Storage::DualIndexHashObject->new( pbot => $self->{pbot}, name => 'Quiet List', filename => $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quietlist', @@ -192,6 +192,7 @@ sub on_quietlist_entry { return 0; } +# irc.endofbanlist sub compare_banlist { my ($self, $event_type, $event) = @_; my $channel = lc $event->{event}->{args}[1]; @@ -235,6 +236,7 @@ sub compare_banlist { delete $self->{temp_banlist}->{$channel}->{'+b'}; } +# irc.endofquietlist sub compare_quietlist { my ($self, $event_type, $event) = @_; my $channel = lc $event->{event}->{args}[1]; diff --git a/lib/PBot/Capabilities.pm b/lib/PBot/Capabilities.pm index 7d8da8a8..82a530b4 100644 --- a/lib/PBot/Capabilities.pm +++ b/lib/PBot/Capabilities.pm @@ -17,206 +17,19 @@ sub initialize { my $filename = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/capabilities'; # capabilities hash table - $self->{caps} = PBot::HashObject->new(name => 'Capabilities', filename => $filename, pbot => $self->{pbot}); + $self->{caps} = PBot::Storage::HashObject->new(name => 'Capabilities', filename => $filename, pbot => $self->{pbot}); # load capabilities $self->{caps}->load; - # 'cap' command registered in PBot.pm because $self->{pbot}->{commands} is not yet loaded at this point. - # add some capabilities used in this file $self->add('can-modify-capabilities', undef, 1); $self->add('can-group-capabilities', undef, 1); - # add some useful capabilities + # add some misc capabilities $self->add('is-whitelisted', undef, 1); } -sub cmd_cap { - my ($self, $context) = @_; - - my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); - - given ($command) { - when ('list') { - my $cap = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); - return $self->list($cap); - } - - when ('whohas') { - my $cap = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); - - if (not defined $cap) { - return "Usage: cap whohas ; Lists all users who have "; - } - - if (not $self->exists($cap)) { - return "No such capability $cap."; - } - - my $result = "Users with capability $cap: "; - my $users = $self->{pbot}->{users}->{storage}; - my @matches; - - foreach my $name (sort $users->get_keys) { - my $u = $users->get_data($name); - - if ($self->userhas($u, $cap)) { - push @matches, $users->get_key_name($name); - } - } - - if (@matches) { - $result .= join(', ', @matches); - } else { - $result .= 'nobody'; - } - - return $result; - } - - when ('userhas') { - my ($name, $cap) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); - - if (not defined $name) { - return "Usage: cap userhas [capability]; Lists capabilities belonging to "; - } - - $cap = lc $cap if defined $cap; - - my $u = $self->{pbot}->{users}->{storage}->get_data($name); - - if (not defined $u) { - return "No such user $name."; - } - - $name = $self->{pbot}->{users}->{storage}->get_key_name($name); - - if (defined $cap) { - if (not $self->exists($cap)) { - return "Try again. No such capability $cap."; - } - - if ($self->userhas($u, $cap)) { - return "Yes. User $name has capability $cap."; - } else { - return "No. User $name does not have capability $cap."; - } - } else { - my @groups; - my @single; - - foreach my $key (sort keys %{$u}) { - next if $key eq '_name'; # skip internal cached metadata - next if not $self->exists($key); # skip metadata that isn't a capability - - my $count = $self->{caps}->get_keys; - - if ($count > 0) { - push @groups, "$key ($count cap" . ($count == 1 ? '' : 's') . ")"; - } else { - push @single, $key; - } - } - - if (@groups or @single) { - # first list all capabilities that have sub-capabilities (i.e. grouped capabilities) - # then list stand-alone (single) capabilities - return "User $name has capabilities: " . join ', ', @groups, @single; - } else { - return "User $name has no capabilities."; - } - } - } - - when ('group') { - my ($cap, $subcaps) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); - - if (not defined $cap or not defined $subcaps) { - return "Usage: cap group "; - } - - my $u = $self->{pbot}->{users}->loggedin($context->{from}, $context->{hostmask}); - - if (not defined $u) { - return "You must be logged into your user account to group capabilities together."; - } - - if (not $self->userhas($u, 'can-group-capabilities')) { - return "You must have the can-group-capabilities capability to group capabilities together."; - } - - my @caps = split /\s+|,\s*/, $subcaps; # split by spaces or comma - - foreach my $c (@caps) { - if (not $self->exists($c)) { - return "No such capability $c."; - } - - if (lc $cap eq lc $c) { - return "You cannot group a capability with itself."; - } - - $self->add($cap, $c); - } - - if (@caps > 1) { - return "Capabilities " . join(', ', @caps) . " added to the $cap capability group."; - } else { - return "Capability $subcaps added to the $cap capability group."; - } - } - - when ('ungroup') { - my ($cap, $subcaps) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); - - if (not defined $cap or not defined $subcaps) { - return "Usage: cap ungroup "; - } - - if (not $self->exists($cap)) { - return "No such capability $cap."; - } - - my $u = $self->{pbot}->{users}->loggedin($context->{from}, $context->{hostmask}); - - if (not defined $u) { - return "You must be logged into your user account to remove capabilities from groups."; - } - - if (not $self->userhas($u, 'can-group-capabilities')) { - return "You must have the can-group-capabilities capability to remove capabilities from groups."; - } - - my @caps = split /\s+|,\s*/, $subcaps; # split by spaces or comma - - foreach my $c (@caps) { - if (not $self->exists($c)) { - return "No such capability $c."; - } - - if (not $self->has($cap, $c)) { - return "Capability $c does not belong to the $cap capability group."; - } - - $self->remove($cap, $c); - } - - if (@caps > 1) { - return "Capabilities " . join(', ', @caps) . " removed from the $cap capability group."; - } else { - return "Capability $subcaps removed from the $cap capability group."; - } - } - - default { - return "Usage: cap list [capability] | cap group " - . "| cap ungroup | cap userhas [capability] " - . "| cap whohas "; - } - } -} - sub has { my ($self, $cap, $subcap, $depth) = @_; my $cap_data = $self->{caps}->get_data($cap); diff --git a/lib/PBot/ChanOps.pm b/lib/PBot/ChanOps.pm index 3fb30030..5399cf68 100644 --- a/lib/PBot/ChanOps.pm +++ b/lib/PBot/ChanOps.pm @@ -10,8 +10,6 @@ use parent 'PBot::Class'; use PBot::Imports; -use PBot::ChanOpCommands; - use Time::HiRes qw(gettimeofday); use Time::Duration qw(concise duration); @@ -22,8 +20,6 @@ sub initialize { $self->{is_opped} = {}; $self->{op_requested} = {}; - $self->{commands} = PBot::ChanOpCommands->new(pbot => $self->{pbot}); - $self->{pbot}->{registry}->add_default('text', 'general', 'deop_timeout', 300); # TODO: enqueue OP events as needed instead of naively checking every 10 seconds diff --git a/lib/PBot/Channels.pm b/lib/PBot/Channels.pm index 1db5bab9..3f759bdd 100644 --- a/lib/PBot/Channels.pm +++ b/lib/PBot/Channels.pm @@ -12,7 +12,7 @@ use PBot::Imports; sub initialize { my ($self, %conf) = @_; - $self->{storage} = PBot::HashObject->new(pbot => $self->{pbot}, name => 'Channels', filename => $conf{filename}); + $self->{storage} = PBot::Storage::HashObject->new(pbot => $self->{pbot}, name => 'Channels', filename => $conf{filename}); $self->{storage}->load; $self->{pbot}->{commands}->register(sub { $self->cmd_join(@_) }, "join", 1); diff --git a/lib/PBot/Class.pm b/lib/PBot/Class.pm index dc7a76b3..1ebb1044 100644 --- a/lib/PBot/Class.pm +++ b/lib/PBot/Class.pm @@ -13,8 +13,6 @@ use PBot::Imports; sub new { my ($class, %args) = @_; - my $self = bless {}, $class; - # ensure class was passed a PBot instance if (not exists $args{pbot}) { my ($package, $filename, $line) = caller(0); @@ -22,7 +20,7 @@ sub new { Carp::croak("Missing pbot reference to " . $class . ", created by $subroutine at $filename:$line"); } - $self->{pbot} = $args{pbot}; + my $self = bless { pbot => $args{pbot} }, $class; $self->{pbot}->{logger}->log("Initializing $class\n"); $self->initialize(%args); diff --git a/lib/PBot/Commands.pm b/lib/PBot/Commands.pm index e316a911..e9b692fc 100644 --- a/lib/PBot/Commands.pm +++ b/lib/PBot/Commands.pm @@ -11,7 +11,7 @@ use parent 'PBot::Class', 'PBot::Registerable'; use PBot::Imports; -use Time::Duration qw/duration/; +use PBot::Utils::LoadPackages qw/load_packages/; sub initialize { my ($self, %conf) = @_; @@ -20,153 +20,16 @@ sub initialize { $self->PBot::Registerable::initialize(%conf); # command metadata stored as a HashObject - $self->{metadata} = PBot::HashObject->new(pbot => $self->{pbot}, name => 'Command metadata', filename => $conf{filename}); + $self->{metadata} = PBot::Storage::HashObject->new(pbot => $self->{pbot}, name => 'Command metadata', filename => $conf{filename}); $self->{metadata}->load; - - # register commands to manipulate command metadata and obtain help - $self->register(sub { $self->cmd_set(@_) }, "cmdset", 1); - $self->register(sub { $self->cmd_unset(@_) }, "cmdunset", 1); - $self->register(sub { $self->cmd_help(@_) }, "help", 0); } -sub cmd_set { - my ($self, $context) = @_; +sub register_commands { + my ($self) = @_; - my ($command, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); - - if (not defined $command) { - return "Usage: cmdset [key [value]]"; - } - - return $self->{metadata}->set($command, $key, $value); -} - -sub cmd_unset { - my ($self, $context) = @_; - - my ($command, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); - - if (not defined $command or not defined $key) { - return "Usage: cmdunset "; - } - - return $self->{metadata}->unset($command, $key); -} - -sub cmd_help { - my ($self, $context) = @_; - - if (not length $context->{arguments}) { - return "For general help, see . For help about a specific command or factoid, use `help [channel]`."; - } - - my $keyword = lc $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); - - # check built-in commands first - if ($self->exists($keyword)) { - - # check for command metadata - if ($self->{metadata}->exists($keyword)) { - my $name = $self->{metadata}->get_key_name($keyword); - my $requires_cap = $self->{metadata}->get_data($keyword, 'requires_cap'); - my $help = $self->{metadata}->get_data($keyword, 'help'); - - my $result = "/say $name: "; - - # prefix help text with required capability - if ($requires_cap) { - $result .= "[Requires can-$keyword] "; - } - - if (not defined $help or not length $help) { - $result .= "I have no help text for this command yet. To add help text, use the command `cmdset $keyword help `."; - } else { - $result .= $help; - } - - return $result; - } - - # no command metadata available - return "$keyword is a built-in command, but I have no help for it yet."; - } - - # then factoids - my $channel_arg = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); - - if (not defined $channel_arg or not length $channel_arg) { - # set channel argument to from if no argument was passed - $channel_arg = $context->{from}; - } - - if ($channel_arg !~ /^#/) { - # set channel argument to global if it's not channel-like - $channel_arg = '.*'; - } - - # find factoids - my @factoids = $self->{pbot}->{factoids}->find_factoid($channel_arg, $keyword, exact_trigger => 1); - - if (not @factoids or not $factoids[0]) { - # nothing found - return "I don't know anything about $keyword."; - } - - my ($channel, $trigger); - - if (@factoids > 1) { - # ask to disambiguate factoids if found in multiple channels - if (not grep { $_->[0] eq $channel_arg } @factoids) { - return - "/say $keyword found in multiple channels: " - . (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids) - . "; use `help $keyword ` to disambiguate."; - } else { - foreach my $factoid (@factoids) { - if ($factoid->[0] eq $channel_arg) { - ($channel, $trigger) = ($factoid->[0], $factoid->[1]); - last; - } - } - } - } else { - ($channel, $trigger) = ($factoids[0]->[0], $factoids[0]->[1]); - } - - # get canonical channel and trigger names with original typographical casing - my $channel_name = $self->{pbot}->{factoids}->{storage}->get_key_name($channel); - my $trigger_name = $self->{pbot}->{factoids}->{storage}->get_key_name($channel, $trigger); - - # prettify channel name if it's ".*" - if ($channel_name eq '.*') { - $channel_name = 'global channel'; - } - - # prettify trigger name with double-quotes if it contains spaces - if ($trigger_name =~ / /) { - $trigger_name = "\"$trigger_name\""; - } - - # get factoid's `help` metadata - my $help = $self->{pbot}->{factoids}->{storage}->get_data($channel, $trigger, 'help'); - - # return immediately if no help text - if (not defined $help or not length $help) { - return "/say $trigger_name is a factoid for $channel_name, but I have no help text for it yet." - . " To add help text, use the command `factset $trigger_name help `."; - } - - my $result = "/say "; - - # if factoid doesn't belong to invoked or global channel, - # then prefix with the factoid's channel name. - if ($channel ne $context->{from} and $channel ne '.*') { - $result .= "[$channel_name] "; - } - - $result .= "$trigger_name: $help"; - - return $result; + # register commands in Commands directory + $self->{pbot}->{logger}->log("Registering commands:\n"); + load_packages($self, 'Commands'); } sub register { diff --git a/lib/PBot/Commands/Capabilities.pm b/lib/PBot/Commands/Capabilities.pm new file mode 100644 index 00000000..58fb3fd8 --- /dev/null +++ b/lib/PBot/Commands/Capabilities.pm @@ -0,0 +1,216 @@ +# File: Capabilities.pm +# +# Purpose: Registers the capabilities `cap` command. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::Commands::Capabilities; + +use PBot::Imports; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + $self->{pbot}->{commands}->register(sub { $self->cmd_cap(@_) }, "cap"); +} + +sub cmd_cap { + my ($self, $context) = @_; + + my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); + + given ($command) { + when ('list') { + my $cap = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); + return $self->{pbot}->{capabilities}->list($cap); + } + + when ('whohas') { + my $cap = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); + + if (not defined $cap) { + return "Usage: cap whohas ; Lists all users who have "; + } + + if (not $self->{pbot}->{capabilities}->exists($cap)) { + return "No such capability $cap."; + } + + my $result = "Users with capability $cap: "; + my $users = $self->{pbot}->{users}->{storage}; + my @matches; + + foreach my $name (sort $users->get_keys) { + my $u = $users->get_data($name); + + if ($self->{pbot}->{capabilities}->userhas($u, $cap)) { + push @matches, $users->get_key_name($name); + } + } + + if (@matches) { + $result .= join(', ', @matches); + } else { + $result .= 'nobody'; + } + + return $result; + } + + when ('userhas') { + my ($name, $cap) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); + + if (not defined $name) { + return "Usage: cap userhas [capability]; Lists capabilities belonging to "; + } + + $cap = lc $cap if defined $cap; + + my $u = $self->{pbot}->{users}->{storage}->get_data($name); + + if (not defined $u) { + return "No such user $name."; + } + + $name = $self->{pbot}->{users}->{storage}->get_key_name($name); + + if (defined $cap) { + if (not $self->{pbot}->{capabilities}->exists($cap)) { + return "Try again. No such capability $cap."; + } + + if ($self->{pbot}->{capabilities}->userhas($u, $cap)) { + return "Yes. User $name has capability $cap."; + } else { + return "No. User $name does not have capability $cap."; + } + } else { + my @groups; + my @single; + + foreach my $key (sort keys %{$u}) { + next if $key eq '_name'; # skip internal cached metadata + next if not $self->{pbot}->{capabilities}->exists($key); # skip metadata that isn't a capability + + my $count = $self->{pbot}->{capabilities}->{caps}->get_keys; + + if ($count > 0) { + push @groups, "$key ($count cap" . ($count == 1 ? '' : 's') . ")"; + } else { + push @single, $key; + } + } + + if (@groups or @single) { + # first list all capabilities that have sub-capabilities (i.e. grouped capabilities) + # then list stand-alone (single) capabilities + return "User $name has capabilities: " . join ', ', @groups, @single; + } else { + return "User $name has no capabilities."; + } + } + } + + when ('group') { + my ($cap, $subcaps) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); + + if (not defined $cap or not defined $subcaps) { + return "Usage: cap group "; + } + + my $u = $self->{pbot}->{users}->loggedin($context->{from}, $context->{hostmask}); + + if (not defined $u) { + return "You must be logged into your user account to group capabilities together."; + } + + if (not $self->{pbot}->{capabilities}->userhas($u, 'can-group-capabilities')) { + return "You must have the can-group-capabilities capability to group capabilities together."; + } + + my @caps = split /\s+|,\s*/, $subcaps; # split by spaces or comma + + foreach my $c (@caps) { + if (not $self->{pbot}->{capabilities}->exists($c)) { + return "No such capability $c."; + } + + if (lc $cap eq lc $c) { + return "You cannot group a capability with itself."; + } + + $self->{pbot}->{capabilities}->add($cap, $c); + } + + if (@caps > 1) { + return "Capabilities " . join(', ', @caps) . " added to the $cap capability group."; + } else { + return "Capability $subcaps added to the $cap capability group."; + } + } + + when ('ungroup') { + my ($cap, $subcaps) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); + + if (not defined $cap or not defined $subcaps) { + return "Usage: cap ungroup "; + } + + if (not $self->{pbot}->{capabilities}->exists($cap)) { + return "No such capability $cap."; + } + + my $u = $self->{pbot}->{users}->loggedin($context->{from}, $context->{hostmask}); + + if (not defined $u) { + return "You must be logged into your user account to remove capabilities from groups."; + } + + if (not $self->{pbot}->{capabilities}->userhas($u, 'can-group-capabilities')) { + return "You must have the can-group-capabilities capability to remove capabilities from groups."; + } + + my @caps = split /\s+|,\s*/, $subcaps; # split by spaces or comma + + foreach my $c (@caps) { + if (not $self->{pbot}->{capabilities}->exists($c)) { + return "No such capability $c."; + } + + if (not $self->{pbot}->{capabilities}->has($cap, $c)) { + return "Capability $c does not belong to the $cap capability group."; + } + + $self->{pbot}->{capabilities}->remove($cap, $c); + } + + if (@caps > 1) { + return "Capabilities " . join(', ', @caps) . " removed from the $cap capability group."; + } else { + return "Capability $subcaps removed from the $cap capability group."; + } + } + + default { + return "Usage: cap list [capability] | cap group " + . "| cap ungroup | cap userhas [capability] " + . "| cap whohas "; + } + } +} + +1; diff --git a/lib/PBot/ChanOpCommands.pm b/lib/PBot/Commands/ChanOp.pm similarity index 96% rename from lib/PBot/ChanOpCommands.pm rename to lib/PBot/Commands/ChanOp.pm index df17c2e8..c68fc388 100644 --- a/lib/PBot/ChanOpCommands.pm +++ b/lib/PBot/Commands/ChanOp.pm @@ -1,18 +1,30 @@ -# File: ChanOpCommands.pm +# File: ChanOp.pm # # Purpose: Channel operator command subroutines. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::ChanOpCommands; -use parent 'PBot::Class'; +package PBot::Commands::ChanOp; use PBot::Imports; use Time::Duration; use Time::HiRes qw/gettimeofday/; +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + sub initialize { my ($self, %conf) = @_; @@ -88,28 +100,43 @@ sub initialize { } sub on_inviting { - my ($self, $event_type, $event) = @_; - my ($botnick, $target, $channel) = $event->{event}->args; + my ($self, $event_type, $event) = @_; + + my ($botnick, $target, $channel) = $event->{event}->args; + $self->{pbot}->{logger}->log("User $target invited to channel $channel.\n"); - return 0 if not exists $self->{invites}->{lc $channel} or not exists $self->{invites}->{lc $channel}->{lc $target}; + + if (not exists $self->{invites}->{lc $channel} or not exists $self->{invites}->{lc $channel}->{lc $target}) { + return 0; + } + $event->{conn}->privmsg($self->{invites}->{lc $channel}->{lc $target}, "$target invited to $channel."); + delete $self->{invites}->{lc $channel}->{lc $target}; return 1; } sub on_useronchannel { - my ($self, $event_type, $event) = @_; - my ($botnick, $target, $channel) = $event->{event}->args; + my ($self, $event_type, $event) = @_; + + my ($botnick, $target, $channel) = $event->{event}->args; + $self->{pbot}->{logger}->log("User $target is already on channel $channel.\n"); - return 0 if not exists $self->{invites}->{lc $channel} or not exists $self->{invites}->{lc $channel}->{lc $target}; + + if (not exists $self->{invites}->{lc $channel} or not exists $self->{invites}->{lc $channel}->{lc $target}) { + return 0; + } + $event->{conn}->privmsg($self->{invites}->{lc $channel}->{lc $target}, "$target is already on $channel."); + delete $self->{invites}->{lc $channel}->{lc $target}; return 1; } sub on_nosuchnick { - my ($self, $event_type, $event) = @_; - my ($botnick, $target, $msg) = $event->{event}->args; + my ($self, $event_type, $event) = @_; + + my ($botnick, $target, $msg) = $event->{event}->args; $self->{pbot}->{logger}->log("$target: $msg\n"); diff --git a/lib/PBot/Commands/CommandMetadata.pm b/lib/PBot/Commands/CommandMetadata.pm new file mode 100644 index 00000000..0c3da925 --- /dev/null +++ b/lib/PBot/Commands/CommandMetadata.pm @@ -0,0 +1,57 @@ +# File: CommandMetadata.pm +# +# Purpose: Registers commands for manipulating command metadata. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::Commands::CommandMetadata; + +use PBot::Imports; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + # register commands to manipulate command metadata + $self->{pbot}->{commands}->register(sub { $self->cmd_set(@_) }, "cmdset", 1); + $self->{pbot}->{commands}->register(sub { $self->cmd_unset(@_) }, "cmdunset", 1); +} + +sub cmd_set { + my ($self, $context) = @_; + + my ($command, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3); + + if (not defined $command) { + return "Usage: cmdset [key [value]]"; + } + + return $self->{metadata}->set($command, $key, $value); +} + +sub cmd_unset { + my ($self, $context) = @_; + + my ($command, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2); + + if (not defined $command or not defined $key) { + return "Usage: cmdunset "; + } + + return $self->{metadata}->unset($command, $key); +} + +1; diff --git a/lib/PBot/FactoidCommands.pm b/lib/PBot/Commands/Factoids.pm similarity index 98% rename from lib/PBot/FactoidCommands.pm rename to lib/PBot/Commands/Factoids.pm index ec2b667e..6ee890bd 100644 --- a/lib/PBot/FactoidCommands.pm +++ b/lib/PBot/Commands/Factoids.pm @@ -1,12 +1,11 @@ -# File: FactoidCommands.pm +# File: Factoids.pm # -# Purpose: Factoid command subroutines. +# Purpose: Factoids command subroutines. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::FactoidCommands; -use parent 'PBot::Class'; +package PBot::Commands::Factoids; use PBot::Imports; @@ -41,9 +40,23 @@ our %factoid_metadata_capabilities = ( # all others are allowed to be factset by anybody ); +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + sub initialize { my ($self, %conf) = @_; - $self->{pbot}->{registry}->add_default('text', 'general', 'module_repo', $conf{module_repo} // 'https://github.com/pragma-/pbot/blob/master/modules/'); + $self->{pbot}->{registry}->add_default('text', 'general', 'module_repo', $conf{module_repo} + // 'https://github.com/pragma-/pbot/blob/master/modules/'); $self->{pbot}->{commands}->register(sub { $self->cmd_factadd(@_) }, "learn", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_factadd(@_) }, "factadd", 0); @@ -849,8 +862,8 @@ sub cmd_factinfo { $channel_name = 'global' if $channel_name eq '.*'; $trigger_name = "\"$trigger_name\"" if $trigger_name =~ / /; - my $created_ago = ago(gettimeofday - $factoids->get_data($channel, $trigger, 'created_on')); - my $ref_ago = ago(gettimeofday - $factoids->get_data($channel, $trigger, 'last_referenced_on')) if defined $factoids->get_data($channel, $trigger, 'last_referenced_on'); + my $created_ago = concise ago(gettimeofday - $factoids->get_data($channel, $trigger, 'created_on')); + my $ref_ago = concise ago(gettimeofday - $factoids->get_data($channel, $trigger, 'last_referenced_on')) if defined $factoids->get_data($channel, $trigger, 'last_referenced_on'); # factoid if ($factoids->get_data($channel, $trigger, 'type') eq 'text') { @@ -865,7 +878,7 @@ sub cmd_factinfo { ? 'last edited by ' . $factoids->get_data($channel, $trigger, 'edited_by') . ' on ' . localtime($factoids->get_data($channel, $trigger, 'edited_on')) . " [" - . ago(gettimeofday - $factoids->get_data($channel, $trigger, 'edited_on')) . "], " + . concise ago(gettimeofday - $factoids->get_data($channel, $trigger, 'edited_on')) . "], " : "" ) . "referenced " @@ -908,7 +921,7 @@ sub cmd_factinfo { ? 'last edited by ' . $factoids->get_data($channel, $trigger, 'edited_by') . ' on ' . localtime($factoids->get_data($channel, $trigger, 'edited_on')) . " [" - . ago(gettimeofday - $factoids->get_data($channel, $trigger, 'edited_on')) . "], " + . concise ago(gettimeofday - $factoids->get_data($channel, $trigger, 'edited_on')) . "], " : "" ) . ' used ' @@ -1200,7 +1213,7 @@ sub cmd_factchange { if ($@) { my $err = $@; - $err =~ s/ at PBot\/FactoidCommand.*$//; + $err =~ s/ at PBot\/.*$//; return "/msg $context->{nick} Change $trigger_name failed: $err"; } return $ret if length $ret; diff --git a/lib/PBot/Commands/Help.pm b/lib/PBot/Commands/Help.pm new file mode 100644 index 00000000..3e089838 --- /dev/null +++ b/lib/PBot/Commands/Help.pm @@ -0,0 +1,147 @@ +# File: Help.pm +# +# Purpose: Registers `help` command. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::Commands::Help; + +use PBot::Imports; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + $self->{pbot}->{commands}->register(sub { $self->cmd_help(@_) }, 'help'); +} + +sub cmd_help { + my ($self, $context) = @_; + + if (not length $context->{arguments}) { + return "For general help, see . For help about a specific command or factoid, use `help [channel]`."; + } + + my $keyword = lc $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); + + # check built-in commands first + if ($self->exists($keyword)) { + + # check for command metadata + if ($self->{metadata}->exists($keyword)) { + my $name = $self->{metadata}->get_key_name($keyword); + my $requires_cap = $self->{metadata}->get_data($keyword, 'requires_cap'); + my $help = $self->{metadata}->get_data($keyword, 'help'); + + my $result = "/say $name: "; + + # prefix help text with required capability + if ($requires_cap) { + $result .= "[Requires can-$keyword] "; + } + + if (not defined $help or not length $help) { + $result .= "I have no help text for this command yet. To add help text, use the command `cmdset $keyword help `."; + } else { + $result .= $help; + } + + return $result; + } + + # no command metadata available + return "$keyword is a built-in command, but I have no help for it yet."; + } + + # then factoids + my $channel_arg = $self->{pbot}->{interpreter}->shift_arg($context->{arglist}); + + if (not defined $channel_arg or not length $channel_arg) { + # set channel argument to from if no argument was passed + $channel_arg = $context->{from}; + } + + if ($channel_arg !~ /^#/) { + # set channel argument to global if it's not channel-like + $channel_arg = '.*'; + } + + # find factoids + my @factoids = $self->{pbot}->{factoids}->find_factoid($channel_arg, $keyword, exact_trigger => 1); + + if (not @factoids or not $factoids[0]) { + # nothing found + return "I don't know anything about $keyword."; + } + + my ($channel, $trigger); + + if (@factoids > 1) { + # ask to disambiguate factoids if found in multiple channels + if (not grep { $_->[0] eq $channel_arg } @factoids) { + return + "/say $keyword found in multiple channels: " + . (join ', ', sort map { $_->[0] eq '.*' ? 'global' : $_->[0] } @factoids) + . "; use `help $keyword ` to disambiguate."; + } else { + foreach my $factoid (@factoids) { + if ($factoid->[0] eq $channel_arg) { + ($channel, $trigger) = ($factoid->[0], $factoid->[1]); + last; + } + } + } + } else { + ($channel, $trigger) = ($factoids[0]->[0], $factoids[0]->[1]); + } + + # get canonical channel and trigger names with original typographical casing + my $channel_name = $self->{pbot}->{factoids}->{storage}->get_key_name($channel); + my $trigger_name = $self->{pbot}->{factoids}->{storage}->get_key_name($channel, $trigger); + + # prettify channel name if it's ".*" + if ($channel_name eq '.*') { + $channel_name = 'global channel'; + } + + # prettify trigger name with double-quotes if it contains spaces + if ($trigger_name =~ / /) { + $trigger_name = "\"$trigger_name\""; + } + + # get factoid's `help` metadata + my $help = $self->{pbot}->{factoids}->{storage}->get_data($channel, $trigger, 'help'); + + # return immediately if no help text + if (not defined $help or not length $help) { + return "/say $trigger_name is a factoid for $channel_name, but I have no help text for it yet." + . " To add help text, use the command `factset $trigger_name help `."; + } + + my $result = "/say "; + + # if factoid doesn't belong to invoked or global channel, + # then prefix with the factoid's channel name. + if ($channel ne $context->{from} and $channel ne '.*') { + $result .= "[$channel_name] "; + } + + $result .= "$trigger_name: $help"; + + return $result; +} + +1; diff --git a/lib/PBot/MiscCommands.pm b/lib/PBot/Commands/Misc.pm similarity index 95% rename from lib/PBot/MiscCommands.pm rename to lib/PBot/Commands/Misc.pm index 47261f4c..81620c59 100644 --- a/lib/PBot/MiscCommands.pm +++ b/lib/PBot/Commands/Misc.pm @@ -1,4 +1,4 @@ -# File: MiscCommands.pm +# File: Misc.pm # # Purpose: Registers misc PBot commands that don't really belong in any # other file. @@ -6,13 +6,25 @@ # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::MiscCommands; -use parent 'PBot::Class'; +package PBot::Commands::Misc; use PBot::Imports; use Time::Duration qw/duration/; +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + sub initialize { my ($self, %conf) = @_; diff --git a/lib/PBot/RegistryCommands.pm b/lib/PBot/Commands/Registry.pm similarity index 96% rename from lib/PBot/RegistryCommands.pm rename to lib/PBot/Commands/Registry.pm index cd9ec0d4..75bfde4b 100644 --- a/lib/PBot/RegistryCommands.pm +++ b/lib/PBot/Commands/Registry.pm @@ -1,15 +1,27 @@ -# File: RegistryCommands.pm +# File: Registry.pm # # Purpose: Bot commands to manipulate Registry entries. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::RegistryCommands; -use parent 'PBot::Class'; +package PBot::Commands::Registry; use PBot::Imports; +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + sub initialize { my ($self, %conf) = @_; $self->{pbot}->{commands}->register(sub { $self->cmd_regset(@_) }, "regset", 1); diff --git a/lib/PBot/Factoids.pm b/lib/PBot/Factoids.pm index 85f241bb..f4d2e899 100644 --- a/lib/PBot/Factoids.pm +++ b/lib/PBot/Factoids.pm @@ -17,8 +17,6 @@ use POSIX qw(strftime); use Text::ParseWords; use JSON; -use PBot::FactoidCommands; - use PBot::Utils::Indefinite; use PBot::Utils::ValidateString; @@ -67,9 +65,7 @@ sub initialize { $self->{pbot} = $self->{pbot}; - $self->{storage} = PBot::DualIndexSQLiteObject->new(name => 'Factoids', filename => $filename, pbot => $self->{pbot}); - - $self->{commands} = PBot::FactoidCommands->new(pbot => $self->{pbot}); + $self->{storage} = PBot::Storage::DualIndexSQLiteObject->new(name => 'Factoids', filename => $filename, pbot => $self->{pbot}); $self->{pbot}->{registry}->add_default('text', 'factoids', 'default_rate_limit', 15); $self->{pbot}->{registry}->add_default('text', 'factoids', 'max_name_length', 100); diff --git a/lib/PBot/IRCHandlers.pm b/lib/PBot/IRCHandlers.pm index aeca57fa..4772faad 100644 --- a/lib/PBot/IRCHandlers.pm +++ b/lib/PBot/IRCHandlers.pm @@ -1,9 +1,7 @@ # File: IRCHandlers.pm # -# Purpose: Subroutines to handle IRC events. Note that various PBot packages -# can in turn register their own IRC event handlers as well. There can be -# multiple handlers for PRIVMSG spread throughout the bot and its plugins, -# for example. +# Purpose: Pipes the PBot::IRC default handler through PBot::EventDispatcher, +# and loads all the packages in the IRCHandlers directory. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT @@ -13,77 +11,58 @@ use parent 'PBot::Class'; use PBot::Imports; -use Time::HiRes qw/time/; -use Data::Dumper; +use PBot::Utils::LoadPackages; -use MIME::Base64; -use Encode; +use Data::Dumper; sub initialize { my ($self, %conf) = @_; - # convenient alias so the following lines aren't so long - my $ed = $self->{pbot}->{event_dispatcher}; - - # various IRC events (note that other PBot packages and plugins can - # also register additional IRC event handlers, including handlers for - # the events listed here. any duplicate events will be chained.) - $ed->register_handler('irc.welcome', sub { $self->on_connect (@_) }); - $ed->register_handler('irc.disconnect', sub { $self->on_disconnect (@_) }); - $ed->register_handler('irc.motd', sub { $self->on_motd (@_) }); - $ed->register_handler('irc.notice', sub { $self->on_notice (@_) }); - $ed->register_handler('irc.public', sub { $self->on_public (@_) }); - $ed->register_handler('irc.caction', sub { $self->on_action (@_) }); - $ed->register_handler('irc.msg', sub { $self->on_msg (@_) }); - $ed->register_handler('irc.mode', sub { $self->on_mode (@_) }); - $ed->register_handler('irc.part', sub { $self->on_departure (@_) }); - $ed->register_handler('irc.join', sub { $self->on_join (@_) }); - $ed->register_handler('irc.kick', sub { $self->on_kick (@_) }); - $ed->register_handler('irc.quit', sub { $self->on_departure (@_) }); - $ed->register_handler('irc.nick', sub { $self->on_nickchange (@_) }); - $ed->register_handler('irc.nicknameinuse', sub { $self->on_nicknameinuse (@_) }); - $ed->register_handler('irc.invite', sub { $self->on_invite (@_) }); - $ed->register_handler('irc.isupport', sub { $self->on_isupport (@_) }); - $ed->register_handler('irc.channelmodeis', sub { $self->on_channelmodeis (@_) }); - $ed->register_handler('irc.topic', sub { $self->on_topic (@_) }); - $ed->register_handler('irc.topicinfo', sub { $self->on_topicinfo (@_) }); - $ed->register_handler('irc.channelcreate', sub { $self->on_channelcreate (@_) }); - $ed->register_handler('irc.yourhost', sub { $self->log_first_arg (@_) }); - $ed->register_handler('irc.created', sub { $self->log_first_arg (@_) }); - $ed->register_handler('irc.luserconns', sub { $self->log_first_arg (@_) }); - $ed->register_handler('irc.notregistered', sub { $self->log_first_arg (@_) }); - $ed->register_handler('irc.n_local', sub { $self->log_third_arg (@_) }); - $ed->register_handler('irc.n_global', sub { $self->log_third_arg (@_) }); - $ed->register_handler('irc.nononreg', sub { $self->on_nononreg (@_) }); - $ed->register_handler('irc.whoreply', sub { $self->on_whoreply (@_) }); - $ed->register_handler('irc.whospcrpl', sub { $self->on_whospcrpl (@_) }); - $ed->register_handler('irc.endofwho', sub { $self->on_endofwho (@_) }); - - # IRCv3 client capabilities - $ed->register_handler('irc.cap', sub { $self->on_cap(@_) }); - - # IRCv3 SASL - $ed->register_handler('irc.authenticate', sub { $self->on_sasl_authenticate (@_) }); - $ed->register_handler('irc.rpl_loggedin', sub { $self->on_rpl_loggedin (@_) }); - $ed->register_handler('irc.rpl_loggedout', sub { $self->on_rpl_loggedout (@_) }); - $ed->register_handler('irc.err_nicklocked', sub { $self->on_err_nicklocked (@_) }); - $ed->register_handler('irc.rpl_saslsuccess', sub { $self->on_rpl_saslsuccess (@_) }); - $ed->register_handler('irc.err_saslfail', sub { $self->on_err_saslfail (@_) }); - $ed->register_handler('irc.err_sasltoolong', sub { $self->on_err_sasltoolong (@_) }); - $ed->register_handler('irc.err_saslaborted', sub { $self->on_err_saslaborted (@_) }); - $ed->register_handler('irc.err_saslalready', sub { $self->on_err_saslalready (@_) }); - $ed->register_handler('irc.rpl_saslmechs', sub { $self->on_rpl_saslmechs (@_) }); - - # bot itself joining and parting channels - $ed->register_handler('pbot.join', sub { $self->on_self_join(@_) }); - $ed->register_handler('pbot.part', sub { $self->on_self_part(@_) }); - - # TODO: enqueue these events as needed instead of naively checking every 10 seconds - $self->{pbot}->{event_queue}->enqueue(sub { $self->check_pending_whos }, 10, 'Check pending WHOs'); + # register all the IRC handlers in the IRCHandlers directory + $self->register_handlers(%conf); } -# default PBot::IRC handler. this handler prepends 'irc.' to the event-type -# and then dispatches the event through PBot::EventDispatcher +# registers handlers with a PBot::IRC connection + +sub add_handlers { + my ($self) = @_; + + # set up handlers for the IRC engine + $self->{pbot}->{conn}->add_default_handler( + sub { $self->default_handler(@_) }, 1); + + # send these events to on_init() + $self->{pbot}->{conn}->add_handler([251, 252, 253, 254, 255, 302], + sub { $self->{irchandlers}->{Server}->on_init(@_) }); + + # ignore these events + $self->{pbot}->{conn}->add_handler( + [ + 'myinfo', + 'whoisserver', + 'whoiscountry', + 'whoischannels', + 'whoisidle', + 'motdstart', + 'endofmotd', + 'away', + ], + sub { } + ); +} + +# registers all the IRC handler files in the IRCHandlers directory + +sub register_handlers { + my ($self, %conf) = @_; + + $self->{pbot}->{logger}->log("Registering IRC handlers:\n"); + load_packages($self, 'IRCHandlers'); +} + +# this default handler prepends 'irc.' to the event-type and then dispatches +# the event to the rest of PBot via PBot::EventDispatcher. + sub default_handler { my ($self, $conn, $event) = @_; @@ -95,6 +74,7 @@ sub default_handler { } ); + # log event if it was not handled and logging is requested if (not defined $result and $self->{pbot}->{registry}->get_value('irc', 'log_default_handler')) { $Data::Dumper::Sortkeys = 1; $Data::Dumper::Indent = 2; @@ -103,943 +83,18 @@ sub default_handler { } } -sub on_init { - my ($self, $conn, $event) = @_; - my (@args) = ($event->args); - shift @args; - $self->{pbot}->{logger}->log("*** @args\n"); -} - -sub on_connect { - my ($self, $event_type, $event) = @_; - - $self->{pbot}->{logger}->log("Connected!\n"); - - if (not $self->{pbot}->{irc_capabilities}->{sasl}) { - # not using SASL, so identify the old way by /msging NickServ or some such services bot - if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) { - $self->{pbot}->{logger}->log("Identifying with NickServ . . .\n"); - - my $nickserv = $self->{pbot}->{registry}->get_value('general', 'identify_nick') // 'nickserv'; - my $command = $self->{pbot}->{registry}->get_value('general', 'identify_command') // 'identify $nick $password'; - - my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); - my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password'); - - $command =~ s/\$nick\b/$botnick/g; - $command =~ s/\$password\b/$password/g; - - $event->{conn}->privmsg($nickserv, $command); - } else { - # using SASL, we're already identified at this point - $self->{pbot}->{logger}->log("No identify password; skipping identification to services.\n"); - } - - # auto-join channels unless general.autojoin_wait_for_nickserv is true - if (not $self->{pbot}->{registry}->get_value('general', 'autojoin_wait_for_nickserv')) { - $self->{pbot}->{logger}->log("Autojoining channels immediately; to wait for services set general.autojoin_wait_for_nickserv to 1.\n"); - $self->{pbot}->{channels}->autojoin; - } else { - $self->{pbot}->{logger}->log("Waiting for services identify response before autojoining channels.\n"); - } - } else { - # using SASL; go ahead and auto-join channels now - $self->{pbot}->{logger}->log("Autojoining channels.\n"); - $self->{pbot}->{channels}->autojoin; - } - - return 0; -} - -sub on_disconnect { - my ($self, $event_type, $event) = @_; - - $self->{pbot}->{logger}->log("Disconnected...\n"); - $self->{pbot}->{connected} = 0; - - # attempt to reconnect to server - # TODO: maybe add a registry entry to control whether the bot auto-reconnects - $self->{pbot}->connect; - - return 0; -} - -sub on_motd { - my ($self, $event_type, $event) = @_; - - if ($self->{pbot}->{registry}->get_value('irc', 'show_motd')) { - my $from = $event->{event}->{from}; - my $msg = $event->{event}->{args}->[1]; - $self->{pbot}->{logger}->log("MOTD from $from :: $msg\n"); - } - - return 0; -} - -# the bot itself joining a channel -sub on_self_join { - my ($self, $event_type, $event) = @_; - - # early-return if we don't send WHO on join - # (we send WHO to see who is in the channel, for ban-evasion enforcement and such) - return 0 if not $self->{pbot}->{registry}->get_value('general', 'send_who_on_join') // 1; - - # we turn on send_who if the following conditions are met - my $send_who = 0; - - if ($self->{pbot}->{registry}->get_value('general', 'send_who_chanop_only') // 1) { - # check if we only send WHO to where we can gain ops - if ($self->{pbot}->{channels}->get_meta($event->{channel}, 'chanop')) { - # yup, we can +o in this channel, turn on send_who - $send_who = 1; - } - } else { - # otherwise just go ahead turn on send_who - $send_who = 1; - } - - # schedule the WHO to be sent to this channel - $self->send_who($event->{channel}) if $send_who; - - return 0; -} - -# the bot itself leaving a channel -sub on_self_part { - my ($self, $event_type, $event) = @_; - # nothing to do here yet - return 0; -} - -sub on_public { - my ($self, $event_type, $event) = @_; - - my ($from, $nick, $user, $host, $text) = ( - $event->{event}->{to}->[0], - $event->{event}->nick, - $event->{event}->user, - $event->{event}->host, - $event->{event}->{args}->[0], - ); - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - # send text to be processed for bot commands, anti-flood enforcement, etc - $event->{interpreted} = $self->{pbot}->{interpreter}->process_line($from, $nick, $user, $host, $text); - - return 0; -} - -sub on_msg { - my ($self, $event_type, $event) = @_; - - my ($nick, $user, $host, $text) = ( - $event->{event}->nick, - $event->{event}->user, - $event->{event}->host, - $event->{event}->{args}->[0], - ); - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - # send text to be processed as a bot command, coming from $nick - $event->{interpreted} = $self->{pbot}->{interpreter}->process_line($nick, $nick, $user, $host, $text, 1); - - return 0; -} - -sub on_notice { - my ($self, $event_type, $event) = @_; - - my ($nick, $user, $host, $to, $text) = ( - $event->{event}->nick, - $event->{event}->user, - $event->{event}->host, - $event->{event}->to, - $event->{event}->{args}->[0], - ); - - # log notice - $self->{pbot}->{logger}->log("NOTICE from $nick!$user\@$host to $to: $text\n"); - - # notice from NickServ - if ($nick eq 'NickServ') { - # if we have enabled NickServ GUARD protection and we're not identified yet, - # NickServ will warn us to identify -- this is our cue to identify. - if ($text =~ m/This nickname is registered/) { - if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) { - $self->{pbot}->{logger}->log("Identifying with NickServ . . .\n"); - $event->{conn}->privmsg("nickserv", "identify " . $self->{pbot}->{registry}->get_value('irc', 'identify_password')); - } - } - elsif ($text =~ m/You are now identified/) { - # we have identified with NickServ - if ($self->{pbot}->{registry}->get_value('irc', 'randomize_nick')) { - # if irc.randomize_nicks was enabled, we go ahead and attempt to - # change to our real botnick. we don't auto-join channels just yet in case - # the nick change fails. - $event->{conn}->nick($self->{pbot}->{registry}->get_value('irc', 'botnick')); - } else { - # otherwise go ahead and autojoin channels now - $self->{pbot}->{channels}->autojoin; - } - } - elsif ($text =~ m/has been ghosted/) { - # we have ghosted someone using our botnick, let's attempt to regain it now - $event->{conn}->nick($self->{pbot}->{registry}->get_value('irc', 'botnick')); - } - } else { - # if NOTICE is sent to the bot then replace the `to` field with the - # sender's nick instead so when we pass it on to on_public ... - if ($to eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) { - $event->{event}->{to}->[0] = $nick; - } - - # handle this NOTICE as a public message - # (check for bot commands, anti-flooding, etc) - $self->on_public($event_type, $event) unless $to eq '*'; - } - - return 0; -} - -sub on_action { - my ($self, $event_type, $event) = @_; - - # prepend "/me " to the message text - $event->{event}->{args}->[0] = "/me " . $event->{event}->{args}->[0]; - - # pass this along to on_public - $self->on_public($event_type, $event); - return 0; -} - -# FIXME: on_mode doesn't handle chanmodes that have parameters, e.g. +l -sub on_mode { - my ($self, $event_type, $event) = @_; - - my ($nick, $user, $host, $mode_string, $channel) = ( - $event->{event}->nick, - $event->{event}->user, - $event->{event}->host, - $event->{event}->{args}->[0], - lc $event->{event}->{to}->[0], - ); - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - my $i = 0; - my ($modifier, $char, $mode, $target); - - while ($mode_string =~ m/(.)/g) { - $char = $1; - - if ($char eq '-' or $char eq '+') { - $modifier = $char; - next; - } - - $mode = $modifier . $char; - $target = $event->{event}->{args}->[++$i]; - - $self->{pbot}->{logger}->log("Mode $channel [$mode" . (length $target ? " $target" : '') . "] by $nick!$user\@$host\n"); - - # TODO: figure out a good way to allow other packages to receive "track_mode" events - # i.e., perhaps by emitting a modechange event or some such and registering handlers - $self->{pbot}->{banlist}->track_mode("$nick!$user\@$host", $channel, $mode, $target); - $self->{pbot}->{chanops}->track_mode("$nick!$user\@$host", $channel, $mode, $target); - - if (defined $target and length $target) { - # mode set on user - my $message_account = $self->{pbot}->{messagehistory}->get_message_account($nick, $user, $host); - - $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, "MODE $mode $target", $self->{pbot}->{messagehistory}->{MSG_CHAT}); - - # TODO: here as well - if ($modifier eq '-') { - $self->{pbot}->{nicklist}->delete_meta($channel, $target, "+$char"); - } else { - $self->{pbot}->{nicklist}->set_meta($channel, $target, $mode, 1); - } - } else { - # mode set on channel - my $modes = $self->{pbot}->{channels}->get_meta($channel, 'MODE'); - - if (defined $modes) { - if ($modifier eq '+') { - $modes = '+' if not length $modes; - $modes .= $char; - } else { - $modes =~ s/\Q$char//g; - } - - # TODO: here as well - $self->{pbot}->{channels}->{storage}->set($channel, 'MODE', $modes, 1); - } - } - } - - return 0; -} - -sub on_join { - my ($self, $event_type, $event) = @_; - - my ($nick, $user, $host, $channel) = ( - $event->{event}->nick, - $event->{event}->user, - $event->{event}->host, - lc $event->{event}->{to}->[0], - ); - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - my $message_account = $self->{pbot}->{messagehistory}->get_message_account($nick, $user, $host); - $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, "JOIN", $self->{pbot}->{messagehistory}->{MSG_JOIN}); - - $self->{pbot}->{messagehistory}->{database}->devalidate_channel($message_account, $channel); - - my $msg = 'JOIN'; - - # IRCv3 extended-join capability provides more details about user - if (exists $self->{pbot}->{irc_capabilities}->{'extended-join'}) { - my ($nickserv, $gecos) = ( - $event->{event}->{args}->[0], - $event->{event}->{args}->[1], - ); - - $msg .= " $nickserv :$gecos"; - - $self->{pbot}->{messagehistory}->{database}->update_gecos($message_account, $gecos, scalar time); - - if ($nickserv ne '*') { - $self->{pbot}->{messagehistory}->{database}->link_aliases($message_account, undef, $nickserv); - $self->{pbot}->{antiflood}->check_nickserv_accounts($nick, $nickserv); - } else { - $self->{pbot}->{messagehistory}->{database}->set_current_nickserv_account($message_account, ''); - } - - $self->{pbot}->{antiflood}->check_bans($message_account, $event->{event}->from, $channel); - } - - $self->{pbot}->{antiflood}->check_flood( - $channel, $nick, $user, $host, $msg, - $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), - $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), - $self->{pbot}->{messagehistory}->{MSG_JOIN} - ); - - return 0; -} - -sub on_invite { - my ($self, $event_type, $event) = @_; - - my ($nick, $user, $host, $target, $channel) = ( - $event->{event}->nick, - $event->{event}->user, - $event->{event}->host, - $event->{event}->to, - lc $event->{event}->{args}->[0] - ); - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - $self->{pbot}->{logger}->log("$nick!$user\@$host invited $target to $channel!\n"); - - # if invited to a channel on our channel list, go ahead and join it - if ($target eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) { - if ($self->{pbot}->{channels}->is_active($channel)) { - $self->{pbot}->{interpreter}->add_botcmd_to_command_queue($channel, "join $channel", 0); - } - } - - return 0; -} - -sub on_kick { - my ($self, $event_type, $event) = @_; - - my ($nick, $user, $host, $target, $channel, $reason) = ( - $event->{event}->nick, - $event->{event}->user, - $event->{event}->host, - $event->{event}->to, - lc $event->{event}->{args}->[0], - $event->{event}->{args}->[1] - ); - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - $self->{pbot}->{logger}->log("$nick!$user\@$host kicked $target from $channel ($reason)\n"); - - # hostmask of the person being kicked - my $target_hostmask; - - # look up message history account for person being kicked - my ($message_account) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($target); - - if (defined $message_account) { - # update target hostmask - $target_hostmask = $self->{pbot}->{messagehistory}->{database}->find_most_recent_hostmask($message_account); - - # add "KICKED by" to kicked person's message history - my $text = "KICKED by $nick!$user\@$host ($reason)"; - - $self->{pbot}->{messagehistory}->add_message($message_account, $target_hostmask, $channel, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}); - - # do stuff that happens in check_flood - my ($target_nick, $target_user, $target_host) = $target_hostmask =~ m/^([^!]+)!([^@]+)@(.*)/; - - $self->{pbot}->{antiflood}->check_flood( - $channel, $target_nick, $target_user, $target_host, $text, - $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), - $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), - $self->{pbot}->{messagehistory}->{MSG_DEPARTURE} - ); - } - - # look up message history account for person doing the kicking - $message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account_id("$nick!$user\@$host"); - - if (defined $message_account) { - # replace target nick with target hostmask if available - if (defined $target_hostmask) { - $target = $target_hostmask; - } - - # add "KICKED $target" to kicker's message history - my $text = "KICKED $target from $channel ($reason)"; - $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, $self->{pbot}->{messagehistory}->{MSG_CHAT}); - } - - return 0; -} - -sub on_departure { - my ($self, $event_type, $event) = @_; - - my ($nick, $user, $host, $channel, $args) = ( - $event->{event}->nick, - $event->{event}->user, - $event->{event}->host, - lc $event->{event}->{to}->[0], - $event->{event}->args - ); - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - my $text = uc ($event->{event}->type) . ' ' . $args; - - my $message_account = $self->{pbot}->{messagehistory}->get_message_account($nick, $user, $host); - - if ($text =~ m/^QUIT/) { - # QUIT messages must be added to the mesasge history of each channel the user is on - my $channels = $self->{pbot}->{nicklist}->get_channels($nick); - foreach my $chan (@$channels) { - next if $chan !~ m/^#/; - $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $chan, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}); - } - } else { - $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, $self->{pbot}->{messagehistory}->{MSG_DEPARTURE}); - } - - $self->{pbot}->{antiflood}->check_flood( - $channel, $nick, $user, $host, $text, - $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), - $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), - $self->{pbot}->{messagehistory}->{MSG_DEPARTURE} - ); - - my $u = $self->{pbot}->{users}->find_user($channel, "$nick!$user\@$host"); - - # log user out if logged in and not stayloggedin - # TODO: this should probably be in Users.pm with its own part/quit/kick handler - if (defined $u and $u->{loggedin} and not $u->{stayloggedin}) { - $self->{pbot}->{logger}->log("Logged out $nick.\n"); - delete $u->{loggedin}; - $self->{pbot}->{users}->save; - } - - return 0; -} - -sub on_isupport { - my ($self, $event_type, $event) = @_; - - # remove and discard first and last arguments - # (first arg is botnick, last arg is "are supported by this server") - shift @{$event->{event}->{args}}; - pop @{$event->{event}->{args}}; - - my $logmsg = "$event->{event}->{from} supports:"; - - foreach my $arg (@{$event->{event}->{args}}) { - my ($key, $value) = split /=/, $arg; - - if ($key =~ s/^-//) { - # server removed suppport for this key - delete $self->{pbot}->{isupport}->{$key}; - } else { - $self->{pbot}->{isupport}->{$key} = $value // 1; - } - - $logmsg .= defined $value ? " $key=$value" : " $key"; - } - - $self->{pbot}->{logger}->log("$logmsg\n"); - - return 0; -} - -# IRCv3 client capability negotiation -# TODO: most, if not all, of this should probably be in PBot::IRC::Connection -# but at the moment I don't want to change Net::IRC more than the absolute -# minimum necessary. -# -# TODO: CAP NEW and CAP DEL - -sub on_cap { - my ($self, $event_type, $event) = @_; - - # configure client capabilities that PBot currently supports - my %desired_caps = ( - 'account-notify' => 1, - 'extended-join' => 1, - - # TODO: unsupported capabilities worth looking into - 'away-notify' => 0, - 'chghost' => 0, - 'identify-msg' => 0, - 'multi-prefix' => 0, - ); - - if ($event->{event}->{args}->[0] eq 'LS') { - my $capabilities; - my $caps_done = 0; - - if ($event->{event}->{args}->[1] eq '*') { - # more CAP LS messages coming - $capabilities = $event->{event}->{args}->[2]; - } else { - # final CAP LS message - $caps_done = 1; - $capabilities = $event->{event}->{args}->[1]; - } - - $self->{pbot}->{logger}->log("Client capabilities available: $capabilities\n"); - - my @caps = split /\s+/, $capabilities; - - foreach my $cap (@caps) { - my $value; - - if ($cap =~ /=/) { - ($cap, $value) = split /=/, $cap; - } else { - $value = 1; - } - - # store available capability - $self->{pbot}->{irc_capabilities_available}->{$cap} = $value; - - # request desired capabilities - if ($desired_caps{$cap}) { - $self->{pbot}->{logger}->log("Requesting client capability $cap\n"); - $event->{conn}->sl("CAP REQ :$cap"); - } - } - - # capability negotiation done - # now we either start SASL authentication or we send CAP END - if ($caps_done) { - # start SASL authentication if enabled - if ($self->{pbot}->{registry}->get_value('irc', 'sasl')) { - $self->{pbot}->{logger}->log("Requesting client capability sasl\n"); - $event->{conn}->sl("CAP REQ :sasl"); - } else { - $self->{pbot}->{logger}->log("Completed client capability negotiation\n"); - $event->{conn}->sl("CAP END"); - } - } - } - elsif ($event->{event}->{args}->[0] eq 'ACK') { - $self->{pbot}->{logger}->log("Client capabilities granted: $event->{event}->{args}->[1]\n"); - - my @caps = split /\s+/, $event->{event}->{args}->[1]; - - foreach my $cap (@caps) { - $self->{pbot}->{irc_capabilities}->{$cap} = 1; - - if ($cap eq 'sasl') { - # begin SASL authentication - # TODO: for now we support only PLAIN - $self->{pbot}->{logger}->log("Performing SASL authentication PLAIN\n"); - $event->{conn}->sl("AUTHENTICATE PLAIN"); - } - } - } - elsif ($event->{event}->{args}->[0] eq 'NAK') { - $self->{pbot}->{logger}->log("Client capabilities rejected: $event->{event}->{args}->[1]\n"); - } - else { - $self->{pbot}->{logger}->log("Unknown CAP event:\n"); - $Data::Dumper::Sortkeys = 1; - $self->{pbot}->{logger}->log(Dumper $event->{event}); - } - - return 0; -} - -# IRCv3 SASL authentication -# TODO: this should probably be in PBot::IRC::Connection as well... -# but at the moment I don't want to change Net::IRC more than the absolute -# minimum necessary. - -sub on_sasl_authenticate { - my ($self, $event_type, $event) = @_; - - my $nick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); - my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password'); - - if (not defined $password or not length $password) { - $self->{pbot}->{logger}->log("Error: Registry entry irc.identify_password is not set.\n"); - $self->{pbot}->exit; - } - - $password = encode('UTF-8', "$nick\0$nick\0$password"); - - $password = encode_base64($password, ''); - - my @chunks = unpack('(A400)*', $password); - - foreach my $chunk (@chunks) { - $event->{conn}->sl("AUTHENTICATE $chunk"); - } - - # must send final AUTHENTICATE + if last chunk was exactly 400 bytes - if (length $chunks[$#chunks] == 400) { - $event->{conn}->sl("AUTHENTICATE +"); - } - - return 0; -} - -sub on_rpl_loggedin { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); - return 0; -} - -sub on_rpl_loggedout { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); - return 0; -} - -sub on_err_nicklocked { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); - $self->{pbot}->exit; -} - -sub on_rpl_saslsuccess { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); - $event->{conn}->sl("CAP END"); - return 0; -} - -sub on_err_saslfail { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); - $self->{pbot}->exit; -} - -sub on_err_sasltoolong { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); - $self->{pbot}->exit; -} - -sub on_err_saslaborted { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); - $self->{pbot}->exit; -} - -sub on_err_saslalready { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); - return 0; -} - -sub on_rpl_saslmechs { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log("SASL mechanism not available.\n"); - $self->{pbot}->{logger}->log("Available mechanisms are: $event->{event}->{args}->[1]\n"); - $self->{pbot}->exit; -} - -sub on_nickchange { - my ($self, $event_type, $event) = @_; - my ($nick, $user, $host, $newnick) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->args); - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - $self->{pbot}->{logger}->log("[NICKCHANGE] $nick!$user\@$host changed nick to $newnick\n"); - - if ($newnick eq $self->{pbot}->{registry}->get_value('irc', 'botnick') and not $self->{pbot}->{joined_channels}) { - $self->{pbot}->{channels}->autojoin; - return 0; - } - - my $message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host); - $self->{pbot}->{messagehistory}->{database}->devalidate_all_channels($message_account, $self->{pbot}->{antiflood}->{NEEDS_CHECKBAN}); - my $channels = $self->{pbot}->{nicklist}->get_channels($nick); - foreach my $channel (@$channels) { - next if $channel !~ m/^#/; - $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, "NICKCHANGE $newnick", $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}); - } - $self->{pbot}->{messagehistory}->{database}->update_hostmask_data("$nick!$user\@$host", {last_seen => scalar time}); - - my $newnick_account = $self->{pbot}->{messagehistory}->{database}->get_message_account($newnick, $user, $host, $nick); - $self->{pbot}->{messagehistory}->{database}->devalidate_all_channels($newnick_account, $self->{pbot}->{antiflood}->{NEEDS_CHECKBAN}); - $self->{pbot}->{messagehistory}->{database}->update_hostmask_data("$newnick!$user\@$host", {last_seen => scalar time}); - - $self->{pbot}->{antiflood}->check_flood( - "$nick!$user\@$host", $nick, $user, $host, "NICKCHANGE $newnick", - $self->{pbot}->{registry}->get_value('antiflood', 'nick_flood_threshold'), - $self->{pbot}->{registry}->get_value('antiflood', 'nick_flood_time_threshold'), - $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE} - ); - - return 0; -} - -sub on_nicknameinuse { - my ($self, $event_type, $event) = @_; - - my (undef, $nick, $msg) = $event->{event}->args; - my $from = $event->{event}->from; - - $self->{pbot}->{logger}->log("Received nicknameinuse for nick $nick from $from: $msg\n"); - - # attempt to use NickServ GHOST command to kick nick off - $event->{conn}->privmsg("nickserv", "ghost $nick " . $self->{pbot}->{registry}->get_value('irc', 'identify_password')); - - return 0; -} - -sub on_channelmodeis { - my ($self, $event_type, $event) = @_; - - my (undef, $channel, $modes) = $event->{event}->args; - - $self->{pbot}->{logger}->log("Channel $channel modes: $modes\n"); - - $self->{pbot}->{channels}->{storage}->set($channel, 'MODE', $modes, 1); -} - -sub on_channelcreate { - my ($self, $event_type, $event) = @_; - - my ($owner, $channel, $timestamp) = $event->{event}->args; - - $self->{pbot}->{logger}->log("Channel $channel created by $owner on " . localtime($timestamp) . "\n"); - - $self->{pbot}->{channels}->{storage}->set($channel, 'CREATED_BY', $owner, 1); - $self->{pbot}->{channels}->{storage}->set($channel, 'CREATED_ON', $timestamp, 1); -} - -sub on_topic { - my ($self, $event_type, $event) = @_; - - if (not length $event->{event}->{to}->[0]) { - # on join - my (undef, $channel, $topic) = $event->{event}->args; - $self->{pbot}->{logger}->log("Topic for $channel: $topic\n"); - $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC', $topic, 1); - } else { - # user changing topic - my ($nick, $user, $host) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host); - my $channel = $event->{event}->{to}->[0]; - my $topic = $event->{event}->{args}->[0]; - - $self->{pbot}->{logger}->log("$nick!$user\@$host changed topic for $channel to: $topic\n"); - $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC', $topic, 1); - $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_BY', "$nick!$user\@$host", 1); - $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_ON', time); - } - - return 0; -} - -sub on_topicinfo { - my ($self, $event_type, $event) = @_; - my (undef, $channel, $by, $timestamp) = $event->{event}->args; - $self->{pbot}->{logger}->log("Topic for $channel set by $by on " . localtime($timestamp) . "\n"); - $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_BY', $by, 1); - $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_ON', $timestamp, 1); - return 0; -} - -sub on_nononreg { - my ($self, $event_type, $event) = @_; - - my $target = $event->{event}->{args}->[1]; - - $self->{pbot}->{logger}->log("Cannot send private /msg to $target; they are blocking unidentified /msgs.\n"); - - return 0; -} - -sub log_first_arg { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log("$event->{event}->{args}->[1]\n"); - return 0; -} - -sub log_third_arg { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log("$event->{event}->{args}->[3]\n"); - return 0; -} +# replace randomized gibberish in certain hostmasks with identifying information sub normalize_hostmask { my ($self, $nick, $user, $host) = @_; - if ($host =~ m{^(gateway|nat)/(.*)/x-[^/]+$}) { $host = "$1/$2/x-$user"; } + if ($host =~ m{^(gateway|nat)/(.*)/x-[^/]+$}) { + $host = "$1/$2/x-$user"; + } $host =~ s{/session$}{/x-$user}; return ($nick, $user, $host); } -my %who_queue; -my %who_cache; -my $last_who_id; -my $who_pending = 0; - -sub on_whoreply { - my ($self, $event_type, $event) = @_; - - my (undef, $id, $user, $host, $server, $nick, $usermodes, $gecos) = $event->{event}->args; - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - my $hostmask = "$nick!$user\@$host"; - my $channel; - - if ($id =~ m/^#/) { - $id = lc $id; - foreach my $x (keys %who_cache) { - if ($who_cache{$x} eq $id) { - $id = $x; - last; - } - } - } - - $last_who_id = $id; - $channel = $who_cache{$id}; - delete $who_queue{$id}; - - return 0 if not defined $channel; - - $self->{pbot}->{logger}->log("WHO id: $id [$channel], hostmask: $hostmask, $usermodes, $server, $gecos.\n"); - - $self->{pbot}->{nicklist}->add_nick($channel, $nick); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'hostmask', $hostmask); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'user', $user); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'host', $host); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'server', $server); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'gecos', $gecos); - - my $account_id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host); - $self->{pbot}->{messagehistory}->{database}->update_hostmask_data($hostmask, {last_seen => scalar time}); - - $self->{pbot}->{messagehistory}->{database}->link_aliases($account_id, $hostmask, undef); - - $self->{pbot}->{messagehistory}->{database}->devalidate_channel($account_id, $channel); - $self->{pbot}->{antiflood}->check_bans($account_id, $hostmask, $channel); - - return 0; -} - -sub on_whospcrpl { - my ($self, $event_type, $event) = @_; - - my (undef, $id, $user, $host, $nick, $nickserv, $gecos) = $event->{event}->args; - - ($nick, $user, $host) = $self->normalize_hostmask($nick, $user, $host); - - $last_who_id = $id; - my $hostmask = "$nick!$user\@$host"; - my $channel = $who_cache{$id}; - delete $who_queue{$id}; - - return 0 if not defined $channel; - - $self->{pbot}->{logger}->log("WHO id: $id [$channel], hostmask: $hostmask, $nickserv, $gecos.\n"); - - $self->{pbot}->{nicklist}->add_nick($channel, $nick); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'hostmask', $hostmask); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'user', $user); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'host', $host); - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'nickserv', $nickserv) if $nickserv ne '0'; - $self->{pbot}->{nicklist}->set_meta($channel, $nick, 'gecos', $gecos); - - my $account_id = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host); - $self->{pbot}->{messagehistory}->{database}->update_hostmask_data($hostmask, {last_seen => scalar time}); - - if ($nickserv ne '0') { - $self->{pbot}->{messagehistory}->{database}->link_aliases($account_id, undef, $nickserv); - $self->{pbot}->{antiflood}->check_nickserv_accounts($nick, $nickserv); - } - - $self->{pbot}->{messagehistory}->{database}->link_aliases($account_id, $hostmask, undef); - - $self->{pbot}->{messagehistory}->{database}->devalidate_channel($account_id, $channel); - $self->{pbot}->{antiflood}->check_bans($account_id, $hostmask, $channel); - - return 0; -} - -sub on_endofwho { - my ($self, $event_type, $event) = @_; - $self->{pbot}->{logger}->log("WHO session $last_who_id ($who_cache{$last_who_id}) completed.\n"); - delete $who_cache{$last_who_id}; - delete $who_queue{$last_who_id}; - $who_pending = 0; - return 0; -} - -sub send_who { - my ($self, $channel) = @_; - $channel = lc $channel; - $self->{pbot}->{logger}->log("pending WHO to $channel\n"); - - for (my $id = 1; $id < 99; $id++) { - if (not exists $who_cache{$id}) { - $who_cache{$id} = $channel; - $who_queue{$id} = $channel; - $last_who_id = $id; - last; - } - } -} - -sub check_pending_whos { - my $self = shift; - return if $who_pending; - foreach my $id (keys %who_queue) { - $self->{pbot}->{logger}->log("sending WHO to $who_queue{$id} [$id]\n"); - $self->{pbot}->{conn}->sl("WHO $who_queue{$id} %tuhnar,$id"); - $who_pending = 1; - $last_who_id = $id; - last; - } -} - 1; diff --git a/lib/PBot/IRCHandlers/Cap.pm b/lib/PBot/IRCHandlers/Cap.pm new file mode 100644 index 00000000..d36c84fd --- /dev/null +++ b/lib/PBot/IRCHandlers/Cap.pm @@ -0,0 +1,126 @@ +# File: Cap.pm +# +# Purpose: Handles IRCv3 CAP event. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::IRCHandlers::Cap; + +use PBot::Imports; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + # IRCv3 client capabilities + $self->{pbot}->{event_dispatcher}->register_handler('irc.cap', sub { $self->on_cap(@_) }); +} + +# TODO: CAP NEW and CAP DEL + +sub on_cap { + my ($self, $event_type, $event) = @_; + + # configure client capabilities that PBot currently supports + my %desired_caps = ( + 'account-notify' => 1, + 'extended-join' => 1, + + # TODO: unsupported capabilities worth looking into + 'away-notify' => 0, + 'chghost' => 0, + 'identify-msg' => 0, + 'multi-prefix' => 0, + ); + + if ($event->{event}->{args}->[0] eq 'LS') { + my $capabilities; + my $caps_done = 0; + + if ($event->{event}->{args}->[1] eq '*') { + # more CAP LS messages coming + $capabilities = $event->{event}->{args}->[2]; + } else { + # final CAP LS message + $caps_done = 1; + $capabilities = $event->{event}->{args}->[1]; + } + + $self->{pbot}->{logger}->log("Client capabilities available: $capabilities\n"); + + my @caps = split /\s+/, $capabilities; + + foreach my $cap (@caps) { + my $value; + + if ($cap =~ /=/) { + ($cap, $value) = split /=/, $cap; + } else { + $value = 1; + } + + # store available capability + $self->{pbot}->{irc_capabilities_available}->{$cap} = $value; + + # request desired capabilities + if ($desired_caps{$cap}) { + $self->{pbot}->{logger}->log("Requesting client capability $cap\n"); + $event->{conn}->sl("CAP REQ :$cap"); + } + } + + # capability negotiation done + # now we either start SASL authentication or we send CAP END + if ($caps_done) { + # start SASL authentication if enabled + if ($self->{pbot}->{registry}->get_value('irc', 'sasl')) { + $self->{pbot}->{logger}->log("Requesting client capability sasl\n"); + $event->{conn}->sl("CAP REQ :sasl"); + } else { + $self->{pbot}->{logger}->log("Completed client capability negotiation\n"); + $event->{conn}->sl("CAP END"); + } + } + } + elsif ($event->{event}->{args}->[0] eq 'ACK') { + $self->{pbot}->{logger}->log("Client capabilities granted: $event->{event}->{args}->[1]\n"); + + my @caps = split /\s+/, $event->{event}->{args}->[1]; + + foreach my $cap (@caps) { + $self->{pbot}->{irc_capabilities}->{$cap} = 1; + + if ($cap eq 'sasl') { + # begin SASL authentication + # TODO: for now we support only PLAIN + $self->{pbot}->{logger}->log("Performing SASL authentication PLAIN\n"); + $event->{conn}->sl("AUTHENTICATE PLAIN"); + } + } + } + elsif ($event->{event}->{args}->[0] eq 'NAK') { + $self->{pbot}->{logger}->log("Client capabilities rejected: $event->{event}->{args}->[1]\n"); + } + else { + $self->{pbot}->{logger}->log("Unknown CAP event:\n"); + $Data::Dumper::Sortkeys = 1; + $self->{pbot}->{logger}->log(Dumper $event->{event}); + } + + return 1; +} + +1; diff --git a/lib/PBot/IRCHandlers/Channel.pm b/lib/PBot/IRCHandlers/Channel.pm new file mode 100644 index 00000000..7fd32a2e --- /dev/null +++ b/lib/PBot/IRCHandlers/Channel.pm @@ -0,0 +1,351 @@ +# File: Channel.pm +# +# Purpose: Handlers for channel-related IRC events. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::IRCHandlers::Channel; +use parent 'PBot::Class'; + +use PBot::Imports; + +use PBot::MessageHistory::Constants ':all'; + +use Time::HiRes qw/time/; +use Data::Dumper; + +use MIME::Base64; +use Encode; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + $self->{pbot}->{event_dispatcher}->register_handler('irc.mode', sub { $self->on_mode (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.join', sub { $self->on_join (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_departure (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.kick', sub { $self->on_kick (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.invite', sub { $self->on_invite (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.channelmodeis', sub { $self->on_channelmodeis (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.topic', sub { $self->on_topic (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.topicinfo', sub { $self->on_topicinfo (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.channelcreate', sub { $self->on_channelcreate (@_) }); +} + +# FIXME: on_mode doesn't handle chanmodes that have parameters, e.g. +l +sub on_mode { + my ($self, $event_type, $event) = @_; + + my ($nick, $user, $host, $mode_string, $channel) = ( + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + $event->{event}->{args}->[0], + lc $event->{event}->{to}->[0], + ); + + ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); + + my $i = 0; + my ($modifier, $char, $mode, $target); + + while ($mode_string =~ m/(.)/g) { + $char = $1; + + if ($char eq '-' or $char eq '+') { + $modifier = $char; + next; + } + + $mode = $modifier . $char; + $target = $event->{event}->{args}->[++$i]; + + $self->{pbot}->{logger}->log("Mode $channel [$mode" . (length $target ? " $target" : '') . "] by $nick!$user\@$host\n"); + + # TODO: figure out a good way to allow other packages to receive "track_mode" events + # i.e., perhaps by emitting a modechange event or some such and registering handlers + $self->{pbot}->{banlist}->track_mode("$nick!$user\@$host", $channel, $mode, $target); + $self->{pbot}->{chanops}->track_mode("$nick!$user\@$host", $channel, $mode, $target); + + if (defined $target and length $target) { + # mode set on user + my $message_account = $self->{pbot}->{messagehistory}->get_message_account($nick, $user, $host); + + $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, "MODE $mode $target", MSG_CHAT); + + # TODO: here as well + if ($modifier eq '-') { + $self->{pbot}->{nicklist}->delete_meta($channel, $target, "+$char"); + } else { + $self->{pbot}->{nicklist}->set_meta($channel, $target, $mode, 1); + } + } else { + # mode set on channel + my $modes = $self->{pbot}->{channels}->get_meta($channel, 'MODE'); + + if (defined $modes) { + if ($modifier eq '+') { + $modes = '+' if not length $modes; + $modes .= $char; + } else { + $modes =~ s/\Q$char//g; + } + + # TODO: here as well + $self->{pbot}->{channels}->{storage}->set($channel, 'MODE', $modes, 1); + } + } + } + + return 0; +} + +sub on_join { + my ($self, $event_type, $event) = @_; + + my ($nick, $user, $host, $channel) = ( + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + lc $event->{event}->{to}->[0], + ); + + ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); + + my $message_account = $self->{pbot}->{messagehistory}->get_message_account($nick, $user, $host); + $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, "JOIN", MSG_JOIN); + + $self->{pbot}->{messagehistory}->{database}->devalidate_channel($message_account, $channel); + + my $msg = 'JOIN'; + + # IRCv3 extended-join capability provides more details about user + if (exists $self->{pbot}->{irc_capabilities}->{'extended-join'}) { + my ($nickserv, $gecos) = ( + $event->{event}->{args}->[0], + $event->{event}->{args}->[1], + ); + + $msg .= " $nickserv :$gecos"; + + $self->{pbot}->{messagehistory}->{database}->update_gecos($message_account, $gecos, scalar time); + + if ($nickserv ne '*') { + $self->{pbot}->{messagehistory}->{database}->link_aliases($message_account, undef, $nickserv); + $self->{pbot}->{antiflood}->check_nickserv_accounts($nick, $nickserv); + } else { + $self->{pbot}->{messagehistory}->{database}->set_current_nickserv_account($message_account, ''); + } + + $self->{pbot}->{antiflood}->check_bans($message_account, $event->{event}->from, $channel); + } + + $self->{pbot}->{antiflood}->check_flood( + $channel, $nick, $user, $host, $msg, + $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), + $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), + MSG_JOIN, + ); + + return 0; +} + +sub on_invite { + my ($self, $event_type, $event) = @_; + + my ($nick, $user, $host, $target, $channel) = ( + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + $event->{event}->to, + lc $event->{event}->{args}->[0] + ); + + ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); + + $self->{pbot}->{logger}->log("$nick!$user\@$host invited $target to $channel!\n"); + + # if invited to a channel on our channel list, go ahead and join it + if ($target eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) { + if ($self->{pbot}->{channels}->is_active($channel)) { + $self->{pbot}->{interpreter}->add_botcmd_to_command_queue($channel, "join $channel", 0); + } + } + + return 0; +} + +sub on_kick { + my ($self, $event_type, $event) = @_; + + my ($nick, $user, $host, $target, $channel, $reason) = ( + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + $event->{event}->to, + lc $event->{event}->{args}->[0], + $event->{event}->{args}->[1] + ); + + ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); + + $self->{pbot}->{logger}->log("$nick!$user\@$host kicked $target from $channel ($reason)\n"); + + # hostmask of the person being kicked + my $target_hostmask; + + # look up message history account for person being kicked + my ($message_account) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($target); + + if (defined $message_account) { + # update target hostmask + $target_hostmask = $self->{pbot}->{messagehistory}->{database}->find_most_recent_hostmask($message_account); + + # add "KICKED by" to kicked person's message history + my $text = "KICKED by $nick!$user\@$host ($reason)"; + + $self->{pbot}->{messagehistory}->add_message($message_account, $target_hostmask, $channel, $text, MSG_DEPARTURE); + + # do stuff that happens in check_flood + my ($target_nick, $target_user, $target_host) = $target_hostmask =~ m/^([^!]+)!([^@]+)@(.*)/; + + $self->{pbot}->{antiflood}->check_flood( + $channel, $target_nick, $target_user, $target_host, $text, + $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), + $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), + MSG_DEPARTURE, + ); + } + + # look up message history account for person doing the kicking + $message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account_id("$nick!$user\@$host"); + + if (defined $message_account) { + # replace target nick with target hostmask if available + if (defined $target_hostmask) { + $target = $target_hostmask; + } + + # add "KICKED $target" to kicker's message history + my $text = "KICKED $target from $channel ($reason)"; + $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, MSG_CHAT); + } + + return 0; +} + +sub on_departure { + my ($self, $event_type, $event) = @_; + + my ($nick, $user, $host, $channel, $args) = ( + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + lc $event->{event}->{to}->[0], + $event->{event}->args + ); + + ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); + + my $text = uc ($event->{event}->type) . ' ' . $args; + + my $message_account = $self->{pbot}->{messagehistory}->get_message_account($nick, $user, $host); + + if ($text =~ m/^QUIT/) { + # QUIT messages must be added to the mesasge history of each channel the user is on + my $channels = $self->{pbot}->{nicklist}->get_channels($nick); + foreach my $chan (@$channels) { + next if $chan !~ m/^#/; + $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $chan, $text, MSG_DEPARTURE); + } + } else { + $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, $text, MSG_DEPARTURE); + } + + $self->{pbot}->{antiflood}->check_flood( + $channel, $nick, $user, $host, $text, + $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_threshold'), + $self->{pbot}->{registry}->get_value('antiflood', 'join_flood_time_threshold'), + MSG_DEPARTURE, + ); + + my $u = $self->{pbot}->{users}->find_user($channel, "$nick!$user\@$host"); + + # log user out if logged in and not stayloggedin + # TODO: this should probably be in Users.pm with its own part/quit/kick handler + if (defined $u and $u->{loggedin} and not $u->{stayloggedin}) { + $self->{pbot}->{logger}->log("Logged out $nick.\n"); + delete $u->{loggedin}; + $self->{pbot}->{users}->save; + } + + return 0; +} + +sub on_channelmodeis { + my ($self, $event_type, $event) = @_; + + my (undef, $channel, $modes) = $event->{event}->args; + + $self->{pbot}->{logger}->log("Channel $channel modes: $modes\n"); + + $self->{pbot}->{channels}->{storage}->set($channel, 'MODE', $modes, 1); +} + +sub on_channelcreate { + my ($self, $event_type, $event) = @_; + + my ($owner, $channel, $timestamp) = $event->{event}->args; + + $self->{pbot}->{logger}->log("Channel $channel created by $owner on " . localtime($timestamp) . "\n"); + + $self->{pbot}->{channels}->{storage}->set($channel, 'CREATED_BY', $owner, 1); + $self->{pbot}->{channels}->{storage}->set($channel, 'CREATED_ON', $timestamp, 1); +} + +sub on_topic { + my ($self, $event_type, $event) = @_; + + if (not length $event->{event}->{to}->[0]) { + # on join + my (undef, $channel, $topic) = $event->{event}->args; + $self->{pbot}->{logger}->log("Topic for $channel: $topic\n"); + $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC', $topic, 1); + } else { + # user changing topic + my ($nick, $user, $host) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host); + my $channel = $event->{event}->{to}->[0]; + my $topic = $event->{event}->{args}->[0]; + + $self->{pbot}->{logger}->log("$nick!$user\@$host changed topic for $channel to: $topic\n"); + $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC', $topic, 1); + $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_BY', "$nick!$user\@$host", 1); + $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_ON', time); + } + + return 0; +} + +sub on_topicinfo { + my ($self, $event_type, $event) = @_; + my (undef, $channel, $by, $timestamp) = $event->{event}->args; + $self->{pbot}->{logger}->log("Topic for $channel set by $by on " . localtime($timestamp) . "\n"); + $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_BY', $by, 1); + $self->{pbot}->{channels}->{storage}->set($channel, 'TOPIC_SET_ON', $timestamp, 1); + return 0; +} + +1; diff --git a/lib/PBot/IRCHandlers/Chat.pm b/lib/PBot/IRCHandlers/Chat.pm new file mode 100644 index 00000000..4aeb4f06 --- /dev/null +++ b/lib/PBot/IRCHandlers/Chat.pm @@ -0,0 +1,112 @@ +# File: Chat.pm +# +# Purpose: IRC handlers for chat/message events. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::IRCHandlers::Chat; + +use PBot::Imports; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + $self->{pbot}->{event_dispatcher}->register_handler('irc.notice', sub { $self->on_notice (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_public (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_action (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.msg', sub { $self->on_msg (@_) }); +} + +sub on_notice { + my ($self, $event_type, $event) = @_; + + my ($nick, $user, $host, $to, $text) = ( + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + $event->{event}->to, + $event->{event}->{args}->[0], + ); + + # don't handle non-chat NOTICE + return undef if $to eq '*'; + + # log notice + $self->{pbot}->{logger}->log("NOTICE from $nick!$user\@$host to $to: $text\n"); + + # if NOTICE is sent to the bot then replace the `to` field with the + # sender's nick instead so when we pass it on to on_public ... + if ($to eq $self->{pbot}->{registry}->get_value('irc', 'botnick')) { + $event->{event}->{to}->[0] = $nick; + } + + # handle this NOTICE as a public message + # (check for bot commands, anti-flooding, etc) + $self->on_public($event_type, $event); + + return 1; +} + +sub on_public { + my ($self, $event_type, $event) = @_; + + my ($from, $nick, $user, $host, $text) = ( + $event->{event}->{to}->[0], + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + $event->{event}->{args}->[0], + ); + + ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); + + # send text to be processed for bot commands, anti-flood enforcement, etc + $event->{interpreted} = $self->{pbot}->{interpreter}->process_line($from, $nick, $user, $host, $text); + + return 1; +} + +sub on_action { + my ($self, $event_type, $event) = @_; + + # prepend "/me " to the message text + $event->{event}->{args}->[0] = "/me " . $event->{event}->{args}->[0]; + + # pass this along to on_public + $self->on_public($event_type, $event); + return 1; +} + +sub on_msg { + my ($self, $event_type, $event) = @_; + + my ($nick, $user, $host, $text) = ( + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + $event->{event}->{args}->[0], + ); + + ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); + + # send text to be processed as a bot command, coming from $nick + $event->{interpreted} = $self->{pbot}->{interpreter}->process_line($nick, $nick, $user, $host, $text, 1); + + return 1; +} + +1; diff --git a/lib/PBot/IRCHandlers/NickServ.pm b/lib/PBot/IRCHandlers/NickServ.pm new file mode 100644 index 00000000..14772e98 --- /dev/null +++ b/lib/PBot/IRCHandlers/NickServ.pm @@ -0,0 +1,136 @@ +# File: NickServ.pm +# +# Purpose: Handles NickServ-related IRC events. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::IRCHandlers::NickServ; + +use PBot::Imports; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + # NickServ-related IRC events get priority 10 + # priority is from 0 to 100 where 0 is highest and 100 is lowest + $self->{pbot}->{event_dispatcher}->register_handler('irc.welcome', sub { $self->on_welcome (@_) }, 10); + $self->{pbot}->{event_dispatcher}->register_handler('irc.notice', sub { $self->on_notice (@_) }, 10); + $self->{pbot}->{event_dispatcher}->register_handler('irc.nicknameinuse', sub { $self->on_nicknameinuse (@_) }, 10); +} + +sub on_welcome { + my ($self, $event_type, $event) = @_; + + # if not using SASL, identify the old way by msging NickServ or some services bot + if (not $self->{pbot}->{irc_capabilities}->{sasl}) { + if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) { + my $nickserv = $self->{pbot}->{registry}->get_value('general', 'identify_nick') // 'NickServ'; + my $command = $self->{pbot}->{registry}->get_value('general', 'identify_command') // 'identify $nick $password'; + + $self->{pbot}->{logger}->log("Identifying with $nickserv . . .\n"); + + my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); + my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password'); + + $command =~ s/\$nick\b/$botnick/g; + $command =~ s/\$password\b/$password/g; + + $event->{conn}->privmsg($nickserv, $command); + } else { + $self->{pbot}->{logger}->log("No identify password; skipping identification to services.\n"); + } + + # auto-join channels unless general.autojoin_wait_for_nickserv is true + if (not $self->{pbot}->{registry}->get_value('general', 'autojoin_wait_for_nickserv')) { + $self->{pbot}->{logger}->log("Autojoining channels immediately; to wait for services set general.autojoin_wait_for_nickserv to 1.\n"); + $self->{pbot}->{channels}->autojoin; + } else { + $self->{pbot}->{logger}->log("Waiting for services identify response before autojoining channels.\n"); + } + + return 1; + } + + # event not handled + return undef; +} + +sub on_notice { + my ($self, $event_type, $event) = @_; + + my ($nick, $user, $host, $to, $text) = ( + $event->{event}->nick, + $event->{event}->user, + $event->{event}->host, + $event->{event}->to, + $event->{event}->{args}->[0], + ); + + my $nickserv = $self->{pbot}->{registry}->get_value('general', 'identify_nick') // 'NickServ'; + + # notice from NickServ + if (lc $nick eq lc $nickserv) { + # log notice + $self->{pbot}->{logger}->log("NOTICE from $nick!$user\@$host to $to: $text\n"); + + # if we have enabled NickServ GUARD protection and we're not identified yet, + # NickServ will warn us to identify -- this is our cue to identify. + if ($text =~ m/This nickname is registered/) { + if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) { + $self->{pbot}->{logger}->log("Identifying with NickServ . . .\n"); + $event->{conn}->privmsg("nickserv", "identify " . $self->{pbot}->{registry}->get_value('irc', 'identify_password')); + } + } + elsif ($text =~ m/You are now identified/) { + # we have identified with NickServ + if ($self->{pbot}->{registry}->get_value('irc', 'randomize_nick')) { + # if irc.randomize_nicks was enabled, we go ahead and attempt to + # change to our real botnick. we don't auto-join channels just yet in case + # the nick change fails. + $event->{conn}->nick($self->{pbot}->{registry}->get_value('irc', 'botnick')); + } else { + # otherwise go ahead and autojoin channels now + $self->{pbot}->{channels}->autojoin; + } + } + elsif ($text =~ m/has been ghosted/) { + # we have ghosted someone using our botnick, let's attempt to regain it now + $event->{conn}->nick($self->{pbot}->{registry}->get_value('irc', 'botnick')); + } + + return 1; + } + + # event not handled + return undef; +} + +sub on_nicknameinuse { + my ($self, $event_type, $event) = @_; + + my (undef, $nick, $msg) = $event->{event}->args; + my $from = $event->{event}->from; + + $self->{pbot}->{logger}->log("Received nicknameinuse for nick $nick from $from: $msg\n"); + + # attempt to use NickServ GHOST command to kick nick off + $event->{conn}->privmsg("nickserv", "ghost $nick " . $self->{pbot}->{registry}->get_value('irc', 'identify_password')); + + return 1; +} + +1; diff --git a/lib/PBot/IRCHandlers/SASL.pm b/lib/PBot/IRCHandlers/SASL.pm new file mode 100644 index 00000000..e45c40df --- /dev/null +++ b/lib/PBot/IRCHandlers/SASL.pm @@ -0,0 +1,128 @@ +# File: SASL.pm +# +# Purpose: Handles IRCv3 SASL events. Currently only PLAIN is supported. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::IRCHandlers::SASL; + +use PBot::Imports; + +use Encode; +use MIME::Base64; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + $self->{pbot}->{event_dispatcher}->register_handler('irc.authenticate', sub { $self->on_sasl_authenticate (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_loggedin', sub { $self->on_rpl_loggedin (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_loggedout', sub { $self->on_rpl_loggedout (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.err_nicklocked', sub { $self->on_err_nicklocked (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_saslsuccess', sub { $self->on_rpl_saslsuccess (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.err_saslfail', sub { $self->on_err_saslfail (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.err_sasltoolong', sub { $self->on_err_sasltoolong (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.err_saslaborted', sub { $self->on_err_saslaborted (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.err_saslalready', sub { $self->on_err_saslalready (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_saslmechs', sub { $self->on_rpl_saslmechs (@_) }); +} + +sub on_sasl_authenticate { + my ($self, $event_type, $event) = @_; + + my $nick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); + my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password'); + + if (not defined $password or not length $password) { + $self->{pbot}->{logger}->log("Error: Registry entry irc.identify_password is not set.\n"); + $self->{pbot}->exit; + } + + $password = encode('UTF-8', "$nick\0$nick\0$password"); + + $password = encode_base64($password, ''); + + my @chunks = unpack('(A400)*', $password); + + foreach my $chunk (@chunks) { + $event->{conn}->sl("AUTHENTICATE $chunk"); + } + + # must send final AUTHENTICATE + if last chunk was exactly 400 bytes + if (length $chunks[$#chunks] == 400) { + $event->{conn}->sl("AUTHENTICATE +"); + } + + return 1; +} + +sub on_rpl_loggedin { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); + return 1; +} + +sub on_rpl_loggedout { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); + return 1; +} + +sub on_err_nicklocked { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); + $self->{pbot}->exit; +} + +sub on_rpl_saslsuccess { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); + $event->{conn}->sl("CAP END"); + return 1; +} + +sub on_err_saslfail { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); + $self->{pbot}->exit; +} + +sub on_err_sasltoolong { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); + $self->{pbot}->exit; +} + +sub on_err_saslaborted { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); + $self->{pbot}->exit; +} + +sub on_err_saslalready { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n"); + return 1; +} + +sub on_rpl_saslmechs { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log("SASL mechanism not available.\n"); + $self->{pbot}->{logger}->log("Available mechanisms are: $event->{event}->{args}->[1]\n"); + $self->{pbot}->exit; +} + +1; diff --git a/lib/PBot/IRCHandlers/Server.pm b/lib/PBot/IRCHandlers/Server.pm new file mode 100644 index 00000000..2c27d49c --- /dev/null +++ b/lib/PBot/IRCHandlers/Server.pm @@ -0,0 +1,209 @@ +# File: Server.pm +# +# Purpose: Handles server-related IRC events. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::IRCHandlers::Server; + +use PBot::Imports; + +use PBot::MessageHistory::Constants ':all'; + +use Time::HiRes qw/time/; + +sub new { + my ($class, %args) = @_; + + # ensure class was passed a PBot instance + if (not exists $args{pbot}) { + Carp::croak("Missing pbot reference to $class"); + } + + my $self = bless { pbot => $args{pbot} }, $class; + $self->initialize(%args); + return $self; +} + +sub initialize { + my ($self, %conf) = @_; + + $self->{pbot}->{event_dispatcher}->register_handler('irc.welcome', sub { $self->on_welcome (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.disconnect', sub { $self->on_disconnect (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.motd', sub { $self->on_motd (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.notice', sub { $self->on_notice (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.nick', sub { $self->on_nickchange (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.nicknameinuse', sub { $self->on_nicknameinuse (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.isupport', sub { $self->on_isupport (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.yourhost', sub { $self->log_first_arg (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.created', sub { $self->log_first_arg (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.luserconns', sub { $self->log_first_arg (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.notregistered', sub { $self->log_first_arg (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.n_local', sub { $self->log_third_arg (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.n_global', sub { $self->log_third_arg (@_) }); + $self->{pbot}->{event_dispatcher}->register_handler('irc.nononreg', sub { $self->on_nononreg (@_) }); +} + +sub on_init { + my ($self, $conn, $event) = @_; + my (@args) = ($event->args); + shift @args; + $self->{pbot}->{logger}->log("*** @args\n"); +} + +sub on_welcome { + my ($self, $event_type, $event) = @_; + + $self->{pbot}->{logger}->log("Welcome!\n"); + + if ($self->{pbot}->{irc_capabilities}->{sasl}) { + # using SASL; go ahead and auto-join channels now + $self->{pbot}->{logger}->log("Autojoining channels.\n"); + $self->{pbot}->{channels}->autojoin; + } + + return 1; +} + +sub on_disconnect { + my ($self, $event_type, $event) = @_; + + $self->{pbot}->{logger}->log("Disconnected...\n"); + $self->{pbot}->{connected} = 0; + + # attempt to reconnect to server + # TODO: maybe add a registry entry to control whether the bot auto-reconnects + $self->{pbot}->connect; + + return 1; +} + +sub on_motd { + my ($self, $event_type, $event) = @_; + + if ($self->{pbot}->{registry}->get_value('irc', 'show_motd')) { + my $from = $event->{event}->{from}; + my $msg = $event->{event}->{args}->[1]; + $self->{pbot}->{logger}->log("MOTD from $from :: $msg\n"); + } + + return 1; +} + +sub on_notice { + my ($self, $event_type, $event) = @_; + + my ($server, $to, $text) = ( + $event->{event}->nick, + $event->{event}->to, + $event->{event}->{args}->[0], + ); + + # don't handle non-server NOTICE + return undef if $to ne '*'; + + # log notice + $self->{pbot}->{logger}->log("NOTICE from $server: $text\n"); + + return 1; +} + +sub on_isupport { + my ($self, $event_type, $event) = @_; + + # remove and discard first and last arguments + # (first arg is botnick, last arg is "are supported by this server") + shift @{$event->{event}->{args}}; + pop @{$event->{event}->{args}}; + + my $logmsg = "$event->{event}->{from} supports:"; + + foreach my $arg (@{$event->{event}->{args}}) { + my ($key, $value) = split /=/, $arg; + + if ($key =~ s/^-//) { + # server removed suppport for this key + delete $self->{pbot}->{isupport}->{$key}; + } else { + $self->{pbot}->{isupport}->{$key} = $value // 1; + } + + $logmsg .= defined $value ? " $key=$value" : " $key"; + } + + $self->{pbot}->{logger}->log("$logmsg\n"); + + return 1; +} + +sub on_nickchange { + my ($self, $event_type, $event) = @_; + my ($nick, $user, $host, $newnick) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->args); + + ($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host); + + $self->{pbot}->{logger}->log("[NICKCHANGE] $nick!$user\@$host changed nick to $newnick\n"); + + if ($newnick eq $self->{pbot}->{registry}->get_value('irc', 'botnick') and not $self->{pbot}->{joined_channels}) { + $self->{pbot}->{channels}->autojoin; + return 1; + } + + my $message_account = $self->{pbot}->{messagehistory}->{database}->get_message_account($nick, $user, $host); + $self->{pbot}->{messagehistory}->{database}->devalidate_all_channels($message_account, $self->{pbot}->{antiflood}->{NEEDS_CHECKBAN}); + my $channels = $self->{pbot}->{nicklist}->get_channels($nick); + foreach my $channel (@$channels) { + next if $channel !~ m/^#/; + $self->{pbot}->{messagehistory}->add_message($message_account, "$nick!$user\@$host", $channel, "NICKCHANGE $newnick", MSG_NICKCHANGE); + } + $self->{pbot}->{messagehistory}->{database}->update_hostmask_data("$nick!$user\@$host", {last_seen => scalar time}); + + my $newnick_account = $self->{pbot}->{messagehistory}->{database}->get_message_account($newnick, $user, $host, $nick); + $self->{pbot}->{messagehistory}->{database}->devalidate_all_channels($newnick_account, $self->{pbot}->{antiflood}->{NEEDS_CHECKBAN}); + $self->{pbot}->{messagehistory}->{database}->update_hostmask_data("$newnick!$user\@$host", {last_seen => scalar time}); + + $self->{pbot}->{antiflood}->check_flood( + "$nick!$user\@$host", $nick, $user, $host, "NICKCHANGE $newnick", + $self->{pbot}->{registry}->get_value('antiflood', 'nick_flood_threshold'), + $self->{pbot}->{registry}->get_value('antiflood', 'nick_flood_time_threshold'), + MSG_NICKCHANGE, + ); + + return 1; +} + +sub on_nicknameinuse { + my ($self, $event_type, $event) = @_; + + my (undef, $nick, $msg) = $event->{event}->args; + my $from = $event->{event}->from; + + $self->{pbot}->{logger}->log("Received nicknameinuse for nick $nick from $from: $msg\n"); + + return 1; +} + +sub on_nononreg { + my ($self, $event_type, $event) = @_; + + my $target = $event->{event}->{args}->[1]; + + $self->{pbot}->{logger}->log("Cannot send private /msg to $target; they are blocking unidentified /msgs.\n"); + + return 1; +} + +sub log_first_arg { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log("$event->{event}->{args}->[1]\n"); + return 1; +} + +sub log_third_arg { + my ($self, $event_type, $event) = @_; + $self->{pbot}->{logger}->log("$event->{event}->{args}->[3]\n"); + return 1; +} + +1; diff --git a/lib/PBot/IgnoreList.pm b/lib/PBot/IgnoreList.pm index ba003f46..f86b25ae 100644 --- a/lib/PBot/IgnoreList.pm +++ b/lib/PBot/IgnoreList.pm @@ -17,7 +17,7 @@ sub initialize { $self->{filename} = $conf{filename}; - $self->{storage} = PBot::DualIndexHashObject->new(pbot => $self->{pbot}, name => 'IgnoreList', filename => $self->{filename}); + $self->{storage} = PBot::Storage::DualIndexHashObject->new(pbot => $self->{pbot}, name => 'IgnoreList', filename => $self->{filename}); $self->{storage}->load; $self->enqueue_ignores; diff --git a/lib/PBot/Interpreter.pm b/lib/PBot/Interpreter.pm index 1088d058..c77dd8cb 100644 --- a/lib/PBot/Interpreter.pm +++ b/lib/PBot/Interpreter.pm @@ -14,6 +14,8 @@ use parent 'PBot::Class', 'PBot::Registerable'; use PBot::Imports; +use PBot::MessageHistory::Constants ':all'; + use Time::HiRes qw/gettimeofday/; use Time::Duration; @@ -64,7 +66,7 @@ sub process_line { $context->{message_account} = $message_account; # add message to message history as a chat message - $self->{pbot}->{messagehistory}->add_message($message_account, $context->{hostmask}, $from, $text, $self->{pbot}->{messagehistory}->{MSG_CHAT}); + $self->{pbot}->{messagehistory}->add_message($message_account, $context->{hostmask}, $from, $text, MSG_CHAT); # look up channel-specific flood threshold settings from registry my $flood_threshold = $self->{pbot}->{registry}->get_value($from, 'chat_flood_threshold'); @@ -78,7 +80,7 @@ sub process_line { $self->{pbot}->{antiflood}->check_flood( $from, $nick, $user, $host, $text, $flood_threshold, $flood_time_threshold, - $self->{pbot}->{messagehistory}->{MSG_CHAT}, + MSG_CHAT, $context ); diff --git a/lib/PBot/MessageHistory.pm b/lib/PBot/MessageHistory.pm index b9e8235b..ec0f38a0 100644 --- a/lib/PBot/MessageHistory.pm +++ b/lib/PBot/MessageHistory.pm @@ -18,21 +18,20 @@ use Getopt::Long qw(GetOptionsFromArray); use Time::HiRes qw(time tv_interval); use Time::Duration; -use PBot::MessageHistory_SQLite; +use PBot::MessageHistory::Storage::SQLite; sub initialize { my ($self, %conf) = @_; $self->{filename} = $conf{filename} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/message_history.sqlite3'; - $self->{database} = PBot::MessageHistory_SQLite->new(pbot => $self->{pbot}, filename => $self->{filename}); + $self->{database} = PBot::MessageHistory::Storage::SQLite->new( + pbot => $self->{pbot}, + filename => $self->{filename} + ); + $self->{database}->begin(); $self->{database}->devalidate_all_channels(); - $self->{MSG_CHAT} = 0; # PRIVMSG, ACTION - $self->{MSG_JOIN} = 1; # JOIN - $self->{MSG_DEPARTURE} = 2; # PART, QUIT, KICK - $self->{MSG_NICKCHANGE} = 3; # CHANGED NICK - $self->{pbot}->{registry}->add_default('text', 'messagehistory', 'max_recall_time', $conf{max_recall_time} // 0); $self->{pbot}->{commands}->register(sub { $self->cmd_recall_message(@_) }, "recall", 0); diff --git a/lib/PBot/MessageHistory/Constants.pm b/lib/PBot/MessageHistory/Constants.pm new file mode 100644 index 00000000..f1eed4ad --- /dev/null +++ b/lib/PBot/MessageHistory/Constants.pm @@ -0,0 +1,26 @@ +# File: Constants.pm +# +# Purpose: Constants related to message history. + +package PBot::MessageHistory::Constants; + +use Exporter qw/import/; + +our @EXPORT = (); + +our %EXPORT_TAGS = ( + 'all' => [qw/MSG_CHAT MSG_JOIN MSG_DEPARTURE MSG_NICKCHANGE/], +); + +our @EXPORT_OK = ( + @{ $EXPORT_TAGS{all} }, +); + +use constant { + MSG_CHAT => 0, # PRIVMSG, ACTION + MSG_JOIN => 1, # JOIN + MSG_DEPARTURE => 2, # PART, QUIT, KICK + MSG_NICKCHANGE => 3, # CHANGED NICK +}; + +1; diff --git a/lib/PBot/MessageHistory_SQLite.pm b/lib/PBot/MessageHistory/Storage/SQLite.pm similarity index 98% rename from lib/PBot/MessageHistory_SQLite.pm rename to lib/PBot/MessageHistory/Storage/SQLite.pm index 1735f1f1..c468cd59 100644 --- a/lib/PBot/MessageHistory_SQLite.pm +++ b/lib/PBot/MessageHistory/Storage/SQLite.pm @@ -1,4 +1,4 @@ -# File: MessageHistory_SQLite.pm +# File: SQLite.pm # # Purpose: SQLite backend for storing/retreiving a user's message history. # Peforms intelligent hostmask and nickserv heuristics to link nicknames @@ -9,11 +9,16 @@ # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::MessageHistory_SQLite; +package PBot::MessageHistory::Storage::SQLite; use parent 'PBot::Class'; use PBot::Imports; +use PBot::MessageHistory::Constants ':all'; + +use PBot::Utils::SQLiteLogger; +use PBot::Utils::SQLiteLoggerLayer; + use DBI; use Carp qw/shortmess/; use Time::HiRes qw/time/; @@ -31,14 +36,16 @@ sub initialize { $self->{pbot}->{registry}->add_default('text', 'messagehistory', 'sqlite_commit_interval', 30); $self->{pbot}->{registry}->add_default('text', 'messagehistory', 'sqlite_debug', $conf{sqlite_debug} // 0); - $self->{pbot}->{registry}->add_trigger('messagehistory', 'sqlite_commit_interval', sub { $self->sqlite_commit_interval_trigger(@_) }); - $self->{pbot}->{registry}->add_trigger('messagehistory', 'sqlite_debug', sub { $self->sqlite_debug_trigger(@_) }); + $self->{pbot}->{registry}->add_trigger('messagehistory', 'sqlite_commit_interval', + sub { $self->sqlite_commit_interval_trigger(@_) }); + + $self->{pbot}->{registry}->add_trigger('messagehistory', 'sqlite_debug', + sub { $self->sqlite_debug_trigger(@_) }); $self->{pbot}->{event_queue}->enqueue( sub { $self->commit_message_history }, $self->{pbot}->{registry}->get_value('messagehistory', 'sqlite_commit_interval'), - 'messagehistory commit' - ); + 'messagehistory commit'); $self->{alias_type}->{WEAK} = 0; $self->{alias_type}->{STRONG} = 1; @@ -53,7 +60,7 @@ sub sqlite_debug_trigger { my ($self, $section, $item, $newvalue) = @_; if ($newvalue) { - open $self->{trace_layer}, '>:via(PBot::SQLiteLoggerLayer)', PBot::SQLiteLogger->new(pbot => $self->{pbot}); + open $self->{trace_layer}, '>:via(PBot::Utils::SQLiteLoggerLayer)', PBot::Utils::SQLiteLogger->new(pbot => $self->{pbot}); } else { close $self->{trace_layer} if $self->{trace_layer}; delete $self->{trace_layer}; @@ -72,10 +79,8 @@ sub begin { eval { my $sqlite_debug = $self->{pbot}->{registry}->get_value('messagehistory', 'sqlite_debug'); - use PBot::SQLiteLoggerLayer; - use PBot::SQLiteLogger; if ($sqlite_debug) { - open $self->{trace_layer}, '>:via(PBot::SQLiteLoggerLayer)', PBot::SQLiteLogger->new(pbot => $self->{pbot}); + open $self->{trace_layer}, '>:via(PBot::Utils::SQLiteLoggerLayer)', PBot::Utils::SQLiteLogger->new(pbot => $self->{pbot}); $self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$sqlite_debug"), $self->{trace_layer}); } @@ -894,7 +899,7 @@ sub get_recent_messages { my %seen_id; my %akas; - if (defined $mode and $mode == $self->{pbot}->{messagehistory}->{MSG_NICKCHANGE}) { + if (defined $mode and $mode == MSG_NICKCHANGE) { %akas = $self->get_also_known_as($nick); } else { $akas{$id} = { @@ -1226,7 +1231,7 @@ sub get_random_message { my $param = 1; $sth->bind_param($param++, $channel); - $sth->bind_param($param++, $self->{pbot}->{messagehistory}->{MSG_CHAT}); + $sth->bind_param($param++, MSG_CHAT); map { $sth->bind_param($param++, $_) } keys %seen_id; diff --git a/lib/PBot/PBot.pm b/lib/PBot/PBot.pm index 67cc39c4..e505ad47 100644 --- a/lib/PBot/PBot.pm +++ b/lib/PBot/PBot.pm @@ -31,13 +31,10 @@ use PBot::Capabilities; use PBot::Commands; use PBot::Channels; use PBot::ChanOps; -use PBot::DualIndexHashObject; -use PBot::DualIndexSQLiteObject; use PBot::EventDispatcher; use PBot::EventQueue; use PBot::Factoids; use PBot::Functions; -use PBot::HashObject; use PBot::IgnoreList; use PBot::Interpreter; use PBot::IRC; @@ -45,7 +42,6 @@ use PBot::IRCHandlers; use PBot::LagChecker; use PBot::MessageHistory; use PBot::Modules; -use PBot::MiscCommands; use PBot::NickList; use PBot::Plugins; use PBot::ProcessManager; @@ -53,6 +49,9 @@ use PBot::Registry; use PBot::Refresher; use PBot::SelectHandler; use PBot::StdinReader; +use PBot::Storage::HashObject; +use PBot::Storage::DualIndexHashObject; +use PBot::Storage::DualIndexSQLiteObject; use PBot::Updater; use PBot::Users; use PBot::Utils::ParseDate; @@ -158,9 +157,6 @@ sub initialize { # create commands so the modules can register new commands $self->{commands} = PBot::Commands->new(pbot => $self, filename => "$conf{data_dir}/commands", %conf); - # add 'cap' capability command here since $self->{commands} is created after $self->{capabilities} - $self->{commands}->register(sub { $self->{capabilities}->cmd_cap(@_) }, "cap"); - # prepare the version information and `version` command $self->{version} = PBot::VERSION->new(pbot => $self, %conf); $self->{logger}->log($self->{version}->version . "\n"); @@ -194,7 +190,6 @@ sub initialize { $self->{irchandlers} = PBot::IRCHandlers->new(pbot => $self, %conf); $self->{interpreter} = PBot::Interpreter->new(pbot => $self, %conf); $self->{lagchecker} = PBot::LagChecker->new(pbot => $self, %conf); - $self->{misc_commands} = PBot::MiscCommands->new(pbot => $self, %conf); $self->{messagehistory} = PBot::MessageHistory->new(pbot => $self, filename => "$conf{data_dir}/message_history.sqlite3", %conf); $self->{modules} = PBot::Modules->new(pbot => $self, %conf); $self->{nicklist} = PBot::NickList->new(pbot => $self, %conf); @@ -205,6 +200,9 @@ sub initialize { $self->{stdin_reader} = PBot::StdinReader->new(pbot => $self, %conf); $self->{webpaste} = PBot::WebPaste->new(pbot => $self, %conf); + # register commands in Commands directory + $self->{commands}->register_commands; + # register command/factoid interpreters $self->{interpreter}->register(sub { $self->{commands}->interpreter(@_) }); $self->{interpreter}->register(sub { $self->{factoids}->interpreter(@_) }); @@ -286,24 +284,8 @@ sub connect { $self->{connected} = 1; - # set up handlers for the IRC engine - $self->{conn}->add_default_handler(sub { $self->{irchandlers}->default_handler(@_) }, 1); - $self->{conn}->add_handler([251, 252, 253, 254, 255, 302], sub { $self->{irchandlers}->on_init(@_) }); - - # ignore these events - $self->{conn}->add_handler( - [ - 'myinfo', - 'whoisserver', - 'whoiscountry', - 'whoischannels', - 'whoisidle', - 'motdstart', - 'endofmotd', - 'away', - ], - sub { } - ); + # set up IRC handlers + $self->{irchandlers}->add_handlers; } sub register_signal_handlers { diff --git a/lib/PBot/Plugin/Quotegrabs.pm b/lib/PBot/Plugin/Quotegrabs.pm index 80586bfc..dc11e647 100644 --- a/lib/PBot/Plugin/Quotegrabs.pm +++ b/lib/PBot/Plugin/Quotegrabs.pm @@ -18,8 +18,8 @@ use Time::Duration; use Time::HiRes qw(gettimeofday); use Getopt::Long qw(GetOptionsFromArray); -use PBot::Plugin::Quotegrabs::Quotegrabs_SQLite; # use SQLite backend for quotegrabs database -#use PBot::Plugin::Quotegrabs::Quotegrabs_Hashtable; # use Perl hashtable backend for quotegrabs database +use PBot::Plugin::Quotegrabs::Storage::SQLite; # use SQLite backend for quotegrabs database +#use PBot::Plugin::Quotegrabs::Storage::Hashtable; # use Perl hashtable backend for quotegrabs database use PBot::Utils::ValidateString; use POSIX qw(strftime); @@ -28,8 +28,8 @@ sub initialize { my ($self, %conf) = @_; $self->{filename} = $conf{quotegrabs_file} // $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/quotegrabs.sqlite3'; - $self->{database} = PBot::Plugin::Quotegrabs::Quotegrabs_SQLite->new(pbot => $self->{pbot}, filename => $self->{filename}); - #$self->{database} = PBot::Plugin::Quotegrabs::Quotegrabs_Hashtable->new(pbot => $self->{pbot}, filename => $self->{filename}); + $self->{database} = PBot::Plugin::Quotegrabs::Storage::SQLite->new(pbot => $self->{pbot}, filename => $self->{filename}); + #$self->{database} = PBot::Plugin::Quotegrabs::Storage::Hashtable->new(pbot => $self->{pbot}, filename => $self->{filename}); $self->{database}->begin(); $self->{pbot}->{atexit}->register(sub { $self->{database}->end(); return; }); diff --git a/lib/PBot/Plugin/Quotegrabs/Quotegrabs_Hashtable.pm b/lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm similarity index 97% rename from lib/PBot/Plugin/Quotegrabs/Quotegrabs_Hashtable.pm rename to lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm index 4e28a54c..fb8682b7 100644 --- a/lib/PBot/Plugin/Quotegrabs/Quotegrabs_Hashtable.pm +++ b/lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm @@ -1,11 +1,11 @@ -# File: Quotegrabs_Hashtable.pm +# File: Hashtable.pm # -# Purpose: Hashtable backend for storing and retreiving quotegrabs +# Purpose: Hashtable backend for storing and retreiving quotegrabs. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::Plugin::Quotegrabs::Quotegrabs_Hashtable; +package PBot::Plugin::Quotegrabs::Storage::Hashtable; use PBot::Imports; diff --git a/lib/PBot/Plugin/Quotegrabs/Quotegrabs_SQLite.pm b/lib/PBot/Plugin/Quotegrabs/Storage/SQLite.pm similarity index 96% rename from lib/PBot/Plugin/Quotegrabs/Quotegrabs_SQLite.pm rename to lib/PBot/Plugin/Quotegrabs/Storage/SQLite.pm index 7e534f6b..31590e08 100644 --- a/lib/PBot/Plugin/Quotegrabs/Quotegrabs_SQLite.pm +++ b/lib/PBot/Plugin/Quotegrabs/Storage/SQLite.pm @@ -1,11 +1,11 @@ -# File: Quotegrabs_SQLite.pm +# File: SQLite.pm # -# Purpose: SQLite back-end for storing and retreiving quotegrabs +# Purpose: SQLite backend for storing and retreiving quotegrabs. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::Plugin::Quotegrabs::Quotegrabs_SQLite; +package PBot::Plugin::Quotegrabs::Storage::SQLite; use PBot::Imports; diff --git a/lib/PBot/Plugin/Spinach.pm b/lib/PBot/Plugin/Spinach.pm index a7514b67..fccf057a 100644 --- a/lib/PBot/Plugin/Spinach.pm +++ b/lib/PBot/Plugin/Spinach.pm @@ -13,7 +13,7 @@ package PBot::Plugin::Spinach; use parent 'PBot::Plugin::Base'; use PBot::Imports; -use PBot::HashObject; +use PBot::Storage::HashObject; use PBot::Plugin::Spinach::Stats; use PBot::Plugin::Spinach::Rank; @@ -55,7 +55,7 @@ sub initialize { $self->{metadata_filename} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spinach/metadata'; $self->{stats_filename} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spinach/stats.sqlite'; - $self->{metadata} = PBot::HashObject->new(pbot => $self->{pbot}, name => 'Spinach Metadata', filename => $self->{metadata_filename}); + $self->{metadata} = PBot::Storage::HashObject->new(pbot => $self->{pbot}, name => 'Spinach Metadata', filename => $self->{metadata_filename}); $self->{metadata}->load; $self->set_metadata_defaults; diff --git a/lib/PBot/Registry.pm b/lib/PBot/Registry.pm index 034788c5..405746ce 100644 --- a/lib/PBot/Registry.pm +++ b/lib/PBot/Registry.pm @@ -11,9 +11,6 @@ use parent 'PBot::Class'; use PBot::Imports; -use Time::HiRes qw(gettimeofday); -use PBot::RegistryCommands; - sub initialize { my ($self, %conf) = @_; @@ -21,7 +18,7 @@ sub initialize { my $filename = $conf{filename} // Carp::croak("Missing filename configuration item in " . __FILE__); # registry is stored as a dual-index hash object - $self->{storage} = PBot::DualIndexHashObject->new(name => 'Registry', filename => $filename, pbot => $self->{pbot}); + $self->{storage} = PBot::Storage::DualIndexHashObject->new(name => 'Registry', filename => $filename, pbot => $self->{pbot}); # registry triggers are processed when a registry entry is modified $self->{triggers} = {}; @@ -29,9 +26,6 @@ sub initialize { # save registry data at bot exit $self->{pbot}->{atexit}->register(sub { $self->save; return; }); - # prepare registry-specific bot commands - PBot::RegistryCommands->new(pbot => $self->{pbot}); - # load existing registry entries from file (if exists) if (-e $filename) { $self->load; diff --git a/lib/PBot/DualIndexHashObject.pm b/lib/PBot/Storage/DualIndexHashObject.pm similarity index 98% rename from lib/PBot/DualIndexHashObject.pm rename to lib/PBot/Storage/DualIndexHashObject.pm index bdb46475..858558dd 100644 --- a/lib/PBot/DualIndexHashObject.pm +++ b/lib/PBot/Storage/DualIndexHashObject.pm @@ -8,12 +8,14 @@ # original case when displaying the keys. # # Data is stored in working memory for lightning fast performance. If you have -# a huge amount of data, consider DualIndexSQLiteObject instead. +# a huge amount of data, consider using DualIndexSQLiteObject instead. +# +# If a filename is provided, data is written to a file after any modifications. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::DualIndexHashObject; +package PBot::Storage::DualIndexHashObject; use PBot::Imports; diff --git a/lib/PBot/DualIndexSQLiteObject.pm b/lib/PBot/Storage/DualIndexSQLiteObject.pm similarity index 98% rename from lib/PBot/DualIndexSQLiteObject.pm rename to lib/PBot/Storage/DualIndexSQLiteObject.pm index a2b18569..909604e9 100644 --- a/lib/PBot/DualIndexSQLiteObject.pm +++ b/lib/PBot/Storage/DualIndexSQLiteObject.pm @@ -3,14 +3,21 @@ # Purpose: Provides a dual-indexed SQLite object with an abstracted API that includes # setting and deleting values, caching, displaying nearest matches, etc. Designed to # be as compatible as possible with DualIndexHashObject; e.g. get_keys, get_data, etc. - +# +# This class is ideal if you don't want to store the data in working memory. However, +# data is temporarily cached in working memory for lightning fast performance. The TTL +# value can be adjusted via the `dualindexsqliteobject.cache_timeout` registry entry. +# # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::DualIndexSQLiteObject; +package PBot::Storage::DualIndexSQLiteObject; use PBot::Imports; +use PBot::Utils::SQLiteLogger; +use PBot::Utils::SQLiteLoggerLayer; + use DBI; use Text::Levenshtein qw(fastdistance); @@ -56,9 +63,7 @@ sub begin { eval { my $sqlite_debug = $self->{pbot}->{registry}->get_value('dualindexsqliteobject', "debug_$self->{name}"); - use PBot::SQLiteLoggerLayer; - use PBot::SQLiteLogger; - open $self->{trace_layer}, '>:via(PBot::SQLiteLoggerLayer)', PBot::SQLiteLogger->new(pbot => $self->{pbot}); + open $self->{trace_layer}, '>:via(PBot::Utils::SQLiteLoggerLayer)', PBot::Utils::SQLiteLogger->new(pbot => $self->{pbot}); $self->{dbh}->trace($self->{dbh}->parse_trace_flags("SQL|$sqlite_debug"), $self->{trace_layer}); }; diff --git a/lib/PBot/HashObject.pm b/lib/PBot/Storage/HashObject.pm similarity index 97% rename from lib/PBot/HashObject.pm rename to lib/PBot/Storage/HashObject.pm index 927dd014..31cf6646 100644 --- a/lib/PBot/HashObject.pm +++ b/lib/PBot/Storage/HashObject.pm @@ -4,11 +4,14 @@ # setting and deleting values, saving to and loading from files, etc. Provides # case-insensitive access to the index key while preserving original case when # displaying index key. +# +# Data is stored in working memory for lightning fast performance. If a filename +# is provided, data is written to a file after any modifications. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::HashObject; +package PBot::Storage::HashObject; use PBot::Imports; diff --git a/lib/PBot/Users.pm b/lib/PBot/Users.pm index 54587c5f..c357846d 100644 --- a/lib/PBot/Users.pm +++ b/lib/PBot/Users.pm @@ -12,7 +12,7 @@ use PBot::Imports; sub initialize { my ($self, %conf) = @_; - $self->{storage} = PBot::HashObject->new(name => 'Users', filename => $conf{filename}, pbot => $conf{pbot}); + $self->{storage} = PBot::Storage::HashObject->new(name => 'Users', filename => $conf{filename}, pbot => $conf{pbot}); $self->{pbot}->{commands}->register(sub { $self->cmd_login(@_) }, "login", 0); $self->{pbot}->{commands}->register(sub { $self->cmd_logout(@_) }, "logout", 0); diff --git a/lib/PBot/Utils/LoadPackages.pm b/lib/PBot/Utils/LoadPackages.pm new file mode 100644 index 00000000..c70dfe88 --- /dev/null +++ b/lib/PBot/Utils/LoadPackages.pm @@ -0,0 +1,64 @@ +# File: LoadPackages.pm +# +# Purpose: Loads all Perl package files in a given directory. + +# SPDX-FileCopyrightText: 2021 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::Utils::LoadPackages; + +use PBot::Imports; + +use Cwd; + +# export load_packages subroutine +require Exporter; +our @ISA = qw/Exporter/; +our @EXPORT = qw/load_packages/; + +sub load_packages { + my ($self, $directory) = @_; + + use FindBin qw/$RealBin/; + + my $cwd = getcwd; + + chdir "$RealBin/../lib/PBot"; + + my @packages = glob "$directory/*.pm"; + + chdir $cwd; + + foreach my $package (sort @packages) { + $package = "PBot/$package"; + + my $class = $package; + $class =~ s/\//::/g; + $class =~ s/\.pm$//; + + my ($name) = $class =~ /.*::(.*)$/; + + $self->{pbot}->{logger}->log(" $name\n"); + + $self->{pbot}->{refresher}->{refresher}->refresh_module($package); + + eval { + require "$package"; + + if (my $exception = $@) { + $self->{pbot}->{logger}->log("Error loading $package: $exception"); + return 0; + } + + $self->{lc $directory}->{$name} = $class->new(pbot => $self->{pbot}); + $self->{pbot}->{refresher}->{refresher}->update_cache($package); + }; + + if (my $exception = $@) { + $self->{pbot}->{logger}->log("Error loading $package: $exception"); + exit; + } + } +} + +1; diff --git a/lib/PBot/Utils/PriorityQueue.pm b/lib/PBot/Utils/PriorityQueue.pm index 93b109ef..778528e7 100644 --- a/lib/PBot/Utils/PriorityQueue.pm +++ b/lib/PBot/Utils/PriorityQueue.pm @@ -6,15 +6,16 @@ # SPDX-License-Identifier: MIT package PBot::Utils::PriorityQueue; -use parent 'PBot::Class'; use PBot::Imports; -sub initialize { - my ($self, %conf) = @_; +sub new { + my ($class, %args) = @_; - # list of entrie; each entry is expected to have a `priority` and an `id` field - $self->{queue} = []; + return bless { + # list of entries; each entry is expected to have a `priority` and an `id` field + queue => [], + }, $class; } sub queue { diff --git a/lib/PBot/SQLiteLogger.pm b/lib/PBot/Utils/SQLiteLogger.pm similarity index 97% rename from lib/PBot/SQLiteLogger.pm rename to lib/PBot/Utils/SQLiteLogger.pm index 97d52dc9..c6ce9d4a 100644 --- a/lib/PBot/SQLiteLogger.pm +++ b/lib/PBot/Utils/SQLiteLogger.pm @@ -6,7 +6,7 @@ # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::SQLiteLogger; +package PBot::Utils::SQLiteLogger; use PBot::Imports; diff --git a/lib/PBot/SQLiteLoggerLayer.pm b/lib/PBot/Utils/SQLiteLoggerLayer.pm similarity index 93% rename from lib/PBot/SQLiteLoggerLayer.pm rename to lib/PBot/Utils/SQLiteLoggerLayer.pm index 05f41c27..289248c9 100644 --- a/lib/PBot/SQLiteLoggerLayer.pm +++ b/lib/PBot/Utils/SQLiteLoggerLayer.pm @@ -5,7 +5,7 @@ # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT -package PBot::SQLiteLoggerLayer; +package PBot::Utils::SQLiteLoggerLayer; use PBot::Imports;