File Coverage

blib/lib/Bot/Cobalt/IRC.pm

Criterion	Covered	Total	%
statement	51	369	13.8
branch	0	86	0.0
condition	0	83	0.0
subroutine	17	50	34.0
pod	0	28	0.0
total	68	616	11.0

package Bot::Cobalt::IRC;
$Bot::Cobalt::IRC::VERSION = '0.021001';
use strictures 2;
use Scalar::Util 'reftype';

use Bot::Cobalt;
use Bot::Cobalt::Common;

use Bot::Cobalt::IRC::FloodChk;

use Bot::Cobalt::IRC::Server;

use Bot::Cobalt::IRC::Message;
use Bot::Cobalt::IRC::Message::Public;

use Bot::Cobalt::IRC::Event::Channel;
use Bot::Cobalt::IRC::Event::Kick;
use Bot::Cobalt::IRC::Event::Mode;
use Bot::Cobalt::IRC::Event::Nick;
use Bot::Cobalt::IRC::Event::Quit;
use Bot::Cobalt::IRC::Event::Topic;

use POE qw/
  Component::IRC::State
  Component::IRC::Plugin::CTCP
  Component::IRC::Plugin::AutoJoin
  Component::IRC::Plugin::Connector
  Component::IRC::Plugin::NickServID
  Component::IRC::Plugin::NickReclaim
/;

## Bot::Cobalt::Common pulls the rest of these:
use IRC::Utils 'parse_mode_line';


use Moo;

has NON_RELOADABLE => (
  ## Well, really, it's sort-of unloadable.
  ##  ... but life usually sucks when you do.
  ## Call _set_NON_RELOADABLE if you really need to
  isa       => Bool,
  is        => 'rwp',
  default   => sub { 1 },
);

## We keep references to our ircobjs; core tracks these also,
## but there is no guarantee that we're the only IRC plugin loaded.
has ircobjs => (
  lazy      => 1,
  is        => 'rw',
  isa       => HashObj,
  coerce    => 1,
  default   => sub { {} },
);

has flood => (
  is        => 'ro',
  isa       => Object,
  lazy      => 1,
  predicate => 'has_flood',
  default   => sub {
    my $ccfg  = core->get_core_cfg;
    my $count = $ccfg->opts->{FloodCount} || 5;
    my $secs  = $ccfg->opts->{FloodTime}  || 6;
    Bot::Cobalt::IRC::FloodChk->new(
      count => $count,
      in    => $secs,
    )
  },
);

## Outgoing IRC traffic is handled by UserEvents role:
with 'Bot::Cobalt::IRC::Role::UserEvents';

## Administrative commands:
with 'Bot::Cobalt::IRC::Role::AdminCmds';

sub Cobalt_register {
  my ($self, $core) = splice @_, 0, 2;

  register($self, SERVER => 'all' );
  broadcast( 'initialize_irc' );

  ## Start a lazy cleanup timer for flood->expire
  $core->timer_set( 180,
    +{ Event => 'ircplug_chk_floodkey_expire' },
    'IRCPLUG_CHK_FLOODKEY_EXPIRE'
  );

  logger->info("Loaded");

  PLUGIN_EAT_NONE
}

sub Cobalt_unregister {
  my ($self, $core) = splice @_, 0, 2;
  logger->info("Unregistering and dropping servers.");
  $self->_clear_context($_) for keys %{ $self->ircobjs };
  logger->debug("Clean unload");
  PLUGIN_EAT_NONE
}

