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

Progress on polishing things

Browse Source
This commit is contained in:
Pragmatic Software 2021-07-21 12:43:30 -07:00
parent 91da60bf72
commit a21c475681
14 changed files with 1675 additions and 1457 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

87
lib/PBot/Core/Channels.pm
View File

@ -14,93 +14,6 @@ sub initialize {
my ($self, %conf) = @_;
$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);
$self->{pbot}->{commands}->register(sub { $self->cmd_part(@_) }, "part", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_set(@_) }, "chanset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unset(@_) }, "chanunset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_add(@_) }, "chanadd", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_remove(@_) }, "chanrem", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_list(@_) }, "chanlist", 1);
$self->{pbot}->{capabilities}->add('admin', 'can-join', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-part', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-chanlist', 1);
}
sub cmd_join {
my ($self, $context) = @_;
foreach my $channel (split /[\s+,]/, $context->{arguments}) {
$self->{pbot}->{logger}->log("$context->{hostmask} made me join $channel\n");
$self->join($channel);
}
return "/msg $context->{nick} Joining $context->{arguments}";
}
sub cmd_part {
my ($self, $context) = @_;
$context->{arguments} = $context->{from} if not $context->{arguments};
foreach my $channel (split /[\s+,]/, $context->{arguments}) {
$self->{pbot}->{logger}->log("$context->{hostmask} made me part $channel\n");
$self->part($channel);
}
return "/msg $context->{nick} Parting $context->{arguments}";
}
sub cmd_set {
my ($self, $context) = @_;
my ($channel, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
return "Usage: chanset <channel> [key [value]]" if not defined $channel;
return $self->{storage}->set($channel, $key, $value);
}
sub cmd_unset {
my ($self, $context) = @_;
my ($channel, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: chanunset <channel> <key>" if not defined $channel or not defined $key;
return $self->{storage}->unset($channel, $key);
}
sub cmd_add {
my ($self, $context) = @_;
return "Usage: chanadd <channel>" if not length $context->{arguments};
my $data = {
enabled => 1,
chanop => 0,
permop => 0
};
return $self->{storage}->add($context->{arguments}, $data);
}
sub cmd_remove {
my ($self, $context) = @_;
return "Usage: chanrem <channel>" if not length $context->{arguments};
# clear banlists
$self->{pbot}->{banlist}->{banlist}->remove($context->{arguments});
$self->{pbot}->{banlist}->{quietlist}->remove($context->{arguments});
$self->{pbot}->{event_queue}->dequeue_event("unban $context->{arguments} .*");
$self->{pbot}->{event_queue}->dequeue_event("unmute $context->{arguments} .*");
# TODO: ignores, etc?
return $self->{storage}->remove($context->{arguments});
}
sub cmd_list {
my ($self, $context) = @_;
my $result;
foreach my $channel (sort $self->{storage}->get_keys) {
$result .= $self->{storage}->get_key_name($channel) . ': {';
my $comma = ' ';
foreach my $key (sort $self->{storage}->get_keys($channel)) {
$result .= "$comma$key => " . $self->{storage}->get_data($channel, $key);
$comma = ', ';
}
$result .= " }\n";
}
return $result;
}
sub join {

118
lib/PBot/Core/Commands/Channels.pm Normal file
View File

@ -0,0 +1,118 @@
# File: Channels.pm
#
# Purpose: Commands to manage list of channels, and channel metadata.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::Channels;
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
$self->{pbot}->{commands}->register(sub { $self->cmd_join(@_) }, "join", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_part(@_) }, "part", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_set(@_) }, "chanset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_unset(@_) }, "chanunset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_add(@_) }, "chanadd", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_remove(@_) }, "chanrem", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_list(@_) }, "chanlist", 1);
# add capabilities to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-join', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-part', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-chanlist', 1);
}
sub cmd_join {
my ($self, $context) = @_;
foreach my $channel (split /[\s+,]/, $context->{arguments}) {
$self->{pbot}->{logger}->log("$context->{hostmask} made me join $channel\n");
$self->{pbot}->{channels}->join($channel);
}
return "/msg $context->{nick} Joining $context->{arguments}";
}
sub cmd_part {
my ($self, $context) = @_;
$context->{arguments} = $context->{from} if not $context->{arguments};
foreach my $channel (split /[\s+,]/, $context->{arguments}) {
$self->{pbot}->{logger}->log("$context->{hostmask} made me part $channel\n");
$self->{pbot}->{channels}->part($channel);
}
return "/msg $context->{nick} Parting $context->{arguments}";
}
sub cmd_set {
my ($self, $context) = @_;
my ($channel, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
return "Usage: chanset <channel> [key [value]]" if not defined $channel;
return $self->{pbot}->{channels}->{storage}->set($channel, $key, $value);
}
sub cmd_unset {
my ($self, $context) = @_;
my ($channel, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
return "Usage: chanunset <channel> <key>" if not defined $channel or not defined $key;
return $self->{pbot}->{channels}->{storage}->unset($channel, $key);
}
sub cmd_add {
my ($self, $context) = @_;
return "Usage: chanadd <channel>" if not length $context->{arguments};
my $data = {
enabled => 1,
chanop => 0,
permop => 0
};
return $self->{pbot}->{channels}->{storage}->add($context->{arguments}, $data);
}
sub cmd_remove {
my ($self, $context) = @_;
return "Usage: chanrem <channel>" if not length $context->{arguments};
# clear banlists
$self->{pbot}->{banlist}->{banlist}->remove($context->{arguments});
$self->{pbot}->{banlist}->{quietlist}->remove($context->{arguments});
$self->{pbot}->{event_queue}->dequeue_event("unban $context->{arguments} .*");
$self->{pbot}->{event_queue}->dequeue_event("unmute $context->{arguments} .*");
# TODO: ignores, etc?
return $self->{storage}->remove($context->{arguments});
}
sub cmd_list {
my ($self, $context) = @_;
my $result;
foreach my $channel (sort $self->{pbot}->{channels}->{storage}->get_keys) {
$result .= $self->{pbot}->{channels}->{storage}->get_key_name($channel) . ': {';
my $comma = ' ';
foreach my $key (sort $self->{pbot}->{channels}->{storage}->get_keys($channel)) {
$result .= "$comma$key => " . $self->{pbot}->{channels}->{storage}->get_data($channel, $key);
$comma = ', ';
}
$result .= " }\n";
}
return $result;
}
1;

134
lib/PBot/Core/Commands/EventQueue.pm Normal file
View File

@ -0,0 +1,134 @@
# File: EventQueue.pm
#
# Purpose: Registers command for manipulating PBot event queue.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::EventQueue;
use PBot::Imports;
use Time::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) = @_;
# register `eventqueue` bot command
$self->{pbot}->{commands}->register(sub { $self->cmd_eventqueue(@_) }, 'eventqueue', 1);
# add `can-eventqueue` capability to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-eventqueue', 1);
}
sub cmd_eventqueue {
my ($self, $context) = @_;
my $usage = "Usage: eventqueue list [filter regex] | add <relative time> <command> [-repeat] | remove <regex>";
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
if (not defined $command) {
return $usage;
}
if ($command eq 'list') {
return "No events queued." if not $self->{pbot}->{event_queue}->count;
my $result = eval {
my $text = "Queued events:\n";
my ($regex) = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
my $i = 0;
my $events = 0;
foreach my $event ($self->{pbot}->{event_queue}->entries) {
$i++;
if ($regex) {
next unless $event->{id} =~ /$regex/i;
}
$events++;
my $duration = $event->{priority} - time;
if ($duration < 0) {
# current time has passed an event's time but the
# event hasn't left the queue yet. we'll show these
# as, e.g., "pending 5s ago"
$duration = 'pending ' . concise ago -$duration;
} else {
$duration = 'in ' . concise duration $duration;
}
$text .= " $i) $duration: $event->{id}";
$text .= ' [R]' if $event->{repeating};
$text .= ";\n";
}
return "No events found." if $events == 0;
return $text . "$events events.\n";
};
if (my $error = $@) {
# strip source information to prettify error for non-developer consumption
$error =~ s/ at PBot.*//;
return "Bad regex: $error";
}
return $result;
}
if ($command eq 'add') {
my ($duration, $command) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $duration or not defined $command) {
return "Usage: eventqueue add <relative time> <command> [-repeat]";
}
# convert text like "5 minutes" or "1 week" or "next tuesday" to seconds
my ($seconds, $error) = $self->{pbot}->{parsedate}->parsedate($duration);
return $error if defined $error;
# check for `-repeating` at front or end of command
my $repeating = $command =~ s/^-repeat\s+|\s+-repeat$//g;
my $cmd = {
nick => $context->{nick},
user => $context->{user},
host => $context->{host},
hostmask => $context->{hostmask},
command => $command,
};
$self->{pbot}->{interpreter}->add_to_command_queue($context->{from}, $cmd, $seconds, $repeating);
return "Command added to event queue.";
}
if ($command eq 'remove') {
my ($regex) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 1);
return "Usage: eventqueue remove <regex>" if not defined $regex;
$regex =~ s/(?<!\.)\*/.*?/g;
return $self->{pbot}->{event_queue}->dequeue_event($regex);
}
return "Unknown command '$command'. $usage";
}
1;

532
lib/PBot/Core/Commands/MessageHistory.pm Normal file
View File

