315 lines
9.1 KiB
Perl
315 lines
9.1 KiB
Perl
use v5.32;
|
|
use strict;
|
|
use warnings;
|
|
use Object::Pad;
|
|
|
|
use Net::Async::IRC;
|
|
|
|
# Delay for reconnect after the first few failures. Any more than this, and
|
|
# it'll just use the default reconnect time from config
|
|
my @RECONN_DELAYS = qw( 0 0 5 20 60 );
|
|
|
|
class MetaBot::IRC {
|
|
has $_core;
|
|
has $_config;
|
|
has $_irc;
|
|
|
|
has $_server_index = 0;
|
|
has $_connect_errors = 0;
|
|
has $_reconn_delay;
|
|
|
|
has @_server_list;
|
|
|
|
has $_on_disconnected;
|
|
has $_is_connected = 0;
|
|
|
|
has $_conn;
|
|
|
|
BUILD {
|
|
($_core, $_config) = @_;
|
|
|
|
$_irc = Net::Async::IRC->new(
|
|
on_message => sub { shift; $self->on_irc_message( @_ ) },
|
|
on_ping_timeout => sub { shift; $self->on_ping_timeout( @_ ) },
|
|
on_closed => sub { shift; $self->on_closed( @_ ) },
|
|
on_irc_error => sub { shift; $_core->log("ERR", "IRC", "@_")},
|
|
|
|
on_pong_reply => sub {
|
|
my ( $self, $lag ) = @_;
|
|
$_core->log( "DEBUG", "<Conn>", sprintf "Received PONG reply in %.2fs", $lag );
|
|
},
|
|
|
|
encoding => "UTF-8",
|
|
use_caps => [qw/cap-notify account-tag account-notify userhost-in-names echo-message multi-prefix extended-join away-notify chghost/],
|
|
);
|
|
|
|
$_core->get_loop->add($_irc);
|
|
|
|
$self->reconfigure($_config);
|
|
}
|
|
|
|
method reconfigure($_config) {
|
|
my ( $_config ) = @_;
|
|
|
|
@_server_list = $_config->get_list(
|
|
'server',
|
|
default => { port => 6667 }
|
|
)->@*;
|
|
|
|
$_irc->{pingtime} = $_config->get_string( '@pingtime', default => 60 );
|
|
$_irc->{pongtime} = $_config->get_string( '@pongtime', default => 10 );
|
|
|
|
$_reconn_delay = $_config->get_string( '@reconn_delay', default => 180 );
|
|
}
|
|
|
|
method is_connected() {$_is_connected}
|
|
|
|
method connect() {
|
|
my $server = $_server_list[$_server_index];
|
|
|
|
my ($host, $port) = $server->@{qw/host port/};
|
|
|
|
if ($_is_connected) {
|
|
$_core->err( "No point reconnecting $self as it's already connected" );
|
|
return;
|
|
}
|
|
|
|
$_core->log("CONN", "<Conn>", "Connecting to $host:$port");
|
|
|
|
$_irc->login(
|
|
host => $host,
|
|
service => $port,
|
|
|
|
nick => $_config->get_string( '@nick', default => "Cel" ),
|
|
user => $_config->get_string( '@user', default => $ENV{USER} || "user" ),
|
|
realname => $_config->get_string( '@realname', default => "realname" ),
|
|
pass => $_config->get_string( '@pass', default => undef ),
|
|
|
|
on_login => sub {
|
|
my ( $sock ) = @_;
|
|
|
|
$_core->log("LOGIN", "<LOGIN>", "Doing login");
|
|
|
|
$_is_connected = 1;
|
|
$_connect_errors = 0;
|
|
},
|
|
|
|
on_connect_error => sub {
|
|
$_core->err( "Connect failed \@_" );
|
|
$self->on_connect_error;
|
|
},
|
|
|
|
on_resolve_error => sub {
|
|
$_core->err( "Cannot resolve $host:$port - $_[0]" );
|
|
# Name resolution error; probably best to cycle to the next server in
|
|
# the list just in case
|
|
$self->on_connect_error( cycle => 1 );
|
|
}
|
|
);
|
|
}
|
|
|
|
method on_connect_error(%args) {
|
|
my $_reconn_delay;
|
|
|
|
if( $_connect_errors < scalar @RECONN_DELAYS ) {
|
|
$_reconn_delay = $RECONN_DELAYS[$_connect_errors];
|
|
}
|
|
|
|
$_connect_errors++;
|
|
|
|
# If there have been more than 3 errors, there may be a problem with this
|
|
# server. Cycle it anyway
|
|
if( $args{cycle} or $_connect_errors > 3 ) {
|
|
$_server_index++;
|
|
$_server_index %= scalar @_server_list;
|
|
}
|
|
|
|
if( $_reconn_delay ) {
|
|
$_core->log( "CONN", "<Conn>: ", "Need to reconnect to server [$self->{server_index}] after $_reconn_delay seconds" );
|
|
$_core->get_loop->enqueue_timer(
|
|
delay => $_reconn_delay,
|
|
code => sub { $self->connect },
|
|
);
|
|
} else {
|
|
$self->connect;
|
|
}
|
|
}
|
|
|
|
method disconnect(%args) {
|
|
my $message = $args{message};
|
|
|
|
$self->send_message( "QUIT", undef, $message );
|
|
|
|
$_on_disconnected = $args{on_disconnected};
|
|
}
|
|
|
|
method shutdown() {
|
|
my $loop = $_core->get_loop;
|
|
|
|
$_core->log("SHUTDOWN", "<shut>", "Shutting down!");
|
|
|
|
$self->disconnect(
|
|
on_disconnected => sub { $loop->remove( $_conn ) },
|
|
);
|
|
}
|
|
|
|
method on_closed() {
|
|
$_is_connected = 0;
|
|
|
|
if( $_on_disconnected ) {
|
|
$_on_disconnected->();
|
|
undef $_on_disconnected;
|
|
} else {
|
|
$_core->err( "Unexpected disconnect" );
|
|
$self->on_connect_error;
|
|
}
|
|
}
|
|
|
|
method on_irc_message($command, $message, $hints) {
|
|
return if $hints->{handled};
|
|
|
|
my $method = "on_message_$command";
|
|
|
|
# First look for internal handling
|
|
return 1 if $self->can( $method ) and $self->$method( $message );
|
|
|
|
return 1 if $_core->run_plugins( [ $method, "on_message" ], $command, $message, $hints );
|
|
|
|
# TODO check this out and see if it's how I want to do things
|
|
my @args = $message->args;
|
|
$_core->log( "INFO", "<Message>", "$command @args" ) unless $hints->{synthesized};
|
|
return 0;
|
|
}
|
|
|
|
method on_ping_timeout() {
|
|
$_core->log( "ERR", "<Error>", "PONG timer expired - reconnecting" );
|
|
|
|
# TODO: Close the old connection?
|
|
$self->connect;
|
|
}
|
|
|
|
# Specific message handlers, I'll likely need a few of these for handling weird stuff with extensions
|
|
# Initial connect
|
|
method on_message_001() {0} # don't eat it
|
|
|
|
# series of utility functions
|
|
method is_me($nick) {$self->is_nick_me( $nick )}
|
|
|
|
# TODO I likely want to remove or redo this bit for metabot
|
|
method get_users_plugin() {$_core->get_plugin( "users" )}
|
|
method get_user($nick) {$self->get_users_plugin->get_user( $nick )}
|
|
method get_user_me() {$self->get_user( $_irc->nick )}
|
|
method get_users() {$self->get_users_plugin->get_users}
|
|
method nick_to_user($nick) {$self->get_users_plugin->nick_to_user( $nick )}
|
|
method hints_to_user(@hints) {$self->get_users_plugin->hints_to_user( @hints )}
|
|
|
|
method get_channels_plugin() {$_core->get_plugin( "channels" )}
|
|
method get_channel($name) {$self->get_channels_plugin->get_channel( $name )}
|
|
method get_channels() {$self->get_channels_plugin->get_channels}
|
|
|
|
# LeoNerd's original code here used some package manipulation and softrefs to generate these automatically.
|
|
# There's no clean way i see to do that with Object::Pad but they're so short with it I'm just going to manually
|
|
# inclulde them.
|
|
method send_message(@args) {$_irc->send_message(@args)}
|
|
method casefold_name(@args) {$_irc->casefold_name(@args)}
|
|
method is_nick_me(@args) {$_irc->is_nick_me(@args)} # why create is_me() above that's the same?
|
|
method cmp_prefix_flags(@args) {$_irc->cmp_prefix_flags(@args)}
|
|
method cmp_prefix_modes(@args) {$_irc->cmp_prefix_modes(@args)}
|
|
method prefix_mode2flag(@args) {$_irc->prefix_flag2mode(@args)}
|
|
method isupport(@args) {$_irc->isupport(@args)}
|
|
|
|
# Bot framework related stuff, possibly going to change, possibly not.
|
|
|
|
###
|
|
# Commands
|
|
###
|
|
|
|
method register_commands($commands_plugin) {
|
|
# likely to remove and not ever use these particular ones, i'll be behind znc and letting it handle things
|
|
$commands_plugin->register(
|
|
plugin => $self,
|
|
command => "reconnect",
|
|
perm => 'master', # Allow non-owner masters
|
|
|
|
args => [
|
|
CelBot::Commands::ArgSpec->new( 'quitmsg', eatall => 1, optional => 1 ),
|
|
],
|
|
|
|
summary => "Disconnect then reconnect to the IRC server",
|
|
);
|
|
|
|
$commands_plugin->register(
|
|
plugin => $self,
|
|
command => "cycle",
|
|
perm => 'master', # Allow non-owner masters
|
|
|
|
args => [
|
|
CelBot::Commands::ArgSpec->new( 'quitmsg', eatall => 1, optional => 1 ),
|
|
],
|
|
|
|
summary => "Disconnect then reconnect to the next IRC server in the list",
|
|
);
|
|
}
|
|
|
|
method command_reconnect($contect, $quitmsg) {
|
|
$quitmsg = "Reconnecting..." if !defined $quitmsg;
|
|
|
|
$self->disconnect(
|
|
message => $quitmsg,
|
|
on_disconnected => sub { $self->connect },
|
|
);
|
|
|
|
return ( "OK" );
|
|
}
|
|
|
|
method command_cycle($_connect, $quitmsg) {
|
|
$_server_index++;
|
|
$_server_index %= scalar @_server_list;
|
|
|
|
$quitmsg = "Reconnecting..." if !defined $quitmsg;
|
|
|
|
$self->disconnect(
|
|
message => $quitmsg,
|
|
on_disconnected => sub { $self->connect },
|
|
);
|
|
|
|
return ( "OK" );
|
|
}
|
|
|
|
###
|
|
# Settings
|
|
###
|
|
method register_settings($settings_plugin) {
|
|
$settings_plugin->register(
|
|
type => 'custom',
|
|
name => "servers",
|
|
perm => 'owner',
|
|
|
|
storage => \@_server_list,
|
|
|
|
print => sub {
|
|
return join( ", ", map { $_->{host} . ":" . $_->{port} } @_ );
|
|
},
|
|
|
|
parse => sub {
|
|
my ( $context ) = @_;
|
|
|
|
my $text = $context->text;
|
|
|
|
my ( $host, $port );
|
|
if( $text =~ m/^(.*):(\d+)$/ ) {
|
|
( $host, $port ) = ( $1, $2 );
|
|
}
|
|
else {
|
|
( $host, $port ) = ( $text, 6667 );
|
|
}
|
|
|
|
return { host => $host, port => $port };
|
|
},
|
|
|
|
desc => "List of IRC servers to connect to",
|
|
);
|
|
}
|
|
}
|
|
|
|
1;
|