sub Bot_initialize_irc {
  my ($self, $core) = splice @_, 0, 2;

  ## The IRC: directive in cobalt.conf provides context 'Main'
  ## (This will override any 'Main' specified in multiserv.conf)
  ## Munge core->irc() hash into our plugin's opts()
  my $p_cfg = $core->cfg->plugins->plugin( plugin_alias($self) );
  $p_cfg->opts->{Networks}->{Main} = $core->cfg->core->irc;

  if (exists $p_cfg->opts->{Networks}->{'-ALL'}) {
    ## Reserved by core Auth plugin
    logger->error("-ALL is not a valid context name, disregarding.");
    delete $p_cfg->opts->{Networks}->{'-ALL'}
  }

  my $active_contexts = 0;
  for my $context (keys %{ $p_cfg->opts->{Networks} } ) {
    ++$active_contexts;
    next if defined $p_cfg->opts->{Networks}->{$context}->{Enabled}
         and $p_cfg->opts->{Networks}->{$context}->{Enabled} == 0;
    logger->debug("Found configured context $context");
    broadcast( 'ircplug_connect', $context );
  }

  unless ($active_contexts) {
    logger->error("No contexts configured/enabled!");
  }
  logger->info("Connecting to $active_contexts contexts");

  PLUGIN_EAT_ALL
}

sub Bot_ircplug_connect {
  my ($self, $core) = splice @_, 0, 2;
  my $context = ${ $_[0] };

  ## Spawn an IRC Component and a Session to manage it.
  ##
  ## Called for each configured context.
  ##
  ## The sessions call the same object with different contexts in HEAP;
  ## the handlers do some processing and relay the event from the
  ## PoCo::IRC syndicator to the Bot::Cobalt::Core pipeline.

  if ($core->Servers->{$context}) {
    if ( $core->Servers->{$context}->has_irc ) {
      $core->Servers->{$context}->irc->call('shutdown',
        'Reconnecting'
      );

      $core->Servers->{$context}->clear_irc;
    }

    ## Just in case ...
    $core->auth->clear($context);
    $core->ignore->clear($context);
  }

  logger->debug("ircplug_connect issued for $context");

  my $pcfg    = core->cfg->plugins->plugin( plugin_alias($self) );
  my $thiscfg = $pcfg->opts->{Networks}->{$context};

  unless (ref $thiscfg && reftype $thiscfg eq 'HASH' && keys %$thiscfg) {
    logger->error("Connect issued for context without valid cfg ($context)");
    return PLUGIN_EAT_ALL
  }

  my $server = $thiscfg->{ServerAddr};

  unless (defined $server) {
    logger->error("Context $context has no defined ServerAddr");
    return PLUGIN_EAT_ALL
  }

  my $port   = $thiscfg->{ServerPort} || 6667;
  my $nick   = $thiscfg->{Nickname}   || 'cobalt2' ;

  my $usessl = $thiscfg->{UseSSL} ? 1 : 0;
  my $use_v6 = $thiscfg->{IPv6}   ? 1 : 0;

  logger->info(
    "Spawning IRC for $context ($nick on $server : $port)"
  );
  logger->debug(
    "Context $context; SSL $usessl ; V6 $use_v6"
  );

  # FIXME at least optionally disable outgoing flood queue,
  #   probably better to reimplement on top of IRC::FloodChk
  my %spawn_opts = (
      resolver => core->resolver,

      alias    => $context,
      nick     => $nick,
      username => $thiscfg->{Username} // 'cobalt',
      ircname  => $thiscfg->{Realname} // 'http://cobaltirc.org',
      server   => $server,
      port     => $port,
      useipv6  => $use_v6,
      usessl   => $usessl,
      raw      => 0,
  );

  $spawn_opts{localaddr} = $thiscfg->{BindAddr}
    if defined $thiscfg->{BindAddr};

  $spawn_opts{password} = $thiscfg->{ServerPass}
    if defined $thiscfg->{ServerPass};

  my $irc = POE::Component::IRC::State->spawn(%spawn_opts)
    or logger->error("IRC component spawn() for $context failed")
    and return PLUGIN_EAT_ALL;

  my $server_obj = Bot::Cobalt::IRC::Server->new(
    name => $server,
    irc  => $irc,
    prefer_nick => $nick,
  );

  $core->Servers->{$context} = $server_obj;
  $self->ircobjs->{$context} = $irc;

  ## Attempt to spin up a session.
  if ( $self->_spawn_for_context($context) ) {
    logger->debug("Successful session creation for context $context");
  }

  return PLUGIN_EAT_ALL
}