@ -0,0 +1,532 @@
# File: MessageHistory.pm
#
# Purpose: Registers commands related to a user's message history or aliases.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::MessageHistory;
use PBot::Imports;
use Getopt::Long qw(GetOptionsFromArray);
use Time::HiRes qw(time tv_interval);
use Time::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) = @_;
# unprivileged commands
$self->{pbot}->{commands}->register(sub { $self->cmd_list_also_known_as(@_) }, "aka", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_recall_message(@_) }, "recall", 0);
# commands with the can- capability set
$self->{pbot}->{commands}->register(sub { $self->cmd_rebuild_aliases(@_) }, "rebuildaliases", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_aka_link(@_) }, "akalink", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_aka_unlink(@_) }, "akaunlink", 1);
# add capabilities to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-akalink', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-akaunlink', 1);
}
sub cmd_list_also_known_as {
my ($self, $context) = @_;
my $usage = "Usage: aka [-hilngr] <nick> [-sort <by>]; -h show hostmasks; -i show ids; -l show last seen, -n show nickserv accounts; -g show gecos, -r show relationships";
if (not length $context->{arguments}) {
return $usage;
}
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
Getopt::Long::Configure("bundling_override");
my $sort_method = undef;
my ($show_hostmasks, $show_gecos, $show_nickserv, $show_id, $show_relationship, $show_weak, $show_last_seen, $dont_use_aliases_table);
my @opt_args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
GetOptionsFromArray(
\@opt_args,
'h' => \$show_hostmasks,
'l' => \$show_last_seen,
'n' => \$show_nickserv,
'r' => \$show_relationship,
'g' => \$show_gecos,
'w' => \$show_weak,
'z' => \$dont_use_aliases_table,
'i' => \$show_id,
'sort|s=s' => \$sort_method,
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
return "Too many arguments -- $usage" if @opt_args > 1;
return "Missing argument -- $usage" if @opt_args != 1;
$sort_method = 'seen' if $show_last_seen and not defined $sort_method;
$sort_method = 'nick' if not defined $sort_method;
my %sort = (
'id' => sub {
if ($_[1] eq '+') {
return $_[0]->{$a}->{id} <=> $_[0]->{$b}->{id};
} else {
return $_[0]->{$b}->{id} <=> $_[0]->{$a}->{id};
}
},
'seen' => sub {
if ($_[1] eq '+') {
return $_[0]->{$b}->{last_seen} <=> $_[0]->{$a}->{last_seen};
} else {
return $_[0]->{$a}->{last_seen} <=> $_[0]->{$b}->{last_seen};
}
},
'nickserv' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{nickserv} cmp lc $_[0]->{$b}->{nickserv};
} else {
return lc $_[0]->{$b}->{nickserv} cmp lc $_[0]->{$a}->{nickserv};
}
},
'nick' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{nick} cmp lc $_[0]->{$b}->{nick};
} else {
return lc $_[0]->{$b}->{nick} cmp lc $_[0]->{$a}->{nick};
}
},
'user' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{user} cmp lc $_[0]->{$b}->{user};
} else {
return lc $_[0]->{$b}->{user} cmp lc $_[0]->{$a}->{user};
}
},
'host' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{host} cmp lc $_[0]->{$b}->{host};
} else {
return lc $_[0]->{$b}->{host} cmp lc $_[0]->{$a}->{host};
}
},
'hostmask' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{hostmask} cmp lc $_[0]->{$b}->{hostmask};
} else {
return lc $_[0]->{$b}->{hostmask} cmp lc $_[0]->{$a}->{hostmask};
}
},
'gecos' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{gecos} cmp lc $_[0]->{$b}->{gecos};
} else {
return lc $_[0]->{$b}->{gecos} cmp lc $_[0]->{$a}->{gecos};
}
},
);
my $sort_direction = '+';
if ($sort_method =~ s/^(\+|\-)//) {
$sort_direction = $1;
}
if (not exists $sort{$sort_method}) {
return "Invalid sort method '$sort_method'; valid methods are: " . join(', ', sort keys %sort) . "; prefix with - to invert sort direction.";
}
my %akas = $self->{pbot}->{messagehistory}->{database}->get_also_known_as($opt_args[0], $dont_use_aliases_table);
if (%akas) {
my $result = "$opt_args[0] also known as:\n";
my %nicks;
my $sep = "";
foreach my $aka (sort { $sort{$sort_method}->(\%akas, $sort_direction) } keys %akas) {
next if $aka =~ /^Guest\d+(?:!.*)?$/;
next if exists $akas{$aka}->{type} and $akas{$aka}->{type} == $self->{pbot}->{messagehistory}->{database}->{alias_type}->{WEAK} && not $show_weak;
if (not $show_hostmasks) {
my ($nick) = $aka =~ m/([^!]+)/;
next if exists $nicks{$nick};
$nicks{$nick}->{id} = $akas{$aka}->{id};
$result .= "$sep$nick";
} else {
$result .= "$sep$aka";
}
$result .= "?" if $akas{$aka}->{nickchange} == 1;
$result .= " ($akas{$aka}->{nickserv})" if $show_nickserv and exists $akas{$aka}->{nickserv};
$result .= " {$akas{$aka}->{gecos}}" if $show_gecos and exists $akas{$aka}->{gecos};
if ($show_relationship) {
if ($akas{$aka}->{id} == $akas{$aka}->{alias}) {
$result .= " [$akas{$aka}->{id}]";
} else {
$result .= " [$akas{$aka}->{id} -> $akas{$aka}->{alias}]";
}
} elsif ($show_id) {
$result .= " [$akas{$aka}->{id}]";
}
$result .= " [WEAK]" if exists $akas{$aka}->{type} and $akas{$aka}->{type} == $self->{pbot}->{messagehistory}->{database}->{alias_type}->{WEAK};
if ($show_last_seen) {
my $seen = concise ago (time - $akas{$aka}->{last_seen});
$result .= " (seen $seen)";
}
if ($show_hostmasks or $show_nickserv or $show_gecos or $show_id or $show_relationship) {
$sep = ",\n";
} else {
$sep = ", ";
}
}
return $result;
} else {
return "I don't know anybody named $opt_args[0].";
}
}
sub cmd_recall_message {
my ($self, $context) = @_;
my $usage = 'Usage: recall [nick [history [channel]]] [-c <channel>] [-t <text>] [-b <context before>] [-a <context after>] [-x <filter to nick>] [-n <count>] [-r raw mode] [+ ...]';
my $arguments = $context->{arguments};
if (not length $arguments) {
return $usage;
}
$arguments = lc $arguments;
my @recalls = split /\s\+\s/, $arguments;
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
my $result = '';
Getopt::Long::Configure("bundling_override");
# global state
my ($recall_channel, $raw, $random);
foreach my $recall (@recalls) {
my ($recall_nick, $recall_text, $recall_history, $recall_before, $recall_after, $recall_context, $recall_count);
my @opt_args = $self->{pbot}->{interpreter}->split_line($recall, strip_quotes => 1);
GetOptionsFromArray(
\@opt_args,
'channel|c=s' => \$recall_channel,
'history|h=s' => \$recall_history,
'text|t=s' => \$recall_text,
'before|b=i' => \$recall_before,
'after|a=i' => \$recall_after,
'count|n=i' => \$recall_count,
'context|x=s' => \$recall_context,
'raw|r' => \$raw,
'random' => \$random,
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
if (defined $recall_history and defined $recall_text) {
return "/say $context->{nick}: The -h and -t options cannot be used together.";
}
# we swap these $recall variables around so much later on that we
# need to remember which flags were explicitly set...
my $channel_arg = 1 if defined $recall_channel;
my $history_arg = 1 if defined $recall_history;
$recall_nick = shift @opt_args if @opt_args;
$recall_history = shift @opt_args if @opt_args and not $history_arg and not defined $recall_text;
if (not $channel_arg) {
$recall_channel = "@opt_args" if @opt_args;
} else {
if (defined $recall_history) {
$recall_history .= ' ';
}
$recall_history .= "@opt_args" if @opt_args;
}
if (defined $recall_text and not defined $recall_history) {
$recall_history = $recall_text;
}
my $max_count = $self->{pbot}->{registry}->get_value('messagehistory', 'max_recall_count') // 50;
if ((not defined $recall_count) || ($recall_count <= 0)) {
$recall_count = 1;
}
if ($recall_count > $max_count) {
return "You may only select a count of up to $max_count messages.";
}
$recall_before = 0 if not defined $recall_before;
$recall_after = 0 if not defined $recall_after;
# imply -x if -n > 1 and -x isn't already set to somebody
if ($recall_count > 1 and not defined $recall_context) {
$recall_context = $recall_nick;
}
# make -n behave like -b if -n > 1 and no history is specified
if (not defined $recall_history and $recall_count > 1) {
$recall_before = $recall_count - 1;
$recall_count = 0;
}
if ($recall_before + $recall_after > 100) { return "You may only select up to 100 lines of surrounding context."; }
if ($recall_count > 1 and ($recall_before > 0 or $recall_after > 0)) { return "The `count` and `before/after` options cannot be used together."; }
# swap nick and channel if recall nick looks like channel and channel wasn't specified
if (not $channel_arg and $recall_nick =~ m/^#/) {
my $temp = $recall_nick;
$recall_nick = $recall_channel;
$recall_channel = $temp;
}
$recall_history = 1 if not defined $recall_history;
# swap history and channel if history looks like a channel and neither history or channel were specified
if (not $channel_arg and not $history_arg and $recall_history =~ m/^#/) {
my $temp = $recall_history;
$recall_history = $recall_channel;
$recall_channel = $temp;
}
# skip recall command if recalling self without arguments
if (defined $recall_nick and not defined $recall_history) {
$recall_history = $context->{nick} eq $recall_nick ? 2 : 1;
}
# set history to most recent message if not specified
$recall_history = '1' if not defined $recall_history;
# set channel to current channel if not specified
$recall_channel = $context->{from} if not defined $recall_channel;
# yet another sanity check for people using it wrong
if ($recall_channel !~ m/^#/) {
$recall_history = "$recall_history $recall_channel";
$recall_channel = $context->{from};
}
# set nick argument to -x argument if no nick was provided but -x was
if (not defined $recall_nick and defined $recall_context) {
$recall_nick = $recall_context;
}
# message account and stored nickname with proper typographical casing
my ($account, $found_nick);
# get message account and found nick if a nick was provided
if (defined $recall_nick) {
# account and hostmask
($account, $found_nick) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($recall_nick);
if (not defined $account) {
return "I don't know anybody named $recall_nick.";
}
# keep only nick portion of hostmask
$found_nick =~ s/!.*$//;
}
# matching message found in database, if any
my $message;
if ($random) {
# get a random message
$message = $self->{pbot}->{messagehistory}->{database}->get_random_message($account, $recall_channel, $recall_nick);
} elsif ($recall_history =~ /^\d+$/ and not defined $recall_text) {
# integral history
# if a nick was given, ensure requested history is within range of nick's history count
if (defined $account) {
my $max_messages = $self->{pbot}->{messagehistory}->{database}->get_max_messages($account, $recall_channel, $recall_nick);
if ($recall_history < 1 || $recall_history > $max_messages) {
if ($max_messages == 0) {
return "No messages for $recall_nick in $recall_channel yet.";
} else {
return "Please choose a history between 1 and $max_messages";
}
}
}
$recall_history--;
$message = $self->{pbot}->{messagehistory}->{database}->recall_message_by_count($account, $recall_channel, $recall_history, '(?:recall|mock|ftfy|fix|clapper)', $recall_nick);
if (not defined $message) {
if (defined $account) {
return "No message found at index $recall_history for $found_nick in $recall_channel.";
} else {
return "No message found at index $recall_history in $recall_channel.";
}
}
} else {
# regex history
$message = $self->{pbot}->{messagehistory}->{database}->recall_message_by_text($account, $recall_channel, $recall_history, '(?:recall|mock|ftfy|fix|clapper)', $recall_nick);
if (not defined $message) {
if (defined $account) {
return "No message for $found_nick in $recall_channel containing \"$recall_history\"";
} else {
return "No message in $recall_channel containing \"$recall_history\".";
}
}
}
my ($context_account, $context_nick);
if (defined $recall_context) {
($context_account, $context_nick) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($recall_context);
if (not defined $context_account) {
return "I don't know anybody named $recall_context.";
}
# keep only nick portion of hostmask
$context_nick =~ s/!.*$//;
}
my $messages = $self->{pbot}->{messagehistory}->{database}->get_message_context($message, $recall_before, $recall_after, $recall_count, $recall_history, $context_account, $context_nick);
my $max_recall_time = $self->{pbot}->{registry}->get_value('messagehistory', 'max_recall_time');
foreach my $msg (@$messages) {
# optionally limit messages by by a maximum recall duration from the current time, for privacy
if ($max_recall_time && time - $msg->{timestamp} > $max_recall_time
&& not $self->{pbot}->{users}->loggedin_admin($context->{from}, $context->{hostmask}))
{
$max_recall_time = duration $max_recall_time;
$result .= "Sorry, you can not recall messages older than $max_recall_time.";
return $result;
}
my $text = $msg->{msg};
my $ago = concise ago (time - $msg->{timestamp});
my $nick;
if (not $raw) {
if ($msg->{hostmask}) {
($nick) = $msg->{hostmask} =~ /^([^!]+)!/;
} else {
$nick = $self->{pbot}->{messagehistory}->{database}->find_most_recent_hostmask($msg->{id});
($nick) = $nick =~ m/^([^!]+)/;
}
}
if ( $text =~ s/^(NICKCHANGE)\b/changed nick to/
or $text =~ s/^(KICKED|QUIT)\b/lc "$1"/e
or $text =~ s/^MODE ([^ ]+) (.*)/set mode $1 on $2/
or $text =~ s/^(JOIN|PART)\b/lc "$1ed"/e)
{
$text =~ s/^(quit) (.*)/$1 ($2)/; # fix ugly "[nick] quit Quit: Leaving."
$result .= $raw ? "$text\n" : "[$ago] $nick $text\n";
}
elsif ($text =~ s/^\/me\s+//) {
$result .= $raw ? "$text\n" : "[$ago] * $nick $text\n";
}
else {
$result .= $raw ? "$text\n" : "[$ago] <$nick> $text\n";
}
}
}
return $result;
}
sub cmd_rebuild_aliases {
my ($self, $context) = @_;
$self->{pbot}->{messagehistory}->{database}->rebuild_aliases_table;
}
sub cmd_aka_link {
my ($self, $context) = @_;
my ($id, $alias, $type) = split /\s+/, $context->{arguments};
$type = $self->{pbot}->{messagehistory}->{database}->{alias_type}->{STRONG} if not defined $type;
if (not $id or not $alias) {
return "Usage: link <target id> <alias id> [type]";
}
my $source = $self->{pbot}->{messagehistory}->{database}->find_most_recent_hostmask($id);
my $target = $self->{pbot}->{messagehistory}->{database}->find_most_recent_hostmask($alias);
if (not $source) {
return "No such id $id found.";
}
if (not $target) {
return "No such id $alias found.";
}
if ($self->{pbot}->{messagehistory}->{database}->link_alias($id, $alias, $type)) {
return "/say $source " . ($type == $self->{pbot}->{messagehistory}->{database}->{alias_type}->{WEAK} ? "weakly" : "strongly") . " linked to $target.";
} else {
return "Link failed.";
}
}
sub cmd_aka_unlink {
my ($self, $context) = @_;
my ($id, $alias) = split /\s+/, $context->{arguments};
if (not $id or not $alias) {
return "Usage: unlink <target id> <alias id>";
}
my $source = $self->{pbot}->{messagehistory}->{database}->find_most_recent_hostmask($id);
my $target = $self->{pbot}->{messagehistory}->{database}->find_most_recent_hostmask($alias);
if (not $source) {
return "No such id $id found.";
}
if (not $target) {
return "No such id $alias found.";
}
if ($self->{pbot}->{messagehistory}->{database}->unlink_alias($id, $alias)) {
return "/say $source unlinked from $target.";
} else {
return "Unlink failed.";
}
}
1;

201
lib/PBot/Core/Commands/NickList.pm Normal file
View File

@ -0,0 +1,201 @@
# File: NickList.pm
#
# Purpose: Registers command for viewing nick list and nick metadata.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::NickList;
use PBot::Imports;
use Time::HiRes qw/gettimeofday/;
use Time::Duration qw/concise ago/;
use Getopt::Long qw/GetOptionsFromArray/;
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_nicklist(@_) }, "nicklist", 1);
}
sub cmd_nicklist {
my ($self, $context) = @_;
my $usage = "Usage: nicklist (<channel [nick]> | <nick>) [-sort <by>] [-hostmask] [-join]; -hostmask shows hostmasks instead of nicks; -join includes join time";
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
Getopt::Long::Configure("bundling_override");
my $sort_method = 'nick';
my $full_hostmask = 0;
my $include_join = 0;
my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
GetOptionsFromArray(
\@args,
'sort|s=s' => \$sort_method,
'hostmask|hm' => \$full_hostmask,
'join|j' => \$include_join,
);
return "$getopt_error; $usage" if defined $getopt_error;
return "Too many arguments -- $usage" if @args > 2;
return $usage if @args == 0 or not length $args[0];
my %sort = (
'spoken' => sub {
if ($_[1] eq '+') {
return $_[0]->{$b}->{timestamp} <=> $_[0]->{$a}->{timestamp};
} else {
return $_[0]->{$a}->{timestamp} <=> $_[0]->{$b}->{timestamp};
}
},
'join' => sub {
if ($_[1] eq '+') {
return $_[0]->{$b}->{join} <=> $_[0]->{$a}->{join};
} else {
return $_[0]->{$a}->{join} <=> $_[0]->{$b}->{join};
}
},
'host' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{host} cmp lc $_[0]->{$b}->{host};
} else {
return lc $_[0]->{$b}->{host} cmp lc $_[0]->{$a}->{host};
}
},
'nick' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{nick} cmp lc $_[0]->{$b}->{nick};
} else {
return lc $_[0]->{$b}->{nick} cmp lc $_[0]->{$a}->{nick};
}
},
);
my $sort_direction = '+';
if ($sort_method =~ s/^(\+|\-)//) {
$sort_direction = $1;
}
if (not exists $sort{$sort_method}) {
return "Invalid sort method '$sort_method'; valid methods are: "
. join(', ', sort keys %sort) . "; prefix with - to invert sort direction.";
}
# insert from channel as first argument if first argument is not a channel
if ($args[0] !~ /^#/) {
unshift @args, $context->{from};
}
my $nicklist = $self->{pbot}->{nicklist}->{nicklist};
# ensure channel has a nicklist
if (not exists $nicklist->{lc $args[0]}) {
return "No nicklist for channel $args[0].";
}
my $result;
if (@args == 1) {
# nicklist for a specific channel
my $count = keys %{$nicklist->{lc $args[0]}};
$result = "$count nick" . ($count == 1 ? '' : 's') . " in $args[0]:\n";
foreach my $entry (
sort {
$sort{$sort_method}->($nicklist->{lc $args[0]}, $sort_direction)
} keys %{$nicklist->{lc $args[0]}}
) {
if ($full_hostmask) {
$result .= " $nicklist->{lc $args[0]}->{$entry}->{hostmask}";
} else {
$result .= " $nicklist->{lc $args[0]}->{$entry}->{nick}";
}
my $sep = ': ';
if ($nicklist->{lc $args[0]}->{$entry}->{timestamp} > 0) {
my $duration = concise ago (gettimeofday - $nicklist->{lc $args[0]}->{$entry}->{timestamp});
$result .= "${sep}last spoken $duration";
$sep = ', ';
}
if ($include_join and $nicklist->{lc $args[0]}->{$entry}->{join} > 0) {
my $duration = concise ago (gettimeofday - $nicklist->{lc $args[0]}->{$entry}->{join});
$result .= "${sep}joined $duration";
$sep = ', ';
}
foreach my $key (sort keys %{$nicklist->{lc $args[0]}->{$entry}}) {
next if grep { $key eq $_ } qw/nick user host join timestamp hostmask/;
if ($nicklist->{lc $args[0]}->{$entry}->{$key} == 1) {
$result .= "$sep$key";
} else {
$result .= "$sep$key => $nicklist->{lc $args[0]}->{$entry}->{$key}";
}
$sep = ', ';
}
$result .= "\n";
}
} else {
# nicklist for a specific user
if (not exists $nicklist->{lc $args[0]}->{lc $args[1]}) {
return "No such nick $args[1] in channel $args[0].";
}
$result = "Nicklist information for $nicklist->{lc $args[0]}->{lc $args[1]}->{hostmask} in $args[0]: ";
my $sep = '';
if ($nicklist->{lc $args[0]}->{lc $args[1]}->{timestamp} > 0) {
my $duration = concise ago (gettimeofday - $nicklist->{lc $args[0]}->{lc $args[1]}->{timestamp});
$result .= "last spoken $duration";
$sep = ', ';
}
if ($nicklist->{lc $args[0]}->{lc $args[1]}->{join} > 0) {
my $duration = concise ago (gettimeofday - $nicklist->{lc $args[0]}->{lc $args[1]}->{join});
$result .= "${sep}joined $duration";
$sep = ', ';
}
foreach my $key (sort keys %{$nicklist->{lc $args[0]}->{lc $args[1]}}) {
next if grep { $key eq $_ } qw/nick user host join timestamp hostmask/;
$result .= "$sep$key => $nicklist->{lc $args[0]}->{lc $args[1]}->{$key}";
$sep = ', ';
}
$result .= 'no details' if $sep eq '';
}
return $result;
}
1;

