GitHub/pbot
3
0
Fork 0
mirror of https://github.com/pragma-/pbot.git synced 2024-11-22 11:59:43 +01:00
Code Issues Projects Releases Wiki Activity

Massive reorganization

Browse Source 
Storage-related packages have been moved to PBot/Storage/.

MessageHistory_SQLite.pm has been moved to MessageHistory/Storage/SQLite.pm.

Quotegrabs' storage packages have been moved to Plugin/Quotegrabs/Storage/.

IRC handler-related packages have been moved to PBot/IRCHandlers/.

Commands registered by core PBot packages have been moved to PBot/Commands/.

Some non-core packages have been moved to PBot/Utils/.

Several packages have been cleaned up.

TODO: Move remaining core commands and IRC handlers.

TODO: Split AntiFlood.pm into Plugin/AntiAbuse/ files.
This commit is contained in:
Pragmatic Software 2021-07-20 21:38:07 -07:00
parent 547c4e7135
commit ea63ef8fe8
42 changed files with 1841 additions and 1484 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
lib/PBot/AntiFlood.pm
View File

@ -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 {

2
lib/PBot/AntiSpam.pm
View File

@ -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);

6
lib/PBot/BanList.pm
View File

@ -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];

191
lib/PBot/Capabilities.pm
View File

@ -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 <capability>; Lists all users who have <capability>";
}
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 <username> [capability]; Lists capabilities belonging to <user>";
}
$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 <existing or new capability> <existing capabilities...>";
}
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 <existing capability group> <grouped capabilities...>";
}
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 <existing or new capability group> <existing capabilities...> "
. "| cap ungroup <existing capability group> <grouped capabilities...> | cap userhas <user> [capability] "
. "| cap whohas <capability>";
}
}
}
sub has {
my ($self, $cap, $subcap, $depth) = @_;
my $cap_data = $self->{caps}->get_data($cap);

4
lib/PBot/ChanOps.pm
View File

@ -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

2
lib/PBot/Channels.pm
View File

@ -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);

4
lib/PBot/Class.pm
View File

@ -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);

151
lib/PBot/Commands.pm
View File

@ -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 <command> [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 <command> <key>";
}
return $self->{metadata}->unset($command, $key);
}
sub cmd_help {
my ($self, $context) = @_;
if (not length $context->{arguments}) {
return "For general help, see <https://github.com/pragma-/pbot/tree/master/doc>. For help about a specific command or factoid, use `help <keyword> [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 <text>`.";
} 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 <channel>` 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 <text>`.";
}
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 {

216
lib/PBot/Commands/Capabilities.pm Normal file
View File

@ -0,0 +1,216 @@
# File: Capabilities.pm
#
# Purpose: Registers the capabilities `cap` command.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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 <capability>; Lists all users who have <capability>";
}
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 <username> [capability]; Lists capabilities belonging to <user>";
}
$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 <existing or new capability> <existing capabilities...>";
}
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 <existing capability group> <grouped capabilities...>";
}
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 <existing or new capability group> <existing capabilities...> "
. "| cap ungroup <existing capability group> <grouped capabilities...> | cap userhas <user> [capability] "
. "| cap whohas <capability>";
}
}
}
1;

49
lib/PBot/ChanOpCommands.pm → lib/PBot/Commands/ChanOp.pm
View File

@ -1,18 +1,30 @@
# File: ChanOpCommands.pm
# File: ChanOp.pm
#
# Purpose: Channel operator command subroutines.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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");

57
lib/PBot/Commands/CommandMetadata.pm Normal file
View File

@ -0,0 +1,57 @@
# File: CommandMetadata.pm
#
# Purpose: Registers commands for manipulating command metadata.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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 <command> [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 <command> <key>";
}
return $self->{metadata}->unset($command, $key);
}
1;

33
lib/PBot/FactoidCommands.pm → lib/PBot/Commands/Factoids.pm
View File

@ -1,12 +1,11 @@
# File: FactoidCommands.pm
# File: Factoids.pm
#
# Purpose: Factoid command subroutines.
# Purpose: Factoids command subroutines.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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;

147
lib/PBot/Commands/Help.pm Normal file
View File

@ -0,0 +1,147 @@
# File: Help.pm
#
# Purpose: Registers `help` command.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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 <https://github.com/pragma-/pbot/tree/master/doc>. For help about a specific command or factoid, use `help <keyword> [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 <text>`.";
} 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 <channel>` 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 <text>`.";
}
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;

18
lib/PBot/MiscCommands.pm → lib/PBot/Commands/Misc.pm
View File

@ -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 <pragma78@gmail.com>
# 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) = @_;

18
lib/PBot/RegistryCommands.pm → lib/PBot/Commands/Registry.pm
View File