sub _spawn_for_context {
  my ($self, $context) = @_;

  POE::Session->create(
    ## track this session's context name in HEAP
    heap =>  { Context => $context },
    object_states => [
      $self => [ qw/
        _start

        irc_001
        irc_connected
        irc_disconnected
        irc_error
        irc_socketerr

        irc_chan_sync

        irc_public
        irc_msg
        irc_notice
        irc_ctcp_action

        irc_kick
        irc_mode
        irc_topic
        irc_invite

        irc_nick
        irc_join
        irc_part
        irc_quit
      / ],
    ],
  ) or
     logger->error("Session creation failed for context $context")
     and return;
}

sub Bot_ircplug_disconnect {
  my ($self, $core) = splice @_, 0, 2;
  my $context = ${ $_[0] };

  logger->debug("ircplug_disconnect event caught for $context");

  $self->_clear_context($context);

  return PLUGIN_EAT_ALL
}

sub _clear_context {
  my ($self, $context) = @_;

  logger->debug("_clear_context called for $context");

  core->auth->clear($context);
  core->ignore->clear($context);

  core->Servers->{$context}->clear_irc;

  my $irc = delete $self->ircobjs->{$context}
    or logger->error(
       "ircplug_disconnect called for nonexistant context $context"
     ) and return PLUGIN_EAT_ALL;

  $irc->call('shutdown', "IRC component shut down");

  logger->info("Called shutdown for context $context");

  return $context
}