404
lib/PBot/Core/Commands/Users.pm Normal file
View File

@ -0,0 +1,404 @@
# File: Users.pm
#
# Purpose: Commands to manage list of bot users/admins and their metadata.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::Commands::Users;
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
$self->{pbot}->{commands}->register(sub { $self->cmd_login(@_) }, "login", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_logout(@_) }, "logout", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_useradd(@_) }, "useradd", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_userdel(@_) }, "userdel", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_userset(@_) }, "userset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_userunset(@_) }, "userunset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_users(@_) }, "users", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_my(@_) }, "my", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_id(@_) }, "id", 0);
# add capabilities to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-useradd', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-userdel', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-userset', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-userunset', 1);
# create capability (it will get added to botowner group when Core is done loading)
$self->{pbot}->{capabilities}->add('can-modify-admins', undef, 1);
}
sub cmd_login {
my ($self, $context) = @_;
my $channel = $context->{from};
return "Usage: login [channel] password" if not $context->{arguments};
my $arguments = $context->{arguments};
if ($arguments =~ m/^([^ ]+)\s+(.+)/) {
$channel = $1;
$arguments = $2;
}
my ($user_channel, $user_hostmask) = $self->{pbot}->{users}->find_user_account($channel, $context->{hostmask});
return "/msg $context->{nick} You do not have a user account. You may use the `my` command to create a personal user account. See `help my`." if not defined $user_channel;
my $name = $self->{pbot}->{users}->{user_index}->{$user_channel}->{$user_hostmask};
my $u = $self->{pbot}->{users}->{storage}->get_data($name);
my $channel_text = $user_channel eq 'global' ? '' : " for $user_channel";
if ($u->{loggedin}) {
return "/msg $context->{nick} You are already logged into " . $self->{pbot}->{users}->{storage}->get_key_name($name) . " ($user_hostmask)$channel_text.";
}
my $result = $self->{pbot}->{users}->login($user_channel, $user_hostmask, $arguments);
return "/msg $context->{nick} $result";
}
sub cmd_logout {
my ($self, $context) = @_;
$context->{from} = $context->{arguments} if length $context->{arguments};
my ($user_channel, $user_hostmask) = $self->{pbot}->{users}->find_user_account($context->{from}, $context->{hostmask});
return "/msg $context->{nick} You do not have a user account. You may use the `my` command to create a personal user account. See `help my`." if not defined $user_channel;
my $name = $self->{pbot}->{users}->{user_index}->{$user_channel}->{$user_hostmask};
my $u = $self->{pbot}->{users}->{storage}->get_data($name);
my $channel_text = $user_channel eq 'global' ? '' : " for $user_channel";
return "/msg $context->{nick} You are not logged into " . $self->{pbot}->{users}->{storage}->get_key_name($name) . " ($user_hostmask)$channel_text." if not $u->{loggedin};
$self->{pbot}->{users}->logout($user_channel, $user_hostmask);
return "/msg $context->{nick} Logged out of " . $self->{pbot}->{users}->{storage}->get_key_name($name) . " ($user_hostmask)$channel_text.";
}
sub cmd_users {
my ($self, $context) = @_;
my $channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
my $include_global = '';
if (not defined $channel) {
$channel = $context->{from};
$include_global = 'global';
} else {
$channel = 'global' if $channel !~ /^#/;
}
my $text = "Users: ";
my $last_channel = "";
my $sep = "";
foreach my $chan (sort keys %{$self->{pbot}->{users}->{user_index}}) {
next if $context->{from} =~ m/^#/ and $chan ne $channel and $chan ne $include_global;
next if $context->{from} !~ m/^#/ and $channel =~ m/^#/ and $chan ne $channel;
if ($last_channel ne $chan) {
$text .= "$sep$chan: ";
$last_channel = $chan;
$sep = "";
}
my %seen_names;
foreach my $hostmask (
sort { $self->{pbot}->{users}->{user_index}->{$chan}->{$a} cmp $self->{pbot}->{users}->{user_index}->{$chan}->{$b} }
keys %{$self->{pbot}->{users}->{user_index}->{$chan}}
)
{
my $name = $self->{pbot}->{users}->{user_index}->{$chan}->{$hostmask};
next if $seen_names{$name};
$seen_names{$name} = 1;
$text .= $sep;
my $has_cap = 0;
foreach my $key ($self->{pbot}->{users}->{storage}->get_keys($name)) {
if ($self->{pbot}->{capabilities}->exists($key)) {
$has_cap = 1;
last;
}
}
$text .= '+' if $has_cap;
$text .= $self->{pbot}->{users}->{storage}->get_key_name($name);
$sep = " ";
}
$sep = "; ";
}
return $text;
}
sub cmd_useradd {
my ($self, $context) = @_;
my ($name, $hostmasks, $channels, $capabilities, $password) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 5);
$capabilities //= 'none';
if (not defined $name or not defined $hostmasks) { return "Usage: useradd <username> <hostmasks> [channels [capabilities [password]]]"; }
$channels = 'global' if !$channels or $channels !~ /^#/;
my $u;
foreach my $channel (sort split /\s*,\s*/, lc $channels) {
$u = $self->{pbot}->{users}->find_user($channel, $context->{hostmask});
if (not defined $u) {
return "You do not have a user account for $channel; cannot add users to that channel.\n";
}
}
if ($capabilities ne 'none' and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
return "Your user account does not have the can-modify-capabilities capability. You cannot create user accounts with capabilities.";
}
foreach my $cap (split /\s*,\s*/, lc $capabilities) {
next if $cap eq 'none';
return "There is no such capability $cap." if not $self->{pbot}->{capabilities}->exists($cap);
if (not $self->{pbot}->{capabilities}->userhas($u, $cap)) { return "To set the $cap capability your user account must also have it."; }
if ($self->{pbot}->{capabilities}->has($cap, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To set the $cap capability your user account must have the can-modify-admins capability.";
}
}
$self->{pbot}->{users}->add_user($name, $channels, $hostmasks, $capabilities, $password);
return "User added.";
}
sub cmd_userdel {
my ($self, $context) = @_;
if (not length $context->{arguments}) { return "Usage: userdel <username>"; }
my $u = $self->{pbot}->{users}->find_user($context->{from}, $context->{hostmask});
my $t = $self->{pbot}->{users}->{storage}->get_data($context->{arguments});
if ($self->{pbot}->{capabilities}->userhas($t, 'botowner') and not $self->{pbot}->{capabilities}->userhas($u, 'botowner')) {
return "Only botowners may delete botowner user accounts.";
}
if ($self->{pbot}->{capabilities}->userhas($t, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To delete admin user accounts your user account must have the can-modify-admins capability.";
}
return $self->{pbot}->{users}->remove_user($context->{arguments});
}
sub cmd_userset {
my ($self, $context) = @_;
my ($name, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
if (not defined $name) { return "Usage: userset <username> [key [value]]"; }
my $channel = $context->{from};
my $u = $self->{pbot}->{users}->find_user($channel, $context->{hostmask}, 1);
my $target = $self->{pbot}->{users}->{storage}->get_data($name);
if (not $u) {
$channel = 'global' if $channel !~ /^#/;
return "You do not have a user account for $channel; cannot modify their users.";
}
if (not $target) {
return "There is no user account $name.";
}
$key = lc $key if defined $key;
if (defined $value and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
if ($key =~ m/^can-/i or $self->{pbot}->{capabilities}->exists($key)) {
return "The $key metadata requires the can-modify-capabilities capability, which your user account does not have.";
}
}
if (defined $value and $self->{pbot}->{capabilities}->userhas($target, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To modify admin user accounts your user account must have the can-modify-admins capability.";
}
if (defined $key and $self->{pbot}->{capabilities}->exists($key) and not $self->{pbot}->{capabilities}->userhas($u, $key)) {
return "To set the $key capability your user account must also have it." unless $self->{pbot}->{capabilities}->userhas($u, 'botowner');
}
my $result = $self->{pbot}->{users}->{storage}->set($name, $key, $value);
print "result [$result]\n";
$result =~ s/^password: .*;?$/password: <private>;/m;
if (defined $key and ($key eq 'channels' or $key eq 'hostmasks') and defined $value) {
$self->{pbot}->{users}->rebuild_user_index;
}
return $result;
}
sub cmd_userunset {
my ($self, $context) = @_;
my ($name, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $name or not defined $key) { return "Usage: userunset <username> <key>"; }
$key = lc $key;
my @disallowed = qw/channels hostmasks password/;
if (grep { $_ eq $key } @disallowed) {
return "The $key metadata cannot be unset. Use the `userset` command to modify it.";
}
my $channel = $context->{from};
my $u = $self->{pbot}->{users}->find_user($channel, $context->{hostmask}, 1);
my $target = $self->{pbot}->{users}->{storage}->get_data($name);
if (not $u) {
$channel = 'global' if $channel !~ /^#/;
return "You do not have a user account for $channel; cannot modify their users.";
}
if (not $target) {
return "There is no user account $name.";
}
if (not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
if ($key =~ m/^can-/i or $self->{pbot}->{capabilities}->exists($key)) {
return "The $key metadata requires the can-modify-capabilities capability, which your user account does not have.";
}
}
if ($self->{pbot}->{capabilities}->userhas($target, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To modify admin user accounts your user account must have the can-modify-admins capability.";
}
if ($self->{pbot}->{capabilities}->exists($key) and not $self->{pbot}->{capabilities}->userhas($u, $key)) {
return "To unset the $key capability your user account must also have it." unless $self->{pbot}->{capabilities}->userhas($u, 'botowner');
}
return $self->{pbot}->{users}->{storage}->unset($name, $key);
}
sub cmd_my {
my ($self, $context) = @_;
my ($key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (defined $value) {
$value =~ s/^is\s+//;
$value = undef if not length $value;
}
my $channel = $context->{from};
my $hostmask = $context->{hostmask};
my ($u, $name) = $self->{pbot}->{users}->find_user($channel, $hostmask, 1);
if (not $u) {
$channel = 'global';
$hostmask = "$context->{nick}!$context->{user}\@" . $self->{pbot}->{antiflood}->address_to_mask($context->{host});
$name = $context->{nick};
$u = $self->{pbot}->{users}->{storage}->get_data($name);
if ($u) {
$self->{pbot}->{logger}->log("Adding additional hostmask $hostmask to user account $name\n");
$u->{hostmasks} .= ",$hostmask";
$self->{pbot}->{users}->rebuild_user_index;
} else {
$u = $self->{pbot}->{users}->add_user($name, $channel, $hostmask, undef, undef, 1);
$u->{loggedin} = 1;
$u->{stayloggedin} = 1;
$u->{autologin} = 1;
$self->{pbot}->{users}->save;
}
}
my $result = '';
if (defined $key) {
$key = lc $key;
if (defined $value) {
if (not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
if ($key =~ m/^is-/ or $key =~ m/^can-/ or $self->{pbot}->{capabilities}->exists($key)) {
return "The $key metadata requires the can-modify-capabilities capability, which your user account does not have.";
}
}
if (not $self->{pbot}->{capabilities}->userhas($u, 'botowner')) {
my @disallowed = qw/can-modify-admins botowner can-modify-capabilities channels/;
if (grep { $_ eq $key } @disallowed) {
return "The $key metadata requires the botowner capability to set, which your user account does not have.";
}
}
if (not $self->{pbot}->{capabilities}->userhas($u, 'admin')) {
my @disallowed = qw/name autoop autovoice chanop admin hostmasks/;
if (grep { $_ eq $key } @disallowed) {
return "The $key metadata requires the admin capability to set, which your user account does not have.";
}
}
}
} else {
$result = "Usage: my <key> [value]; ";
}
$result .= $self->{pbot}->{users}->{storage}->set($name, $key, $value);
$result =~ s/^password: .*;?$/password: <private>;/m;
return $result;
}
sub cmd_id {
my ($self, $context) = @_;
my $target = length $context->{arguments} ? $context->{arguments} : $context->{nick};
my ($message_account, $hostmask);
if ($target =~ m/^\d+$/) {
$hostmask = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_id($target);
return "I don't know anybody with id $target." if not $hostmask;
$message_account = $target;
} else {
($message_account, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($target);
return "I don't know anybody named $target." if not $message_account;
}
my $ancestor_id = $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($message_account);
my $nickserv = $self->{pbot}->{messagehistory}->{database}->get_current_nickserv_account($message_account);
my ($u, $name) = $self->{pbot}->{users}->find_user($context->{from}, $hostmask, 1);
my $result = "$target ($hostmask): user id: $message_account; ";
if ($message_account != $ancestor_id) {
my $ancestor_hostmask = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_id($ancestor_id);
$ancestor_hostmask = 'undefined' if not $ancestor_hostmask;
$result .= "parent user id: $ancestor_id ($ancestor_hostmask); ";
}
if (defined $u) {
$result .= "user account: $name (";
$result .= ($u->{loggedin} ? "logged in" : "not logged in") . '); ';
}
if (defined $nickserv and length $nickserv) {
$result .= "NickServ: $nickserv";
}
return $result;
}
1;

117
lib/PBot/Core/EventQueue.pm
View File

@ -16,117 +16,10 @@ use PBot::Imports;
use PBot::Utils::PriorityQueue;
use Time::HiRes qw/time/;
use Time::Duration;
sub initialize {
my ($self, %conf) = @_;
# array of pending events
$self->{event_queue} = PBot::Utils::PriorityQueue->new(pbot => $self->{pbot});
# register `eventqueue` bot command
$self->{pbot}->{commands}->register(sub { $self->cmd_eventqueue(@_) }, 'eventqueue', 1);
# add `can-eventqueue` capability to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-eventqueue', 1);
}
# eventqueue bot command
sub cmd_eventqueue {
my ($self, $context) = @_;
my $usage = "Usage: eventqueue list [filter regex] | add <relative time> <command> [-repeat] | remove <regex>";
my $command = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
if (not defined $command) {
return $usage;
}
if ($command eq 'list') {
return "No events queued." if not $self->{event_queue}->count;
my $result = eval {
my $text = "Queued events:\n";
my ($regex) = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
my $i = 0;
my $events = 0;
foreach my $event ($self->{event_queue}->entries) {
$i++;
if ($regex) {
next unless $event->{id} =~ /$regex/i;
}
$events++;
my $duration = $event->{priority} - time;
if ($duration < 0) {
# current time has passed an event's time but the
# event hasn't left the queue yet. we'll show these
# as, e.g., "pending 5s ago"
$duration = 'pending ' . concise ago -$duration;
} else {
$duration = 'in ' . concise duration $duration;
}
$text .= " $i) $duration: $event->{id}";
$text .= ' [R]' if $event->{repeating};
$text .= ";\n";
}
return "No events found." if $events == 0;
return $text . "$events events.\n";
};
if (my $error = $@) {
# strip source information to prettify error for non-developer consumption
$error =~ s/ at PBot.*//;
return "Bad regex: $error";
}
return $result;
}
if ($command eq 'add') {
my ($duration, $command) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $duration or not defined $command) {
return "Usage: eventqueue add <relative time> <command> [-repeat]";
}
# convert text like "5 minutes" or "1 week" or "next tuesday" to seconds
my ($seconds, $error) = $self->{pbot}->{parsedate}->parsedate($duration);
return $error if defined $error;
# check for `-repeating` at front or end of command
my $repeating = $command =~ s/^-repeat\s+|\s+-repeat$//g;
my $cmd = {
nick => $context->{nick},
user => $context->{user},
host => $context->{host},
hostmask => $context->{hostmask},
command => $command,
};
$self->{pbot}->{interpreter}->add_to_command_queue($context->{from}, $cmd, $seconds, $repeating);
return "Command added to event queue.";
}
if ($command eq 'remove') {
my ($regex) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 1);
return "Usage: eventqueue remove <regex>" if not defined $regex;
$regex =~ s/(?<!\.)\*/.*?/g;
return $self->dequeue_event($regex);
}
return "Unknown command '$command'. $usage";
}
# returns seconds until upcoming event.
@ -365,4 +258,14 @@ sub update_interval {
}
}
sub count {
my ($self) = @_;
return $self->{event_queue}->count;
}
sub entries {
my ($self) = @_;
return $self->{event_queue}->entries;
}
1;

171
lib/PBot/Core/IRCHandlers/NickList.pm Normal file
View File

@ -0,0 +1,171 @@
# File: NickList.pm
#
# Purpose: Maintains lists of nicks currently present in channels.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::IRCHandlers::NickList;
use PBot::Imports;
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) = @_;
# handlers for various IRC events (0 is highest priority, 100 is lowest priority)
# highest priority so these get handled by NickList before any other handlers
# (all other handlers should be given a priority > 0)
$self->{pbot}->{event_dispatcher}->register_handler('irc.namreply', sub { $self->on_namreply(@_) }, 0);
$self->{pbot}->{event_dispatcher}->register_handler('irc.join', sub { $self->on_join(@_) }, 0);
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_activity(@_) }, 0);
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_activity(@_) }, 0);
# lowest priority so these get handled by NickList after all other handlers
# (all other handlers should be given a priority < 100)
$self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_part(@_) }, 100);
$self->{pbot}->{event_dispatcher}->register_handler('irc.quit', sub { $self->on_quit(@_) }, 100);
$self->{pbot}->{event_dispatcher}->register_handler('irc.kick', sub { $self->on_kick(@_) }, 100);
$self->{pbot}->{event_dispatcher}->register_handler('irc.nick', sub { $self->on_nickchange(@_) }, 100);
# handlers for the bot itself joining/leaving channels (highest priority)
$self->{pbot}->{event_dispatcher}->register_handler('pbot.join', sub { $self->on_self_join(@_) }, 0);
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) }, 0);
}
sub on_namreply {
my ($self, $event_type, $event) = @_;
my ($channel, $nicks) = ($event->{event}->{args}[2], $event->{event}->{args}[3]);
foreach my $nick (split ' ', $nicks) {
my $stripped_nick = $nick;
$stripped_nick =~ s/^[@+%]//g; # remove OP/Voice/etc indicator from nick
$self->{pbot}->{nicklist}->add_nick($channel, $stripped_nick);
my ($account_id, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($stripped_nick);
if (defined $hostmask) {
my ($user, $host) = $hostmask =~ m/[^!]+!([^@]+)@(.*)/;
$self->{pbot}->{nicklist}->set_meta($channel, $stripped_nick, 'hostmask', $hostmask);
$self->{pbot}->{nicklist}->set_meta($channel, $stripped_nick, 'user', $user);
$self->{pbot}->{nicklist}->set_meta($channel, $stripped_nick, 'host', $host);
}
if ($nick =~ m/\@/) { $self->{pbot}->{nicklist}->set_meta($channel, $stripped_nick, '+o', 1); }
if ($nick =~ m/\+/) { $self->{pbot}->{nicklist}->set_meta($channel, $stripped_nick, '+v', 1); }
if ($nick =~ m/\%/) { $self->{pbot}->{nicklist}->set_meta($channel, $stripped_nick, '+h', 1); }
}
return 0;
}
sub on_activity {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->{to}[0]);
$self->{pbot}->{nicklist}->update_timestamp($channel, $nick);
return 0;
}
sub on_join {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to);
$self->{pbot}->{nicklist}->add_nick($channel, $nick);
$self->{pbot}->{nicklist}->set_meta($channel, $nick, 'hostmask', "$nick!$user\@$host");
$self->{pbot}->{nicklist}->set_meta($channel, $nick, 'user', $user);
$self->{pbot}->{nicklist}->set_meta($channel, $nick, 'host', $host);
$self->{pbot}->{nicklist}->set_meta($channel, $nick, 'join', gettimeofday);
return 0;
}
sub on_part {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to);
$self->{pbot}->{nicklist}->remove_nick($channel, $nick);
return 0;
}
sub on_quit {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host);
foreach my $channel (keys %{$self->{pbot}->{nicklist}->{nicklist}}) {
if ($self->{pbot}->{nicklist}->is_present($channel, $nick)) {
$self->{pbot}->{nicklist}->remove_nick($channel, $nick);
}
}
return 0;
}
sub on_kick {
my ($self, $event_type, $event) = @_;
my ($nick, $channel) = ($event->{event}->to, $event->{event}->{args}[0]);
$self->{pbot}->{nicklist}->remove_nick($channel, $nick);
return 0;
}
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);
foreach my $channel (keys %{$self->{pbot}->{nicklist}->{nicklist}}) {
if ($self->{pbot}->{nicklist}->is_present($channel, $nick)) {
my $meta = delete $self->{pbot}->{nicklist}->{nicklist}->{$channel}->{lc $nick};
$meta->{nick} = $newnick;
$meta->{timestamp} = gettimeofday;
$self->{pbot}->{nicklist}->{nicklist}->{$channel}->{lc $newnick} = $meta;
}
}
return 0;
}
sub on_self_join {
my ($self, $event_type, $event) = @_;
# clear nicklist to remove any stale nicks before repopulating with namreplies
$self->{pbot}->{nicklist}->remove_channel($event->{channel});
return 0;
}
sub on_self_part {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{nicklist}->remove_channel($event->{channel});
return 0;
}
1;

