mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-22 20:09:43 +01:00
Massive reorganization
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
parent
547c4e7135
commit
ea63ef8fe8
@ -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 {
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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];
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
216
lib/PBot/Commands/Capabilities.pm
Normal 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;
|
||||
@ -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) = @_;
|
||||
|
||||
@ -89,26 +101,41 @@ sub initialize {
|
||||
|
||||
sub on_inviting {
|
||||
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;
|
||||
|
||||
$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;
|
||||
|
||||
$self->{pbot}->{logger}->log("$target: $msg\n");
|
||||
57
lib/PBot/Commands/CommandMetadata.pm
Normal file
57
lib/PBot/Commands/CommandMetadata.pm
Normal 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;
|
||||
@ -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
147
lib/PBot/Commands/Help.pm
Normal 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;
|
||||
@ -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) = @_;
|
||||
|
||||
@ -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);
|
||||
@ -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);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
126
lib/PBot/IRCHandlers/Cap.pm
Normal file
126
lib/PBot/IRCHandlers/Cap.pm
Normal 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
351
lib/PBot/IRCHandlers/Channel.pm
Normal 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
112
lib/PBot/IRCHandlers/Chat.pm
Normal 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
136
lib/PBot/IRCHandlers/NickServ.pm
Normal 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
128
lib/PBot/IRCHandlers/SASL.pm
Normal 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
209
lib/PBot/IRCHandlers/Server.pm
Normal 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;
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
);
|
||||
|
||||
|
||||
@ -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
26
lib/PBot/MessageHistory/Constants.pm
Normal 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;
|
||||
@ -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;
|
||||
|
||||
@ -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 {
|
||||
|
||||
@ -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; });
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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});
|
||||
};
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
64
lib/PBot/Utils/LoadPackages.pm
Normal 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;
|
||||
@ -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 {
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user