sub _start {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $ccfg = core->get_core_cfg;
  my $pcfg = core->cfg->plugins->plugin( plugin_alias($self) );

  logger->debug("pocoirc plugin load");

  ## autoreconn plugin:
  my %connector;

  $connector{delay}     = $ccfg->opts->{StonedCheck}    || 300;
  $connector{reconnect} = $ccfg->opts->{ReconnectDelay} || 60;

  $irc->plugin_add('Connector' =>
    POE::Component::IRC::Plugin::Connector->new(
      %connector
    ),
  );

  ## attempt to regain primary nickname:
  $irc->plugin_add('NickReclaim' =>
    POE::Component::IRC::Plugin::NickReclaim->new(
        poll => $ccfg->opts->{NickRegainDelay} // 30,
      ),
    );

  if (defined $pcfg->opts->{Networks}->{$context}->{NickServPass}) {
    logger->debug("Adding NickServ ID for $context");
    $irc->plugin_add('NickServID' =>
      POE::Component::IRC::Plugin::NickServID->new(
        Password => $pcfg->opts->{Networks}->{$context}->{NickServPass},
      ),
    );
  }

  my $chanhash = core->cfg->channels->context($context) // {};
  ## AutoJoin plugin takes a hash in form of { $channel => $passwd }:
  my %ajoin;
  for my $chan (%$chanhash) {
    my $key = $chanhash->{$chan}->{password} // '';
    $ajoin{$chan} = $key;
  }

  $irc->plugin_add('AutoJoin' =>
    POE::Component::IRC::Plugin::AutoJoin->new(
      Channels     => \%ajoin,
      RejoinOnKick => $ccfg->opts->{Chan_RetryAfterKick} // 1,
      Rejoin_delay => $ccfg->opts->{Chan_RejoinDelay}    // 5,
      NickServ_delay    => $ccfg->opts->{Chan_NickServDelay} // 1,
      Retry_when_banned => $ccfg->opts->{Chan_RetryAfterBan} // 60,
    ),
  );

  ## define ctcp responses
  $irc->plugin_add('CTCP' =>
    POE::Component::IRC::Plugin::CTCP->new(
      version  => "Bot::Cobalt ".core->version." (perl $^V) ".core->url,
      userinfo   => "I'm a teapot",
      clientinfo => __PACKAGE__.'-'.(__PACKAGE__->VERSION // 'vcs'),
      source     => core->url,
    ),
  );

  ## register for all events from the component
  $irc->yield(register => 'all');
  ## initiate ze connection:
  $irc->yield(connect => {});

  logger->debug("irc component connect issued");
}


### IRC event 'relay' to our pipeline.

sub irc_connected {
  my ($self, $kernel, $server) = @_[OBJECT, KERNEL, ARG0];

  ##  irc_connected indicates we're connected to the server
  ##  however, irc_001 is the server welcome message
  ##  irc_connected happens before auth, no guarantee we can send yet.
  ##  (we don't broadcast Bot_connected until irc_001)
  logger->debug("Received irc_connected for $server");
}

sub irc_001 {
  my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  ## set up some stuff relevant to our server context:
  irc_context($context)->connected(1);
  irc_context($context)->connectedat( time );
  irc_context($context)->maxmodes( $irc->isupport('MODES') // 4 );
  irc_context($context)->maxtargets( $irc->isupport('MAXTARGETS') // 4 );

  ## irc comes with odd case-mapping rules.
  ## []\~ are considered uppercase equivalents of {}|^
  ##
  ## this may vary by server
  ## (most servers are rfc1459, some are -strict, some are ascii)
  ##
  ## we can tell eq_irc/uc_irc/lc_irc to do the right thing by
  ## checking ISUPPORT and setting the casemapping if available
  my $casemap = lc( $irc->isupport('CASEMAPPING') || 'rfc1459' );
  irc_context($context)->casemap( $casemap );

  ## if the server returns a fubar value IRC::Utils automagically
  ## defaults to rfc1459 casemapping rules
  ##
  ## this is unavoidable in some situations, however:
  ## misconfigured inspircd on paradoxirc gave a codepage for CASEMAPPING
  ## and a casemapping for CHARSET (which is supposed to be deprecated)
  ##
  ## I strongly suspect there are other similarly broken servers around.
  ## para has since fixed this after extensive whining on my part \o/
  ##
  ## we can try to check for this, but it's still a crapshoot.
  ##
  ## this 'fix' will still break when CASEMAPPING is nonsense and CHARSET
  ## is set to 'ascii' but other casemapping rules are being followed.
  ##
  ## the better fix is to smack your admins with a hammer.
  my @valid_casemaps = qw/ rfc1459 ascii strict-rfc1459 /;
  unless (grep { $_ eq $casemap } @valid_casemaps) {
    my $charset = lc( $irc->isupport('CHARSET') || '' );
    if ($charset && grep { $_ eq $charset } @valid_casemaps) {
      irc_context($context)->casemap( $charset );
    }
    ## we don't save CHARSET, it's deprecated per the spec
    ## also mostly unreliable and meaningless
    ## you're on your own for handling fubar encodings.
    ## http://www.irc.org/tech_docs/draft-brocklesby-irc-isupport-03.txt
  }

  ## May have configured umodes to set:
  my $pcfg    = core->cfg->plugins->plugin( plugin_alias($self) );
  my $thiscfg = $pcfg->opts->{Networks}->{$context};

  if (my $umode = $thiscfg->{Umodes}) {
    logger->debug("Setting umode $umode on $context");
    $irc->yield('mode', $irc->nick_name => $umode)
  }

  my $server = $irc->server_name;
  logger->info("Connected: $context: $server");

  ## send a Bot_connected event with context and visible server name:
  broadcast( 'connected', $context, $server );
}

sub irc_disconnected {
  my ($self, $kernel, $server) = @_[OBJECT, KERNEL, ARG0];
  my $context = $_[HEAP]->{Context};

  logger->warn("Disconnected: $context ($server)");

  if ( irc_context($context) ) {
    irc_context($context)->connected(0);
    broadcast( 'disconnected', $context, $server );
  }
}

sub irc_socketerr {
  my ($self, $kernel, $err) = @_[OBJECT, KERNEL, ARG0];
  my $context = $_[HEAP]->{Context};

  logger->warn("Socket error: $context: $err");

  if ( irc_context($context) ) {
    irc_context($context)->connected(0);
    broadcast( 'server_error', $context, $err );
  }
}

sub irc_error {
  my ($self, $kernel, $reason) = @_[OBJECT, KERNEL, ARG0];
  my $context = $_[HEAP]->{Context};

  logger->warn("IRC error: $context: $reason");

  if ( irc_context($context) ) {
    irc_context($context)->connected(0);
    broadcast( 'server_error', $context, $reason );
  }
}

sub irc_chan_sync {
  my ($self, $heap, $chan) = @_[OBJECT, HEAP, ARG0];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $resp = core->rpl( q{RPL_CHAN_SYNC},
    { 'chan' => $chan }
  );

  broadcast( 'chan_sync', $context, $chan );

  my $cf_core = core->get_core_cfg();
  my $notify  = ($cf_core->opts->{NotifyOnSync} //= 1) ? 1 : 0 ;
  my $chan_h = core->cfg->channels->context( $context ) || {};
  ## check if we have a specific setting for this channel (override):
  $notify = $chan_h->{$chan}->{notify_on_sync}
    if exists $chan_h->{$chan}
    and reftype $chan_h->{$chan} eq 'HASH'
    and exists $chan_h->{$chan}->{notify_on_sync};

  $irc->yield(privmsg => $chan => $resp) if $notify;
}

sub irc_ctcp_action {
  my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];
  my ($src, $target, $txt) = @_[ARG0 .. ARG2];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $casemap = core->get_irc_casemap($context);
  for my $mask ( core->ignore->list($context) ) {
    return if matches_mask( $mask, $src, $casemap );
  }

  my $msg_obj = Bot::Cobalt::IRC::Message->new(
    context => $context,
    src     => $src,
    targets => $target,
    message => $txt,
  );

  broadcast( 'ctcp_action', $msg_obj );
}

sub irc_invite {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($src, $channel) = @_[ARG0, ARG1];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $invite = Bot::Cobalt::IRC::Event::Channel->new(
    context => $context,
    src     => $src,
    channel => $channel,
  );

  ## Bot_invited
  broadcast( 'invited', $invite );
}

sub irc_join {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($src, $channel) = @_[ARG0, ARG1];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $join = Bot::Cobalt::IRC::Event::Channel->new(
    context => $context,
    src     => $src,
    channel => $channel,
  );

  my $me = $irc->nick_name();
  my $casemap = core->get_irc_casemap($context);
  if ( eq_irc($me, $join->src_nick, $casemap) ) {
    broadcast( 'self_joined', $context, $channel );
  }

  ## Bot_user_joined
  broadcast( 'user_joined', $join );
}

sub irc_kick {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($src, $channel, $target, $reason) = @_[ARG0 .. ARG3];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $kick = Bot::Cobalt::IRC::Event::Kick->new(
    context => $context,
    channel => $channel,
    src     => $src,
    kicked  => $target,
    reason  => $reason,
  );

  my $me = $irc->nick_name();
  my $casemap = core->get_irc_casemap($context);
  if ( eq_irc($me, $kick->src_nick, $casemap) ) {
    ## Bot_self_kicked:
    broadcast( 'self_kicked', $context, $src, $channel, $reason );
  }

  ## Bot_user_kicked:
  broadcast( 'user_kicked', $kick );
}

sub irc_mode {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($src, $changed_on, $modestr, @modeargs) = @_[ ARG0 .. $#_ ];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $mode_obj = Bot::Cobalt::IRC::Event::Mode->new(
    context => $context,
    src     => $src,
    target  => $changed_on,
    mode    => $modestr,
    args    => [ @modeargs ],
  );

  if ( $mode_obj->is_umode ) {
    broadcast( 'umode_changed', $mode_obj );
    return
  }
  ## otherwise it's mostly safe to assume mode changed on a channel
  ## could check by grabbing isupport('CHANTYPES') and checking against
  ## is_valid_chan_name from IRC::Utils, f.ex:
  ## my $chantypes = $self->irc->isupport('CHANTYPES') || '#&';
  ## is_valid_chan_name($changed_on, [ split '', $chantypes ]) ? 1 : 0;
  ## ...but afaik this Should Be Fine:
  broadcast( 'mode_changed', $mode_obj);
}

sub irc_msg {
  my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];
  my ($src, $target, $txt) = @_[ARG0 .. ARG2];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $casemap = core->get_irc_casemap( $context );
  for my $mask ( core->ignore->list($context) ) {
    return if matches_mask( $mask, $src, $casemap );
  }

  if ( $self->flood->check($context, $src) ) {
    my $nick = parse_user($src);
    $self->flood_ignore($context, $src)
      unless core->auth->level($context, $nick);
    return
  }

  my $msg_obj = Bot::Cobalt::IRC::Message->new(
    context => $context,
    src     => $src,
    targets => $target,
    message => $txt,
  );

  broadcast( 'private_msg', $msg_obj );
}

sub irc_nick {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($src, $new, $common) = @_[ARG0 .. ARG2];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  ## see if it's our nick that changed, send event:
  if ($new eq $irc->nick_name) {
    broadcast( 'self_nick_changed', $context, $new );
    return
  }

  my $nchg = Bot::Cobalt::IRC::Event::Nick->new(
    context  => $context,
    src      => $src,
    new_nick => $new,
    channels => $common,
  );

  ## Bot_nick_changed
  broadcast( 'nick_changed', $nchg );
}

sub irc_notice {
  my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];
  my ($src, $target, $txt) = @_[ARG0 .. ARG2];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $casemap = core->get_irc_casemap($context);
  for my $mask ( core->ignore->list($context) ) {
    return if matches_mask( $mask, $src, $casemap );
  }

  my $msg_obj = Bot::Cobalt::IRC::Message->new(
    context => $context,
    src     => $src,
    targets => $target,
    message => $txt,
  );

  broadcast( 'got_notice', $msg_obj );
}

sub irc_part {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($src, $channel, $msg) = @_[ARG0 .. ARG2];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $part = Bot::Cobalt::IRC::Event::Channel->new(
    context => $context,
    src     => $src,
    channel => $channel,
  );

  my $me = $irc->nick_name();
  my $casemap = core->get_irc_casemap($context);
  ## shouldfix? we could try an 'eq' here ... but is a part issued by
  ## force methods going to be guaranteed the same case ... ?
  if ( eq_irc($me, $part->src_nick, $casemap) ) {
    ## we were the issuer of the part -- possibly via /remove, perhaps?
    ## (autojoin might bring back us back, though)
    broadcast( 'self_left', $context, $channel );
  }

  ## Bot_user_left
  broadcast( 'user_left', $part );
}

sub irc_public {
  my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];
  my ($src, $where, $txt) = @_[ ARG0 .. ARG2 ];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $casemap = core->get_irc_casemap( $context );
  for my $mask ( core->ignore->list($context) ) {
    ## Check against ignore list
    ## (Ignore list should be keyed by hostmask)
    return if matches_mask( $mask, $src, $casemap );
  }

  my $msg_obj = Bot::Cobalt::IRC::Message::Public->new(
    context => $context,
    src     => $src,
    targets => $where,
    message => $txt,
  );

  my $floodchk = sub {
    if ( $self->flood->check(@_) ) {
      $self->flood_ignore($context, $src);
      return 1
    }
  };

  ## Bot_public_msg / Bot_public_cmd_$cmd
  ## FloodChk cmds and highlights
  if (my $cmd = $msg_obj->cmd) {

    $floodchk->($context, $src) ?
      return
      : broadcast( 'public_cmd_'.$cmd, $msg_obj);

  } elsif ($msg_obj->highlight) {

    $floodchk->($context, $src) ?
      return
      : broadcast( 'public_msg', $msg_obj);

  } else {
    ## In the interests of keeping memory usage low on a
    ## large channel, we don't flood-check every incoming public
    ## message; plugins that respond to these may want to create
    ## their own Bot::Cobalt::IRC::FloodChk
    broadcast( 'public_msg', $msg_obj );
  }
}

