package Bot::Cobalt::IRC::Role::AdminCmds;
our $VERSION = '0.016000';
use 5.12.1;
use Moo::Role;
use Bot::Cobalt;
use Bot::Cobalt::Common;
use strictures 1;
sub Bot_public_cmd_server {
my ($self, $core) = splice @_, 0, 2;
my $msg = ${ $_[0] };
my $context = $msg->context;
my $src_nick = $msg->src_nick;
my $auth_flags = $core->auth->flags($context, $src_nick);
return PLUGIN_EAT_ALL unless $auth_flags->{SUPERUSER};
my $cmd = lc($msg->message_array->[0] || 'list');
my $meth = '_cmd_'.$cmd;
unless ( $self->can($meth) ) {
broadcast( 'message',
$msg->context,
$msg->channel,
"Unknown command; try one of: list, current, connect, disconnect"
);
return PLUGIN_EAT_ALL
}
logger->debug("Dispatching $cmd for $src_nick");
$self->$meth($msg)
}
sub _cmd_list {
my ($self, $msg) = @_;
my @contexts = keys %{ core->Servers };
my $pcfg = plugin_cfg($self);
## FIXME look for contexts that are conf'd but not active
broadcast( 'message',
$msg->context,
$msg->channel,
"Active contexts: ".join ' ', @contexts
);
return PLUGIN_EAT_ALL
}
sub _cmd_current {
my ($self, $msg) = @_;
broadcast( 'message',
$msg->context,
$msg->channel,
"Currently on context ".$msg->context
);
return PLUGIN_EAT_ALL
}
sub _cmd_connect {
my ($self, $msg) = @_;
my $pcfg = plugin_cfg($self);
unless (ref $pcfg eq 'HASH' && keys %$pcfg) {
broadcast( 'message',
"Could not locate any network configuration."
);
logger->error("_cmd_connect could not find an IRC network cfg");
return PLUGIN_EAT_ALL
}
my $target_ctxt = $msg->message_array->[1];
unless (defined $target_ctxt) {
broadcast( 'message',
$msg->context,
$msg->channel,
"No context specified."
);
return PLUGIN_EAT_ALL
}
unless ($pcfg->{Networks}->{$target_ctxt}) {
broadcast( 'message',
$msg->context,
$msg->channel,
"Could not locate configuration for context $target_ctxt"
);
return PLUGIN_EAT_ALL
}
## Do we already have this context?
if (my $ctxt_obj = irc_context($target_ctxt) ) {
if ($ctxt_obj->connected) {
broadcast( 'message',
$msg->context,
$msg->channel,
"Attempting reconnect for context $target_ctxt"
);
}
logger->info("Attempting reconnect for context $target_ctxt");
broadcast( 'ircplug_disconnect', $target_ctxt );
broadcast( 'ircplug_connect', $target_ctxt );
broadcast( 'ircplug_timer_serv_retry',
{
context => $target_ctxt,
delay => 300,
},
);
return PLUGIN_EAT_ALL
}
broadcast( 'message',
$msg->context,
$msg->channel,
"Issuing connect for context $target_ctxt"
);
my $src_nick = $msg->src_nick;
my $auth_usr = core->auth->username($msg->context, $src_nick);
logger->info(
"Issuing connect for context $target_ctxt",
"(Issued by $src_nick [$auth_usr])"
);
broadcast( 'ircplug_connect', $target_ctxt );
return PLUGIN_EAT_ALL
}
sub _cmd_disconnect {
my ($self, $msg) = @_;
my $target_ctxt = $msg->message_array->[1];
unless (defined $target_ctxt) {
broadcast( 'message',
$msg->context,
$msg->channel,
"No context specified."
);
return PLUGIN_EAT_ALL
}
my $ctxt_obj;
unless ($ctxt_obj = irc_context($target_ctxt) ) {
broadcast( 'message',
$msg->context,
$msg->channel,
"Could not find context object for $target_ctxt"
);
return PLUGIN_EAT_ALL
}
unless (keys %{ core->Servers } > 1) {
broadcast( 'message',
$msg->context,
$msg->channel,
"Refusing disconnect; have no other active contexts."
);
return PLUGIN_EAT_ALL
}
broadcast( 'message',
$msg->context,
$msg->channel,
"Attempting to disconnect from $target_ctxt"
);
my $src_nick = $msg->src_nick;
my $auth_usr = core->auth->username($msg->context, $src_nick);
logger->info(
"Issuing disconnect for context $target_ctxt",
"(Issued by $src_nick [$auth_usr])"
);
broadcast( 'ircplug_disconnect', $target_ctxt );
return PLUGIN_EAT_ALL
}
sub Bot_ircplug_timer_serv_retry {
my ($self, $core) = splice @_, 0, 2;
my $hints = ${ $_[0] };
my $context = $hints->{context};
my $delay = $hints->{delay} || 300;
logger->debug("ircplug_timer_serv_retry called for $context");
my $ctxt_obj;
unless ($ctxt_obj = irc_context($context) && $ctxt_obj->connected) {
logger->info("Attempting reconnect to $context . . .");
broadcast( 'ircplug_connect', $context );
core->timer_set( $delay,
{
Event => 'ircplug_timer_serv_retry',
Args => [ { context => $context, delay => $delay } ],
},
);
}
return PLUGIN_EAT_ALL
}
1;
__END__
=pod
=head1 NAME
Bot::Cobalt::IRC::Role::AdminCmds - IRC-specific admin commands
=head1 SYNOPSIS
## Check current context name:
!server current
## List contexts:
!server list
## Issue a (re)connect:
!server connect Main
## Issue a disconnect:
!server disconnect Alpha
=head1 DESCRIPTION
This is a L<Moo::Role> consumed by the default IRC plugin
(L<Bot::Cobalt::IRC>). It provides basic administrative commands
specific to IRC connection control.
As a failsafe you cannot disconnect from all contexts. See the C<die>
command provided by L<Bot::Cobalt::Plugin::Master> instead.
However, Issuing a connect for a currently-connected context will
attempt a reconnection (note that it's possible to 'lose' bots this way,
particularly if the configuration or the remote server has changed in
some way).
See the L</SYNOPSIS> for basic usage information.
=head1 AUTHOR
Jon Portnoy <avenj@cobaltirc.org>
=cut