101
lib/PBot/Core/IRCHandlers/Users.pm Normal file
View File

@ -0,0 +1,101 @@
# File: Users.pm
#
# Purpose: Handles IRC events related to PBot user accounts and user metadata.
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Core::IRCHandlers::Users;
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.join', sub { $self->on_join (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_departure (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.quit', sub { $self->on_departure (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.kick', sub { $self->on_kick (@_) });
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part (@_) });
}
sub on_join {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = (
$event->{event}->nick,
$event->{event}->user,
$event->{event}->host,
$event->{event}->to
);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
my ($u, $name) = $self->{pbot}->{users}->find_user($channel, "$nick!$user\@$host");
if (defined $u) {
if ($self->{pbot}->{chanops}->can_gain_ops($channel)) {
my $modes = '+';
my $targets = '';
if ($u->{autoop}) {
$self->{pbot}->{logger}->log("$nick!$user\@$host autoop in $channel\n");
$modes .= 'o';
$targets .= "$nick ";
}
if ($u->{autovoice}) {
$self->{pbot}->{logger}->log("$nick!$user\@$host autovoice in $channel\n");
$modes .= 'v';
$targets .= "$nick ";
}
if (length $modes > 1) {
$self->{pbot}->{chanops}->add_op_command($channel, "mode $channel $modes $targets");
$self->{pbot}->{chanops}->gain_ops($channel);
}
}
if ($u->{autologin}) {
$self->{pbot}->{logger}->log("$nick!$user\@$host autologin to $name for $channel\n");
$u->{loggedin} = 1;
}
}
return 0;
}
sub on_departure {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
$self->{pbot}->{users}->decache_user($channel, "$nick!$user\@$host");
return 0;
}
sub on_kick {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->{args}[0]);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
$self->{pbot}->{users}->decache_user($channel, "$nick!$user\@$host");
return 0;
}
sub on_self_part {
my ($self, $event_type, $event) = @_;
delete $self->{pbot}->{users}->{user_cache}->{lc $event->{channel}};
return 0;
}
1;