sub irc_quit {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($src, $msg, $common) = @_[ARG0 .. ARG2];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $quit = Bot::Cobalt::IRC::Event::Quit->new(
    context => $context,
    src     => $src,
    reason  => $msg,
    common  => $common,
  );

  ## Bot_user_quit
  broadcast( 'user_quit', $quit );
}

sub irc_snotice {
  my ($self, $heap, $kernel) = @_[OBJECT, HEAP, KERNEL];

  my $context = $heap->{Context};

  ## These are weird.
  ## There should be at least a string.
  my ($string, $target, $sender) = @_[ARG0 .. ARG2];

  ## FIXME test / POD
  broadcast( 'server_notice', $context, $string, $target, $sender );
}

sub irc_topic {
  my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
  my ($src, $channel, $topic) = @_[ARG0 .. ARG2];

  my $context = $heap->{Context};
  my $irc     = $self->ircobjs->{$context};

  my $topic_obj = Bot::Cobalt::IRC::Event::Topic->new(
    context => $context,
    src     => $src,
    channel => $channel,
    topic   => $topic,
  );

  ## Bot_topic_changed
  broadcast( 'topic_changed', $topic_obj );
}


### Internals.

sub Bot_rehashed {
  my ($self, $core) = splice @_, 0, 2;
  my $type = ${ $_[0] };

  if ($type eq 'core' || $type eq 'channels') {
    logger->info("Rehash received ($type), resetting ajoins");
    $self->_reset_ajoins;
  }

  ## FIXME nickservid rehash if needed

  return PLUGIN_EAT_NONE
}

