311 lines
8.9 KiB
Perl
311 lines
8.9 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_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',
|
|
{ port => '@port', host => '@host' },
|
|
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 ) = @_;
|
|
|
|
$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;
|
|
|
|
$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;
|