502
lib/PBot/Core/MessageHistory.pm
View File

@ -14,9 +14,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports;
use Getopt::Long qw(GetOptionsFromArray);
use Time::HiRes qw(time tv_interval);
use Time::Duration;
use PBot::Core::MessageHistory::Storage::SQLite;
@ -29,510 +27,14 @@ sub initialize {
filename => $self->{filename}
);
$self->{database}->begin();
$self->{database}->devalidate_all_channels();
$self->{database}->begin;
$self->{database}->devalidate_all_channels;
$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);
$self->{pbot}->{commands}->register(sub { $self->cmd_rebuild_aliases(@_) }, "rebuildaliases", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_list_also_known_as(@_) }, "aka", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_aka_link(@_) }, "akalink", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_aka_unlink(@_) }, "akaunlink", 1);
# add capabilities to admin group
$self->{pbot}->{capabilities}->add('admin', 'can-akalink', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-akaunlink', 1);
$self->{pbot}->{atexit}->register(sub { $self->{database}->end(); return; });
}
sub cmd_list_also_known_as {
my ($self, $context) = @_;
my $usage = "Usage: aka [-hilngr] <nick> [-sort <by>]; -h show hostmasks; -i show ids; -l show last seen, -n show nickserv accounts; -g show gecos, -r show relationships";
if (not length $context->{arguments}) {
return $usage;
}
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
Getopt::Long::Configure("bundling_override");
my $sort_method = undef;
my ($show_hostmasks, $show_gecos, $show_nickserv, $show_id, $show_relationship, $show_weak, $show_last_seen, $dont_use_aliases_table);
my @opt_args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
GetOptionsFromArray(
\@opt_args,
'h' => \$show_hostmasks,
'l' => \$show_last_seen,
'n' => \$show_nickserv,
'r' => \$show_relationship,
'g' => \$show_gecos,
'w' => \$show_weak,
'z' => \$dont_use_aliases_table,
'i' => \$show_id,
'sort|s=s' => \$sort_method,
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
return "Too many arguments -- $usage" if @opt_args > 1;
return "Missing argument -- $usage" if @opt_args != 1;
$sort_method = 'seen' if $show_last_seen and not defined $sort_method;
$sort_method = 'nick' if not defined $sort_method;
my %sort = (
'id' => sub {
if ($_[1] eq '+') {
return $_[0]->{$a}->{id} <=> $_[0]->{$b}->{id};
} else {
return $_[0]->{$b}->{id} <=> $_[0]->{$a}->{id};
}
},
'seen' => sub {
if ($_[1] eq '+') {
return $_[0]->{$b}->{last_seen} <=> $_[0]->{$a}->{last_seen};
} else {
return $_[0]->{$a}->{last_seen} <=> $_[0]->{$b}->{last_seen};
}
},
'nickserv' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{nickserv} cmp lc $_[0]->{$b}->{nickserv};
} else {
return lc $_[0]->{$b}->{nickserv} cmp lc $_[0]->{$a}->{nickserv};
}
},
'nick' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{nick} cmp lc $_[0]->{$b}->{nick};
} else {
return lc $_[0]->{$b}->{nick} cmp lc $_[0]->{$a}->{nick};
}
},
'user' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{user} cmp lc $_[0]->{$b}->{user};
} else {
return lc $_[0]->{$b}->{user} cmp lc $_[0]->{$a}->{user};
}
},
'host' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{host} cmp lc $_[0]->{$b}->{host};
} else {
return lc $_[0]->{$b}->{host} cmp lc $_[0]->{$a}->{host};
}
},
'hostmask' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{hostmask} cmp lc $_[0]->{$b}->{hostmask};
} else {
return lc $_[0]->{$b}->{hostmask} cmp lc $_[0]->{$a}->{hostmask};
}
},
'gecos' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{gecos} cmp lc $_[0]->{$b}->{gecos};
} else {
return lc $_[0]->{$b}->{gecos} cmp lc $_[0]->{$a}->{gecos};
}
},
);
my $sort_direction = '+';
if ($sort_method =~ s/^(\+|\-)//) {
$sort_direction = $1;
}
if (not exists $sort{$sort_method}) {
return "Invalid sort method '$sort_method'; valid methods are: " . join(', ', sort keys %sort) . "; prefix with - to invert sort direction.";
}
my %akas = $self->{database}->get_also_known_as($opt_args[0], $dont_use_aliases_table);
if (%akas) {
my $result = "$opt_args[0] also known as:\n";
my %nicks;
my $sep = "";
foreach my $aka (sort { $sort{$sort_method}->(\%akas, $sort_direction) } keys %akas) {
next if $aka =~ /^Guest\d+(?:!.*)?$/;
next if exists $akas{$aka}->{type} and $akas{$aka}->{type} == $self->{database}->{alias_type}->{WEAK} && not $show_weak;
if (not $show_hostmasks) {
my ($nick) = $aka =~ m/([^!]+)/;
next if exists $nicks{$nick};
$nicks{$nick}->{id} = $akas{$aka}->{id};
$result .= "$sep$nick";
} else {
$result .= "$sep$aka";
}
$result .= "?" if $akas{$aka}->{nickchange} == 1;
$result .= " ($akas{$aka}->{nickserv})" if $show_nickserv and exists $akas{$aka}->{nickserv};
$result .= " {$akas{$aka}->{gecos}}" if $show_gecos and exists $akas{$aka}->{gecos};
if ($show_relationship) {
if ($akas{$aka}->{id} == $akas{$aka}->{alias}) {
$result .= " [$akas{$aka}->{id}]";
} else {
$result .= " [$akas{$aka}->{id} -> $akas{$aka}->{alias}]";
}
} elsif ($show_id) {
$result .= " [$akas{$aka}->{id}]";
}
$result .= " [WEAK]" if exists $akas{$aka}->{type} and $akas{$aka}->{type} == $self->{database}->{alias_type}->{WEAK};
if ($show_last_seen) {
my $seen = concise ago (time - $akas{$aka}->{last_seen});
$result .= " (seen $seen)";
}
if ($show_hostmasks or $show_nickserv or $show_gecos or $show_id or $show_relationship) {
$sep = ",\n";
} else {
$sep = ", ";
}
}
return $result;
} else {
return "I don't know anybody named $opt_args[0].";
}
}
sub cmd_recall_message {
my ($self, $context) = @_;
my $usage = 'Usage: recall [nick [history [channel]]] [-c <channel>] [-t <text>] [-b <context before>] [-a <context after>] [-x <filter to nick>] [-n <count>] [-r raw mode] [+ ...]';
my $arguments = $context->{arguments};
if (not length $arguments) {
return $usage;
}
$arguments = lc $arguments;
my @recalls = split /\s\+\s/, $arguments;
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
my $result = '';
Getopt::Long::Configure("bundling_override");
# global state
my ($recall_channel, $raw, $random);
foreach my $recall (@recalls) {
my ($recall_nick, $recall_text, $recall_history, $recall_before, $recall_after, $recall_context, $recall_count);
my @opt_args = $self->{pbot}->{interpreter}->split_line($recall, strip_quotes => 1);
GetOptionsFromArray(
\@opt_args,
'channel|c=s' => \$recall_channel,
'history|h=s' => \$recall_history,
'text|t=s' => \$recall_text,
'before|b=i' => \$recall_before,
'after|a=i' => \$recall_after,
'count|n=i' => \$recall_count,
'context|x=s' => \$recall_context,
'raw|r' => \$raw,
'random' => \$random,
);
return "/say $getopt_error -- $usage" if defined $getopt_error;
if (defined $recall_history and defined $recall_text) {
return "/say $context->{nick}: The -h and -t options cannot be used together.";
}
# we swap these $recall variables around so much later on that we
# need to remember which flags were explicitly set...
my $channel_arg = 1 if defined $recall_channel;
my $history_arg = 1 if defined $recall_history;
$recall_nick = shift @opt_args if @opt_args;
$recall_history = shift @opt_args if @opt_args and not $history_arg and not defined $recall_text;
if (not $channel_arg) {
$recall_channel = "@opt_args" if @opt_args;
} else {
if (defined $recall_history) {
$recall_history .= ' ';
}
$recall_history .= "@opt_args" if @opt_args;
}
if (defined $recall_text and not defined $recall_history) {
$recall_history = $recall_text;
}
my $max_count = $self->{pbot}->{registry}->get_value('messagehistory', 'max_recall_count') // 50;
if ((not defined $recall_count) || ($recall_count <= 0)) {
$recall_count = 1;
}
if ($recall_count > $max_count) {
return "You may only select a count of up to $max_count messages.";
}
$recall_before = 0 if not defined $recall_before;
$recall_after = 0 if not defined $recall_after;
# imply -x if -n > 1 and -x isn't already set to somebody
if ($recall_count > 1 and not defined $recall_context) {
$recall_context = $recall_nick;
}
# make -n behave like -b if -n > 1 and no history is specified
if (not defined $recall_history and $recall_count > 1) {
$recall_before = $recall_count - 1;
$recall_count = 0;
}
if ($recall_before + $recall_after > 100) { return "You may only select up to 100 lines of surrounding context."; }
if ($recall_count > 1 and ($recall_before > 0 or $recall_after > 0)) { return "The `count` and `before/after` options cannot be used together."; }
# swap nick and channel if recall nick looks like channel and channel wasn't specified
if (not $channel_arg and $recall_nick =~ m/^#/) {
my $temp = $recall_nick;
$recall_nick = $recall_channel;
$recall_channel = $temp;
}
$recall_history = 1 if not defined $recall_history;
# swap history and channel if history looks like a channel and neither history or channel were specified
if (not $channel_arg and not $history_arg and $recall_history =~ m/^#/) {
my $temp = $recall_history;
$recall_history = $recall_channel;
$recall_channel = $temp;
}
# skip recall command if recalling self without arguments
if (defined $recall_nick and not defined $recall_history) {
$recall_history = $context->{nick} eq $recall_nick ? 2 : 1;
}
# set history to most recent message if not specified
$recall_history = '1' if not defined $recall_history;
# set channel to current channel if not specified
$recall_channel = $context->{from} if not defined $recall_channel;
# yet another sanity check for people using it wrong
if ($recall_channel !~ m/^#/) {
$recall_history = "$recall_history $recall_channel";
$recall_channel = $context->{from};
}
# set nick argument to -x argument if no nick was provided but -x was
if (not defined $recall_nick and defined $recall_context) {
$recall_nick = $recall_context;
}
# message account and stored nickname with proper typographical casing
my ($account, $found_nick);
# get message account and found nick if a nick was provided
if (defined $recall_nick) {
# account and hostmask
($account, $found_nick) = $self->{database}->find_message_account_by_nick($recall_nick);
if (not defined $account) {
return "I don't know anybody named $recall_nick.";
}
# keep only nick portion of hostmask
$found_nick =~ s/!.*$//;
}
# matching message found in database, if any
my $message;
if ($random) {
# get a random message
$message = $self->{database}->get_random_message($account, $recall_channel, $recall_nick);
} elsif ($recall_history =~ /^\d+$/ and not defined $recall_text) {
# integral history
# if a nick was given, ensure requested history is within range of nick's history count
if (defined $account) {
my $max_messages = $self->{database}->get_max_messages($account, $recall_channel, $recall_nick);
if ($recall_history < 1 || $recall_history > $max_messages) {
if ($max_messages == 0) {
return "No messages for $recall_nick in $recall_channel yet.";
} else {
return "Please choose a history between 1 and $max_messages";
}
}
}
$recall_history--;
$message = $self->{database}->recall_message_by_count($account, $recall_channel, $recall_history, '(?:recall|mock|ftfy|fix|clapper)', $recall_nick);
if (not defined $message) {
if (defined $account) {
return "No message found at index $recall_history for $found_nick in $recall_channel.";
} else {
return "No message found at index $recall_history in $recall_channel.";
}
}
} else {
# regex history
$message = $self->{database}->recall_message_by_text($account, $recall_channel, $recall_history, '(?:recall|mock|ftfy|fix|clapper)', $recall_nick);
if (not defined $message) {
if (defined $account) {
return "No message for $found_nick in $recall_channel containing \"$recall_history\"";
} else {
return "No message in $recall_channel containing \"$recall_history\".";
}
}
}
my ($context_account, $context_nick);
if (defined $recall_context) {
($context_account, $context_nick) = $self->{database}->find_message_account_by_nick($recall_context);
if (not defined $context_account) {
return "I don't know anybody named $recall_context.";
}
# keep only nick portion of hostmask
$context_nick =~ s/!.*$//;
}
my $messages = $self->{database}->get_message_context($message, $recall_before, $recall_after, $recall_count, $recall_history, $context_account, $context_nick);
my $max_recall_time = $self->{pbot}->{registry}->get_value('messagehistory', 'max_recall_time');
foreach my $msg (@$messages) {
# optionally limit messages by by a maximum recall duration from the current time, for privacy
if ($max_recall_time && time - $msg->{timestamp} > $max_recall_time
&& not $self->{pbot}->{users}->loggedin_admin($context->{from}, $context->{hostmask}))
{
$max_recall_time = duration $max_recall_time;
$result .= "Sorry, you can not recall messages older than $max_recall_time.";
return $result;
}
my $text = $msg->{msg};
my $ago = concise ago (time - $msg->{timestamp});
my $nick;
if (not $raw) {
if ($msg->{hostmask}) {
($nick) = $msg->{hostmask} =~ /^([^!]+)!/;
} else {
$nick = $self->{database}->find_most_recent_hostmask($msg->{id});
($nick) = $nick =~ m/^([^!]+)/;
}
}
if ( $text =~ s/^(NICKCHANGE)\b/changed nick to/
or $text =~ s/^(KICKED|QUIT)\b/lc "$1"/e
or $text =~ s/^MODE ([^ ]+) (.*)/set mode $1 on $2/
or $text =~ s/^(JOIN|PART)\b/lc "$1ed"/e)
{
$text =~ s/^(quit) (.*)/$1 ($2)/; # fix ugly "[nick] quit Quit: Leaving."
$result .= $raw ? "$text\n" : "[$ago] $nick $text\n";
}
elsif ($text =~ s/^\/me\s+//) {
$result .= $raw ? "$text\n" : "[$ago] * $nick $text\n";
}
else {
$result .= $raw ? "$text\n" : "[$ago] <$nick> $text\n";
}
}
}
return $result;
}
sub cmd_rebuild_aliases {
my ($self, $context) = @_;
$self->{database}->rebuild_aliases_table;
}
sub cmd_aka_link {
my ($self, $context) = @_;
my ($id, $alias, $type) = split /\s+/, $context->{arguments};
$type = $self->{database}->{alias_type}->{STRONG} if not defined $type;
if (not $id or not $alias) {
return "Usage: link <target id> <alias id> [type]";
}
my $source = $self->{database}->find_most_recent_hostmask($id);
my $target = $self->{database}->find_most_recent_hostmask($alias);
if (not $source) {
return "No such id $id found.";
}
if (not $target) {
return "No such id $alias found.";
}
if ($self->{database}->link_alias($id, $alias, $type)) {
return "/say $source " . ($type == $self->{database}->{alias_type}->{WEAK} ? "weakly" : "strongly") . " linked to $target.";
} else {
return "Link failed.";
}
}
sub cmd_aka_unlink {
my ($self, $context) = @_;
my ($id, $alias) = split /\s+/, $context->{arguments};
if (not $id or not $alias) {
return "Usage: unlink <target id> <alias id>";
}
my $source = $self->{database}->find_most_recent_hostmask($id);
my $target = $self->{database}->find_most_recent_hostmask($alias);
if (not $source) {
return "No such id $id found.";
}
if (not $target) {
return "No such id $alias found.";
}
if ($self->{database}->unlink_alias($id, $alias)) {
return "/say $source unlinked from $target.";
} else {
return "Unlink failed.";
}
}
sub get_message_account {
my ($self, $nick, $user, $host) = @_;
return $self->{database}->get_message_account($nick, $user, $host);

311
lib/PBot/Core/NickList.pm
View File

@ -13,13 +13,7 @@ use parent 'PBot::Core::Class';
use PBot::Imports;
use Text::Levenshtein qw/fastdistance/;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
use Time::HiRes qw/gettimeofday/;
use Time::Duration qw/concise ago/;
use Getopt::Long qw/GetOptionsFromArray/;
sub initialize {
my ($self, %conf) = @_;
@ -29,188 +23,6 @@ sub initialize {
# nicklist debug registry entry
$self->{pbot}->{registry}->add_default('text', 'nicklist', 'debug', '0');
# nicklist bot command
$self->{pbot}->{commands}->register(sub { $self->cmd_nicklist(@_) }, "nicklist", 1);
# handlers for various IRC events (0 is highest priority, 100 is lowest priority)
# highest priority so these get handled by NickList before any other handlers
# (all other handlers should be given a priority > 0)
$self->{pbot}->{event_dispatcher}->register_handler('irc.namreply', sub { $self->on_namreply(@_) }, 0);
$self->{pbot}->{event_dispatcher}->register_handler('irc.join', sub { $self->on_join(@_) }, 0);
$self->{pbot}->{event_dispatcher}->register_handler('irc.public', sub { $self->on_activity(@_) }, 0);
$self->{pbot}->{event_dispatcher}->register_handler('irc.caction', sub { $self->on_activity(@_) }, 0);
# lowest priority so these get handled by NickList after all other handlers
# (all other handlers should be given a priority < 100)
$self->{pbot}->{event_dispatcher}->register_handler('irc.part', sub { $self->on_part(@_) }, 100);
$self->{pbot}->{event_dispatcher}->register_handler('irc.quit', sub { $self->on_quit(@_) }, 100);
$self->{pbot}->{event_dispatcher}->register_handler('irc.kick', sub { $self->on_kick(@_) }, 100);
$self->{pbot}->{event_dispatcher}->register_handler('irc.nick', sub { $self->on_nickchange(@_) }, 100);
# handlers for the bot itself joining/leaving channels (highest priority)
$self->{pbot}->{event_dispatcher}->register_handler('pbot.join', sub { $self->on_self_join(@_) }, 0);
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) }, 0);
}
sub cmd_nicklist {
my ($self, $context) = @_;
my $usage = "Usage: nicklist (<channel [nick]> | <nick>) [-sort <by>] [-hostmask] [-join]; -hostmask shows hostmasks instead of nicks; -join includes join time";
my $getopt_error;
local $SIG{__WARN__} = sub {
$getopt_error = shift;
chomp $getopt_error;
};
Getopt::Long::Configure("bundling_override");
my $sort_method = 'nick';
my $full_hostmask = 0;
my $include_join = 0;
my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments}, strip_quotes => 1);
GetOptionsFromArray(
\@args,
'sort|s=s' => \$sort_method,
'hostmask|hm' => \$full_hostmask,
'join|j' => \$include_join,
);
return "$getopt_error; $usage" if defined $getopt_error;
return "Too many arguments -- $usage" if @args > 2;
return $usage if @args == 0 or not length $args[0];
my %sort = (
'spoken' => sub {
if ($_[1] eq '+') {
return $_[0]->{$b}->{timestamp} <=> $_[0]->{$a}->{timestamp};
} else {
return $_[0]->{$a}->{timestamp} <=> $_[0]->{$b}->{timestamp};
}
},
'join' => sub {
if ($_[1] eq '+') {
return $_[0]->{$b}->{join} <=> $_[0]->{$a}->{join};
} else {
return $_[0]->{$a}->{join} <=> $_[0]->{$b}->{join};
}
},
'host' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{host} cmp lc $_[0]->{$b}->{host};
} else {
return lc $_[0]->{$b}->{host} cmp lc $_[0]->{$a}->{host};
}
},
'nick' => sub {
if ($_[1] eq '+') {
return lc $_[0]->{$a}->{nick} cmp lc $_[0]->{$b}->{nick};
} else {
return lc $_[0]->{$b}->{nick} cmp lc $_[0]->{$a}->{nick};
}
},
);
my $sort_direction = '+';
if ($sort_method =~ s/^(\+|\-)//) {
$sort_direction = $1;
}
if (not exists $sort{$sort_method}) {
return "Invalid sort method '$sort_method'; valid methods are: " . join(', ', sort keys %sort) . "; prefix with - to invert sort direction.";
}
# insert from channel as first argument if first argument is not a channel
if ($args[0] !~ /^#/) {
unshift @args, $context->{from};
}
# ensure channel has a nicklist
if (not exists $self->{nicklist}->{lc $args[0]}) {
return "No nicklist for channel $args[0].";
}
my $result;
if (@args == 1) {
# nicklist for a specific channel
my $count = keys %{$self->{nicklist}->{lc $args[0]}};
$result = "$count nick" . ($count == 1 ? '' : 's') . " in $args[0]:\n";
foreach my $entry (sort { $sort{$sort_method}->($self->{nicklist}->{lc $args[0]}, $sort_direction) } keys %{$self->{nicklist}->{lc $args[0]}}) {
if ($full_hostmask) {
$result .= " $self->{nicklist}->{lc $args[0]}->{$entry}->{hostmask}";
} else {
$result .= " $self->{nicklist}->{lc $args[0]}->{$entry}->{nick}";
}
my $sep = ': ';
if ($self->{nicklist}->{lc $args[0]}->{$entry}->{timestamp} > 0) {
my $duration = concise ago (gettimeofday - $self->{nicklist}->{lc $args[0]}->{$entry}->{timestamp});
$result .= "${sep}last spoken $duration";
$sep = ', ';
}
if ($include_join and $self->{nicklist}->{lc $args[0]}->{$entry}->{join} > 0) {
my $duration = concise ago (gettimeofday - $self->{nicklist}->{lc $args[0]}->{$entry}->{join});
$result .= "${sep}joined $duration";
$sep = ', ';
}
foreach my $key (sort keys %{$self->{nicklist}->{lc $args[0]}->{$entry}}) {
next if grep { $key eq $_ } qw/nick user host join timestamp hostmask/;
if ($self->{nicklist}->{lc $args[0]}->{$entry}->{$key} == 1) {
$result .= "$sep$key";
} else {
$result .= "$sep$key => $self->{nicklist}->{lc $args[0]}->{$entry}->{$key}";
}
$sep = ', ';
}
$result .= "\n";
}
} else {
# nicklist for a specific user
if (not exists $self->{nicklist}->{lc $args[0]}->{lc $args[1]}) {
return "No such nick $args[1] in channel $args[0].";
}
$result = "Nicklist information for $self->{nicklist}->{lc $args[0]}->{lc $args[1]}->{hostmask} in $args[0]: ";
my $sep = '';
if ($self->{nicklist}->{lc $args[0]}->{lc $args[1]}->{timestamp} > 0) {
my $duration = concise ago (gettimeofday - $self->{nicklist}->{lc $args[0]}->{lc $args[1]}->{timestamp});
$result .= "last spoken $duration";
$sep = ', ';
}
if ($self->{nicklist}->{lc $args[0]}->{lc $args[1]}->{join} > 0) {
my $duration = concise ago (gettimeofday - $self->{nicklist}->{lc $args[0]}->{lc $args[1]}->{join});
$result .= "${sep}joined $duration";
$sep = ', ';
}
foreach my $key (sort keys %{$self->{nicklist}->{lc $args[0]}->{lc $args[1]}}) {
next if grep { $key eq $_ } qw/nick user host join timestamp hostmask/;
$result .= "$sep$key => $self->{nicklist}->{lc $args[0]}->{lc $args[1]}->{$key}";
$sep = ', ';
}
$result .= 'no details' if $sep eq '';
}
return $result;
}
sub update_timestamp {
@ -432,127 +244,4 @@ sub random_nick {
}
}
sub on_namreply {
my ($self, $event_type, $event) = @_;
my ($channel, $nicks) = ($event->{event}->{args}[2], $event->{event}->{args}[3]);
foreach my $nick (split ' ', $nicks) {
my $stripped_nick = $nick;
$stripped_nick =~ s/^[@+%]//g; # remove OP/Voice/etc indicator from nick
$self->add_nick($channel, $stripped_nick);
my ($account_id, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($stripped_nick);
if (defined $hostmask) {
my ($user, $host) = $hostmask =~ m/[^!]+!([^@]+)@(.*)/;
$self->set_meta($channel, $stripped_nick, 'hostmask', $hostmask);
$self->set_meta($channel, $stripped_nick, 'user', $user);
$self->set_meta($channel, $stripped_nick, 'host', $host);
}
if ($nick =~ m/\@/) { $self->set_meta($channel, $stripped_nick, '+o', 1); }
if ($nick =~ m/\+/) { $self->set_meta($channel, $stripped_nick, '+v', 1); }
if ($nick =~ m/\%/) { $self->set_meta($channel, $stripped_nick, '+h', 1); }
}
return 0;
}
sub on_activity {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->{to}[0]);
$self->update_timestamp($channel, $nick);
return 0;
}
sub on_join {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to);
$self->add_nick($channel, $nick);
$self->set_meta($channel, $nick, 'hostmask', "$nick!$user\@$host");
$self->set_meta($channel, $nick, 'user', $user);
$self->set_meta($channel, $nick, 'host', $host);
$self->set_meta($channel, $nick, 'join', gettimeofday);
return 0;
}
sub on_part {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to);
$self->remove_nick($channel, $nick);
return 0;
}
sub on_quit {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host);
foreach my $channel (keys %{$self->{nicklist}}) {
if ($self->is_present($channel, $nick)) {
$self->remove_nick($channel, $nick);
}
}
return 0;
}
sub on_kick {
my ($self, $event_type, $event) = @_;
my ($nick, $channel) = ($event->{event}->to, $event->{event}->{args}[0]);
$self->remove_nick($channel, $nick);
return 0;
}
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);
foreach my $channel (keys %{$self->{nicklist}}) {
if ($self->is_present($channel, $nick)) {
my $meta = delete $self->{nicklist}->{$channel}->{lc $nick};
$meta->{nick} = $newnick;
$meta->{timestamp} = gettimeofday;
$self->{nicklist}->{$channel}->{lc $newnick} = $meta;
}
}
return 0;
}
sub on_self_join {
my ($self, $event_type, $event) = @_;
$self->remove_channel($event->{channel}); # clear nicklist to remove any stale nicks before repopulating with namreplies
return 0;
}
sub on_self_part {
my ($self, $event_type, $event) = @_;
$self->remove_channel($event->{channel});
return 0;
}
1;