sub Bot_ircplug_chk_floodkey_expire {
  my ($self, $core) = splice @_, 0, 2;

  ## Lazy flood tracker cleanup.
  ## These are just arrays of timestamps, but they gotta be cleaned up
  ## when they're stale.

  $self->flood->expire if $self->has_flood;

  $core->timer_set( 60,
    { Event => 'ircplug_chk_floodkey_expire' },
    'IRCPLUG_CHK_FLOODKEY_EXPIRE'
  );

  return PLUGIN_EAT_ALL
}

sub Bot_ircplug_flood_rem_ignore {
  my ($self, $core) = splice @_, 0, 2;
  my $context = ${ $_[0] };
  my $mask    = ${ $_[1] };
  ## Internal timer-fired event to remove temp ignores.

  logger->info("Clearing temp ignore: $mask ($context)");

  $core->ignore->del( $context, $mask );

  broadcast( 'flood_ignore_deleted', $context, $mask );

  return PLUGIN_EAT_ALL
}

sub flood_ignore {
  ## Pass me a context and a mask
  ## Set a temporary ignore and a timer to remove it
  my ($self, $context, $mask) = @_;

  my $corecf = core->get_core_cfg;
  my $ignore_time = $corecf->opts->{FloodIgnore} || 20;

  $self->flood->clear($context, $mask);

  logger->info(
    "Issuing temporary ignore due to flood: $mask ($context)"
  );

  my $added = core->ignore->add(
    $context, $mask, "flood_ignore", __PACKAGE__
  );

  broadcast( 'flood_ignore_added', $context, $mask );

  core->timer_set( $ignore_time,
    {
      Event => 'ircplug_flood_rem_ignore',
      Args  => [ $context, $mask ],
    },
  );
}

sub _reset_ajoins {
  my ($self) = @_;

  my $corecf  = core->get_core_cfg;
  my $servers = core->Servers;

  CONTEXT: for my $context (keys %$servers) {
    my $chanscf = core->get_channels_cfg($context) // {};

    my $irc = core->get_irc_obj($context) || next CONTEXT;

    my %ajoin;

    CHAN: for my $channel (keys %$chanscf) {
      my $key = $chanscf->{$channel}->{password} // '';
      $ajoin{$channel} = $key;
    }

    logger->debug("Removing AutoJoin plugin for $context");
    $irc->plugin_del('AutoJoin');

    logger->debug("Loading new AutoJoin plugin for $context");
    $irc->plugin_add('AutoJoin' =>
      POE::Component::IRC::Plugin::AutoJoin->new(
        Channels => \%ajoin,
        RejoinOnKick => $corecf->opts->{Chan_RetryAfterKick} // 1,
        Rejoin_delay => $corecf->opts->{Chan_RejoinDelay}    // 5,
        NickServ_delay    => $corecf->opts->{Chan_NickServDelay} // 1,
        Retry_when_banned => $corecf->opts->{Chan_RetryAfterBan} // 60,
      ),
    );

  }

}

1;
__END__