@ -1,15 +1,27 @@
# File: RegistryCommands.pm
# File: Registry.pm
#
# Purpose: Bot commands to manipulate Registry entries.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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);

6
lib/PBot/Factoids.pm
View File

@ -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);

1049
lib/PBot/IRCHandlers.pm
View File

File diff suppressed because it is too large Load Diff

126
lib/PBot/IRCHandlers/Cap.pm Normal file
View File

@ -0,0 +1,126 @@
# File: Cap.pm
#
# Purpose: Handles IRCv3 CAP event.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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;

351
lib/PBot/IRCHandlers/Channel.pm Normal file
View File

@ -0,0 +1,351 @@
# File: Channel.pm
#
# Purpose: Handlers for channel-related IRC events.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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;

112
lib/PBot/IRCHandlers/Chat.pm Normal file
View File

@ -0,0 +1,112 @@
# File: Chat.pm
#
# Purpose: IRC handlers for chat/message events.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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;

136
lib/PBot/IRCHandlers/NickServ.pm Normal file
View File

@ -0,0 +1,136 @@
# File: NickServ.pm
#
# Purpose: Handles NickServ-related IRC events.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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;

128
lib/PBot/IRCHandlers/SASL.pm Normal file
View File

@ -0,0 +1,128 @@
# File: SASL.pm
#
# Purpose: Handles IRCv3 SASL events. Currently only PLAIN is supported.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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;

209
lib/PBot/IRCHandlers/Server.pm Normal file
View File

@ -0,0 +1,209 @@
# File: Server.pm
#
# Purpose: Handles server-related IRC events.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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;

2
lib/PBot/IgnoreList.pm
View File

@ -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;

6
lib/PBot/Interpreter.pm
View File

@ -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
);

13
lib/PBot/MessageHistory.pm
View File

@ -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);

26
lib/PBot/MessageHistory/Constants.pm Normal file
View File

@ -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;

29
lib/PBot/MessageHistory_SQLite.pm → lib/PBot/MessageHistory/Storage/SQLite.pm
View File

@ -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 <pragma78@gmail.com>
# 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;

34
lib/PBot/PBot.pm
View File

@ -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 {

8
lib/PBot/Plugin/Quotegrabs.pm
View File

@ -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; });

6
lib/PBot/Plugin/Quotegrabs/Quotegrabs_Hashtable.pm → lib/PBot/Plugin/Quotegrabs/Storage/Hashtable.pm
View File

@ -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 <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::Quotegrabs::Quotegrabs_Hashtable;
package PBot::Plugin::Quotegrabs::Storage::Hashtable;
use PBot::Imports;

6
lib/PBot/Plugin/Quotegrabs/Quotegrabs_SQLite.pm → lib/PBot/Plugin/Quotegrabs/Storage/SQLite.pm
View File

@ -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 <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::Quotegrabs::Quotegrabs_SQLite;
package PBot::Plugin::Quotegrabs::Storage::SQLite;
use PBot::Imports;

4
lib/PBot/Plugin/Spinach.pm
View File

@ -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;

8
lib/PBot/Registry.pm
View File

@ -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;

6
lib/PBot/DualIndexHashObject.pm → lib/PBot/Storage/DualIndexHashObject.pm
View File

@ -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 <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::DualIndexHashObject;
package PBot::Storage::DualIndexHashObject;
use PBot::Imports;

15
lib/PBot/DualIndexSQLiteObject.pm → lib/PBot/Storage/DualIndexSQLiteObject.pm
View File

@ -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 <pragma78@gmail.com>
# 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});
};

5
lib/PBot/HashObject.pm → lib/PBot/Storage/HashObject.pm
View File

@ -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 <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::HashObject;
package PBot::Storage::HashObject;
use PBot::Imports;

2
lib/PBot/Users.pm
View File

@ -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);

64
lib/PBot/Utils/LoadPackages.pm Normal file
View File

@ -0,0 +1,64 @@
# File: LoadPackages.pm
#
# Purpose: Loads all Perl package files in a given directory.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# 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;

11
lib/PBot/Utils/PriorityQueue.pm
View File

@ -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 {

2
lib/PBot/SQLiteLogger.pm → lib/PBot/Utils/SQLiteLogger.pm
View File

@ -6,7 +6,7 @@
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::SQLiteLogger;
package PBot::Utils::SQLiteLogger;
use PBot::Imports;

2
lib/PBot/SQLiteLoggerLayer.pm → lib/PBot/Utils/SQLiteLoggerLayer.pm
View File

@ -5,7 +5,7 @@
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::SQLiteLoggerLayer;
package PBot::Utils::SQLiteLoggerLayer;
use PBot::Imports;