From d1017893475d6824f66e721996b42c26eda47489 Mon Sep 17 00:00:00 2001 From: Pragmatic Software Date: Sat, 12 Jun 2021 01:23:37 -0700 Subject: [PATCH] Improve IRCv3 support and add SASL support --- PBot/IRC/Connection.pm | 28 +++-- PBot/IRC/Event.pm | 18 ++- PBot/IRCHandlers.pm | 251 +++++++++++++++++++++++++++++++++++++---- PBot/PBot.pm | 30 ++++- PBot/Registry.pm | 7 +- 5 files changed, 295 insertions(+), 39 deletions(-) diff --git a/PBot/IRC/Connection.pm b/PBot/IRC/Connection.pm index afbb9b7e..350ec33f 100644 --- a/PBot/IRC/Connection.pm +++ b/PBot/IRC/Connection.pm @@ -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( @@ -1015,11 +1029,11 @@ sub parse { carp "Unknown event type: $type"; } } elsif ( - $line =~ /^:? # Here's Ye Olde Numeric Handler! - \S+? # the servername (can't assume RFC hostname) - \s+? # Some spaces here... - \d+? # The actual number - \b/x # Some other crap, whatever... + $line =~ /^:? # Here's Ye Olde Numeric Handler! + \S+? # the servername (can't assume RFC hostname) + \s+? # Some spaces here... + \d+? # The actual number + \b/x # Some other crap, whatever... ) { $ev = $self->parse_num($line); @@ -1038,7 +1052,7 @@ sub parse { .+? # the servername (can't assume RFC hostname) \s+? # Some spaces here... NOTICE # The server notice - \b/x # Some other crap, whatever... + \b/x # Some other crap, whatever... ) { $ev = PBot::IRC::Event->new( diff --git a/PBot/IRC/Event.pm b/PBot/IRC/Event.pm index a1e6f35b..f6d3570a 100644 --- a/PBot/IRC/Event.pm +++ b/PBot/IRC/Event.pm @@ -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', - 'cap' => 'cap', - 'account' => 'account', + + # IRCv3 + 'cap' => 'cap', + 'account' => 'account', + 'authenticate' => 'authenticate', ); 1; diff --git a/PBot/IRCHandlers.pm b/PBot/IRCHandlers.pm index e2b3cec9..ed7819ab 100644 --- a/PBot/IRCHandlers.pm +++ b/PBot/IRCHandlers.pm @@ -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,31 +91,35 @@ 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"); - if (length $self->{pbot}->{registry}->get_value('irc', 'identify_password')) { - $self->{pbot}->{logger}->log("Identifying with NickServ . . .\n"); + my $nickserv = $self->{pbot}->{registry}->get_value('general', 'identify_nick') // 'nickserv'; + my $command = $self->{pbot}->{registry}->get_value('general', 'identify_command') // 'identify $nick $password'; - my $nickserv = $self->{pbot}->{registry}->get_value('general', 'identify_nick') // 'nickserv'; - my $command = $self->{pbot}->{registry}->get_value('general', 'identify_command') // 'identify $nick $password'; + my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); + my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password'); - my $botnick = $self->{pbot}->{registry}->get_value('irc', 'botnick'); - my $password = $self->{pbot}->{registry}->get_value('irc', 'identify_password'); + $command =~ s/\$nick\b/$botnick/g; + $command =~ s/\$password\b/$password/g; - $command =~ s/\$nick\b/$botnick/g; - $command =~ s/\$password\b/$password/g; + $event->{conn}->privmsg($nickserv, $command); + } else { + $self->{pbot}->{logger}->log("No identify password; skipping identification to services.\n"); + } - $event->{conn}->privmsg($nickserv, $command); + if (not $self->{pbot}->{registry}->get_value('general', 'autojoin_wait_for_nickserv')) { + $self->{pbot}->{logger}->log("Autojoining channels immediately; to wait for services set general.autojoin_wait_for_nickserv to 1.\n"); + $self->{pbot}->{channels}->autojoin; + } else { + $self->{pbot}->{logger}->log("Waiting for services identify response before autojoining channels.\n"); + } } else { - $self->{pbot}->{logger}->log("No identify password; skipping identification to services.\n"); - } - - if (not $self->{pbot}->{registry}->get_value('general', 'autojoin_wait_for_nickserv')) { - $self->{pbot}->{logger}->log("Autojoining channels immediately; to wait for services set general.autojoin_wait_for_nickserv to 1.\n"); + # using SASL; go ahead and auto-join channels + $self->{pbot}->{logger}->log("Autojoining channels.\n"); $self->{pbot}->{channels}->autojoin; - } else { - $self->{pbot}->{logger}->log("Waiting for services identify response before autojoining channels.\n"); } 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); diff --git a/PBot/PBot.pm b/PBot/PBot.pm index 48b907d4..848f2104 100644 --- a/PBot/PBot.pm +++ b/PBot/PBot.pm @@ -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; - $self->{logger}->log("Good-bye.\n"); + 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 diff --git a/PBot/Registry.pm b/PBot/Registry.pm index 4b036d6c..593f830a 100644 --- a/PBot/Registry.pm +++ b/PBot/Registry.pm @@ -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");