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

Improve IRCv3 support and add SASL support

Browse Source
This commit is contained in:
Pragmatic Software 2021-06-12 01:23:37 -07:00
parent 7c90cd56d6
commit d101789347
5 changed files with 295 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
PBot/IRC/Connection.pm
View File

@ -230,6 +230,7 @@ sub connect {
$self->ircname($arg{'Ircname'}) if exists $arg{'Ircname'};
$self->username($arg{'Username'}) if exists $arg{'Username'};
$self->pacing($arg{'Pacing'}) if exists $arg{'Pacing'};
$self->debug($arg{'Debug'}) if exists $arg{'Debug'};
$self->utf8($arg{'UTF8'}) if exists $arg{'UTF8'};
$self->ssl($arg{'SSL'}) if exists $arg{'SSL'};
$self->ssl_ca_path($arg{'SSL_ca_path'}) if exists $arg{'SSL_ca_path'};
@ -312,6 +313,9 @@ sub connect {
return;
}
# send CAP LS first
$self->sl("CAP LS 302");
# Send a PASS command if they specified a password. According to
# the RFC, we should do this as soon as we connect.
if (defined $password) { $self->sl("PASS $password"); }
@ -872,6 +876,16 @@ sub parse {
(split /:/, $line, 2)[1]
);
} elsif ($line =~ /^AUTHENTICATE \+$/) { # IRCv3 SASL pragma- June 11, 2021
$ev = PBot::IRC::Event->new(
'authenticate',
$self->server,
$self->nick,
'server',
'+'
);
# Spurious backslashes are for the benefit of cperl-mode.
# Assumption: all non-numeric message types begin with a letter
} elsif (
@ -958,7 +972,7 @@ sub parse {
or $type eq "topic"
or $type eq "invite"
or $type eq "whoisaccount"
or $type eq "cap")
or $type eq "cap") # IRCv3 client capabilities pragma-
{
$ev = PBot::IRC::Event->new(

14
PBot/IRC/Event.pm
View File

@ -454,6 +454,17 @@ sub trans {
728 => "quietlist", # freenode +q, pragma_ 12/12/2011
729 => "endofquietlist", # freenode +q, pragma_ 27/4/2020
# IRCv3 SASL pragma- June 11, 2021
900 => "repl_loggedin",
901 => "repl_loggedout",
902 => "err_nicklocked",
903 => "rpl_saslsuccess",
904 => "err_saslfail",
905 => "err_sasltoolong",
906 => "err_saslaborted",
907 => "err_saslalready",
908 => "rpl_saslmechs",
999 => "numericerror", # Bahamut IRCD
# add these events so that default handlers will kick in and handle them
@ -471,8 +482,11 @@ sub trans {
'nick' => 'nick',
'pong' => 'pong',
'invite' => 'invite',
# IRCv3
'cap' => 'cap',
'account' => 'account',
'authenticate' => 'authenticate',
);
1;

221
PBot/IRCHandlers.pm
View File

@ -18,6 +18,9 @@ use utf8;
use Time::HiRes qw(gettimeofday);
use Data::Dumper;
use MIME::Base64;
use Encode;
$Data::Dumper::Sortkeys = 1;
sub initialize {
@ -37,7 +40,6 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.nick', sub { $self->on_nickchange(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.nicknameinuse', sub { $self->on_nicknameinuse(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.invite', sub { $self->on_invite(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.cap', sub { $self->on_cap(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.map', sub { $self->on_map(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.whoreply', sub { $self->on_whoreply(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.whospcrpl', sub { $self->on_whospcrpl(@_) });
@ -47,6 +49,22 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.topicinfo', sub { $self->on_topicinfo(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.channelcreate', sub { $self->on_channelcreate(@_) });
# IRCv3 client capabilities
$self->{pbot}->{event_dispatcher}->register_handler('irc.cap', sub { $self->on_cap(@_) });
# IRCv3 SASL
$self->{pbot}->{event_dispatcher}->register_handler('irc.authenticate', sub { $self->on_sasl_authenticate(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_loggedin', sub { $self->on_rpl_loggedin(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_loggedout', sub { $self->on_rpl_loggedout(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.err_nicklocked', sub { $self->on_err_nicklocked(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_saslsuccess', sub { $self->on_rpl_saslsuccess(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.err_saslfail', sub { $self->on_err_saslfail(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.err_sasltoolong', sub { $self->on_err_sasltoolong(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.err_saslaborted', sub { $self->on_err_saslaborted(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.err_saslalready', sub { $self->on_err_saslalready(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.rpl_saslmechs', sub { $self->on_rpl_saslmechs(@_) });
# bot itself joining and parting channels
$self->{pbot}->{event_dispatcher}->register_handler('pbot.join', sub { $self->on_self_join(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('pbot.part', sub { $self->on_self_part(@_) });
@ -73,9 +91,8 @@ sub on_connect {
$self->{pbot}->{logger}->log("Connected!\n");
$event->{conn}->{connected} = 1;
$self->{pbot}->{logger}->log("Requesting account-notify and extended-join . . .\n");
$event->{conn}->sl("CAP REQ :account-notify extended-join");
if (not $self->{pbot}->{irc_capabilities}->{sasl}) {
# not using SASL, so identify the old way by /msg NickServ or some bot
if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) {
$self->{pbot}->{logger}->log("Identifying with NickServ . . .\n");
@ -99,6 +116,11 @@ sub on_connect {
} else {
$self->{pbot}->{logger}->log("Waiting for services identify response before autojoining channels.\n");
}
} else {
# using SASL; go ahead and auto-join channels
$self->{pbot}->{logger}->log("Autojoining channels.\n");
$self->{pbot}->{channels}->autojoin;
}
return 0;
}
@ -409,26 +431,205 @@ sub on_map {
foreach my $arg (@{$event->{event}->{args}}) {
my ($key, $value) = split /=/, $arg;
$self->{pbot}->{ircd}->{$key} = $value;
$self->{pbot}->{logger}->log(" $key\n") if not defined $value;
$self->{pbot}->{logger}->log(" $key=$value\n") if defined $value;
if (not defined $value) {
$self->{pbot}->{logger}->log(" $key\n");
} else {
$self->{pbot}->{logger}->log(" $key=$value\n");
}
}
}
# IRCv3 client capability negotiation
# TODO: most, if not all, of this should probably be in PBot::IRC::Connection
# but at the moment I don't want to change Net::IRC more then the absolute
# minimum necessary.
#
# TODO: CAP NEW and CAP DEL
sub on_cap {
my ($self, $event_type, $event) = @_;
if ($event->{event}->{args}->[0] eq 'ACK') {
$self->{pbot}->{logger}->log("Client capabilities granted: " . $event->{event}->{args}->[1] . "\n");
# configure client capabilities that PBot currently supports
my %desired_caps = (
'account-notify' => 1,
'extended-join' => 1,
# TODO: unsupported capabilities worth looking into
'away-notify' => 0,
'chghost' => 0,
'identify-msg' => 0,
'multi-prefix' => 0,
);
if ($event->{event}->{args}->[0] eq 'LS') {
my $capabilities;
my $caps_done = 0;
if ($event->{event}->{args}->[1] eq '*') {
# more CAP LS messages coming
$capabilities = $event->{event}->{args}->[2];
} else {
# final CAP LS message
$caps_done = 1;
$capabilities = $event->{event}->{args}->[1];
}
$self->{pbot}->{logger}->log("Client capabilities available: $capabilities\n");
my @caps = split /\s+/, $capabilities;
foreach my $cap (@caps) {
my $value;
if ($cap =~ /=/) {
($cap, $value) = split /=/, $cap;
} else {
$value = 1;
}
# store available capability
$self->{pbot}->{irc_capabilities_available}->{$cap} = $value;
# request desired capabilities
if ($desired_caps{$cap}) {
$self->{pbot}->{logger}->log("Requesting client capability $cap\n");
$event->{conn}->sl("CAP REQ :$cap");
}
}
# capability negotiation done
# now we either start SASL authentication or we send CAP END
if ($caps_done) {
# start SASL authentication if enabled
if ($self->{pbot}->{registry}->get_value('irc', 'sasl')) {
$self->{pbot}->{logger}->log("Requesting client capability sasl\n");
$event->{conn}->sl("CAP REQ :sasl");
} else {
$self->{pbot}->{logger}->log("Completed client capability negotiation\n");
$event->{conn}->sl("CAP END");
}
}
}
elsif ($event->{event}->{args}->[0] eq 'ACK') {
$self->{pbot}->{logger}->log("Client capabilities granted: $event->{event}->{args}->[1]\n");
my @caps = split /\s+/, $event->{event}->{args}->[1];
foreach my $cap (@caps) { $self->{pbot}->{irc_capabilities}->{$cap} = 1; }
} else {
foreach my $cap (@caps) {
$self->{pbot}->{irc_capabilities}->{$cap} = 1;
if ($cap eq 'sasl') {
# begin SASL authentication
# TODO: for now we support only PLAIN
$self->{pbot}->{logger}->log("Performing SASL authentication [PLAIN]\n");
$event->{conn}->sl("AUTHENTICATE PLAIN");
}
}
}
elsif ($event->{event}->{args}->[0] eq 'NAK') {
$self->{pbot}->{logger}->log("Client capabilities rejected: $event->{event}->{args}->[1]\n");
}
else {
$self->{pbot}->{logger}->log("Unknown CAP event:\n");
$self->{pbot}->{logger}->log(Dumper $event->{event});
}
return 0;
}
# IRCv3 SASL authentication
# TODO: this should probably be in PBot::IRC::Connection as well...
# but at the moment I don't want to change Net::IRC more then the absolute
# minimum necessary.
sub on_sasl_authenticate {
my ($self, $event_type, $event) = @_;
my $nick = $self->{pbot}->{registry}->get_value('irc', 'botnick');
my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password');
if (not defined $password or not length $password) {
$self->{pbot}->{logger}->log("Error: Registry entry irc.password is not set.\n");
$self->{pbot}->exit;
}
$password = encode('UTF-8', "$nick\0$nick\0$password");
$password = encode_base64($password, '');
my @chunks = unpack('(A400)*', $password);
foreach my $chunk (@chunks) {
$event->{conn}->sl("AUTHENTICATE $chunk");
}
# must send final AUTHENTICATE + if last chunk was exactly 400 bytes
if (length $chunks[$#chunks] == 400) {
$event->{conn}->sl("AUTHENTICATE +");
}
return 0;
}
sub on_rpl_loggedin {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n");
return 0;
}
sub on_rpl_loggedout {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n");
return 0;
}
sub on_err_nicklocked {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n");
$self->{pbot}->exit;
}
sub on_rpl_saslsuccess {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n");
$event->{conn}->sl("CAP END");
return 0;
}
sub on_err_saslfail {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n");
$self->{pbot}->exit;
}
sub on_err_sasltoolong {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n");
$self->{pbot}->exit;
}
sub on_err_saslaborted {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n");
$self->{pbot}->exit;
}
sub on_err_saslalready {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log($event->{event}->{args}->[1] . "\n");
return 0;
}
sub on_rpl_saslmechs {
my ($self, $event_type, $event) = @_;
$self->{pbot}->{logger}->log("SASL mechanism not available.\n");
$self->{pbot}->{logger}->log("Available mechanisms are: $event->{event}->{args}->[1]\n");
$self->{pbot}->exit;
}
sub on_nickchange {
my ($self, $event_type, $event) = @_;
my ($nick, $user, $host, $newnick) = ($event->{event}->nick, $event->{event}->user, $event->{event}->host, $event->{event}->args);

28
PBot/PBot.pm
View File

@ -246,6 +246,7 @@ sub connect {
SSL => $self->{registry}->get_value('irc', 'SSL'),
SSL_ca_file => $self->{registry}->get_value('irc', 'SSL_ca_file'),
SSL_ca_path => $self->{registry}->get_value('irc', 'SSL_ca_path'),
Debug => $self->{registry}->get_value('irc', 'debug'),
)
)
{
@ -281,7 +282,12 @@ sub register_signal_handlers {
my $self = shift;
$SIG{INT} = sub {
$self->{logger}->log("SIGINT received, exiting immediately.\n");
my $msg = "SIGINT received, exiting immediately.\n";
if (exists $self->{pbot}->{logger}) {
$self->{logger}->log($msg);
} else {
print $msg;
}
$self->atexit;
exit 0;
};
@ -292,7 +298,27 @@ sub atexit {
my $self = shift;
$self->{atexit}->execute_all;
alarm 0;
if (exists $self->{logger}) {
$self->{logger}->log("Good-bye.\n");
} else {
print "Good-bye.\n";
}
}
# convenient function to exit PBot
sub exit {
my ($self, $exitval) = @_;
$exitval //= 0;
my $msg = "Exiting immediately.\n";
if (exists $self->{logger}) {
$self->{logger}->log($msg);
} else {
print $msg;
}
$self->atexit;
exit $exitval;
}
# main loop

7
PBot/Registry.pm
View File

@ -59,9 +59,10 @@ sub initialize {
$self->add_default('text', 'irc', 'max_msg_len', $conf{max_msg_len} // 425);
$self->add_default('text', 'irc', 'server', $conf{server} // "irc.libera.chat");
$self->add_default('text', 'irc', 'port', $conf{port} // 6667);
$self->add_default('text', 'irc', 'SSL', $conf{SSL} // 0);
$self->add_default('text', 'irc', 'SSL_ca_file', $conf{SSL_ca_file} // 'none');
$self->add_default('text', 'irc', 'SSL_ca_path', $conf{SSL_ca_path} // 'none');
$self->add_default('text', 'irc', 'sasl', $conf{SASL} // 0);
$self->add_default('text', 'irc', 'ssl', $conf{SSL} // 0);
$self->add_default('text', 'irc', 'ssl_ca_file', $conf{SSL_ca_file} // 'none');
$self->add_default('text', 'irc', 'ssl_ca_path', $conf{SSL_ca_path} // 'none');
$self->add_default('text', 'irc', 'botnick', $conf{botnick} // "");
$self->add_default('text', 'irc', 'username', $conf{username} // "pbot3");
$self->add_default('text', 'irc', 'realname', $conf{realname} // "https://github.com/pragma-/pbot");