9
lib/PBot/Core/Plugins.pm
View File

@ -126,15 +126,8 @@ sub load {
$self->{pbot}->{refresher}->{refresher}->refresh_module($module);
my $ret = eval {
require "$module";
if (my $exception = $@) {
$self->{pbot}->{logger}->log("Error loading $plugin: $exception");
return 0;
}
$self->{pbot}->{logger}->log("Loading $plugin\n");
require "$module";
my $class = "PBot::Plugin::$plugin";
$self->{plugins}->{$plugin} = $class->new(pbot => $self->{pbot}, %conf);
$self->{pbot}->{refresher}->{refresher}->update_cache($module);

439
lib/PBot/Core/Users.pm
View File

@ -12,451 +12,14 @@ use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
$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);
$self->{pbot}->{commands}->register(sub { $self->cmd_useradd(@_) }, "useradd", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_userdel(@_) }, "userdel", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_userset(@_) }, "userset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_userunset(@_) }, "userunset", 1);
$self->{pbot}->{commands}->register(sub { $self->cmd_users(@_) }, "users", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_my(@_) }, "my", 0);
$self->{pbot}->{commands}->register(sub { $self->cmd_id(@_) }, "id", 0);
$self->{pbot}->{capabilities}->add('admin', 'can-useradd', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-userdel', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-userset', 1);
$self->{pbot}->{capabilities}->add('admin', 'can-userunset', 1);
$self->{pbot}->{capabilities}->add('can-modify-admins', undef, 1);
$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.quit', sub { $self->on_departure(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.kick', sub { $self->on_kick(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) });
$self->{storage} = PBot::Storage::HashObject->new(name => 'Users', filename => $conf{filename}, pbot => $conf{pbot});
$self->{user_index} = {};
$self->{user_cache} = {};
$self->load;
}
sub on_join {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
my ($u, $name) = $self->find_user($channel, "$nick!$user\@$host");
if (defined $u) {
if ($self->{pbot}->{chanops}->can_gain_ops($channel)) {
my $modes = '+';
my $targets = '';
if ($u->{autoop}) {
$self->{pbot}->{logger}->log("$nick!$user\@$host autoop in $channel\n");
$modes .= 'o';
$targets .= "$nick ";
}
if ($u->{autovoice}) {
$self->{pbot}->{logger}->log("$nick!$user\@$host autovoice in $channel\n");
$modes .= 'v';
$targets .= "$nick ";
}
if (length $modes > 1) {
$self->{pbot}->{chanops}->add_op_command($channel, "mode $channel $modes $targets");
$self->{pbot}->{chanops}->gain_ops($channel);
}
}
if ($u->{autologin}) {
$self->{pbot}->{logger}->log("$nick!$user\@$host autologin to $name for $channel\n");
$u->{loggedin} = 1;
}
}
return 0;
}
sub on_departure {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->to);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
$self->decache_user($channel, "$nick!$user\@$host");
return 0;
}
sub on_kick {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $channel) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->{args}[0]);
($nick, $user, $host) = $self->{pbot}->{irchandlers}->normalize_hostmask($nick, $user, $host);
$self->decache_user($channel, "$nick!$user\@$host");
return 0;
}
sub on_self_part {
my ($self, $event_type, $event) = @_;
delete $self->{user_cache}->{lc $event->{channel}};
return 0;
}
sub cmd_login {
my ($self, $context) = @_;
my $channel = $context->{from};
return "Usage: login [channel] password" if not $context->{arguments};
my $arguments = $context->{arguments};
if ($arguments =~ m/^([^ ]+)\s+(.+)/) {
$channel = $1;
$arguments = $2;
}
my ($user_channel, $user_hostmask) = $self->find_user_account($channel, $context->{hostmask});
return "/msg $context->{nick} You do not have a user account. You may use the `my` command to create a personal user account. See `help my`." if not defined $user_channel;
my $name = $self->{user_index}->{$user_channel}->{$user_hostmask};
my $u = $self->{storage}->get_data($name);
my $channel_text = $user_channel eq 'global' ? '' : " for $user_channel";
if ($u->{loggedin}) {
return "/msg $context->{nick} You are already logged into " . $self->{storage}->get_key_name($name) . " ($user_hostmask)$channel_text.";
}
my $result = $self->login($user_channel, $user_hostmask, $arguments);
return "/msg $context->{nick} $result";
}
sub cmd_logout {
my ($self, $context) = @_;
$context->{from} = $context->{arguments} if length $context->{arguments};
my ($user_channel, $user_hostmask) = $self->find_user_account($context->{from}, $context->{hostmask});
return "/msg $context->{nick} You do not have a user account. You may use the `my` command to create a personal user account. See `help my`." if not defined $user_channel;
my $name = $self->{user_index}->{$user_channel}->{$user_hostmask};
my $u = $self->{storage}->get_data($name);
my $channel_text = $user_channel eq 'global' ? '' : " for $user_channel";
return "/msg $context->{nick} You are not logged into " . $self->{storage}->get_key_name($name) . " ($user_hostmask)$channel_text." if not $u->{loggedin};
$self->logout($user_channel, $user_hostmask);
return "/msg $context->{nick} Logged out of " . $self->{storage}->get_key_name($name) . " ($user_hostmask)$channel_text.";
}
sub cmd_users {
my ($self, $context) = @_;
my $channel = $self->{pbot}->{interpreter}->shift_arg($context->{arglist});
my $include_global = '';
if (not defined $channel) {
$channel = $context->{from};
$include_global = 'global';
} else {
$channel = 'global' if $channel !~ /^#/;
}
my $text = "Users: ";
my $last_channel = "";
my $sep = "";
foreach my $chan (sort keys %{$self->{user_index}}) {
next if $context->{from} =~ m/^#/ and $chan ne $channel and $chan ne $include_global;
next if $context->{from} !~ m/^#/ and $channel =~ m/^#/ and $chan ne $channel;
if ($last_channel ne $chan) {
$text .= "$sep$chan: ";
$last_channel = $chan;
$sep = "";
}
my %seen_names;
foreach my $hostmask (
sort { $self->{user_index}->{$chan}->{$a} cmp $self->{user_index}->{$chan}->{$b} }
keys %{$self->{user_index}->{$chan}}
)
{
my $name = $self->{user_index}->{$chan}->{$hostmask};
next if $seen_names{$name};
$seen_names{$name} = 1;
$text .= $sep;
my $has_cap = 0;
foreach my $key ($self->{storage}->get_keys($name)) {
if ($self->{pbot}->{capabilities}->exists($key)) {
$has_cap = 1;
last;
}
}
$text .= '+' if $has_cap;
$text .= $self->{storage}->get_key_name($name);
$sep = " ";
}
$sep = "; ";
}
return $text;
}
sub cmd_useradd {
my ($self, $context) = @_;
my ($name, $hostmasks, $channels, $capabilities, $password) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 5);
$capabilities //= 'none';
if (not defined $name or not defined $hostmasks) { return "Usage: useradd <username> <hostmasks> [channels [capabilities [password]]]"; }
$channels = 'global' if !$channels or $channels !~ /^#/;
my $u;
foreach my $channel (sort split /\s*,\s*/, lc $channels) {
$u = $self->find_user($channel, $context->{hostmask});
if (not defined $u) {
return "You do not have a user account for $channel; cannot add users to that channel.\n";
}
}
if ($capabilities ne 'none' and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
return "Your user account does not have the can-modify-capabilities capability. You cannot create user accounts with capabilities.";
}
foreach my $cap (split /\s*,\s*/, lc $capabilities) {
next if $cap eq 'none';
return "There is no such capability $cap." if not $self->{pbot}->{capabilities}->exists($cap);
if (not $self->{pbot}->{capabilities}->userhas($u, $cap)) { return "To set the $cap capability your user account must also have it."; }
if ($self->{pbot}->{capabilities}->has($cap, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To set the $cap capability your user account must have the can-modify-admins capability.";
}
}
$self->add_user($name, $channels, $hostmasks, $capabilities, $password);
return "User added.";
}
sub cmd_userdel {
my ($self, $context) = @_;
if (not length $context->{arguments}) { return "Usage: userdel <username>"; }
my $u = $self->find_user($context->{from}, $context->{hostmask});
my $t = $self->{storage}->get_data($context->{arguments});
if ($self->{pbot}->{capabilities}->userhas($t, 'botowner') and not $self->{pbot}->{capabilities}->userhas($u, 'botowner')) {
return "Only botowners may delete botowner user accounts.";
}
if ($self->{pbot}->{capabilities}->userhas($t, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To delete admin user accounts your user account must have the can-modify-admins capability.";
}
return $self->remove_user($context->{arguments});
}
sub cmd_userset {
my ($self, $context) = @_;
my ($name, $key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 3);
if (not defined $name) { return "Usage: userset <username> [key [value]]"; }
my $channel = $context->{from};
my $u = $self->find_user($channel, $context->{hostmask}, 1);
my $target = $self->{storage}->get_data($name);
if (not $u) {
$channel = 'global' if $channel !~ /^#/;
return "You do not have a user account for $channel; cannot modify their users.";
}
if (not $target) {
return "There is no user account $name.";
}
$key = lc $key if defined $key;
if (defined $value and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
if ($key =~ m/^can-/i or $self->{pbot}->{capabilities}->exists($key)) {
return "The $key metadata requires the can-modify-capabilities capability, which your user account does not have.";
}
}
if (defined $value and $self->{pbot}->{capabilities}->userhas($target, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To modify admin user accounts your user account must have the can-modify-admins capability.";
}
if (defined $key and $self->{pbot}->{capabilities}->exists($key) and not $self->{pbot}->{capabilities}->userhas($u, $key)) {
return "To set the $key capability your user account must also have it." unless $self->{pbot}->{capabilities}->userhas($u, 'botowner');
}
my $result = $self->{storage}->set($name, $key, $value);
print "result [$result]\n";
$result =~ s/^password: .*;?$/password: <private>;/m;
if (defined $key and ($key eq 'channels' or $key eq 'hostmasks') and defined $value) {
$self->rebuild_user_index;
}
return $result;
}
sub cmd_userunset {
my ($self, $context) = @_;
my ($name, $key) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (not defined $name or not defined $key) { return "Usage: userunset <username> <key>"; }
$key = lc $key;
my @disallowed = qw/channels hostmasks password/;
if (grep { $_ eq $key } @disallowed) {
return "The $key metadata cannot be unset. Use the `userset` command to modify it.";
}
my $channel = $context->{from};
my $u = $self->find_user($channel, $context->{hostmask}, 1);
my $target = $self->{storage}->get_data($name);
if (not $u) {
$channel = 'global' if $channel !~ /^#/;
return "You do not have a user account for $channel; cannot modify their users.";
}
if (not $target) {
return "There is no user account $name.";
}
if (not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
if ($key =~ m/^can-/i or $self->{pbot}->{capabilities}->exists($key)) {
return "The $key metadata requires the can-modify-capabilities capability, which your user account does not have.";
}
}
if ($self->{pbot}->{capabilities}->userhas($target, 'admin') and not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-admins')) {
return "To modify admin user accounts your user account must have the can-modify-admins capability.";
}
if ($self->{pbot}->{capabilities}->exists($key) and not $self->{pbot}->{capabilities}->userhas($u, $key)) {
return "To unset the $key capability your user account must also have it." unless $self->{pbot}->{capabilities}->userhas($u, 'botowner');
}
return $self->{storage}->unset($name, $key);
}
sub cmd_my {
my ($self, $context) = @_;
my ($key, $value) = $self->{pbot}->{interpreter}->split_args($context->{arglist}, 2);
if (defined $value) {
$value =~ s/^is\s+//;
$value = undef if not length $value;
}
my $channel = $context->{from};
my $hostmask = $context->{hostmask};
my ($u, $name) = $self->find_user($channel, $hostmask, 1);
if (not $u) {
$channel = 'global';
$hostmask = "$context->{nick}!$context->{user}\@" . $self->{pbot}->{antiflood}->address_to_mask($context->{host});
$name = $context->{nick};
$u = $self->{storage}->get_data($name);
if ($u) {
$self->{pbot}->{logger}->log("Adding additional hostmask $hostmask to user account $name\n");
$u->{hostmasks} .= ",$hostmask";
$self->rebuild_user_index;
} else {
$u = $self->add_user($name, $channel, $hostmask, undef, undef, 1);
$u->{loggedin} = 1;
$u->{stayloggedin} = 1;
$u->{autologin} = 1;
$self->save;
}
}
my $result = '';
if (defined $key) {
$key = lc $key;
if (defined $value) {
if (not $self->{pbot}->{capabilities}->userhas($u, 'can-modify-capabilities')) {
if ($key =~ m/^is-/ or $key =~ m/^can-/ or $self->{pbot}->{capabilities}->exists($key)) {
return "The $key metadata requires the can-modify-capabilities capability, which your user account does not have.";
}
}
if (not $self->{pbot}->{capabilities}->userhas($u, 'botowner')) {
my @disallowed = qw/can-modify-admins botowner can-modify-capabilities channels/;
if (grep { $_ eq $key } @disallowed) {
return "The $key metadata requires the botowner capability to set, which your user account does not have.";
}
}
if (not $self->{pbot}->{capabilities}->userhas($u, 'admin')) {
my @disallowed = qw/name autoop autovoice chanop admin hostmasks/;
if (grep { $_ eq $key } @disallowed) {
return "The $key metadata requires the admin capability to set, which your user account does not have.";
}
}
}
} else {
$result = "Usage: my <key> [value]; ";
}
$result .= $self->{storage}->set($name, $key, $value);
$result =~ s/^password: .*;?$/password: <private>;/m;
return $result;
}
sub cmd_id {
my ($self, $context) = @_;
my $target = length $context->{arguments} ? $context->{arguments} : $context->{nick};
my ($message_account, $hostmask);
if ($target =~ m/^\d+$/) {
$hostmask = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_id($target);
return "I don't know anybody with id $target." if not $hostmask;
$message_account = $target;
} else {
($message_account, $hostmask) = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_nick($target);
return "I don't know anybody named $target." if not $message_account;
}
my $ancestor_id = $self->{pbot}->{messagehistory}->{database}->get_ancestor_id($message_account);
my $nickserv = $self->{pbot}->{messagehistory}->{database}->get_current_nickserv_account($message_account);
my ($u, $name) = $self->find_user($context->{from}, $hostmask, 1);
my $result = "$target ($hostmask): user id: $message_account; ";
if ($message_account != $ancestor_id) {
my $ancestor_hostmask = $self->{pbot}->{messagehistory}->{database}->find_message_account_by_id($ancestor_id);
$ancestor_hostmask = 'undefined' if not $ancestor_hostmask;
$result .= "parent user id: $ancestor_id ($ancestor_hostmask); ";
}
if (defined $u) {
$result .= "user account: $name (";
$result .= ($u->{loggedin} ? "logged in" : "not logged in") . '); ';
}
if (defined $nickserv and length $nickserv) {
$result .= "NickServ: $nickserv";
}
return $result;
}
sub add_user {
my ($self, $name, $channels, $hostmasks, $capabilities, $password, $dont_save) = @_;
$channels = 'global' if $channels !~ m/^#/;

6
lib/PBot/Utils/LoadPackages.pm
View File

@ -44,12 +44,6 @@ sub load_packages {
eval {
require "$package";
if (my $exception = $@) {
$self->{pbot}->{logger}->log("Error loading $package: $exception");
return 0;
}
$self->{packages}->{$name} = $class->new(pbot => $self->{pbot});
$self->{pbot}->{refresher}->{refresher}->update_cache($package);
};