celbots

extern/cel-bot/.bzr/README

@@ -0,0 +1,3 @@
+This is a Bazaar control directory.
+Do not change any files in this directory.
+See http://bazaar.canonical.com/ for more information about Bazaar.

extern/cel-bot/.bzr/branch-format

@@ -0,0 +1 @@
+Bazaar-NG meta directory, format 1

extern/cel-bot/.bzr/branch/branch.conf

@@ -0,0 +1,2 @@
+bound_location = http://bazaar.leonerd.org.uk/code/cel-bot/
+bound = True

extern/cel-bot/.bzr/branch/format

@@ -0,0 +1 @@
+Bazaar Branch Format 7 (needs bzr 1.6)

extern/cel-bot/.bzr/branch/last-revision

@@ -0,0 +1 @@
+378 leonerd@leonerd.org.uk-20160719223125-2dgolyshrebe6fs1

extern/cel-bot/.bzr/checkout/conflicts

@@ -0,0 +1 @@
+BZR conflict list format 1

extern/cel-bot/.bzr/checkout/format

@@ -0,0 +1 @@
+Bazaar Working Tree Format 6 (bzr 1.14)

extern/cel-bot/.bzr/repository/format

@@ -0,0 +1 @@
+Bazaar repository format 2a (needs bzr 1.16 or later)

extern/cel-bot/.bzr/repository/indices/1f2220adc248e649d6a8877e39704992.six

@@ -0,0 +1,5 @@
+B+Tree Graph Index 2
+node_ref_lists=0
+key_elements=1
+len=0
+row_lengths=

extern/cel-bot/.bzrignore

@@ -0,0 +1 @@
+logs

extern/cel-bot/CelBot/Channel.pm

@@ -0,0 +1,610 @@
+package CelBot::Channel;
+
+use strict;
+
+use CelBot::RateLimiter;
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $name, $config ) = @_;
+
+   my $irc = $core->get_plugin( "irc" );
+
+   my $self = bless {
+      core => $core,
+      irc  => $irc,
+
+      name => $name,
+
+      modes => {},
+
+      occupants => {}, # {$nick} -> [ $flag, $jointime ]
+
+      topic => undef,
+
+      deferred_modes => [],
+   }, $class;
+
+   $self->reconfigure( $config );
+
+   return $self;
+}
+
+sub reconfigure
+{
+   my $self = shift;
+   my ( $config ) = @_;
+
+   my $rate_count = defined $config ? $config->get_string( '@rate_count', default => 10 ) : 10;
+   my $rate_time  = defined $config ? $config->get_string( '@rate_time',  default => 10 ) : 10;
+
+   $self->{key} = defined $config ? $config->get_string( '@key', default => undef ) : undef;
+
+   if( !$self->{ratelimiter} ) {
+      my $core = $self->{core};
+      my $loop = $core->get_loop;
+
+      $self->{ratelimiter} = CelBot::RateLimiter->new( $loop, $rate_count, $rate_time );
+   }
+   else {
+      $self->{ratelimiter}->{count} = $rate_count;
+      $self->{ratelimiter}->{delay} = $rate_time;
+   }
+}
+
+use overload '""' => "STRING";
+
+sub STRING
+{
+   my $self = shift;
+   return __PACKAGE__."[name=$self->{name}]";
+}
+
+sub name
+{
+   my $self = shift;
+   return $self->{name};
+}
+
+sub is_joined
+{
+   my $self = shift;
+   return $self->{is_joined};
+}
+
+sub get_modes
+{
+   my $self = shift;
+   return $self->{modes};
+}
+
+sub get_userflags
+{
+   my $self = shift;
+
+   my $occupants = $self->{occupants};
+
+   return { map { $_ => $occupants->{$_}[0] } keys %$occupants };
+}
+
+sub get_userflag
+{
+   my $self = shift;
+   my ( $user ) = @_;
+
+   my $occupants = $self->{occupants};
+
+   my $nick_folded = $user->nick_folded;
+
+   if( exists $occupants->{$nick_folded} ) {
+      return $occupants->{$nick_folded}[0];
+   }
+   else {
+      return undef;
+   }
+}
+
+sub get_jointime
+{
+   my $self = shift;
+   my ( $user ) = @_;
+
+   my $occupants = $self->{occupants};
+
+   my $nick_folded = $user->nick_folded;
+
+   if( exists $occupants->{$nick_folded} ) {
+      return $occupants->{$nick_folded}[1];
+   }
+   else {
+      return undef;
+   }
+}
+
+sub get_users
+{
+   my $self = shift;
+
+   my $occupants = $self->{occupants};
+
+   my $irc = $self->{irc};
+   my @users = map { $irc->get_user( $_ ) } keys %$occupants;
+
+   return @users;
+}
+
+sub join
+{
+   my $self = shift;
+   my %args = @_;
+
+   my $name = $self->{name};
+   my $irc = $self->{irc};
+
+   $irc->send_message( "JOIN", undef, $name, defined $self->{key} ? ( $self->{key} ) : () );
+
+   $self->{on_joined} = $args{on_joined};
+}
+
+sub kick
+{
+   my $self = shift;
+   my ( $user, $message ) = @_;
+
+   my $name = $self->{name};
+   my $irc = $self->{irc};
+
+   $irc->send_message( "KICK", undef, $self->name, $user->nick, $message );
+}
+
+sub mode
+{
+   my $self = shift;
+   my ( $flag, $arg, $defer ) = @_;
+
+   if( $defer ) {
+      push @{ $self->{deferred_modes} }, [ $flag, $arg ];
+      if( !$self->{flush_timer_id} ) {
+         my $core = $self->{core};
+         my $loop = $core->get_loop;
+         $self->{flush_timer_id} = $loop->enqueue_timer(
+            delay => 2,
+            code => sub {
+               undef $self->{flush_timer_id};
+               $self->_flush_modes;
+            },
+         );
+      }
+   }
+   else {
+      my $irc = $self->{irc};
+      $irc->send_message( "MODE", undef, $self->name, $flag, ( defined $arg ? ( $arg ) : () ) );
+   }
+}
+
+sub _flush_modes
+{
+   my $self = shift;
+
+   my @modes = splice @{ $self->{deferred_modes} };
+   return unless @modes;
+
+   my $irc = $self->{irc};
+
+   my $flags = "";
+   my @args;
+
+   my $maxmodes = $irc->isupport( "MODES" ) || 3;
+
+   my $lastsense = "";
+   my $count = 0;
+   foreach my $m ( @modes ) {
+      my ( $flag, $arg ) = @$m;
+      ( my $sense, $flag ) = $flag =~ m/^(.)(.*)/;
+
+      if( $sense ne $lastsense ) {
+         $flags .= $sense;
+         $lastsense = $sense;
+      }
+
+      $flags .= $flag;
+      push @args, $arg if defined $arg;
+
+      $count++;
+
+      if( $count == $maxmodes ) {
+         $irc->send_message( "MODE", undef, $self->name, $flags, @args );
+         $flags = "";
+         @args = ();
+         $lastsense = "";
+         $count = 0;
+      }
+   }
+
+   if( $flags ) {
+      $irc->send_message( "MODE", undef, $self->name, $flags, @args );
+   }
+}
+
+sub part
+{
+   my $self = shift;
+   my %args = @_;
+
+   my $name = $self->{name};
+   my $irc = $self->{irc};
+
+   $irc->send_message( "PART", undef, $name );
+
+   $self->{on_parted} = $args{on_parted};
+}
+
+sub privmsg
+{
+   my $self = shift;
+   my ( $text ) = @_;
+
+   my $irc = $self->{irc};
+
+   $self->{ratelimiter}->do( sub {
+      $irc->send_message( "PRIVMSG", undef, $self->{name}, $text );
+   } );
+}
+
+sub notice
+{
+   my $self = shift;
+   my ( $text ) = @_;
+
+   my $irc = $self->{irc};
+
+   $self->{ratelimiter}->do( sub {
+      $irc->send_message( "NOTICE", undef, $self->{name}, $text );
+   } );
+}
+
+sub restricted_privmsg
+{
+   my $self = shift;
+   my ( $text, $restriction ) = @_;
+
+   my $irc = $self->{irc};
+
+   $self->{ratelimiter}->do( sub {
+      $irc->send_message( "PRIVMSG", undef, $restriction . $self->{name}, $text );
+   } );
+}
+
+sub start_who
+{
+   my $self = shift;
+
+   my $irc = $self->{irc};
+   $irc->send_message( "WHO", undef, $self->{name} );
+}
+
+# There are three ways a user could leave a channel, PART, QUIT, KICK. Handle
+# them all here
+sub user_leave
+{
+   my $self = shift;
+   my ( $user, $command, $reason, $kicker ) = @_;
+
+   my $occupants = $self->{occupants};
+
+   delete $occupants->{$user->nick_folded};
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_leave", $self, $user, $command, $reason, $kicker );
+}
+
+sub user_rename
+{
+   my $self = shift;
+   my ( $oldname, $newname ) = @_;
+
+   my $occupants = $self->{occupants};
+
+   return unless exists $occupants->{$oldname};
+
+   my $occ = delete $occupants->{$oldname};
+   $occupants->{$newname} = $occ;
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_user_rename", $self, $oldname, $newname );
+}
+
+sub on_message_311 # No TOPIC
+{
+   my $self = shift;
+   my ( $command, $message ) = @_;
+
+   $self->{topic} = undef;
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_topic", $self, $self->{topic} );
+
+   return 1;
+}
+
+sub on_message_332 # TOPIC
+{
+   my $self = shift;
+   my ( $command, $message ) = @_;
+
+   $self->{topic} = $message->arg(2);
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_topic", $self, $self->{topic} );
+
+   return 1;
+}
+
+sub on_message_names
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my $names = $hints->{names};
+
+   my $irc = $self->{irc};
+
+   my %occupants;
+
+   foreach my $nick_folded ( keys %$names ) {
+      my $flag = $names->{$nick_folded}{flag};
+
+      # Make sure the User object exists
+      $irc->nick_to_user( $names->{$nick_folded}{nick} );
+
+      $occupants{$nick_folded} = [ $flag, 0 ]; # put 0 since we don't know the jointime
+   }
+
+   $self->{occupants} = \%occupants;
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_names", $self, $self->get_userflags );
+
+   return 1;
+}
+
+sub on_message_who
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my $irc = $self->{irc};
+
+   my @who;
+   foreach ( @{ $hints->{who} } ) {
+      my ( $nick, $ident, $host, $flags ) = @{$_}{qw( user_nick user_ident user_host user_flags )};
+
+      my $user = $irc->nick_to_user( $nick );
+      $user->advise_host( $ident, $host );
+
+      push @who, {
+         nick   => $nick,
+         ident  => $ident,
+         host   => $host,
+         flags  => $flags,
+      };
+   }
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_who", $self, @who );
+
+   return 1;
+}
+
+sub on_message_JOIN
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   if( $hints->{prefix_is_me} ) {
+      $self->{is_joined} = 1;
+
+      $self->{on_joined}->() if $self->{on_joined};
+      undef $self->{on_joined};
+
+      $self->{names} = [];
+
+      my $core = $self->{core};
+      $core->run_plugins( "on_channel_self_join", $self );
+
+      return 1;
+   }
+
+   my $prefix = $message->prefix;
+
+   my $irc = $self->{irc};
+   my $user = $irc->hints_to_user( $hints );
+
+   my $occupants = $self->{occupants};
+
+   $occupants->{$user->nick_folded} = [ "", time() ];
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_join", $self, $user );
+
+   return 1;
+}
+
+sub on_message_KICK
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my $kicked = $message->arg(1);
+
+   my $reason = $message->arg(2);
+   defined $reason or $reason = "";
+
+   my $irc = $self->{irc};
+   my $kickeduser = $irc->nick_to_user( $kicked );
+
+   my $core = $self->{core};
+
+   if( $kickeduser->is_me ) {
+      $self->{is_joined} = 0;
+
+      $core->run_plugins( "on_channel_self_leave", $self, "KICK", $reason );
+
+      return 1;
+   }
+
+   $self->user_leave( $kickeduser, "KICK", $reason, $irc->nick_to_user( $hints->{kicker_nick} ) );
+
+   return 1;
+}
+
+sub on_message_MODE
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my $core = $self->{core};
+   my $irc = $self->{irc};
+
+   my $modes = $self->{modes};
+
+   my ( $hostmodes, $opaquemodes, $nummodes, $boolmodes ) = @{ $irc->isupport( "chanmodes_list" ) };
+
+   my ( undef, $modeflags, @modeargs ) = $message->args;
+
+   my $occupants = $self->{occupants};
+
+   my $sense = 0;
+   foreach my $modechar ( split( m//, $modeflags ) ) {
+      $sense =  1, next if $modechar eq "+";
+      $sense = -1, next if $modechar eq "-";
+
+      if( my $flag = $irc->prefix_mode2flag( $modechar ) ) {
+         my $nick = $irc->casefold_name( shift @modeargs );
+
+         if( $sense > 0 ) {
+            $occupants->{$nick}[0] = $flag;
+         }
+         else {
+            $occupants->{$nick}[0] = "";
+         }
+
+         my $user = $irc->nick_to_user( $nick );
+
+         my $core = $self->{core};
+         $core->run_plugins( "on_channel_usermode", $self, $user, $sense>0 ? $flag : "" );
+      }
+      elsif( index($hostmodes, $modechar) > -1 ) {
+         my $target = shift @modeargs;
+         $core->log( "DEBUG", "Channel[$self->{name}]: ", "MODE HOSTMASK $target $sense $modechar" );
+      }
+      elsif( index($nummodes, $modechar) > -1 or index($opaquemodes, $modechar) > -1 ) {
+         my $value;
+         if( $sense > 0 ) {
+            $value = shift @modeargs;
+            $modes->{$modechar} = $value;
+         }
+         else {
+            $value = undef;
+            delete $modes->{$modechar};
+         }
+
+         my $core = $self->{core};
+         $core->run_plugins( "on_channel_mode", $self, $modechar, $value );
+      }
+      elsif( index($boolmodes, $modechar) > -1 ) {
+         my $value;
+         if( $sense > 0 ) {
+            $value = 1;
+            $modes->{$modechar} = $value;
+         }
+         else {
+            $value = undef;
+            delete $modes->{$modechar};
+         }
+
+         my $core = $self->{core};
+         $core->run_plugins( "on_channel_mode", $self, $modechar, $value );
+      }
+      else {
+         $core->log( "DEBUG", "Channel[$self->{name}]: ", "Unrecognised MODE $modechar" );
+      }
+   }
+
+   return 1;
+}
+
+sub on_message_PART
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   if( $hints->{prefix_is_me} ) {
+      $self->{is_joined} = 0;
+
+      my $core = $self->{core};
+      $core->run_plugins( "on_channel_self_leave", $self, "PART" );
+
+      $self->{on_parted}->() if $self->{on_parted};
+      undef $self->{on_parted};
+
+      return 1;
+   }
+
+   my $reason = $message->arg(1);
+   defined $reason or $reason = "";
+
+   my $irc = $self->{irc};
+   my $user = $irc->hints_to_user( $hints );
+
+   $self->user_leave( $user, "PART", $reason );
+
+   return 1;
+}
+
+sub on_message_TOPIC
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   $self->{topic} = $message->arg(1);
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_topic", $self, $self->{topic}, $message->prefix );
+
+   return 1;
+}
+
+sub on_message_text
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my $irc = $self->{irc};
+
+   my $user = $irc->hints_to_user( $hints );
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_privmsg", $self, $user, $message->arg(1) );
+
+   return 1;
+}
+
+sub on_message_ctcp_ACTION
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my $irc = $self->{irc};
+
+   my $user = $irc->hints_to_user( $hints );
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_channel_ctcp_ACTION", $self, $user, $hints->{ctcp_args} );
+
+   return 1;
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Channels.pm

@@ -0,0 +1,335 @@
+package CelBot::Channels;
+
+use strict;
+
+use CelBot::Channel;
+use CelBot::Commands;
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $irc = $core->get_plugin( "irc" );
+
+   my $self = bless {
+      core => $core,
+      irc  => $irc,
+   }, $class;
+
+   my %channels;
+
+   $config->associate_nodeset(
+      'channel',
+      '@name',
+
+      add => sub {
+         my ( $name, $config ) = @_;
+
+         $name = $irc->casefold_name( $name );
+
+         # Deal with adding config to channels that were joined by command
+         if( exists $channels{$name} ) {
+            $channels{$name}->reconfigure( $config ) if $channels{$name}->can( "reconfigure" );
+         }
+         else {
+            $channels{$name} = CelBot::Channel->new( $core, $name, $config );
+
+            if( $irc->is_connected ) {
+               $channels{$name}->join;
+            }
+         }
+      },
+
+      keep => sub {
+         my ( $name, $config ) = @_;
+
+         $name = $irc->casefold_name( $name );
+
+         $channels{$name}->reconfigure( $config ) if $channels{$name}->can( "reconfigure" );
+
+         $config->reload;
+      },
+
+      remove => sub {
+         my ( $name ) = @_;
+
+         $channels{$name}->part(
+            on_parted => sub { delete $channels{$name} }
+         );
+      },
+   );
+
+   $self->{channels} = \%channels;
+
+   return $self;
+}
+
+sub get_channel
+{
+   my $self = shift;
+   my ( $name ) = @_;
+
+   my $irc = $self->{irc};
+   $name = $irc->casefold_name( $name );
+
+   return exists $self->{channels}->{$name} ? $self->{channels}->{$name}
+                                            : undef;
+}
+
+sub get_channels
+{
+   my $self = shift;
+   return values %{ $self->{channels} };
+}
+
+sub gen_argspec
+{
+   my $self = shift;
+
+   if( @_ ) {
+      my $name = shift;
+      return CelBot::Channels::ArgSpec->new( $name, channels => $self, @_ );
+   }
+   else {
+      # Cache a single one
+      return $self->{argspec} ||= CelBot::Channels::ArgSpec->new( 'channel', channels => $self );
+   }
+}
+
+sub on_message
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   return 0 unless $hints->{target_type} and $hints->{target_type} eq "channel";
+
+   if( my $chan = $self->{channels}->{ $hints->{target_name_folded} } ) {
+      # Turn ctcp ACTION into ctcp_ACTION, etc
+      $command =~ s/ /_/g;
+      my $method = "on_message_" . $command;
+      return 1 if $chan->can( $method ) and $chan->$method( $command, $message, $hints );
+
+      return 1 if $chan->can( "on_message" ) and $chan->on_message( $command, $message, $hints );
+   }
+
+   return 0;
+}
+
+sub on_message_001
+{
+   my $self = shift;
+
+   foreach my $chan ( values %{ $self->{channels} } ) {
+      $chan->join;
+   }
+
+   return 1;
+}
+
+sub on_user_rename
+{
+   my $self = shift;
+   my ( $user, $oldnick, $newnick ) = @_;
+
+   my $irc = $self->{irc};
+
+   my $old_folded = $irc->casefold_name( $oldnick );
+   my $new_folded = $irc->casefold_name( $newnick );
+
+   return 1 if $old_folded eq $new_folded;
+
+   foreach my $chan ( values %{ $self->{channels} } ) {
+      $chan->user_rename( $old_folded, $new_folded );
+   }
+
+   return 1;
+}
+
+sub on_user_quit
+{
+   my $self = shift;
+   my ( $user, $reason ) = @_;
+
+   foreach my $chan ( values %{ $self->{channels} } ) {
+      defined $chan->get_userflag( $user ) or next;
+      $chan->user_leave( $user, "QUIT", $reason );
+   }
+
+   return 1;
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "in",
+      perm    => 'public',
+
+      args => [
+         $self->gen_argspec,
+         CelBot::Commands::ArgSpec->new( 'command', trailing => 1 ),
+      ],
+
+      summary => "Execute a command in the context of a (different) channel",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "join",
+      perm    => 'master',
+
+      args => [
+         CelBot::Commands::ArgSpec::Bareword->new( 'channel' ),
+      ],
+
+      summary => "Join a channel",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      scope   => 'channel|privmsg',
+      command => "leave",
+      perm    => 'master',
+
+      args => [
+         $self->gen_argspec( 'channel', optional => 1 ),
+      ],
+
+      summary => "Leave a channel",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      scope   => 'channel|privmsg',
+      command => "rejoin",
+      perm    => 'master',
+
+      args => [
+         $self->gen_argspec( 'channel', optional => 1 ),
+      ],
+
+      summary => "Leave then rejoin a channel",
+   );
+}
+
+sub command_in
+{
+   my $self = shift;
+   my ( $context, $channel ) = @_;
+
+   my $subcontext = $context->new_sub( 
+      scope   => "channel",
+      channel => $channel,
+   );
+
+   my $core = $self->{core};
+
+   my $cmds_plugin = $core->get_plugin( "commands" );
+   $cmds_plugin->run_command( $subcontext );
+
+   return ();
+}
+
+sub command_join
+{
+   my $self = shift;
+   my ( $context, $channame ) = @_;
+
+   my $channel = $self->get_channel( $channame );
+
+   if( !defined $channel ) {
+      $channel = CelBot::Channel->new( $self->{core}, $channame, undef );
+      $self->{channels}->{$channame} = $channel;
+   }
+
+   if( $channel->is_joined ) {
+      return ( "Already joined '$channame'" );
+   }
+
+   $channel->join( 
+      on_joined => sub {
+         $context->respond( "Joined '$channame'" );
+      }
+   );
+
+   return ();
+}
+
+sub command_leave
+{
+   my $self = shift;
+   my ( $context, $channel ) = @_;
+
+   $channel ||= $context->{channel};
+
+   if( !defined $channel ) {
+      return ( "Need to supply 'channel'" );
+   }
+
+   my $channame = $channel->name;
+
+   $channel->part( 
+      on_parted => sub {
+         $context->respond( "Left '$channame'" );
+      }
+   );
+
+   return ();
+}
+
+sub command_rejoin
+{
+   my $self = shift;
+   my ( $context, $channel ) = @_;
+
+   $channel ||= $context->{channel};
+
+   if( !defined $channel ) {
+      return ( "Need to supply 'channel'" );
+   }
+
+   my $channame = $channel->name;
+
+   $channel->part( 
+      on_parted => sub {
+         $channel->join( 
+            on_joined => sub {
+               $context->respond( "Rejoined '$channame'" );
+            }
+         );
+      }
+   );
+
+   return ();
+}
+
+# Keep perl happy, keep Britain tidy
+1;
+
+
+package CelBot::Channels::ArgSpec;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec::Bareword );
+
+sub validate
+{
+   my $self = shift;
+   my ( $channame ) = @_;
+
+   my $channel = $self->{channels}->get_channel( $channame );
+
+   die "No such channel '$channame'\n" if !defined $channel;
+
+   return $channel;
+}
+
+1;

extern/cel-bot/CelBot/CommandContext.pm

@@ -0,0 +1,156 @@
+package CelBot::CommandContext;
+
+use strict;
+
+sub new
+{
+   my $class = shift;
+   my %args = @_;
+
+   my $self = bless \%args, $class;
+
+   return $self;
+}
+
+sub new_sub
+{
+   my $parent = shift;
+   my %args = @_;
+
+   my $self = bless { %$parent }, ref $parent;
+
+   # Remove the list_responder if %args provided a responder to replace it
+   delete $self->{list_responder} if defined $args{responder};
+
+   $self->{$_} = $args{$_} foreach keys %args;
+   $self->{parent} = $parent;
+
+   $self->{cascade} = 1 unless defined $self->{cascade};
+
+   return $self;
+}
+
+sub scope
+{
+   my $self = shift;
+   return $self->{scope};
+}
+
+sub cmduser
+{
+   my $self = shift;
+   return $self->{cmduser};
+}
+
+sub allows_noise
+{
+   my $self = shift;
+   return $self->{allows_noise} || 0;
+}
+
+sub text
+{
+   my $self = shift;
+   return $self->{text};
+}
+
+sub respond
+{
+   my $self = shift;
+   my ( @response ) = @_;
+
+   my @lines;
+
+   foreach my $r ( @response ) {
+      # Protect against linefeeds in the line itself
+      push @lines, split( m/\n/, $r );
+   }
+
+   if( defined $self->{max_spam} and @lines > $self->{max_spam} ) {
+      # Truncate
+      @lines = @lines[ 0 .. $self->{max_spam} - 1 ];
+   }
+
+   if( $self->{list_responder} ) {
+      $self->{list_responder}->( @lines );
+   }
+   else {
+      foreach my $line ( @lines ) {
+         $self->{responder}->( $line );
+      }
+   }
+}
+
+sub respond_noise
+{
+   my $self = shift;
+   $self->respond( @_ ) if $self->allows_noise;
+}
+
+sub allows_scope
+{
+   my $self = shift;
+   my ( $allowedscope ) = @_;
+
+   my $parent = $self->{parent};
+   return $parent->allows_scope( $allowedscope ) if $parent and $self->{cascade}; # "Ask your mother"
+
+   my $core = $self->{core};
+   return $core->ask_plugins( "permit_command_scope", $allowedscope, $self );
+}
+
+sub allows_perm
+{
+   my $self = shift;
+   my ( $allowedperm ) = @_;
+
+   my $parent = $self->{parent};
+   return $parent->allows_perm( $allowedperm ) if $parent and $self->{cascade}; # "Ask your mother"
+
+   my $core = $self->{core};
+   return $core->ask_plugins( "permit_command_perm", $allowedperm, $self );
+}
+
+sub allows_nonpublic
+{
+   my $self = shift;
+
+   my $parent = $self->{parent};
+   return $parent->allows_nonpublic if $parent and $self->{cascade}; # "Ask your mother"
+
+   my $core = $self->{core};
+   return $core->ask_plugins( "permit_command_nonpublic", $self );
+}
+
+# Now some convenient commandline parsing methods
+
+sub peek_token
+{
+   my $self = shift;
+
+   if( $self->{text} =~ m/^(\S+)\s/ ) {
+      return $1;
+   }
+   elsif( $self->{text} =~ m/^(\S+)$/ ) {
+      return $1;
+   }
+   else {
+      return undef;
+   }
+}
+
+sub pull_token
+{
+   my $self = shift;
+
+   my $token = $self->peek_token;
+   return undef unless defined $token;
+
+   substr( $self->{text}, 0, length $token ) = "";
+   $self->{text} =~ s/^\s+//; # Trim whitespace
+
+   return $token;
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Commands.pm

@@ -0,0 +1,645 @@
+package CelBot::Commands;
+
+use strict;
+
+use CelBot::CommandContext;
+
+use Carp;
+
+sub new
+{
+   my $class = shift;
+   my ( $core ) = @_;
+
+   my $self = bless {
+      core => $core,
+      irc  => $core->get_plugin( "irc" ),
+   }, $class;
+
+   return $self;
+}
+
+sub reconfigure
+{
+   my $self = shift;
+
+   # First clear out all the existing ones
+   $self->{commands} = {};
+
+   my $core = $self->{core};
+   $core->run_plugins( "register_commands", $self );
+}
+
+sub _check_cmdstruct
+{
+   my $self = shift;
+   my ( $cmdstruct, $parent, $cmdname, $funcname ) = @_;
+
+   $funcname = $cmdstruct->{funcname} if exists $cmdstruct->{funcname};
+   $funcname = "command_$cmdname" if !defined $funcname;
+
+   my $plugin = $cmdstruct->{plugin} ||
+      $parent && ( $cmdstruct->{plugin} = $parent->{plugin} )
+      or croak "Need a 'plugin' for $cmdname";
+
+   $cmdstruct->{scope}
+      or $parent and $cmdstruct->{scope} = $parent->{scope}
+      or $cmdstruct->{scope} = "privmsg";
+
+   $cmdstruct->{perm}
+      or $parent and $cmdstruct->{perm} = $parent->{perm}
+      or $cmdstruct->{perm} = "recognised";
+
+   if( $cmdstruct->{args} and $cmdstruct->{subcmds} ) {
+      $cmdstruct->{subcmds} and croak "Cannot have both 'args' and 'subcmds' for $cmdname";
+   }
+
+   elsif( my $args = $cmdstruct->{args} ) {
+      ref $args eq "ARRAY" or croak "Expected 'args' to be ARRAY ref for $cmdname";
+      if( not $cmdstruct->{function} ) {
+         $plugin->can( $funcname ) or croak "Plugin $plugin cannot ->$funcname()";
+         $cmdstruct->{function} = sub { $plugin->$funcname( @_ ) };
+      }
+   }
+
+   elsif( my $subs = $cmdstruct->{subcmds} ) {
+      ref $subs eq "HASH" or croak "Expected 'subcmds' to be HASH ref for $cmdname";
+      foreach my $subcmd ( keys %$subs ) {
+         $self->_check_cmdstruct( $subs->{$subcmd}, $cmdstruct, "${cmdname} ${subcmd}", "${funcname}_${subcmd}" );
+      }
+      if( defined $cmdstruct->{default} ) {
+         exists $subs->{$cmdstruct->{default}} or croak "Default command for $cmdname does not exist";
+      }
+   }
+
+   else {
+      croak "Need either 'args' or 'subcmds' for $cmdname";
+   }
+}
+
+sub register
+{
+   my $self = shift;
+   my %args = @_;
+
+   my $command = delete $args{command} or croak "Need a 'command'";
+
+   exists $self->{commands}->{$command} and croak "Command '$command' already registered";
+
+   $self->_check_cmdstruct( \%args, undef, $command );
+
+   $self->{commands}->{$command} = \%args;
+}
+
+sub _parse_args
+{
+   my $self = shift;
+   my ( $argspecs, $context ) = @_;
+
+   return [] unless defined $argspecs and @$argspecs;
+
+   my @args;
+
+   foreach my $arg ( @$argspecs ) {
+      last if $arg->trailing;
+
+      if( $arg->eatall ) {
+         push @args, $context->text;
+         last;
+      }
+      else {
+         eval { push @args, $arg->pull( $context ); };
+         if( $@ ) {
+            $context->respond_noise( $@ );
+            return;
+         }
+      }
+   }
+
+   if( !$argspecs->[-1]->trailing and !$argspecs->[-1]->eatall ) {
+      if( length $context->text ) {
+         $context->respond_noise( "Extra arguments found: '" . $context->text . "'" );
+         return;
+      }
+   }
+
+   return \@args;
+}
+
+sub run_command
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $cmdname = $context->pull_token;
+
+   if( !exists $self->{commands}->{$cmdname} ) {
+      my $response = "No such command '$cmdname'";
+
+      $response .= ", and please don't shout" if( $cmdname eq uc $cmdname );
+
+      $context->respond_noise( $response ) if $context->allows_nonpublic;
+      return;
+   }
+
+   my $cmdstruct = $self->{commands}->{$cmdname};
+
+   $self->run_cmdstruct( $cmdstruct, $context, $cmdname );
+}
+
+sub run_cmdstruct
+{
+   my $self = shift;
+   my ( $cmdstruct, $context, $cmdname ) = @_;
+
+   # Disallow non-recoginised users from running any command that isn't public
+   return if( !$context->allows_nonpublic and $cmdstruct->{perm} ne "public" );
+
+   my $core = $self->{core};
+
+   unless( $context->allows_scope( $cmdstruct->{scope} ) ) {
+      $context->respond_noise( "Not allowed in this scope" );
+      return;
+   }
+
+   unless( $context->allows_perm( $cmdstruct->{perm} ) ) {
+      $context->respond_noise( "$cmdname: You are not allowed" );
+      return;
+   }
+
+   if( my $subs = $cmdstruct->{subcmds} ) {
+      my $subcmd = $context->pull_token;
+      $subcmd ||= $cmdstruct->{default};
+
+      if( !defined $subcmd ) {
+         $context->respond_noise( "$cmdname: Need a subcommand name" );
+         return;
+      }
+
+      if( !exists $subs->{$subcmd} ) {
+         $context->respond_noise( "$cmdname: Has no subcommand '$subcmd'" );
+         return;
+      }
+
+      my $substruct = $subs->{$subcmd};
+
+      if( my $checkfunc = $cmdstruct->{checkfunc} ) {
+         return unless $checkfunc->( $context, $cmdstruct, $substruct );
+      }
+
+      $self->run_cmdstruct( $substruct, $context, "${cmdname} ${subcmd}" );
+      return;
+   }
+
+   my ( $argsref ) = $self->_parse_args( $cmdstruct->{args}, $context );
+   return unless $argsref;
+
+   if( my $checkfunc = $cmdstruct->{checkfunc} ) {
+      return unless $checkfunc->( $context, $cmdstruct, $argsref );
+   }
+
+   my $function = $cmdstruct->{function};
+   my @response = $function->( $context, @$argsref );
+
+   $context->respond( @response );
+}
+
+sub on_channel_privmsg
+{
+   my $self = shift;
+   my ( $channel, $user, $text ) = @_;
+
+   my $irc = $self->{irc};
+
+   return 0 unless $text =~ m/^(\S+):\s+(.*)$/;
+   return 0 unless $irc->is_me( $1 );
+   $text = $2;
+
+   my $nick = $user->nick;
+
+   my $context = CelBot::CommandContext->new(
+      core => $self->{core},
+
+      scope   => "channel",
+      cmduser => $user,
+      text    => $text,
+
+      max_spam => 3, # TODO: Per-channel lookup?
+
+      channel => $channel,
+
+      responder => sub {
+         $channel->privmsg( "$nick: $_[0]" );
+      },
+   );
+
+   $self->run_command( $context );
+
+   return 1;
+}
+
+sub on_user_privmsg
+{
+   my $self = shift;
+   my ( $user, $text ) = @_;
+
+   my $context = CelBot::CommandContext->new(
+      core => $self->{core},
+
+      scope   => "privmsg",
+      cmduser => $user,
+      text    => $text,
+
+      max_spam => 10, # TODO: Per-user lookup?
+      allows_noise => 1,
+
+      responder => sub {
+         $user->privmsg( $_[0] );
+      },
+   );
+
+   $self->run_command( $context );
+
+   return 1;
+}
+
+sub on_console_line
+{
+   my $self = shift;
+   my ( $tab, $text ) = @_;
+
+   my $core = $self->{core};
+
+   # Cheat
+   my $cmdname = (split ' ', $text)[0];
+
+   my $context = CelBot::CommandContext->new(
+      core => $self->{core},
+
+      scope => "console",
+      text  => $text,
+
+      max_spam => undef,
+      allows_noise => 1,
+
+      list_responder => sub {
+         my @lines = @_;
+         $tab->add_line( "$cmdname: $lines[0]" ); shift @lines;
+         $tab->add_line( "          $_" ) for @lines;
+      }
+   );
+
+   $self->run_command( $context );
+
+   return 1;
+}
+
+sub permit_command_scope
+{
+   my $self = shift;
+   my ( $scope, $context ) = @_;
+
+   return 1 if $scope eq 'any';
+   return 1 if grep { $context->scope eq $_ } split( m{\|}, $scope );
+
+   return undef;
+}
+
+sub permit_command_perm
+{
+   my $self = shift;
+   my ( $perm, $context ) = @_;
+
+   return 1 if grep { $_ eq 'public' } split( m{\|}, $perm );
+
+   return undef;
+}
+
+###
+# Internal Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "help",
+      perm    => 'public',
+
+      args => [
+         CelBot::Commands::ArgSpec::Command->new( 'command', optional => 1, commands => $self->{commands} ),
+         CelBot::Commands::ArgSpec->new( 'args', trailing => 1 ),
+      ],
+
+      summary => "Obtain help on available commands",
+   );
+}
+
+sub command_help
+{
+   my $self = shift;
+   my ( $context, $helpcmd ) = @_;
+
+   if( !defined $helpcmd ) {
+      my @ret;
+
+      if( keys %{ $self->{commands} } ) {
+         push @ret, "Commands (* denotes public):";
+
+         my @commands;
+         foreach my $command ( sort keys %{ $self->{commands} } ) {
+            my $cmdstruct = $self->{commands}->{$command};
+
+            next unless $context->allows_perm( $cmdstruct->{perm} );
+
+            push @commands, ( $cmdstruct->{perm} eq "public" ? "*$command" : $command );
+         }
+
+         push @ret, join( "  ", @commands );
+      }
+
+      return @ret;
+   }
+
+   my $cmdstruct = $self->{commands}->{$helpcmd};
+   $self->_do_help_cmdstruct( $cmdstruct, $context, $helpcmd );
+}
+
+sub _do_help_cmdstruct
+{
+   my $self = shift;
+   my ( $cmdstruct, $context, $helpcmd ) = @_;
+
+   if( !length $context->text ) {
+      my @ret;
+
+      push @ret, "Summary: $cmdstruct->{summary}" if defined $cmdstruct->{summary};
+
+      if( $cmdstruct->{args} ) {
+         push @ret, "Usage  : $helpcmd " . join( " ", map { $_->usage } @{ $cmdstruct->{args} } );
+      }
+      elsif( my $subs = $cmdstruct->{subcmds} ) {
+         push @ret, "Subcommands: " . join( " ", sort keys %$subs );
+      }
+
+      if( $cmdstruct->{helpargs} ) {
+         push @ret, "       : help $helpcmd " . join( " ", map { $_->usage } @{ $cmdstruct->{helpargs} } );
+      }
+
+      return @ret;
+   }
+   elsif( defined $cmdstruct->{helpargs} ) {
+      my ( $helpargsref ) = $self->_parse_args( $cmdstruct->{helpargs}, $context );
+      return unless $helpargsref;
+
+      my $cmdplugin = $cmdstruct->{plugin};
+      my $helpcmdmethod = "commandhelp_$helpcmd";
+      my @response = $cmdplugin->$helpcmdmethod( $context, @$helpargsref );
+
+      foreach my $line ( @response ) {
+         # Protect against linefeeds in the line itself
+         $context->respond( $_ ) foreach split( m/\n/, $line );
+      }
+   }
+   elsif( my $subs = $cmdstruct->{subcmds} ) {
+      my $subcmd = $context->pull_token;
+      if( !defined $subcmd ) {
+         return( "help $helpcmd: Need a subcommand name" );
+      }
+
+      if( !exists $subs->{$subcmd} ) {
+         return( "'$helpcmd' has no subcommand '$subcmd'" );
+      }
+
+      $self->_do_help_cmdstruct( $subs->{$subcmd}, $context, "$helpcmd $subcmd" );
+   }
+   else {
+      return ( "'$helpcmd' has no additional help" );
+   }
+}
+
+# Keep perl happy, keep Britain tidy
+1;
+
+
+package CelBot::Commands::ArgSpec;
+
+use strict;
+
+sub new
+{
+   my $class = shift;
+   my ( $name, %args ) = @_;
+
+   $args{name} = $name;
+
+   return bless \%args, $class;
+}
+
+sub name
+{
+   my $self = shift;
+   return $self->{name};
+}
+
+sub optional
+{
+   my $self = shift;
+   return $self->{optional};
+}
+
+sub trailing
+{
+   my $self = shift;
+   return $self->{trailing};
+}
+
+sub eatall
+{
+   my $self = shift;
+   return $self->{eatall};
+}
+
+sub usage
+{
+   my $self = shift;
+
+   my $trailing = $self->trailing || $self->eatall ? "..." : "";
+
+   if( $self->optional ) {
+      return '[$' . $self->name . $trailing . "]";
+   }
+   else {
+      return '$' . $self->name . $trailing;
+   }
+}
+
+sub pull
+{
+   my $self = shift;
+   die "ABSTRACT";
+}
+
+sub validate
+{
+   my $self = shift;
+   my ( $val ) = @_;
+
+   if( $self->{match} ) {
+      die "Unrecognised value for '$self->{name}': $val\n" unless $val =~ $self->{match};
+   }
+
+   return $val;
+}
+
+1;
+
+package CelBot::Commands::ArgSpec::Bareword;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec );
+
+sub pull
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $word = $context->pull_token;
+
+   return undef if !defined $word and $self->{optional};
+
+   die "Need to supply '$self->{name}'\n" if !defined $word;
+
+   return $self->validate( $word );
+}
+
+1;
+
+package CelBot::Commands::ArgSpec::Sugar;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec::Bareword );
+
+sub usage
+{
+   my $self = shift;
+   return $self->{name};
+}
+
+sub validate
+{
+   my $self = shift;
+   my ( $word ) = @_;
+
+   die "Expected '$self->{name}'" unless $word eq $self->{name};
+
+   return (); # Empty list
+}
+
+1;
+
+package CelBot::Commands::ArgSpec::HashKey;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec::Bareword );
+
+sub validate
+{
+   my $self = shift;
+   my ( $word ) = @_;
+
+   die "'$word' is not a valid value of $self->{name}\n" unless exists $self->{hash}->{$word};
+   
+   return $word;
+}
+
+1;
+
+package CelBot::Commands::ArgSpec::HashValue;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec::Bareword );
+
+sub validate
+{
+   my $self = shift;
+   my ( $word ) = @_;
+
+   die "'$word' is not a valid value of $self->{name}\n" unless exists $self->{hash}->{$word};
+   
+   return $self->{hash}->{$word};
+}
+
+1;
+
+package CelBot::Commands::ArgSpec::Options;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec );
+
+sub new
+{
+   my $class = shift;
+   my ( $opts, %args ) = @_;
+
+   # Name doesn't matter since we override 'usage' not to print it
+   return $class->SUPER::new( 'options', options => $opts, %args );
+}
+
+sub usage
+{
+   my $self = shift;
+
+   my $options = $self->{options};
+
+   return "[" . join( "|", map { "$_ " . $options->{$_}->usage } sort keys %$options ) . "]";
+}
+
+sub pull
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $opts = $self->{options};
+   my %optvalues;
+
+   while(1) {
+      my $optname = $context->peek_token;
+      last unless defined $optname;
+
+      last unless exists $opts->{$optname};
+
+      die "Cannot supply '$optname' option more than once\n" if exists $optvalues{$optname};
+
+      $context->pull_token; # Eat the optname token we peeked at
+
+      my $opt = $opts->{$optname};
+
+      $optvalues{$optname} = $opt->pull( $context );
+   }
+
+   return \%optvalues;
+}
+
+1;
+
+
+package CelBot::Commands::ArgSpec::Command;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec::Bareword );
+
+sub validate
+{
+   my $self = shift;
+   my ( $cmdname ) = @_;
+
+   die "No such command '$cmdname'\n" unless exists $self->{commands}->{$cmdname};
+
+   return $cmdname;
+}
+
+1;

extern/cel-bot/CelBot/Connector.pm

@@ -0,0 +1,38 @@
+package CelBot::Connector;
+
+use strict;
+
+use Carp;
+
+sub connect
+{
+   my %args = @_;
+
+   my $loop = $args{loop};
+
+   # Callbacks
+   my $on_connected     = $args{on_connected}     or croak "Expected 'on_connected' callback";
+   my $on_connect_error = $args{on_connect_error} or croak "Expected 'on_connect_error' callback";
+   my $on_resolve_error = $args{on_resolve_error} or croak "Expected 'on_resolve_error' callback";
+
+   my $on_fail;
+   $on_fail = sub { eval { $args{on_fail}->( @_ ) } or
+                       ::console_print_err( "on_fail callback failed - $@\n" ) } if $args{on_fail};
+
+   $loop->connect(
+      host => $args{host},
+      service => $args{service},
+
+      on_connected     => sub { eval { $on_connected->( @_ ); 1 } or
+                                   ::console_print_err( "on_connected callback failed - $@\n" ) },
+      on_connect_error => sub { eval { $on_connect_error->( @_ ); 1 } or
+                                   ::console_print_err( "on_connect_error callback failed - $@\n" ) },
+      on_resolve_error => sub { eval { $on_resolve_error->( @_ ); 1 } or
+                                   ::console_print_err( "on_resolve_error callback failed - $@\n" ) },
+
+      on_fail => $on_fail,
+   );
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Console.pm

@@ -0,0 +1,87 @@
+package CelBot::Console;
+
+use strict;
+
+use base qw( Tickit::Console );
+
+sub new
+{
+   my $class = shift;
+
+   my $self = $class->SUPER::new(
+      on_line => sub {
+         my ( $console, $line ) = @_;
+
+         if( $line =~ m{^/} ) {
+            $console->do_internal_command( $line );
+         }
+         else {
+            $console->active_tab->add_line( "<INPUT>: $line", indent => 9 );
+         }
+      },
+
+      on_key => sub {
+         my ( $console, $key ) = @_;
+
+         if( $key =~ m/^M-(\d)/ ) {
+            # Shortcut switch
+            $console->activate_tab( $1 - 1 );
+            return;
+         }
+
+         # Encode nicely
+         $key =~ s/\//\\\\/g;
+         $key =~ s/\n/\\n/g;
+         $key =~ s/\r/\\r/g;
+         $key =~ s/\e/\\e/g;
+         $key =~ s{([^\x20-\x7e])}{sprintf "\\x%02x", ord $1}eg;
+   
+         $console->active_tab->add_line( "<KEY>: $key", indent => 7 );
+      },
+   );
+
+   $self->{globaltab} = $self->add_tab(
+      name => "GLOBAL",
+
+      on_line => sub {
+         my ( $console, $line ) = @_;
+
+         my ( $cmd, $rest ) = (split m/ +/, $line, 2);
+
+         if( my $func = $self->can( "command_$cmd" ) ) {
+            $func->( $self, $console->active_tab, $rest );
+         }
+         else {
+            $console->active_tab->add_line( "GLOBAL: Unrecognised global command $cmd", indent => 8 );
+         }
+      },
+   );
+
+   return $self;
+}
+
+sub do_internal_command
+{
+   my $self = shift;
+   my ( $command ) = @_;
+
+   if( $command =~ m{^/win (\d+)} ) {
+      $self->switchto_tab( $1 - 1 );
+   }
+   else {
+      $self->curtab->add_line( "Unrecognised command $command" );
+   }
+}
+
+sub command_quit
+{
+   exit(0);
+}
+
+sub command_reload
+{
+   CelBot::Control::global_reload();
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Control.pm

@@ -0,0 +1,111 @@
+package CelBot::Control;
+
+use strict;
+
+use POSIX qw( SIGHUP );
+
+use CelBot::Commands;
+
+# This needs to be a package (not lexical) variable so it keeps its value when
+# the code is reloaded
+our @ON_GLOBAL_RELOAD;
+
+sub new
+{
+   my $class = shift;
+   my ( $core ) = @_;
+
+   my $self = bless {
+      core => $core,
+      irc  => $core->get_plugin( "irc" ),
+   }, $class;
+
+   return $self;
+}
+
+sub quit
+{
+   my $self = shift;
+   my ( $message ) = @_;
+
+   # THIS IS A BOT-GLOBAL ACTION
+
+   # TODO: Find all the IRC objects, create a MergePoint on them,
+   # only exit(0) when they're all done
+
+   $self->{irc}->disconnect( 
+      message => $message,
+      on_disconnected => sub { exit( 0 ); },
+   );
+}
+
+# THIS IS A BOT-GLOBAL ACTION
+sub global_reload
+{
+   # Take a copy of it in case it gets modified
+   my @reload_callbacks = @ON_GLOBAL_RELOAD;
+
+   foreach my $cb ( @reload_callbacks ) {
+      $cb->();
+   }
+
+   return 1; # TRUE
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "quit",
+      perm    => 'owner',
+
+      args => [
+         CelBot::Commands::ArgSpec->new( 'message', eatall => 1 ),
+      ],
+
+      summary => "Disconnect all connections and quit",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "reload",
+      perm    => 'owner',
+
+      args => [],
+
+      summary => "Reload configuration and Perl code",
+   );
+}
+
+sub command_quit
+{
+   my $self = shift;
+   my ( $context, $message ) = @_;
+
+   $context->respond( "OK" );
+
+   $self->quit( $message );
+}
+
+sub command_reload
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   if( defined eval { global_reload } ) {
+      return ( "OK" );
+   }
+   else {
+      return ( "Failed: $@" );
+   }
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Core.pm

@@ -0,0 +1,350 @@
+package CelBot::Core;
+
+use strict;
+
+use CelBot::Plugins qw( construct_plugin );
+
+# We need an ordered hash. We'll cheat
+
+my @builtins = qw(
+   irc
+   commands
+   users
+   channels
+   control
+   settings
+);
+
+my %builtin_package = (
+   irc      => 'CelBot::IRC',
+   commands => 'CelBot::Commands',
+   users    => 'CelBot::Users',
+   channels => 'CelBot::Channels',
+   control  => 'CelBot::Control',
+   settings => 'CelBot::Settings',
+);
+
+sub new
+{
+   my $class = shift;
+   my %args = @_;
+
+   my $config = $args{config};
+
+   my $tag = $config->get_string( '@tag' );
+
+   my %plugins;
+
+   my $self = bless {
+      config => $config,
+      loop   => $args{loop},
+
+      tag  => $tag,
+
+      plugins => \%plugins,
+
+      isupport => {},
+   }, $class;
+
+   $self->reconfigure( $config );
+
+   # Then the dynamic ones from config
+   $config->associate_nodeset(
+      'plugin',
+      '@type',
+
+      add => sub {
+         my ( $type, $config ) = @_;
+
+         $self->load_plugin( $type, $config );
+      },
+
+      keep => sub {
+         my ( $type, $config ) = @_;
+
+         my $plugin = $self->get_plugin( $type );
+
+         $plugin->reconfigure( $config ) if $plugin->can( "reconfigure" );
+
+         $config->reload;
+      },
+
+      remove => sub {
+         my ( $type ) = @_;
+
+         delete $self->{plugins}->{$type};
+      },
+   );
+
+   # Reconfigure the commands module for the first time, so it collects
+   # command registrations
+   $plugins{commands}->reconfigure;
+
+   $self->run_plugins( "connect" );
+
+   return $self;
+}
+
+use overload '""' => "STRING";
+
+sub STRING
+{
+   my $self = shift;
+   return __PACKAGE__."[tag=$self->{tag}]";
+}
+
+sub reconfigure
+{
+   my $self = shift;
+   my ( $config ) = @_;
+
+   # Now reconfigure the standard builtin plugins
+   for my $builtin_name ( @builtins ) {
+      if( exists $self->{plugins}->{$builtin_name} ) {
+         my $builtin = $self->{plugins}->{$builtin_name};
+         $builtin->reconfigure( $config ) if $builtin->can( "reconfigure" );
+      }
+      else {
+         my $builtin_class = $builtin_package{$builtin_name};
+         ( my $builtin_file = "$builtin_class.pm" ) =~ s{::}{/};
+
+         require $builtin_file;
+
+         $self->{plugins}->{$builtin_name} = $builtin_class->new( $self, $config );
+      }
+   }
+}
+
+sub load_plugin
+{
+   my $self = shift;
+   my ( $type, $config ) = @_;
+
+   my $plugin = construct_plugin( $type, $self, $config );
+
+   $self->{plugins}->{$type} = $plugin;
+}
+
+sub get_plugin
+{
+   my $self = shift;
+   my ( $type ) = @_;
+
+   return $self->{plugins}->{$type} if exists $self->{plugins}->{$type};
+   return undef;
+}
+
+sub require_plugin
+{
+   my $self = shift;
+   my ( $type ) = @_;
+
+   return $self->{plugins}->{$type} if exists $self->{plugins}->{$type};
+   return $self->load_plugin( $type, undef );
+}
+
+sub plugins
+{
+   my $self = shift;
+   return values %{ $self->{plugins} };
+}
+
+sub run_plugins
+{
+   my $self = shift;
+   my ( $methods, @args ) = @_;
+
+   my $handled = 0;
+
+   my @methods = ref $methods eq "ARRAY" ? @$methods : ( $methods );
+
+   my @deferred;
+
+   {
+      local $self->{deferral_queue} = [];
+
+      foreach my $plugin ( $self->plugins ) {
+         METHOD: foreach my $method ( @methods ) {
+            if( $plugin->can( $method ) ) {
+               my $ret = eval { $plugin->$method( @args ) };
+
+               if( !defined $ret and $@ ) {
+                  $self->err( "Plugin $plugin failed - $@" );
+               }
+
+               $handled = 1 if $ret;
+
+               last METHOD;
+            }
+         }
+      }
+
+      @deferred = @{ $self->{deferral_queue} };
+   }
+
+   foreach my $d ( @deferred ) {
+      $self->run_plugins( @$d );
+   }
+
+   return $handled;
+}
+
+sub run_plugins_after
+{
+   my $self = shift;
+   my ( $methods, @args ) = @_;
+
+   if( $self->{deferral_queue} ) {
+      push @{ $self->{deferral_queue} }, [ $methods, @args ];
+   }
+   else {
+      # Just run it directly
+      $self->run_plugins( $methods, @args );
+   }
+}
+
+sub ask_plugins
+{
+   my $self = shift;
+   my ( $method, @args ) = @_;
+
+   foreach my $plugin ( $self->plugins ) {
+      if( $plugin->can( $method ) ) {
+         my $ret = eval { $plugin->$method( @args ) };
+
+         if( !defined $ret and $@ ) {
+            $self->err( "Plugin $plugin failed - $@" );
+         }
+
+         return $ret if defined $ret;
+      }
+   }
+
+   return undef;
+}
+
+sub ask_plugins_list
+{
+   my $self = shift;
+   my ( $method, @args ) = @_;
+
+   my @answer;
+
+   foreach my $plugin ( $self->plugins ) {
+      if( $plugin->can( $method ) ) {
+         my @ret = eval { $plugin->$method( @args ) };
+
+         if( $@ ) {
+            $self->err( "Plugin $plugin failed - $@" );
+         }
+
+         push @answer, @ret;
+      }
+   }
+
+   return @answer;
+}
+
+sub scatter_plugins
+{
+   my $self = shift;
+   my ( $on_finished, $method, @args ) = @_;
+
+   my %results;
+   my %later;
+   my $ready = 0;
+
+   foreach my $pluginname ( keys %{ $self->{plugins} } ) {
+      my $plugin = $self->{plugins}->{$pluginname};
+      if( $plugin->can( $method ) ) {
+         my $will_async = 0;
+
+         my $gencb = sub {
+            $will_async = 1;
+
+            $later{$pluginname} = 1;
+
+            return sub {
+               $results{$pluginname} = shift;
+               delete $later{$pluginname};
+               $on_finished->( %results ) if $ready and not keys %later;
+            };
+         };
+
+         my $ret = eval { $plugin->$method( $gencb, @args ) };
+
+         if( $@ ) {
+            $self->err( "Plugin $plugin failed - $@" );
+            delete $later{$pluginname}; # So we won't wait for it
+            next;
+         }
+
+         if( not $will_async and defined $ret ) {
+            $results{$pluginname} = $ret;
+         }
+      }
+   }
+
+   $ready = 1;
+   $on_finished->( %results ) if not keys %later;
+}
+
+sub get_loop
+{
+   my $self = shift;
+   return $self->{loop};
+}
+
+# One shared console
+our $console;
+our $tickit;
+
+sub get_console
+{
+   my $self = shift;
+
+   return $console if $console;
+
+   require Tickit::Async;
+   require CelBot::Console;
+
+   $tickit = Tickit::Async->new;
+   $self->get_loop->add( $tickit );
+
+   $console = CelBot::Console->new;
+   $tickit->set_root_widget( $console );
+
+   $tickit->setup_term;
+
+   my $globaltab = $console->{globaltab};
+
+   $SIG{__WARN__} = sub {
+      return unless defined $console;
+      my $message = $_[0];
+      chomp $message;
+      $globaltab->add_line( "WARN: $message", indent => 6 );
+   };
+
+   return $console;
+}
+
+sub log
+{
+   my $self = shift;
+   my ( $tag, $subject, $message ) = @_;
+
+   chomp $message;
+
+   $self->run_plugins( "do_log", $tag, $subject, $message );
+}
+
+sub err
+{
+   my $self = shift;
+   my ( $message ) = @_;
+
+   $self->run_plugins( "do_log", "ERR", "ERR", $message );
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/IRC.pm

@@ -0,0 +1,436 @@
+package CelBot::IRC;
+
+use strict;
+
+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 );
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+   }, $class;
+
+   my $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",
+   );
+
+   $core->get_loop->add( $irc );
+   $self->{irc} = $irc;
+
+   $self->{core} = $core;
+   $self->{config} = $config;
+
+   $self->{server_index} = 0;
+   $self->{connect_errors} = 0;
+
+   $self->reconfigure( $config );
+
+   return $self;
+}
+
+sub reconfigure
+{
+   my $self = shift;
+   my ( $config ) = @_;
+
+   my @servers = $config->get_list(
+      'server',
+      { port => '@port', host => '@host' },
+      default => { port => 6667 }
+   );
+
+   $self->{servers} = \@servers;
+
+   my $irc = $self->{irc};
+   $irc->{pingtime} = $config->get_string( '@pingtime', default => 60 );
+   $irc->{pongtime} = $config->get_string( '@pongtime', default => 10 );
+
+   $self->{reconn_delay} = $config->get_string( '@reconn_delay', default => 180 );
+}
+
+sub connect
+{
+   my $self = shift;
+
+   my $server = $self->{servers}->[$self->{server_index}];
+
+   my $host = $server->{host};
+   my $port = $server->{port};
+
+   my $core = $self->{core};
+
+   my $config = $self->{config};
+
+   if( $self->{is_connected} ) {
+      $core->err( "No point reconnecting $self as it's already connected" );
+      return;
+   }
+
+   $core->log( "CONN", "<Conn>", "Connecting to $host:$port" );
+
+   my $irc = $self->{irc};
+   $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 ) = @_;
+
+         $self->{is_connected} = 1;
+         $self->{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 );
+      }
+   );
+}
+
+sub is_connected
+{
+   my $self = shift;
+   return $self->{is_connected};
+}
+
+sub on_connect_error
+{
+   my $self = shift;
+   my ( %args ) = @_;
+
+   my $core = $self->{core};
+
+   my $reconn_delay = $self->{reconn_delay};
+
+   if( $self->{connect_errors} < scalar @RECONN_DELAYS ) {
+      $reconn_delay = $RECONN_DELAYS[$self->{connect_errors}];
+   }
+
+   $self->{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 $self->{connect_errors} > 3 ) {
+      $self->{server_index}++;
+      $self->{server_index} %= scalar @{ $self->{servers} };
+   }
+
+   if( $reconn_delay ) {
+      $core->log( "CONN", "<Conn>: ", "Need to reconnect to server [$self->{server_index}] after $reconn_delay seconds" );
+      my $core = $self->{core};
+      my $loop = $core->get_loop;
+      $loop->enqueue_timer(
+         delay => $reconn_delay,
+         code  => sub { $self->connect },
+      );
+   }
+   else {
+      $self->connect;
+   }
+}
+
+sub on_closed
+{
+   my $self = shift;
+
+   my $core = $self->{core};
+
+   $self->{is_connected} = 0;
+
+   if( $self->{on_disconnected} ) {
+     $self->{on_disconnected}->();
+     delete $self->{on_disconnected};
+   }
+   else {
+      $core->err( "Unexpected disconnect" );
+      $self->on_connect_error;
+   }
+}
+
+sub disconnect
+{
+   my $self = shift;
+   my %args = @_;
+
+   my $message = $args{message};
+
+   $self->send_message( "QUIT", undef, $message );
+
+   $self->{on_disconnected} = $args{on_disconnected};
+}
+
+sub shutdown
+{
+   my $self = shift;
+
+   my $core = $self->{core};
+   my $loop = $core->get_loop;
+
+   $self->disconnect(
+      on_disconnected => sub { $loop->remove( $self->{conn} ) },
+   );
+}
+
+sub on_irc_message
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   return if $hints->{handled};
+
+   my $core = $self->{core};
+
+   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 );
+
+   my @args = $message->args;
+   $core->log( "INFO", "<Message>", "$command @args" ) unless $hints->{synthesized};
+   return 0;
+}
+
+sub on_ping_timeout
+{
+   my $self = shift;
+
+   my $core = $self->{core};
+
+   $core->log( "ERR", "<Error>", "PONG timer expired - reconnecting" );
+   
+   # TODO: Close the old connection
+   $self->connect;
+}
+
+sub is_me
+{
+   my $self = shift;
+   my ( $nick ) = @_;
+   return $self->is_nick_me( $nick );
+}
+
+sub get_users_plugin
+{
+   my $self = shift;
+   my $core = $self->{core};
+   return $core->get_plugin( "users" );
+}
+
+sub get_user
+{
+   my $self = shift;
+   my ( $nick ) = @_;
+   return $self->get_users_plugin->get_user( $nick );
+}
+
+sub get_user_me
+{
+   my $self = shift;
+   return $self->get_user( $self->{irc}->nick );
+}
+
+sub get_users
+{
+   my $self = shift;
+   return $self->get_users_plugin->get_users;
+}
+
+sub nick_to_user
+{
+   my $self = shift;
+   my ( $nick ) = @_;
+   return $self->get_users_plugin->nick_to_user( $nick );
+}
+
+sub hints_to_user
+{
+   my $self = shift;
+   return $self->get_users_plugin->hints_to_user( @_ );
+}
+
+sub get_channels_plugin
+{
+   my $self = shift;
+   my $core = $self->{core};
+   return $core->get_plugin( "channels" );
+}
+
+sub get_channel
+{
+   my $self = shift;
+   my ( $name ) = @_;
+   return $self->get_channels_plugin->get_channel( $name );
+}
+
+sub get_channels
+{
+   my $self = shift;
+   return $self->get_channels_plugin->get_channels;
+}
+
+# There are a number of methods we want to reflect to the irc object
+foreach my $method ( qw(
+      send_message
+      casefold_name
+      is_nick_me
+      cmp_prefix_flags
+      cmp_prefix_modes
+      prefix_mode2flag
+      prefix_flag2mode
+      isupport
+      ) ) {
+   no strict 'refs';
+   *{$method} = sub { 
+      my $self = shift;
+      my $irc = $self->{irc};
+      $irc->$method( @_ )
+   };
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $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",
+   );
+}
+
+sub command_reconnect
+{
+   my $self = shift;
+   my ( $contect, $quitmsg ) = @_;
+
+   $quitmsg = "Reconnecting..." if !defined $quitmsg;
+
+   $self->disconnect(
+      message => $quitmsg,
+      on_disconnected => sub { $self->connect },
+   );
+
+   return ( "OK" );
+}
+
+sub command_cycle
+{
+   my $self = shift;
+   my ( $contect, $quitmsg ) = @_;
+
+   $self->{server_index}++;
+   $self->{server_index} %= scalar @{ $self->{servers} };
+
+   $quitmsg = "Reconnecting..." if !defined $quitmsg;
+
+   $self->disconnect(
+      message => $quitmsg,
+      on_disconnected => sub { $self->connect },
+   );
+
+   return ( "OK" );
+}
+
+###
+# Settings
+###
+
+sub register_settings
+{
+   my $self = shift;
+   my ( $settings_plugin ) = @_;
+
+   $settings_plugin->register(
+      type => 'custom',
+      name => "servers",
+      perm => 'owner',
+
+      storage => $self->{servers},
+
+      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",
+   );
+}
+
+### Specific message handlers
+
+sub on_message_001 # Initial connect
+{
+   my $self = shift;
+
+   return 0; # Don't eat it
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/AccountManagement.pm

@@ -0,0 +1,397 @@
+package CelBot::Plugin::AccountManagement;
+
+use strict;
+use constant PLUGIN_TYPE => "account-management";
+
+use Carp;
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+      irc  => $core->get_plugin( "irc" ),
+      userdb => $core->get_plugin( "userdb" ),
+   }, $class;
+
+   return $self;
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   # First clear out all the existing ones
+   $self->{commands} = \my %commands;
+   $self->{privs}    = \my %privs;
+
+   my $core = $self->{core};
+   $core->run_plugins( "register_usermgmt_commands", $self );
+
+   # Now we have privs - generate 'grant' and 'revoke' commands
+   if( keys %privs ) {
+      my %grantcmds;
+      my %revokecmds;
+
+      foreach my $priv ( keys %privs ) {
+         my $grantcmd;
+         my $revokecmd;
+
+         my %args = %{ $privs{$priv} };
+
+         if( $args{appliesto} eq "channels" ) {
+            my $irc = $self->{irc};
+            my $channels = $irc->get_channels_plugin;
+
+            $args{args} = [
+               CelBot::Commands::ArgSpec::Options->new(
+                  {
+                     in => $channels->gen_argspec,
+                  }
+               ),
+            ];
+
+            $grantcmd = { %args,
+               function => sub {
+                  my $context = shift;
+                  $self->priv_delegate_channels( $context, $priv, 1, @_ );
+               },
+            };
+            $revokecmd = { %args,
+               function => sub {
+                  my $context = shift;
+                  $self->priv_delegate_channels( $context, $priv, undef, @_ );
+               },
+            };
+         }
+         else {
+            $grantcmd  = \%args;
+            $revokecmd = \%args;
+         }
+
+         $grantcmds{$priv}  = $grantcmd;
+         $revokecmds{$priv} = $revokecmd;
+      }
+
+      $self->register_command(
+        plugin   => $self,
+        command  => "privs",
+        perm     => 'recognised|self', # We'll do further checks later
+        needhandle => 1,
+
+        args => [],
+
+        summary => "List privileges granted to a user",
+      );
+
+      $self->register_command(
+         plugin  => $self,
+         command => "grant",
+         perm    => 'recognised', # We'll do further checks later
+         needhandle => 1,
+
+         funcname => "command_grant_priv",
+
+         subcmds => \%grantcmds,
+
+         summary => "Grant a privilege to a user",
+      );
+
+      $self->register_command(
+         plugin  => $self,
+         command => "revoke",
+         perm    => 'recognised', # We'll do further checks later
+         needhandle => 1,
+
+         funcname => "command_revoke_priv",
+
+         subcmds => \%revokecmds,
+
+         summary => "Revoke a privilege from a user",
+      );
+   }
+
+   # Now we have commands - work out what is valid for 'myacc' and 'useracc'
+   my %mycmds;
+   my %usercmds;
+
+   foreach my $cmdname ( keys %commands ) {
+      my $cmdstruct = $commands{$cmdname};
+
+      my @perms = split( m{\|}, $cmdstruct->{perm} );
+
+      if( grep { $_ eq "public" } @perms ) {
+         $mycmds{$cmdname} = { %$cmdstruct, perm => "public" };
+      }
+      elsif( grep { $_ eq "self" } @perms ) {
+         $mycmds{$cmdname} = { %$cmdstruct, perm => "recognised" };
+      }
+
+      $usercmds{$cmdname} = $cmdstruct;
+   }
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "myacc",
+      perm    => 'recognised',
+
+      funcname => "command_useracc",
+
+      subcmds => \%mycmds,
+      default => "help",
+
+      checkfunc => sub { $self->check_myacc( @_ ) },
+
+      summary => "Manage your user account",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "useracc",
+      perm    => 'recognised',
+
+      subcmds => \%usercmds,
+      default => "help",
+
+      checkfunc => sub { $self->check_useracc( @_ ) },
+
+      summary => "Manage other users' accounts",
+   );
+}
+
+sub register_command
+{
+   my $self = shift;
+   my %args = @_;
+
+   my $command = delete $args{command} or croak "Need a 'command'";
+
+   exists $self->{commands}->{$command} and croak "Usermanagement command '$command' already registered";
+
+   $args{needhandle} = 1 unless defined $args{needhandle};
+
+   $self->{commands}->{$command} = \%args;
+}
+
+sub register_priv
+{
+   my $self = shift;
+   my %args = @_;
+
+   my $priv = delete $args{priv} or croak "Need a 'priv'";
+
+   $self->{privs}->{$priv} = \%args;
+}
+
+sub check_myacc
+{
+   my $self = shift;
+   my ( $context, $cmdstruct, $substruct ) = @_;
+
+   my $user = $context->cmduser;
+
+   if( !defined $user ) {
+      $context->respond_noise( "You cannot run this account management command" );
+      return 0;
+   }
+
+   my $handle = $user->{handle};
+
+   if( !defined $handle ) {
+      $context->respond_noise( "You cannot run this account management command because you are not recognised" );
+      return 0;
+   }
+
+   $context->{handle} = $handle;
+
+   return 1;
+}
+
+sub check_useracc
+{
+   my $self = shift;
+   my ( $context, $cmdstruct, $substruct ) = @_;
+
+   my $needhandle = $substruct->{needhandle};
+
+   return 1 unless $needhandle;
+
+   my $handle = $context->pull_token;
+
+   if( !defined $handle ) {
+      $context->respond_noise( "Need to supply a handle after the command name" );
+      return 0;
+   }
+
+   my $userdb = $self->{userdb};
+   if( not $userdb->exists_handle( $handle ) ) {
+      $context->respond_noise( "No such handle '$handle'" );
+      return 0;
+   }
+
+   $context->{handle} = $handle;
+
+   return 1;
+}
+
+sub priv_delegate_channels
+{
+   my $self = shift;
+   my ( $context, $priv, $value, $options ) = @_;
+
+   # This is a generic function for both grant and revoke; need some words for
+   # messages
+   my $verb_imp  = $value ? "grant" : "revoke";
+   my $verb_past = $value ? "granted" : "revoked";
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+
+   my $ret;
+
+   if( my $chan = $options->{in} ) {
+      my $channame = $chan->name;
+      my $already_has;
+
+      if( !$value ) {
+         $already_has = $core->ask_plugins( "ask_handle_global_data", $handle, $priv );
+         if( $already_has ) {
+            $context->respond( "Revoking $priv from $handle in $channame will not take effect as it is granted globally" );
+         }
+      }
+
+      $already_has = $core->ask_plugins( "ask_handle_channel_data", $handle, $channame, $priv );
+      if( $already_has and $value ) {
+         return "$handle already has $priv in $channame";
+      }
+      elsif( !$already_has and !$value ) {
+         return "$handle does not have $priv in $channame";
+      }
+
+      $core->run_plugins( "do_handle_set_channel_data", $handle, $channame, $priv, $value );
+      $ret = ucfirst($verb_past) . " $handle $priv in $channame";
+   }
+   else {
+      my $already_has = $core->ask_plugins( "ask_handle_global_data", $handle, $priv );
+      if( $already_has and $value ) {
+         return "$handle already has $priv globally";
+      }
+      elsif( !$already_has and !$value ) {
+         return "$handle does not have $priv globally";
+      }
+
+      $core->run_plugins( "do_handle_set_global_data", $handle, $priv, $value );
+      $ret = ucfirst($verb_past) . " $handle $priv globally";
+   }
+
+   my $privstruct = $self->{privs}->{$priv};
+   if( my $func = $privstruct->{after_priv} ) {
+      $func->( $context, $value, $options );
+   }
+
+   return $ret;
+}
+
+sub get_useracc_privs
+{
+   my $self = shift;
+   my ( $handle ) = @_;
+
+   my $core = $self->{core};
+
+   my @global_privs;
+   my %channel_privs;
+
+   foreach my $priv ( sort keys %{ $self->{privs} } ) {
+      my $chanhash = $core->ask_plugins( "ask_handle_channels_data", $handle, $priv );
+      push @global_privs, $priv if delete $chanhash->{global};
+      foreach my $channel ( keys %$chanhash ) {
+         push @{ $channel_privs{$channel} }, $priv if $chanhash->{$channel};
+      }
+   }
+
+   return \@global_privs, \%channel_privs;
+}
+
+sub command_useracc_privs
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my ( $global_privs, $channel_privs ) = $self->get_useracc_privs( $handle );
+
+   my @ret = @$global_privs ? "Global privs for $handle: " . join( " ", @$global_privs )
+                            : "No global privs for $handle";
+
+   foreach my $chan ( sort keys %$channel_privs ) {
+      push @ret, "  $chan: " . join( " ", @{ $channel_privs->{$chan} } ) if @{ $channel_privs->{$chan} };
+   }
+
+   return @ret;
+}
+
+sub get_useracc_for_display
+{
+   my $self = shift;
+   my ( $handle, $ret ) = @_;
+
+   my ( $global_privs, $channel_privs ) = $self->get_useracc_privs( $handle );
+
+   my @ret = @$global_privs ? "Privs: " . join( " ", @$global_privs )
+                            : "No global privs";
+
+   foreach my $chan ( sort keys %$channel_privs ) {
+      push @ret, "  $chan: " . join( " ", @{ $channel_privs->{$chan} } ) if @{ $channel_privs->{$chan} };
+   }
+
+   $ret->{privs} = \@ret;
+   return 1;
+}
+
+###
+# Internal Commands
+###
+
+sub register_usermgmt_commands
+{
+   my $self = shift;
+   my ( $usermgmt_plugin ) = @_;
+
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "help",
+      perm    => 'public',
+      needhandle => 0,
+
+      args => [],
+
+      summary => "Obtain additional help on user account management commands",
+   );
+}
+
+sub command_useracc_help
+{
+   my $self = shift;
+
+   my $commands = $self->{commands};
+
+   return (
+      q{Manage a user account},
+      q{Usage: myacc $command $args...},
+      q{       useracc $command [$handle] $args...},
+      q{For more information, see 'help myacc' or 'help useracc'},
+   );
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/AutoMode.pm

@@ -0,0 +1,240 @@
+package CelBot::Plugin::AutoMode;
+
+use strict;
+use constant PLUGIN_TYPE => "automode";
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+      irc  => $core->get_plugin( "irc" ),
+   }, $class;
+
+   return $self;
+}
+
+my %mode_priv = (
+   o => "op",
+   h => "halfop",
+   v => "voice",
+);
+
+sub channel_occupant
+{
+   my $self = shift;
+   my ( $channel, $user ) = @_;
+
+   my $irc = $self->{irc};
+
+   my $me = $irc->get_user_me;
+   my $myflag = $channel->get_userflag( $me );
+
+   my $i_am_op = $irc->cmp_prefix_flags( $myflag, '@' ) >= 0;
+   return unless $i_am_op;
+
+   my $userflag = $channel->get_userflag( $user );
+
+   my $core = $self->{core};
+
+   foreach my $mode ( qw( o h v ) ) {
+      next unless $core->ask_plugins( "permit_user_channel_priv", $user, $channel, $mode_priv{$mode} );
+
+      my $flag = $irc->prefix_mode2flag( $mode );
+      if( $irc->cmp_prefix_flags( $userflag, $flag ) < 0 ) {
+         $channel->mode( "+$mode", $user->nick, 1 );
+         last;
+      }
+   }
+}
+
+sub remode_channel
+{
+   my $self = shift;
+   my ( $channel ) = @_;
+
+   foreach my $occupant ( $channel->get_users ) {
+      $self->channel_occupant( $channel, $occupant );
+   }
+}
+
+sub remode_user
+{
+   my $self = shift;
+   my ( $user ) = @_;
+
+   foreach my $channel ( $user->channels ) {
+      $self->channel_occupant( $channel, $user );
+   }
+}
+
+sub on_channel_join
+{
+   my $self = shift;
+   my ( $channel, $user ) = @_;
+
+   $self->channel_occupant( $channel, $user );
+}
+
+sub on_channel_usermode
+{
+   my $self = shift;
+   my ( $channel, $user, $sense, $flag ) = @_;
+
+   return unless $user->is_me;
+
+   my $irc = $self->{irc};
+
+   my $myflag = $channel->get_userflag( $irc->get_user_me );
+   my $i_am_op = $irc->cmp_prefix_flags( $myflag, '@' ) >= 0;
+
+   return 1 unless $i_am_op;
+
+   $self->remode_channel( $channel );
+
+   return 1;
+}
+
+sub on_channel_who
+{
+   my $self = shift;
+   my ( $channel, @who ) = @_;
+
+   my $irc = $self->{irc};
+
+   my $myflag = $channel->get_userflag( $irc->get_user_me );
+   my $i_am_op = $irc->cmp_prefix_flags( $myflag, '@' ) >= 0;
+
+   return 1 unless $i_am_op;
+
+   $self->remode_channel( $channel );
+
+   return 1;
+}
+
+sub on_recognise_user
+{
+   my $self = shift;
+   my ( $user, $handle ) = @_;
+
+   $self->remode_user( $user );
+}
+
+sub permit_user_channel_priv
+{
+   my $self = shift;
+   my ( $user, $channel, $priv ) = @_;
+
+   return 1 if $user->get_channel_data( $channel, $priv );
+   return undef;
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   my $irc = $self->{irc};
+   my $users    = $irc->get_users_plugin;
+   my $channels = $irc->get_channels_plugin;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "remodeuser",
+      perm    => 'master',
+
+      args => [
+         $users->gen_argspec,
+      ],
+
+      summary => "Reapply automode for a given user",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "remodechan",
+      perm    => 'master', # probably should be channel master one day when we have such ability
+
+      args => [
+         $channels->gen_argspec,
+      ],
+
+      summary => "Reapply automode for a given channel",
+   );
+}
+
+sub command_remodeuser
+{
+   my $self = shift;
+   my ( $context, $user ) = @_;
+
+   $self->remode_user( $user );
+
+   return ( "OK" );
+}
+
+sub command_remodechan
+{
+   my $self = shift;
+   my ( $context, $channel ) = @_;
+
+   $self->remode_channel( $channel );
+
+   return ( "OK" );
+}
+
+sub register_usermgmt_commands
+{
+   my $self = shift;
+   my ( $usermgmt_plugin ) = @_;
+
+   my $core = $self->{core};
+
+   my $after_priv = sub {
+      my ( $context, $value, $options ) = @_;
+      return unless $value;
+
+      my $handle = $context->{handle};
+      my @users = $core->ask_plugins_list( "ask_map_handle_to_users", $handle, 1 );
+
+      return unless @users;
+
+      if( my $channel = $options->{in} ) {
+         $self->channel_occupant( $channel, $_ ) foreach @users;
+      }
+      else {
+         $self->remode_user( $_ ) foreach @users;
+      }
+   };
+
+   $usermgmt_plugin->register_priv(
+      priv => "op",
+      perm => 'master',
+
+      appliesto => "channels",
+
+      after_priv => $after_priv,
+
+      summary => "Channel operator status",
+   );
+
+   $usermgmt_plugin->register_priv(
+      priv => "halfop",
+      perm => 'master',
+
+      appliesto => "channels",
+
+      after_priv => $after_priv,
+
+      summary => "Channel half-operator status",
+   );
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/Console.pm

@@ -0,0 +1,98 @@
+package CelBot::Plugin::Console;
+
+use strict;
+use constant PLUGIN_TYPE => "console";
+
+use base qw( CelBot::Plugin::LogBase );
+
+use String::Tagged;
+
+use POSIX qw( strftime );
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $console = $core->get_console;
+   my $tab = $console->add_tab( 
+      name => $core->{tag},
+
+      on_line => sub {
+         my ( $console, $line ) = @_;
+         eval {
+            $core->run_plugins( "on_console_line", $console->active_tab, $line );
+            1;
+         } or warn "Unable to 'on_line' - $@";
+      }
+   );
+
+   my $self = bless {
+      core => $core,
+      tab  => $tab,
+   }, $class;
+
+   return $self;
+}
+
+sub do_log_really
+{
+   my $self = shift;
+   my ( $subject, $message ) = @_;
+
+   if( $message =~ m/[\x00-\x1f]/ ) {
+      my $st = String::Tagged->new( $message );
+      while( $message =~ m/([\x00-\x1f])/g ) {
+         $st->set_substr( $-[1], 1, chr( 64 + ord $1 ) );
+         $st->apply_tag( $-[1], 1, rv => 1 );
+      }
+      $message = $st;
+   }
+
+   my $timestamp = strftime( "%H:%M", localtime );
+
+   my $tab = $self->{tab};
+   $tab->add_line( "[$timestamp]: $subject - " . $message, indent => 9 );
+}
+
+sub permit_command_scope
+{
+   my $self = shift;
+   my ( $scope, $context ) = @_;
+
+   # Anything is always allowed on the console
+   if( $context->scope eq 'console' ) {
+      return 1;
+   }
+
+   return undef;
+}
+
+sub permit_command_perm
+{
+   my $self = shift;
+   my ( $perm, $context ) = @_;
+
+   # Anything is always allowed on the console if there's no user
+   if( $context->scope eq 'console' and not defined $context->cmduser ) {
+      return 1;
+   }
+
+   return undef;
+}
+
+sub permit_command_nonpublic
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   # Anything is always allowed on the console if there's no user
+   if( $context->scope eq 'console' and not defined $context->cmduser ) {
+      return 1;
+   }
+
+   return undef;
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/Debug.pm

@@ -0,0 +1,268 @@
+package CelBot::Plugin::Debug;
+
+use strict;
+use constant PLUGIN_TYPE => "debug";
+
+use CelBot::Commands;
+
+use Data::Dump qw( dump );
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+      eval_enabled => 0,
+   }, $class;
+
+   return $self;
+}
+
+sub print_channel_occupants
+{
+   my $self = shift;
+   my ( $channel, $userflags ) = @_;
+
+   my $core = $self->{core};
+
+   $userflags ||= $channel->get_userflags;
+
+   my $str = $channel->name . " occupants:";
+   $str .= join( " ", map { ($userflags->{$_}||"") . $_ } sort keys %$userflags );
+
+   $core->log( "DEBUG", "<Debug>", $str );
+}
+
+sub on_channel_mode
+{
+   my $self = shift;
+   my ( $channel, $modechar, $value ) = @_;
+
+   my $core = $self->{core};
+
+   if( defined $value ) {
+      $core->log( "DEBUG", "<Debug>", "MODE: channel ".$channel->name." +$modechar $value" );
+   }
+   else {
+      $core->log( "DEBUG", "<Debug>", "MODE: channel ".$channel->name." -$modechar" );
+   }
+
+   my $str = "MODE is now\n";
+   my $modes = $channel->get_modes;
+   $str .= "  $_ = $modes->{$_}\n" for sort keys %$modes;
+   $core->log( "DEBUG", "<Debug>", $str );
+}
+
+sub on_channel_usermode
+{
+   my $self = shift;
+   my ( $channel, $user, $flag ) = @_;
+
+   my $core = $self->{core};
+
+   if( defined $flag ) {
+      $core->log( "DEBUG", "<Debug>", "MODE: channel ".$channel->name." ".$user->nick." => $flag" );
+   }
+   else {
+      $core->log( "DEBUG", "<Debug>", "MODE: channel ".$channel->name." ".$user->nick." X" );
+   }
+
+   # $self->print_channel_occupants( $channel );
+}
+
+sub on_channel_names
+{
+   my $self = shift;
+   my ( $channel, $usermodes ) = @_;
+
+   $self->print_channel_occupants( $channel, $usermodes );
+}
+
+sub on_channel_topic
+{
+   my $self = shift;
+   my ( $channel, $topic, $setby ) = @_;
+
+   my $core = $self->{core};
+
+   if( defined $setby ) {
+      $core->log( "DEBUG", "<Debug>", "TOPIC: channel ".$channel->name." by $setby\n  $topic" );
+   }
+   else {
+      $core->log( "DEBUG", "<Debug>", "TOPIC: channel ".$channel->name."\n  $topic" );
+   }
+}
+
+sub on_channel_join
+{
+   my $self = shift;
+   my ( $channel, $user ) = @_;
+
+   my $core = $self->{core};
+
+   $core->log( "DEBUG", "<Debug>", "JOIN: channel ".$channel->name." ".$user->nick );
+
+   # $self->print_channel_occupants( $channel );
+}
+
+sub on_channel_leave
+{
+   my $self = shift;
+   my ( $channel, $user, $command, $reason ) = @_;
+
+   my $core = $self->{core};
+
+   $core->log( "DEBUG", "<Debug>", "LEAVE: channel ".$channel->name." ".$user->nick." - $command ($reason)" );
+
+   # $self->print_channel_occupants( $channel );
+}
+
+sub on_user_create
+{
+   my $self = shift;
+   my ( $user ) = @_;
+
+   my $core = $self->{core};
+
+   $core->log( "DEBUG", "<Debug>", "CREATE: user ".$user->nick );
+}
+
+sub on_user_quit
+{
+   my $self = shift;
+   my ( $user, $reason ) = @_;
+
+   my $core = $self->{core};
+
+   $core->log( "DEBUG", "<Debug>", "QUIT: user ".$user->nick." ($reason)" );
+}
+
+sub on_user_rename
+{
+   my $self = shift;
+   my ( $user, $oldnick, $newnick ) = @_;
+
+   my $core = $self->{core};
+
+   $core->log( "DEBUG", "<Debug>", "NICK: user $oldnick -> $newnick" );
+}
+
+sub on_user_host
+{
+   my $self = shift;
+   my ( $user, $ident, $host ) = @_;
+
+   my $core = $self->{core};
+
+   $core->log( "DEBUG", "<Debug>", "HOST: user ".$user->nick." ident=$ident host=$host" );
+}
+
+sub on_recognise_user
+{
+   my $self = shift;
+   my ( $user, $handle ) = @_;
+
+   my $core = $self->{core};
+
+   $core->log( "DEBUG", "<Debug>", "RECOGNISE: ".$user->nick." (".$user->location.") is $handle" );
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "debug",
+      perm    => 'owner',
+
+      subcmds => {
+         eval => {
+            scope => 'console',
+
+            args => [
+               CelBot::Commands::ArgSpec->new( 'EXPR', trailing => 1 ),
+            ],
+
+            summary => "Evaluate a Perl expression",
+         },
+      },
+
+      summary => "Debugging introspection system",
+   );
+}
+
+sub command_debug
+{
+   my $self = shift;
+   my ( $context, $subcmd ) = @_;
+
+   my $method = "command_debug_$subcmd";
+   if( $self->can( $method ) ) {
+      return $self->$method( $context );
+   }
+   else {
+      return ( "No such debugging command '$subcmd'" );
+   }
+}
+
+sub command_debug_eval
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   return "EVAL disabled" unless $self->{eval_enabled};
+
+   my $core = $self->{core};
+   my $irc = $core->get_plugin( "irc" );
+
+   # Some useful functions to keep in scope
+   local *CORE = sub { $core };
+   local *IRC  = sub { $irc };
+   local *CHAN = sub { $irc->get_channel( shift ) };
+   local *USER = sub { $irc->get_user( shift ) };
+   local *PLUGIN = sub { $core->get_plugin( shift ) };
+
+   my $result = eval $context->text;
+   if( $@ ) {
+      # Might be many lines - trim just the first three at most
+      my @lines = split( m/\n/, $@ );
+      @lines = @lines[0..3] if @lines > 3;
+      return ( "Died: " . join( "\n", @lines ) );
+   }
+   else {
+      my @lines = split( m/\n/, dump( $result ) );
+      if( @lines > 20 ) {
+         @lines = ( @lines[0..18], "...", $lines[-1] );
+      }
+      return @lines;
+   }
+}
+
+###
+# Settings
+###
+
+sub register_settings
+{
+   my $self = shift;
+   my ( $settings_plugin ) = @_;
+
+   $settings_plugin->register(
+      type    => 'boolean',
+      name    => "eval_enabled",
+      perm    => 'owner',
+
+      storage => \$self->{eval_enabled},
+   );
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/Flood.pm

@@ -0,0 +1,129 @@
+package CelBot::Plugin::Flood;
+
+use strict;
+use constant PLUGIN_TYPE => "flood";
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my %channels;
+
+   my $self = bless {
+      core => $core,
+      irc  => $core->get_plugin( "irc" ),
+      channels => \%channels,
+   }, $class;
+
+   $config->associate_nodeset(
+      'channel',
+      '@name',
+
+      add => sub {
+         my ( $name, $config ) = @_;
+
+         $channels{$name} = {},
+         $self->reconfigure_channel( $channels{$name}, $config );
+      },
+
+      keep => sub {
+         my ( $name, $config ) = @_;
+
+         $self->reconfigure_channel( $channels{$name}, $config );
+      },
+
+      remove => sub {
+         my ( $name ) = @_;
+
+         delete $channels{$name};
+      },
+   );
+
+   return $self;
+}
+
+sub reconfigure_channel
+{
+   my $self = shift;
+   my ( $channelstruct, $config ) = @_;
+
+   $channelstruct->{scores} = {};
+
+   $channelstruct->{score_old} = $config->get_string( '@score_old', default => 5  );
+   $channelstruct->{score_new} = $config->get_string( '@score_new', default => 10 );
+
+   $channelstruct->{limit}     = $config->get_string( '@limit', default => 30 );
+}
+
+sub decay_scores
+{
+   my $self = shift;
+   my ( $channelstruct, $now ) = @_;
+
+   my $scores = $channelstruct->{scores};
+   my $times  = $channelstruct->{times};
+
+   foreach my $nick ( keys %$scores ) {
+      my $newscore = $scores->{$nick} - ( $now - $times->{$nick} );
+      if( $newscore > 0 ) {
+         $scores->{$nick} = $newscore;
+         $times->{$nick}  = $now;
+      }
+      else {
+         delete $scores->{$nick};
+         delete $times->{$nick};
+      }
+   }
+}
+
+sub on_channel_privmsg
+{
+   my $self = shift;
+   my ( $channel, $user, $text ) = @_;
+
+   my $channame = $channel->name;
+
+   return 0 unless exists $self->{channels}->{$channame};
+   my $channelstruct = $self->{channels}->{$channame};
+
+   my $now = time();
+
+   $self->decay_scores( $channelstruct, $now );
+
+   my $joined_since = $now - ( $channel->get_jointime( $user ) || 0 );
+   my $score_inc = $joined_since > 60 ? $channelstruct->{score_old} : $channelstruct->{score_new};
+
+   my $nick = $user->nick_folded;
+
+   my $score_now = ( $channelstruct->{scores}->{$nick} += $score_inc );
+   $channelstruct->{times}->{$nick}  = $now;
+
+   if( $score_now > $channelstruct->{limit} ) {
+      $channel->kick( $user, "Flood (score: $score_now)" );
+   }
+}
+
+sub on_user_rename
+{
+   my $self = shift;
+   my ( $user, $oldnick, $newnick ) = @_;
+
+   my $irc = $self->{irc};
+   my $oldnick_folded = $irc->casefold_name( $oldnick );
+
+   my $newnick_folded = $user->nick_folded;
+
+   foreach my $channel ( keys %{ $self->{channels} } ) {
+      my $scores = $self->{channels}->{$channel}->{scores};
+      my $times  = $self->{channels}->{$channel}->{times};
+
+      next unless exists $scores->{$oldnick_folded};
+
+      $scores->{$newnick_folded} = delete $scores->{$oldnick_folded};
+      $times->{$newnick_folded}  = delete $times->{$oldnick_folded};
+   }
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/Hostmasks.pm

@@ -0,0 +1,273 @@
+package CelBot::Plugin::Hostmasks;
+
+use strict;
+use constant PLUGIN_TYPE => "hostmasks";
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $irc = $core->get_plugin( "irc" );
+
+   my $self = bless {
+      core => $core,
+      irc  => $irc,
+   }, $class;
+
+   return $self;
+}
+
+sub scatter_user_verify_handle
+{
+   my $self = shift;
+   my ( $gencb, $user, $handle ) = @_;
+
+   my $core = $self->{core};
+   my $hostmasks = $core->ask_plugins( "ask_handle_data", $handle, "hostmasks" );
+
+   return 0 unless $hostmasks and @$hostmasks;
+
+   my $location = $user->location;
+
+   foreach my $hostmask ( @$hostmasks ) {
+      my $re = mask_to_re( $hostmask );
+
+      return 1 if $location =~ m/^$re$/;
+   }
+
+   return 0;
+}
+
+## Utility functions
+sub mask_to_re
+{
+   my ( $mask ) = @_;
+
+   my $re = $mask;
+   $re =~ s{(\*\*|\*|\?|\.)}{
+      $1 eq "**" and ".*"    or
+      $1 eq "*"  and "[^.]*" or
+      $1 eq "?"  and "."     or
+      $1 eq "."  and "\\."
+   }eg;
+
+   return $re;
+}
+
+sub mask_to_re_for_mask
+{
+   my ( $mask ) = @_;
+
+   my $re = $mask;
+   $re =~ s{(\*\*|\*|\?|\.)}{
+      $1 eq "**" and ".*"               or
+      $1 eq "*"  and "[^.*]*\\*?[^.*]*" or
+      $1 eq "?"  and "."                or
+      $1 eq "."  and "\\."
+   }eg;
+
+   return $re;
+}
+
+sub on_handle_sync_from_user
+{
+   my $self = shift;
+   my ( $handle, $user, $cmdcontext ) = @_;
+
+   my $core = $self->{core};
+
+   my $newmask = $user->location; # TODO: Some consideration on wildcards?
+
+   my $hostmasks = $core->ask_plugins( "ask_handle_data", $handle, "hostmasks" ) || [];
+
+   if( @$hostmasks ) {
+      foreach my $hostmask ( @$hostmasks ) {
+         my $re = mask_to_re_for_mask( $hostmask );
+         if( $newmask =~ m/^$re$/ ) {
+            undef $newmask;
+            last;
+         }
+      }
+   }
+
+   if( defined $newmask ) {
+      $cmdcontext->respond( "Adding hostmask '$newmask' to $handle" );
+      push @$hostmasks, $newmask;
+      $core->run_plugins( "do_handle_set_data", $handle, "hostmasks", $hostmasks );
+   }
+
+   return 1;
+}
+
+###
+# Commands
+###
+
+sub register_usermgmt_commands
+{
+   my $self = shift;
+   my ( $usermgmt_plugin ) = @_;
+
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "hostmasks",
+      perm    => 'self|master',
+
+      subcmds => {
+         get => { 
+            args => [],
+            summary => "Show current list of hostmasks",
+         },
+
+         add => { 
+            args => [ CelBot::Commands::ArgSpec::Bareword->new( 'mask' ) ],
+            summary => "Add a new hostmask to the list, merging if necessary",
+         },
+
+         del => {
+            args => [ CelBot::Commands::ArgSpec::Bareword->new( 'mask' ) ],
+            summary => "Remove existing hostmask(s) from the list",
+         },
+
+         delall => {
+            args => [],
+            summary => "Remove all existing hostmask(s) from the list",
+         },
+      },
+      default => "get",
+
+      summary => "Adjust recognition hostmasks",
+   );
+}
+
+sub command_useracc_hostmasks_get
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my $hostmasks = $core->ask_plugins( "ask_handle_data", $handle, "hostmasks" );
+
+   return "No hostmasks for $handle" unless defined $hostmasks;
+   return "Hostmasks for $handle: " . join( ", ", @$hostmasks );
+}
+
+sub command_useracc_hostmasks_add
+{
+   my $self = shift;
+   my ( $context, $newmask ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my $hostmasks = $core->ask_plugins( "ask_handle_data", $handle, "hostmasks" ) || [];
+
+   if( @$hostmasks ) {
+      foreach my $hostmask ( @$hostmasks ) {
+         my $re = mask_to_re_for_mask( $hostmask );
+         if( $newmask =~ m/^$re$/ ) {
+            return "Not adding new mask $newmask as it is already matched by $hostmask";
+         }
+      }
+
+      if( $newmask =~ m/[*?]/ ) {
+         # Now see if we can remove any of the existing ones
+         my $newre = mask_to_re_for_mask( $newmask );
+         @$hostmasks = grep {
+            if( $_ =~ m/^$newre$/ ) {
+               $context->respond( "Removing mask $_ as it is covered by $newmask" );
+               0
+            }
+            else {
+               1
+            }
+         } @$hostmasks;
+      }
+   }
+
+   push @$hostmasks, $newmask;
+
+   $core->run_plugins( "do_handle_set_data", $handle, "hostmasks", $hostmasks );
+
+   $core->log( "AUDIT", "<Hostmasks>", ($context->cmduser||"[console]") . " changed $handle hostmasks to: " . join( ", ", @$hostmasks ) );
+
+   my @users = $core->ask_plugins_list( "ask_map_handle_to_users", $handle, 0 );
+   foreach my $user ( @users ) {
+      $user->{rerecognise} = 1;
+      my $irc = $self->{irc};
+      $irc->send_message( "WHOIS", undef, $user->nick );
+   }
+
+   return "New hostmasks for $handle: " . join( ", ", @$hostmasks );
+}
+
+sub command_useracc_hostmasks_del
+{
+   my $self = shift;
+   my ( $context, $oldmask ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my $hostmasks = $core->ask_plugins( "ask_handle_data", $handle, "hostmasks" );
+
+   if( !$hostmasks or !@$hostmasks ) {
+      return "No hostmasks to delete";
+   }
+
+   # TODO: Consideration of masks?
+   @$hostmasks = grep { $_ ne $oldmask } @$hostmasks;
+
+   $core->run_plugins( "do_handle_set_data", $handle, "hostmasks", $hostmasks );
+
+   $core->log( "AUDIT", "<Hostmasks>", ($context->cmduser||"[console]") . " changed $handle hostmasks to: " . join( ", ", @$hostmasks ) );
+
+   return "New hostmasks for $handle: " . join( ", ", @$hostmasks );
+}
+
+sub command_useracc_hostmasks_delall
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my $hostmasks = $core->ask_plugins( "ask_handle_data", $handle, "hostmasks" );
+
+   if( !$hostmasks or !@$hostmasks ) {
+      return "No hostmasks to delete";
+   }
+
+   @$hostmasks = ();
+
+   $core->run_plugins( "do_handle_set_data", $handle, "hostmasks", $hostmasks );
+
+   $core->log( "AUDIT", "<Hostmasks>", ($context->cmduser||"[console]") . " changed $handle hostmasks to: " . join( ", ", @$hostmasks ) );
+
+   return "New hostmasks for $handle: " . join( ", ", @$hostmasks );
+}
+
+sub get_useracc_for_display
+{
+   my $self = shift;
+   my ( $handle, $ret ) = @_;
+
+   my $core = $self->{core};
+   my $hostmasks = $core->ask_plugins( "ask_handle_data", $handle, "hostmasks" );
+
+   if( $hostmasks and @$hostmasks ) {
+      $ret->{hostmasks} = "Hostmasks: " . join( ", ", @$hostmasks );
+   }
+   else {
+      $ret->{hostmasks} = "No hostmasks";
+   }
+
+   return 1;
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/Infoline.pm

@@ -0,0 +1,215 @@
+package CelBot::Plugin::Infoline;
+
+use strict;
+use constant PLUGIN_TYPE => "infoline";
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+   }, $class;
+
+   return $self;
+}
+
+sub print_user_infoline
+{
+   my $self = shift;
+   my ( $user, $channel ) = @_;
+
+   my $infoline = $user->get_channel_data( $channel, "info" );
+
+   my $nick = $user->nick;
+
+   if( defined $infoline ) {
+      $channel->notice( "[$nick] $infoline" );
+   }
+}
+
+sub on_channel_join
+{
+   my $self = shift;
+   my ( $channel, $user ) = @_;
+
+   $self->print_user_infoline( $user, $channel );
+}
+
+sub on_recognise_user
+{
+   my $self = shift;
+   my ( $user, $handle ) = @_;
+
+   my $now = time();
+
+   foreach my $channel ( $user->channels ) {
+      if( $now - $channel->get_jointime( $user ) < 10 ) {
+         $self->print_user_infoline( $user, $channel );
+      }
+   }
+}
+
+###
+# Commands
+###
+
+sub register_usermgmt_commands
+{
+   my $self = shift;
+   my ( $usermgmt_plugin ) = @_;
+
+   my $core = $self->{core};
+   my $channels = $core->get_plugin( "channels" );
+
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "infoline",
+      perm    => 'self|master',
+
+      subcmds => {
+         get => {
+            args => [],
+            summary => "Show current infolines",
+         },
+
+         set => {
+            args => [
+               CelBot::Commands::ArgSpec::Bareword->new( 'text', eatall => 1 ),
+            ],
+            summary => "Set a global default infoline",
+         },
+
+         clear => {
+            args => [],
+            summary => "Remove global default infoline",
+         },
+
+         setchan => {
+            args => [
+               $channels->gen_argspec,
+               CelBot::Commands::ArgSpec::Bareword->new( 'text', eatall => 1 ),
+            ],
+            summary => "Set a per-channel infoline",
+         },
+
+         clearchan => {
+            args => [
+               $channels->gen_argspec,
+            ],
+            summary => "Remove a per-channel infoline",
+         },
+      },
+      default => "get",
+
+      summary => "Adjust channel announcement infolines",
+   );
+}
+
+sub command_useracc_infoline_get
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+
+   my $infolines = $core->ask_plugins( "ask_handle_channels_data", $handle, "info" );
+
+   my @ret;
+
+   my $global = delete $infolines->{global};
+   push @ret, defined $global ? "Global: $global" : "No global";
+
+   push @ret, "$_: $infolines->{$_}" for sort keys %$infolines;
+
+   return @ret;
+}
+
+sub command_useracc_infoline_set
+{
+   my $self = shift;
+   my ( $context, $text ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+
+   $core->run_plugins( "do_handle_set_global_data", $handle, "info", $text ) or
+      return "Not able to set data";
+
+   return "Set global infoline for $handle to '$text'";
+}
+
+sub command_useracc_infoline_clear
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+
+   $core->run_plugins( "do_handle_set_global_data", $handle, "info", undef ) or
+      return "Not able to set data";
+
+   return "Cleared global infoline for $handle";
+}
+
+sub command_useracc_infoline_setchan
+{
+   my $self = shift;
+   my ( $context, $channel, $text ) = @_;
+
+   my $handle = $context->{handle};
+   my $channame = $channel->name;
+
+   my $core = $self->{core};
+
+   $core->run_plugins( "do_handle_set_channel_data", $handle, $channame, "info", $text ) or
+      return "Not able to set data";
+
+   return "Set channel infoline in $channame for $handle to '$text'";
+}
+
+sub command_useracc_infoline_clearchan
+{
+   my $self = shift;
+   my ( $context, $channel ) = @_;
+
+   my $handle = $context->{handle};
+   my $channame = $channel->name;
+
+   my $core = $self->{core};
+
+   $core->run_plugins( "do_handle_set_channel_data", $handle, $channame, "info", undef ) or
+      return "Not able to set data";
+
+   return "Cleared channel infoline in $channame for $handle";
+}
+
+sub get_useracc_for_display
+{
+   my $self = shift;
+   my ( $handle, $ret ) = @_;
+
+   my $core = $self->{core};
+
+   my $infolines = $core->ask_plugins( "ask_handle_channels_data", $handle, "info" );
+
+   my @ret;
+
+   my $global = delete $infolines->{global};
+   push @ret, defined $global ? "Infoline: $global" : "No global";
+
+   push @ret, "  $_: $infolines->{$_}" for sort keys %$infolines;
+
+   $ret->{infoline} = \@ret;
+
+   return 1;
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/LogBase.pm

@@ -0,0 +1,24 @@
+package CelBot::Plugin::LogBase;
+
+use strict;
+# mixin role
+
+sub logs_tag
+{
+   my $self = shift;
+   my ( $tag ) = @_;
+
+   return 1; # TODO
+}
+
+sub do_log
+{
+   my $self = shift;
+   my ( $tag, $subject, $message ) = @_;
+
+   return unless $self->logs_tag( $tag );
+
+   $self->do_log_really( $subject, $message );
+}
+
+1;

extern/cel-bot/CelBot/Plugin/LogFile.pm

@@ -0,0 +1,59 @@
+package CelBot::Plugin::LogFile;
+
+use strict;
+use constant PLUGIN_TYPE => "logfile";
+
+use base qw( CelBot::Plugin::LogBase );
+
+use Date::Format qw( strftime );
+use IO::Handle;
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $file = $config->get_string( '@file' );
+
+   my $self = bless {
+      core => $core,
+      file => $file,
+   }, $class;
+
+   $self->open_file;
+
+   return $self;
+}
+
+sub open_file
+{
+   my $self = shift;
+
+   undef $self->{fileh};
+
+   my $file = $self->{file};
+
+   if( -e $file ) {
+      unlink( "$file.old" ); # Ignore a failure
+      rename( $file, "$file.old" ); # Ignore a failure
+   }
+
+   open( my $fileh, ">", $file ) or die "Cannot write $file - $!\n";
+
+   $fileh->autoflush(1);
+
+   $self->{fileh} = $fileh;
+}
+
+sub do_log_really
+{
+   my $self = shift;
+   my ( $subject, $message ) = @_;
+
+   my $timestamp = strftime( "%Y/%m/%d %H:%M:%S", @{[ localtime ]} );
+
+   $self->{fileh}->print( "[$timestamp] $subject: $message\n" );
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/LogStderr.pm

@@ -0,0 +1,31 @@
+package CelBot::Plugin::LogStderr;
+
+use strict;
+use constant PLUGIN_TYPE => "logstderr";
+
+use base qw( CelBot::Plugin::LogBase );
+
+use Date::Format qw( strftime );
+
+sub new
+{
+   my $class = shift;
+
+   my $self = bless {
+   }, $class;
+
+   return $self;
+}
+
+sub do_log_really
+{
+   my $self = shift;
+   my ( $subject, $message ) = @_;
+
+   my $timestamp = strftime( "%H:%M:%S", @{[ localtime ]} );
+
+   print STDERR "[$timestamp]: $subject: $message\n";
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/MessageLog.pm

@@ -0,0 +1,182 @@
+package CelBot::Plugin::MessageLog;
+
+use strict;
+use constant PLUGIN_TYPE => "messagelog";
+
+use File::Basename qw( dirname );
+use File::Path qw( make_path );
+use POSIX qw( strftime );
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+      targets => {},  # $targetname => [ $filename, $filehandle ]
+   }, $class;
+
+   $self->reconfigure( $config );
+
+   return $self;
+}
+
+sub reconfigure
+{
+   my $self = shift;
+   my ( $config ) = @_;
+
+   $self->{timestamp_format} = $config->get_string( '@timestamp_format',
+      default => "%H:%M:%S"
+   );
+
+   $self->{filename_format} = $config->get_string( '@filename_format',
+      default => 'logs/$target-%Y-%m-%d.log'
+   );
+
+   $self->{file_mode} = oct $config->get_string( '@file_mode', default => '0600' );
+}
+
+my %template = map { split( m/=/, $_, 2 ) } split( m/\n/, <<'EOF' );
+join=*** Joins: $nick [$userhost] has joined $channel
+part=*** Parts: $nick [$userhost] has left $channel ($partmsg)
+kick=*** Kicks: $kicked [$kickedhost] was kicked from $channel by $kicker ($kickmsg) 
+quit=*** Quits: $nick [$userhost] ($quitmsg)
+nick=*** $oldnick is now known as $newnick
+topic=*** Topic change by $nick on $channel: $topic
+mode=*** Mode change for $channel by $nick: $mode
+msg=<$nick> $text
+notice=-$nick- $text
+act=* $nick $text
+EOF
+
+sub log_event
+{
+   my $self = shift;
+   my ( $target, $event, %args ) = @_;
+
+   my $message = $template{$event} or return;
+   $message =~ s{\$(\w+)}{$args{$1}}g;
+
+   my @now = localtime;
+
+   my $filename = $self->{filename_format};
+   $filename = strftime( $filename, @now );
+   $filename =~ s{\$target}{$target};
+
+   my $timestamp = strftime( $self->{timestamp_format}, @now );
+
+   if( !$self->{targets}{$target}[0] or $self->{targets}{$target}[0] ne $filename ) {
+      my $full_timestamp = strftime( "%Y-%m-%d %H:%M:%S", @now );
+
+      if( my $old_fh = $self->{targets}{$target}[1] ) {
+         $old_fh->print( "Closing file at $full_timestamp\n" );
+      }
+
+      my $dir = dirname( $filename );
+      unless( -d $dir ) {
+         make_path( $dir );
+      }
+
+      open my $fh, ">>", $filename or die "Cannot open file $filename - $!";
+      $fh->autoflush(1);
+
+      chmod $self->{file_mode}, $filename; # best-effort ignore failure
+
+      $self->{targets}{$target} = [ $filename, $fh ];
+
+      $fh->print( "Opening file at $full_timestamp\n" );
+   }
+
+   my $fh = $self->{targets}{$target}[1];
+
+   $fh->write( "$timestamp $message\n" );
+}
+
+# Capture the actual events to log
+
+sub on_channel_privmsg
+{
+   my $self = shift;
+   my ( $channel, $user, $text ) = @_;
+
+   $self->log_event( $channel->name, msg => (
+      nick => $user->nick,
+      text => $text,
+   ) );
+}
+
+sub on_channel_ctcp_ACTION
+{
+   my $self = shift;
+   my ( $channel, $user, $text ) = @_;
+
+   $self->log_event( $channel->name, act => (
+      nick => $user->nick,
+      text => $text,
+   ) );
+}
+
+sub on_channel_join
+{
+   my $self = shift;
+   my ( $channel, $user ) = @_;
+
+   $self->log_event( $channel->name, join => (
+      channel  => $channel->name,
+      userhost => $user->host,
+      nick     => $user->nick,
+   ) );
+}
+
+sub on_channel_leave
+{
+   my $self = shift;
+   my ( $channel, $user, $command, $reason, $kicker ) = @_;
+
+   if( $command eq "PART" ) {
+      $self->log_event( $channel->name, part => (
+         channel  => $channel->name,
+         nick     => $user->nick,
+         userhost => $user->host,
+         partmsg  => $reason,
+      ) );
+   }
+   elsif( $command eq "KICK" ) {
+      $self->log_event( $channel->name, kick => (
+         channel    => $channel->name,
+         kicked     => $user->nick,
+         kickedhost => $user->host,
+         kicker     => $kicker->nick,
+         kickerhost => $kicker->host,
+         kickmsg    => $reason,
+      ) );
+   }
+   elsif( $command eq "QUIT" ) {
+      $self->log_event( $channel->name, quit => (
+         channel  => $channel->name,
+         nick     => $user->nick,
+         userhost => $user->host,
+         quitmsg    => $reason,
+      ) );
+   }
+}
+
+sub on_channel_user_rename
+{
+   my $self = shift;
+   my ( $channel, $oldname, $newname ) = @_;
+
+   $self->log_event( $channel->name, nick => (
+      oldnick => $oldname,
+      newnick => $newname,
+   ) );
+}
+
+# topic
+# mode
+# notice
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/Messages.pm

@@ -0,0 +1,44 @@
+package CelBot::Plugin::Messages;
+
+use strict;
+use constant PLUGIN_TYPE => "messages";
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+   }, $class;
+
+   return $self;
+}
+
+sub on_message
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my @args    = $message->args;
+
+   # Eat any of the server stats or MOTD messages
+   # 301 == "away"
+   return 1 if grep { $command eq $_ }
+      qw(
+         002 003 004
+         250 251 252 254 255 265 266
+         301
+         372 375 376
+      );
+
+   return 1 if $command eq "NOTICE" and $args[0] eq "AUTH";
+
+   # Suppress ctcp ACTIONs from debugging log
+   return 1 if $command eq "ctcp ACTION";
+
+   return 0;
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/NickServ.pm

@@ -0,0 +1,130 @@
+package CelBot::Plugin::NickServ;
+
+use strict;
+use constant PLUGIN_TYPE => "nickserv";
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+   }, $class;
+
+   return $self;
+}
+
+sub scatter_user_verify_handle
+{
+   my $self = shift;
+   my ( $gencb, $user, $handle ) = @_;
+
+   my $core = $self->{core};
+   my $enabled = $core->ask_plugins( "ask_handle_data", $handle, "nickserv" );
+
+   return unless $enabled;
+
+   my $cb = $gencb->();
+
+   $user->whois(
+      on_whois => sub {
+         my %whois = @_;
+
+         if( $whois{307} ) {
+            $core->log( "DEBUG", "<NickServ>", "WHOIS claims $user is recognised: " . join( " ", @{ $whois{307} } ) );
+            $cb->(1);
+         }
+         else {
+            $cb->(0);
+         }
+      },
+   );
+}
+
+sub register_usermgmt_commands
+{
+   my $self = shift;
+   my ( $usermgmt_plugin ) = @_;
+
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "nickserv",
+      perm    => 'self|master',
+
+      subcmds => {
+         get => { 
+            args => [],
+            summary => "Show current NickServ setting",
+         },
+
+         enable => { 
+            args => [],
+            summary => "Enable NickServ recognition",
+         },
+
+         disable => {
+            args => [],
+            summary => "Disable NickServ recognition",
+         },
+      },
+      default => "get",
+
+      summary => "Adjust use of NickServ for recognition",
+   );
+}
+
+sub command_useracc_nickserv_get
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my $enabled = $core->ask_plugins( "ask_handle_data", $handle, "nickserv" );
+
+   return "NickServ is " . ( $enabled ? "enabled" : "disabled" ) . " for $handle";
+}
+
+sub command_useracc_nickserv_enable
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   $core->run_plugins( "do_handle_set_data", $handle, "nickserv", 1 );
+
+   return "NickServ is now enabled for $handle";
+}
+
+sub command_useracc_nickserv_disable
+{
+   my $self = shift;
+   my ( $context, $oldmask ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   $core->run_plugins( "do_handle_set_data", $handle, "nickserv", 0 );
+
+   return "NickServ is now disabled for $handle";
+}
+
+sub get_useracc_for_display
+{
+   my $self = shift;
+   my ( $handle, $ret ) = @_;
+
+   my $core = $self->{core};
+   my $enabled = $core->ask_plugins( "ask_handle_data", $handle, "nickserv" );
+
+   $ret->{nickserv} = "NickServ is " . ( $enabled ? "enabled" : "disabled" );
+
+   return 1;
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/OpReport.pm

@@ -0,0 +1,59 @@
+package CelBot::Plugin::OpReport;
+
+use strict;
+use constant PLUGIN_TYPE => "opreport";
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+      irc  => $core->get_plugin( "irc" ),
+   }, $class;
+
+   return $self;
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "opreport",
+      perm    => 'master',
+
+      args => [],
+
+      summary => "Report on my channel status in all channels",
+   );
+}
+
+sub command_opreport
+{
+   my $self = shift;
+
+   my $irc = $self->{irc};
+   my @channels = $irc->get_channels_plugin->get_channels;
+
+   my $me = $irc->get_user_me;
+
+   my @chanflags;
+
+   foreach my $channel ( sort { $a->name cmp $b->name } @channels ) {
+      my $myflag = $channel->get_userflag( $me );
+      push @chanflags, $myflag . $channel->name;
+   }
+
+   return "Channels: " . join( " ", @chanflags );
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/PasswdAuth.pm

@@ -0,0 +1,157 @@
+package CelBot::Plugin::PasswdAuth;
+
+use strict;
+use constant PLUGIN_TYPE => "passwdauth";
+
+use Digest::MD5 qw( md5_base64 );
+
+our $SALT = "57834902-y68923-nfy675923-n4-n49";
+
+sub _hash_password
+{
+   my ( $pass ) = @_;
+   return md5_base64( $SALT . $pass );
+}
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+   }, $class;
+
+   return $self;
+}
+
+###
+# Commands
+###
+
+sub register_usermgmt_commands
+{
+   my $self = shift;
+   my ( $usermgmt_plugin ) = @_;
+
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "password",
+      perm    => 'self|master',
+
+      subcmds => {
+         set => {
+            args => [ CelBot::Commands::ArgSpec::Bareword->new( 'pass' ) ],
+            summary => "Set authentication password",
+         },
+
+         check => {
+            args => [],
+            summary => "Check if a password is set",
+         },
+
+         clear => {
+            args => [],
+            summary => "Clear authentication password",
+         },
+      },
+      default => "check",
+
+      summary => "User authentication by password",
+   );
+}
+
+sub command_useracc_password_set
+{
+   my $self = shift;
+   my ( $context, $pass ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   $core->run_plugins( "do_handle_set_data", $handle, "passwdhash", _hash_password( $pass ) );
+
+   return "Password now set";
+}
+
+sub command_useracc_password_check
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my $hash = $core->ask_plugins( "ask_handle_data", $handle, "passwdhash" );
+
+   return defined $hash ? "Password set" : "No password";
+}
+
+sub command_useracc_password_clear
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   $core->run_plugins( "do_handle_set_data", $handle, "passwdhash", undef );
+
+   return "Password now cleared";
+}
+
+sub get_useracc_for_display
+{
+   my $self = shift;
+   my ( $handle, $ret ) = @_;
+
+   my $core = $self->{core};
+   my $hash = $core->ask_plugins( "ask_handle_data", $handle, "passwdhash" );
+
+   if( defined $hash ) {
+      $ret->{passwdhash} = "Password is set";
+   }
+}
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "identify",
+      perm    => 'public',
+
+      args => [
+         CelBot::Commands::ArgSpec::Bareword->new( 'handle' ),
+         CelBot::Commands::ArgSpec::Bareword->new( 'pass' ),
+      ],
+
+      summary => "Identify as a registered user using a password",
+   );
+}
+
+sub command_identify
+{
+   my $self = shift;
+   my ( $context, $handle, $pass ) = @_;
+
+   my $user = $context->cmduser;
+
+   my $core = $self->{core};
+
+   my $hash = $core->ask_plugins( "ask_handle_data", $handle, "passwdhash" );
+   if( defined $hash and _hash_password( $pass ) eq $hash ) {
+      $core->log( "AUDIT", "<PasswdAuth>", "$user successfully identified as $handle" );
+      my $recognise_plugin = $core->get_plugin( "recognise" );
+      $recognise_plugin->recognise( $user, $handle );
+      return ( "Identify successful - you are now recognised as $handle" );
+   }
+   else {
+      return ( "Identify failed - bad username or password" );
+   }
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/Recognise.pm

@@ -0,0 +1,643 @@
+package CelBot::Plugin::Recognise;
+
+use strict;
+use constant PLUGIN_TYPE => "recognise";
+
+use CPS qw( kforeach );
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $irc = $core->get_plugin( "irc" );
+
+   my $self = bless {
+      core => $core,
+      irc  => $irc,
+   }, $class;
+
+   return $self;
+}
+
+sub recognise
+{
+   my $self = shift;
+   my ( $user, $handle ) = @_;
+
+   # Early exit if no change
+   return if !defined $handle and !defined $user->{handle};
+   return if  defined $handle and  defined $user->{handle} and $handle eq $user->{handle};
+
+   $user->{handle} = $handle;
+
+   my $core = $self->{core};
+   $core->run_plugins_after( "on_recognise_user", $user, $handle );
+}
+
+# FUNCTION
+sub shorten_nick
+{
+   my ( $nick ) = @_;
+
+   $nick =~ s/[\[\|\]].*// or return undef;
+   return $nick;
+}
+
+sub ask_map_user_to_handles
+{
+   my $self = shift;
+   my ( $user ) = @_;
+
+   my $core = $self->{core};
+
+   my $nick = $user->nick_folded;
+
+   my @handles = $core->ask_plugins_list( "ask_map_nick_to_handles", $nick );
+
+   if( !@handles and my $shortnick = shorten_nick( $nick ) ) {
+      # Users often like to put a status message in their nick; usually
+      # Foo|Away or Foo[Away]. Try to cope with those
+      @handles = $core->ask_plugins_list( "ask_map_nick_to_handles", $shortnick );
+   }
+
+   return @handles;
+}
+
+sub ask_map_handle_to_users
+{
+   my $self = shift;
+   my ( $handle, $only_recognised ) = @_;
+
+   my $core = $self->{core};
+   my $irc  = $self->{irc};
+
+   if( $only_recognised ) {
+      # Only want recognised ones - this is a big shortcut
+      return grep { $_->{handle} eq $handle } $irc->get_users;
+   }
+
+   my $nicks = $core->ask_plugins( "ask_handle_data", $handle, "nicks" );
+   return unless $nicks and @$nicks;
+
+   my @users;
+   foreach my $user ( $irc->get_users ) {
+      my $nick = $user->nick_folded;
+      my $shortnick;
+
+      if( grep { $_ eq $nick } @$nicks ) {
+         push @users, $user;
+      }
+      elsif( $shortnick = shorten_nick( $nick ) and grep { $_ eq $shortnick } @$nicks ) {
+         push @users, $user;
+      }
+   }
+
+   return @users;
+}
+
+sub try_recognise
+{
+   my $self = shift;
+   my ( $user ) = @_;
+
+   my $core = $self->{core};
+
+   # Recognition is a two-stage process. First we map the IRC nick of the user
+   # to a candidate list of possible DB handles. We then try to verify those
+   # claims by whatever method is appropriate.
+   my @handles = $core->ask_plugins_list( "ask_map_user_to_handles", $user );
+
+   return unless @handles;
+
+   $self->try_recognise_user_handles( $user, \@handles );
+}
+
+sub try_recognise_user_handles
+{
+   my $self = shift;
+   my ( $user, $handles, $kdone ) = @_;
+
+   my $core = $self->{core};
+
+   my $recognised_handle;
+   kforeach( $handles, sub {
+      my ( $handle, $knext, $klast ) = @_;
+
+      $core->scatter_plugins(
+         sub {
+            my %results = @_;
+
+            # Find any plugins that said "yes"
+            my @yes = grep { $results{$_} } keys %results;
+
+            if( @yes ) {
+               $core->log( "DEBUG", "<Recognise>", "Recognise $user as $handle because the following plugins said yes: " . join( ", ", @yes ) );
+               $self->recognise( $user, $handle );
+               $recognised_handle = $handle;
+               $klast->();
+            }
+            else {
+               $core->log( "DEBUG", "<Recognise>", "No plugin recognised $user as $handle" );
+               $knext->();
+            }
+         }
+         , "scatter_user_verify_handle", $user, $handle
+      );
+   }, sub {
+      $kdone->( $recognised_handle ) if $kdone;
+   } );
+}
+
+sub on_user_rename
+{
+   my $self = shift;
+   my ( $user, $oldnick, $newnick ) = @_;
+
+   $self->try_recognise( $user );
+}
+
+sub on_user_host
+{
+   my $self = shift;
+   my ( $user, $ident, $host ) = @_;
+
+   $self->try_recognise( $user );
+}
+
+sub on_handle_sync_from_user
+{
+   my $self = shift;
+   my ( $handle, $user, $cmdcontext ) = @_;
+
+   my $core = $self->{core};
+
+   my $newnick = $user->nick_folded;
+
+   my $nicks = $core->ask_plugins( "ask_handle_data", $handle, "nicks" ) || [];
+
+   if( !grep { $_ eq $newnick } @$nicks ) {
+      $cmdcontext->respond( "Adding nick '$newnick' to $handle" );
+      push @$nicks, $newnick;
+      $core->run_plugins( "do_handle_set_data", $handle, "nicks", $nicks );
+   }
+
+   # As a result of this addition, the user must now be recognised here
+   $self->recognise( $user, $handle );
+
+   return 1;
+}
+
+sub ask_user_data
+{
+   my $self = shift;
+   my ( $user, $key ) = @_;
+
+   my $handle = $user->{handle};
+   return undef unless defined $handle;
+
+   my $core = $self->{core};
+   return $core->ask_plugins( "ask_handle_data", $handle, $key );
+}
+
+sub ask_user_global_data
+{
+   my $self = shift;
+   my ( $user, $key ) = @_;
+
+   my $handle = $user->{handle};
+   return undef unless defined $handle;
+
+   my $core = $self->{core};
+   return $core->ask_plugins( "ask_handle_global_data", $handle, $key );
+}
+
+sub ask_user_channel_data
+{
+   my $self = shift;
+   my ( $user, $channel, $key ) = @_;
+
+   my $handle = $user->{handle};
+   return undef unless defined $handle;
+
+   my $core = $self->{core};
+   return $core->ask_plugins( "ask_handle_channel_data", $handle, $channel->name, $key );
+}
+
+sub permit_command_perm
+{
+   my $self = shift;
+   my ( $perm, $context ) = @_;
+
+   my $user = $context->cmduser;
+   return undef unless defined $user;
+
+   foreach my $p ( split( m{\|}, $perm ) ) {
+      # Any registered user may do 'recognised'
+      return ( defined $user->{handle} ) if $p eq 'recognised';
+
+      # Check predefined classes
+      return ( $user->get_global_data( 'master' ) ) if $p eq 'master';
+      return ( $user->get_global_data( 'owner' ) ) if $p eq 'owner';
+   }
+
+   return undef;
+}
+
+sub permit_command_nonpublic
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   # Recognised users can perform nonpublic commands
+   my $user = $context->cmduser;
+   return undef unless defined $user;
+
+   return 1 if defined $user->{handle};
+
+   return undef;
+}
+
+sub permit_user_channel_priv
+{
+   my $self = shift;
+   my ( $user, $channel, $priv ) = @_;
+
+   # Autovoice all recognised users
+   return 1 if $priv eq "voice" and defined $user->{handle};
+   return undef;
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   my $irc = $self->{irc};
+   my $users    = $irc->get_users_plugin;
+   my $channels = $irc->get_channels_plugin;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "whoami",
+      perm    => 'public',
+
+      args => [],
+
+      summary => "Show the recognised user handle of the invoking user",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "iam",
+      perm    => 'public',
+
+      args => [
+         CelBot::Commands::ArgSpec::Bareword->new( 'handle' ),
+      ],
+
+      summary => "Claim to be the given username and attempt to verify this claim",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "whois",
+
+      args => [
+         $users->gen_argspec,
+      ],
+
+      summary => "Show the recognised user handle of a given user",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "rerecognise",
+      perm    => 'master',
+
+      args => [
+         CelBot::Commands::ArgSpec->new( 'users', eatall => 1 ),
+      ],
+
+      summary => "Forget recognition of users and discover again",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "recognise",
+      perm    => 'owner',
+
+      args => [
+         $users->gen_argspec,
+         CelBot::Commands::ArgSpec::Sugar->new( 'as' ),
+         CelBot::Commands::ArgSpec::Bareword->new( 'handle' ),
+      ],
+
+      summary => "Force a user recognition",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "unrecognise",
+      perm    => 'owner',
+
+      args => [
+         $users->gen_argspec,
+      ],
+
+      summary => "Remove a forced user recognition",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "regreport",
+      perm    => 'master',
+
+      args => [
+         $channels->gen_argspec,
+      ],
+
+      summary => "Display a report about user registrations in a given channel",
+   );
+}
+
+sub command_whoami
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $cmduser = $context->cmduser;
+
+   if( defined $cmduser->{handle} ) {
+      return ( "You are $cmduser->{handle}" );
+   }
+   else {
+      return ( "I do not recognise you" );
+   }
+}
+
+sub command_iam
+{
+   my $self = shift;
+   my ( $context, $handle ) = @_;
+
+   my $cmduser = $context->cmduser;
+
+   if( defined $cmduser->{handle} ) {
+      return ( "You are already recognised as $cmduser->{handle}" );
+   }
+   else {
+      $self->try_recognise_user_handles( $cmduser, [ $handle ], sub {
+         my ( $recognised ) = @_;
+         if( defined $recognised ) {
+            $context->respond( "You are now recognised as $recognised" );
+         }
+         else {
+            $context->respond( "I could not recognise you" );
+         }
+      } );
+      return ();
+   }
+}
+
+sub command_whois
+{
+   my $self = shift;
+   my ( $context, $user ) = @_;
+
+   my $ret = $user->nick . " (" . $user->location . ") is ";
+
+   if( defined $user->{handle} ) {
+      $ret .= "recognised as $user->{handle}";
+   }
+   else {
+      $ret .= "not recognised";
+   }
+
+   ( $ret );
+}
+
+sub command_rerecognise
+{
+   my $self = shift;
+   my ( $context, $users ) = @_;
+
+   my $irc = $self->{irc};
+   my $users_plugin = $irc->get_users_plugin;
+
+   my @just_users = map { $irc->casefold_name( $_ ) } split( m/ /, $users );
+
+   my $count = 0;
+
+   # Flush all the user data caches
+   foreach my $user ( $users_plugin->get_users ) {
+      my $nick = $user->nick_folded;
+
+      next if @just_users and !grep { $_ eq $nick } @just_users;
+
+      $user->{rerecognise} = 1;
+
+      # Now send a WHOIS message, who when the reply comes back we'll capture
+      # the new ident and host. Though only if we were doing specific users
+      $irc->send_message( "WHOIS", undef, $user->nick ) if @just_users;
+
+      # TODO: We need some way to register "diversions" on numerics that come
+      # back about this user, until such time as we find they're finished
+      # Consider borrowing irssi-like behaviour
+
+      $count++;
+   }
+
+   return ( "Forgot recognition of $count user" . ( $count == 1 ? "" : "s" ) );
+}
+
+sub command_recognise
+{
+   my $self = shift;
+   my ( $context, $user, $handle ) = @_;
+
+   defined $user->{handle} and return ( "User is already recognised as '$user->{handle}'" );
+
+   $self->recognise( $user, $handle );
+
+   return ( $user->nick . " is now recognised as $handle" );
+}
+
+sub command_unrecognise
+{
+   my $self = shift;
+   my ( $context, $user ) = @_;
+
+   defined $user->{handle} or return ( "User is not recognised" );
+
+   $self->recognise( $user, undef );
+
+   return ( $user->nick . " is no longer recognised" );
+}
+
+sub command_regreport
+{
+   my $self = shift;
+   my ( $context, $channel ) = @_;
+
+   my @users = $channel->get_users;
+
+   my @verified;
+   my @unverified;
+   my @unrecognised;
+
+   my $core = $self->{core};
+
+   my $irc = $self->{irc};
+
+   foreach my $user ( @users ) {
+      next if $user->is_me;
+
+      my @nicks;
+
+      if( defined $user->{handle} ) {
+         push @verified, $user->nick;
+      }
+      elsif( $core->ask_plugins_list( "ask_map_nick_to_handles", $user->nick_folded ) ) {
+         push @unverified, $user->nick;
+      }
+      else {
+         push @unrecognised, $user->nick;
+      }
+   }
+
+   my $str = $channel->name . " has " .
+      ( scalar @verified ) . " verified users, " .
+      ( scalar @unverified ) . " unverified users, and " .
+      ( scalar @unrecognised ) . " unrecognised users";
+
+   return (
+      $str,
+      "Verified: " . join( " ", @verified ),
+      "Unverified: " . join( " ", @unverified ),
+      "Unrecognised: " . join( " ", @unrecognised ),
+   );
+}
+
+sub register_usermgmt_commands
+{
+   my $self = shift;
+   my ( $usermgmt_plugin ) = @_;
+
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "nicks",
+      perm    => 'self|master',
+
+      subcmds => {
+         get => {
+            args => [],
+            summary => "Show current list of nicks",
+         },
+
+         add => { 
+            args => [ CelBot::Commands::ArgSpec::Bareword->new( 'nick' ) ],
+            summary => "Add a new nick to the list",
+         },
+
+         del => {
+            args => [ CelBot::Commands::ArgSpec::Bareword->new( 'nick' ) ],
+            summary => "Remove existing nick from the list",
+         },
+      },
+      default => "get",
+
+      summary => "Adjust recognition nicks",
+   );
+}
+
+sub command_useracc_nicks_get
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my $nicks = $core->ask_plugins( "ask_handle_data", $handle, "nicks" );
+
+   return "No nicks for $handle" unless defined $nicks;
+   return "Nicks for $handle: " . join( ", ", @$nicks );
+}
+
+sub command_useracc_nicks_add
+{
+   my $self = shift;
+   my ( $context, $newnick ) = @_;
+
+   $newnick = lc $newnick;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my @clashes = $core->ask_plugins_list( "ask_map_nick_to_handles", $newnick );
+
+   if( @clashes ) {
+      return "Cannot add this nick as it clashes with other users";
+   }
+
+   my $nicks = $core->ask_plugins( "ask_handle_data", $handle, "nicks" ) || [];
+
+   push @$nicks, $newnick;
+
+   $core->run_plugins( "do_handle_set_data", $handle, "nicks", $nicks );
+
+   $core->log( "AUDIT", "<Recognise>", ($context->cmduser||"[console]") . " changed $handle nicks to: " . join( ", ", @$nicks ) );
+
+   my @users = $core->ask_plugins_list( "ask_map_handle_to_users", $handle, 0 );
+   foreach my $user ( @users ) {
+      $user->{rerecognise} = 1;
+      my $irc = $self->{irc};
+      $irc->send_message( "WHOIS", undef, $user->nick );
+   }
+
+   return "New nicks for $handle: " . join( ", ", @$nicks );
+}
+
+sub command_useracc_nicks_del
+{
+   my $self = shift;
+   my ( $context, $oldnick ) = @_;
+
+   my $handle = $context->{handle};
+
+   my $core = $self->{core};
+   my $nicks = $core->ask_plugins( "ask_handle_data", $handle, "nicks" );
+
+   if( !$nicks or !@$nicks ) {
+      return "No nicks to delete";
+   }
+
+   @$nicks = grep { $_ ne $oldnick } @$nicks;
+
+   $core->run_plugins( "do_handle_set_data", $handle, "nicks", $nicks );
+
+   $core->log( "AUDIT", "<Recognise>", ($context->cmduser||"[console]") . " changed $handle nicks to: " . join( ", ", @$nicks ) );
+
+   return "New nicks for $handle: " . join( ", ", @$nicks );
+}
+
+sub get_useracc_for_display
+{
+   my $self = shift;
+   my ( $handle, $ret ) = @_;
+
+   my $core = $self->{core};
+   my $nicks = $core->ask_plugins( "ask_handle_data", $handle, "nicks" );
+
+   $ret->{recognise} = "Nicks: " . join( ", ", @$nicks );
+
+   return 1;
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/Say.pm

@@ -0,0 +1,79 @@
+package CelBot::Plugin::Say;
+
+use strict;
+use constant PLUGIN_TYPE => "say";
+
+use CelBot::Commands;
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+   }, $class;
+
+   return $self;
+}
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => 'say',
+      scope   => 'channel',
+      perm    => "master",
+
+      args => [
+         CelBot::Commands::ArgSpec->new( 'message', eatall => 1 ),
+      ],
+
+      summary => "Send a PRIVMSG directly to a channel",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => 'act',
+      scope   => 'channel',
+      perm    => "master",
+
+      args => [
+         CelBot::Commands::ArgSpec->new( 'action', eatall => 1 ),
+      ],
+
+      summary => "Send a CTCP ACTION directly to a channel",
+   );
+}
+
+sub command_say
+{
+   my $self = shift;
+   my ( $context, $message ) = @_;
+
+   my $channel = $context->{channel};
+   defined $channel or return ( "say: Need a channel" );
+
+   $channel->privmsg( $message );
+   return ();
+}
+
+sub command_act
+{
+   my $self = shift;
+   my ( $context, $action ) = @_;
+
+   my $channel = $context->{channel};
+   defined $channel or return ( "act: Need a channel" );
+
+   my $ctcp = "\001ACTION $action\001";
+
+   $channel->privmsg( $ctcp );
+   return ();
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/URLInfo.pm

@@ -0,0 +1,136 @@
+package CelBot::Plugin::URLInfo;
+
+use strict;
+use constant PLUGIN_TYPE => "urlinfo";
+
+use CelBot::Connector;
+use CelBot::Commands;
+
+use Net::Async::HTTP;
+
+use constant KIBI => 1024;
+use constant MEBI => 1024*1024;
+use constant GIBI => 1024*1024*1024;
+
+use URI;
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $self = bless {
+      core => $core,
+      http => Net::Async::HTTP->new,
+   }, $class;
+
+   $core->get_loop->add( $self->{http} );
+
+   return $self;
+}
+
+my @ordinals = (qw(
+   first
+   second
+   third
+   fourth
+   fifth
+   sixth
+   seventh
+   eighth
+   ninth
+   tenth
+   eleventh
+   twelfth
+));
+
+sub get_url_info
+{
+   my $self = shift;
+   my ( $url, $on_info ) = @_;
+
+   my $http = $self->{http};
+
+   $http->do_request(
+      method => "HEAD",
+      uri => URI->new( $url ),
+  
+      on_response => sub {
+         my ( $response ) = @_;
+
+         my $code = $response->code;
+
+         if( $code == 200 ) {
+            my $type = $response->content_type;
+
+            $type = "unknown" if !defined $type;
+
+            # Trim off a trailing charset declaration
+            $type =~ s/;.*$//;
+
+            my $size = $response->content_length;
+
+            if( !defined $size )  { $size = "unknown"; }
+            elsif( $size > GIBI ) { $size = sprintf '%.1f GiB', $size / GIBI; }
+            elsif( $size > MEBI ) { $size = sprintf '%.1f MiB', $size / MEBI; }
+            elsif( $size > KIBI ) { $size = sprintf '%.1f kiB', $size / KIBI; }
+            else                  { $size = "$size bytes"; }
+
+            $on_info->( "$type, size $size" );
+         }
+         elsif( $code == 301 or $code == 302 ) {
+            my $location = $response->header( "Location" );
+            $on_info->( "redirection to $location" );
+         }
+         else {
+            my $status = $response->message;
+            $status =~ s/\r//; # Trim linefeed
+            $on_info->( "$status [$code]" );
+         }
+      },
+  
+      on_error => sub {
+         my ( $message ) = @_;
+         $on_info->( "unfetchable - $message" );
+      },
+   );
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "urlinfo",
+      scope   => "privmsg|channel",
+
+      args => [
+         CelBot::Commands::ArgSpec::Bareword->new( 'url' ),
+      ],
+
+      summary => "Display information on the given URL",
+   );
+}
+
+sub command_urlinfo
+{
+   my $self = shift;
+   my ( $context, $url ) = @_;
+
+   $self->get_url_info( $url,
+      sub {
+         $context->respond( "URL is $_[0]" );
+      }
+   );
+
+   return (); # No response yet
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/UserDB.pm

@@ -0,0 +1,542 @@
+package CelBot::Plugin::UserDB;
+
+use strict;
+use constant PLUGIN_TYPE => "userdb";
+
+use CelBot::Commands;
+
+use Module::PluginFinder;
+
+my $userdb_finder = Module::PluginFinder->new(
+   search_path => "CelBot::Plugin::UserDB",
+   typefunc    => "DB_TYPE",
+);
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $config ) = @_;
+
+   my $irc = $core->get_plugin( "irc" );
+
+   my $dbtype = $config->get_string( '@dbtype' );
+   $class = $userdb_finder->find_module( $dbtype );
+
+   my $self = bless {
+      core => $core,
+      irc  => $irc,
+
+      dirty => 0,
+
+      autosave       => 1,
+      autosave_delay => 300,
+   }, $class;
+
+   $self->init( $config );
+
+   return $self;
+}
+
+sub get_global_data
+{
+   my $self = shift;
+   my ( $handle, $key ) = @_;
+
+   return undef unless defined $handle;
+
+   my $data = $self->get_all_data( $handle );
+   if( $data->{global} ) {
+      my $globaldata = $data->{global};
+      return $globaldata->{$key} if exists $globaldata->{$key};
+   }
+
+   return undef;
+}
+
+sub get_channel_data
+{
+   my $self = shift;
+   my ( $handle, $channame, $key ) = @_;
+
+   return undef unless defined $handle;
+
+   my $data = $self->get_all_data( $handle );
+
+   if( $data->{channel} and  $data->{channel}{$channame} ){
+      my $channeldata = $data->{channel}{$channame};
+      return $channeldata->{$key} if exists $channeldata->{$key};
+   }
+
+   return $self->get_global_data( $handle, $key );
+}
+
+sub get_channels_data
+{
+   my $self = shift;
+   my ( $handle, $key ) = @_;
+
+   return undef unless defined $handle;
+
+   my $data = $self->get_all_data( $handle );
+
+   my %ret;
+   $ret{global} = $data->{global}{$key};
+
+   foreach my $channame ( keys %{ $data->{channel} } ) {
+      $ret{$channame} = $data->{channel}{$channame}{$key} if exists $data->{channel}{$channame}{$key};
+   }
+
+   return \%ret;
+}
+
+sub get_data
+{
+   my $self = shift;
+   my ( $handle, $key ) = @_;
+
+   return undef unless defined $handle;
+
+   my $data = $self->get_all_data( $handle );
+
+   my $value = $data->{$key};
+   return undef unless defined $value;
+
+   # SHALLOW clone
+   $value = [ @$value ] if ref $value eq "ARRAY";
+   $value = { %$value } if ref $value eq "HASH";
+
+   return $value;
+}
+
+sub set_global_data
+{
+   my $self = shift;
+   my ( $handle, $key, $value ) = @_;
+
+   die "Cannot set global data in $self" unless $self->can( "save" );
+
+   return undef unless defined $handle;
+
+   my $data = $self->get_all_data( $handle );
+
+   if( defined $value ) {
+      # SHALLOW clone
+      $value = [ @$value ] if ref $value eq "ARRAY";
+      $value = { %$value } if ref $value eq "HASH";
+
+      $data->{global}{$key} = $value;
+   }
+   else {
+      delete $data->{global}{$key};
+   }
+
+   $self->mark_dirty;
+}
+
+sub set_channel_data
+{
+   my $self = shift;
+   my ( $handle, $channame, $key, $value ) = @_;
+
+   die "Cannot set channel data in $self" unless $self->can( "save" );
+
+   return undef unless defined $handle;
+
+   my $data = $self->get_all_data( $handle );
+
+   if( defined $value ) {
+      # SHALLOW clone
+      $value = [ @$value ] if ref $value eq "ARRAY";
+      $value = { %$value } if ref $value eq "HASH";
+
+      $data->{channel}{$channame}{$key} = $value;
+   }
+   else {
+      delete $data->{channel}{$channame}{$key};
+      delete $data->{channel}{$channame} if not keys %{ $data->{channel}{$channame} };
+   }
+
+   $self->mark_dirty;
+}
+
+sub set_data
+{
+   my $self = shift;
+   my ( $handle, $key, $value ) = @_;
+
+   die "Cannot set data in $self" unless $self->can( "save" );
+
+   return undef unless defined $handle;
+
+   my $data = $self->get_all_data( $handle );
+
+   # TODO: Consider merging behaviour
+
+   # SHALLOW clone
+   $value = [ @$value ] if ref $value eq "ARRAY";
+   $value = { %$value } if ref $value eq "HASH";
+
+   $data->{$key} = $value;
+
+   $self->mark_dirty;
+}
+
+sub mark_dirty
+{
+   my $self = shift;
+
+   return if $self->{dirty};
+
+   $self->{dirty} = 1;
+
+   return unless $self->{autosave};
+
+   my $core = $self->{core};
+   my $loop = $core->get_loop;
+
+   $core->log( "INFO", "<UserDB>", "Marking UserDB dirty; will autosave in $self->{autosave_delay} seconds" );
+
+   $self->{savetimer_id} = $loop->enqueue_timer(
+      delay => $self->{autosave_delay},
+
+      code => sub {
+         $self->save;
+         $self->{dirty} = 0;
+
+         $core->log( "INFO", "<UserDB>", "UserDB saved to disk; is clean again" );
+      },
+   );
+}
+
+sub mark_clean
+{
+   my $self = shift;
+
+   $self->{dirty} = 0;
+
+   if( $self->{savetimer_id} ) {
+      my $core = $self->{core};
+      my $loop = $core->get_loop;
+
+      $loop->cancel_timer( $self->{savetimer_id} );
+      undef $self->{savetimer_id};
+   }
+}
+
+###
+# Signals
+###
+
+sub ask_handle_data
+{
+   my $self = shift;
+   my ( $handle, $key ) = @_;
+   return $self->get_data( $handle, $key );
+}
+
+sub ask_handle_global_data
+{
+   my $self = shift;
+   my ( $handle, $key ) = @_;
+   return $self->get_global_data( $handle, $key );
+}
+
+sub ask_handle_channel_data
+{
+   my $self = shift;
+   my ( $handle, $channame, $key ) = @_;
+   return $self->get_channel_data( $handle, $channame, $key );
+}
+
+sub ask_handle_channels_data
+{
+   my $self = shift;
+   my ( $handle, $key ) = @_;
+   return $self->get_channels_data( $handle, $key );
+}
+
+sub do_handle_set_data
+{
+   my $self = shift;
+   my ( $handle, $key, $value ) = @_;
+   $self->set_data( $handle, $key, $value );
+   return 1;
+}
+
+sub do_handle_set_global_data
+{
+   my $self = shift;
+   my ( $handle, $key, $value ) = @_;
+   $self->set_global_data( $handle, $key, $value );
+   return 1;
+}
+
+sub do_handle_set_channel_data
+{
+   my $self = shift;
+   my ( $handle, $channame, $key, $value ) = @_;
+   $self->set_channel_data( $handle, $channame, $key, $value );
+   return 1;
+}
+
+sub ask_map_nick_to_handles
+{
+   my $self = shift;
+   my ( $nick ) = @_;
+   return $self->map_nick_to_handles( $nick );
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "userdb",
+
+      subcmds => {
+         reload => {
+            perm => "owner",
+
+            args => [],
+
+            summary => "Reload the database from last saved storage",
+         },
+
+         save => {
+            perm => "owner",
+
+            args => [],
+
+            summary => "Save the database to storage",
+         },
+      },
+
+      summary => "Interact with the user information database",
+   );
+}
+
+sub command_userdb_reload
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   if( $self->{dirty} ) {
+      # TODO: Implement a 'force' option
+      return ( "Database is dirty - will not reload" );
+   }
+
+   $self->reload;
+   $self->mark_clean;
+
+   return ( "OK" );
+}
+
+sub command_userdb_save
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   $self->save;
+   $self->mark_clean;
+
+   return ( "OK" );
+}
+
+sub register_usermgmt_commands
+{
+   my $self = shift;
+   my ( $usermgmt_plugin ) = @_;
+
+   my $irc = $self->{irc};
+   my $users = $irc->get_users_plugin;
+
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "find",
+      perm    => 'master',
+      needhandle => 0,
+
+      args => [
+         CelBot::Commands::ArgSpec::Bareword->new( 'pattern' ),
+      ],
+
+      summary => "List handles matching a pattern",
+   );
+
+   # The method for this command is provided by the concrete subclass
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "get",
+      perm    => "self|master",
+      needhandle => 1,
+
+      args => [],
+
+      summary => "Fetch a record from the userdb",
+   );
+
+   if( $self->can( "add_handle" ) ) {
+      $usermgmt_plugin->register_command(
+         plugin  => $self,
+         command => "add",
+         perm    => 'master',
+         needhandle => 0,
+
+         args => [
+            CelBot::Commands::ArgSpec::Bareword->new( 'newhandle' ),
+            $users->gen_argspec( 'asuser', optional => 1 ),
+         ],
+
+         summary => "Add a new user account",
+      );
+   }
+
+   $usermgmt_plugin->register_command(
+      plugin  => $self,
+      command => "sync",
+      perm    => 'master',
+      needhandle => 1,
+
+      args => [
+         $users->gen_argspec,
+      ],
+
+      summary => "Synchronise a user account from an IRC user",
+   );
+}
+
+sub command_useracc_find
+{
+   my $self = shift;
+   my ( $context, $pattern ) = @_;
+
+   $pattern =~ s/\./\\./g; # Make '.' literal
+   $pattern =~ s/\*/.*/g;  # Make '*' match .*
+   $pattern =~ s/\?/./g;   # Make '?' match .
+
+   my $re = qr/^$pattern$/i; # case-insensitive
+
+   my @handles = grep { $_ =~ $re } $self->list_handles;
+   my $count = @handles;
+
+   if( @handles > 20 ) {
+      return ( "$count matches: " . join( " ", @handles[0 .. 19] ) . " ..." );
+   }
+   else {
+      return ( "$count matches: " . join( " ", @handles ) );
+   }
+}
+
+sub command_useracc_get
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $handle = $context->{handle};
+
+   return "No such userdb handle $handle" unless $self->exists_handle( $handle );
+
+   my %ret;
+
+   my $core = $self->{core};
+   $core->run_plugins( "get_useracc_for_display", $handle, \%ret );
+
+   # TODO: Sort somehow
+   my @ret = map { ref $_ eq 'ARRAY' ? @$_ : $_ } values %ret;
+
+   return @ret;
+}
+
+sub command_useracc_add
+{
+   my $self = shift;
+   my ( $context, $newhandle, $asuser ) = @_;
+
+   return "Cannot add '$newhandle' - already exists" if $self->exists_handle( $newhandle );
+
+   $self->add_handle( $newhandle );
+
+   if( defined $asuser ) {
+      my $core = $self->{core};
+      $core->run_plugins( "on_handle_sync_from_user", $newhandle, $asuser, $context );
+   }
+
+   return "Added '$newhandle' to user database";
+}
+
+sub command_useracc_sync
+{
+   my $self = shift;
+   my ( $context, $user ) = @_;
+
+   my $handle = $context->{handle};
+
+   return "Cannot sync handle '$handle' - does not exist" unless $self->exists_handle( $handle );
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_handle_sync_from_user", $handle, $user, $context );
+
+   return "Synchronised '$handle' from " . $user->nick;
+}
+
+###
+# Settings
+###
+
+sub register_settings
+{
+   my $self = shift;
+   my ( $settings_plugin ) = @_;
+
+   my $core = $self->{core};
+   my $loop = $core->get_loop;
+
+   $settings_plugin->register(
+      type => 'boolean',
+      name => "autosave",
+      perm => 'owner',
+
+      storage => \$self->{autosave},
+
+      after => sub {
+         if( $self->{autosave} and $self->{dirty} and !$self->{savetimer_id} ) {
+            $self->{savetimer_id} = $loop->enqueue_timer(
+               delay => $self->{autosave_delay},
+
+               code => sub {
+                  $self->save;
+                  $self->{dirty} = 0;
+
+                  $core->log( "INFO", "<UserDB>", "UserDB saved to disk; is clean again" );
+               },
+            );
+         }
+
+         if( !$self->{autosave} and $self->{savetimer_id} ) {
+            $loop->cancel_timer( $self->{savetimer_id} );
+            undef $self->{savetimer_id};
+         }
+      },
+
+      desc => "Whether user database is automatically saved after edits",
+   );
+
+   $settings_plugin->register(
+      type => 'int',
+      name => "autosave_delay",
+      perm => 'owner',
+
+      storage => \$self->{autosave_delay},
+
+      desc => "Delay after database edits before it will be saved (if enabled)",
+   );
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/UserDB/XML.pm

@@ -0,0 +1,105 @@
+package CelBot::Plugin::UserDB::XML;
+
+use strict;
+use constant DB_TYPE => "xml";
+use constant PLUGIN_TYPE => undef;
+
+use base qw( CelBot::Plugin::UserDB );
+
+sub init
+{
+   my $self = shift;
+   my ( $config ) = @_;
+
+   my %users;
+   $self->{users} = \%users;
+
+   $config->associate_nodeset(
+      'user',
+      '@handle',
+
+      add => sub {
+         my ( $handle, $config ) = @_;
+
+         my $user = $users{lc $handle} = { handle => $handle };
+
+         $user->{nicks}     = [ $config->get_list( 'nick/text()' ) ];
+         $user->{hostmasks} = [ $config->get_list( 'hostmask/text()' ) ];
+
+         $user->{globaldata} = $config->get_map( 'flag', '@name', 'text()' );
+      },
+
+      keep => sub {
+         my ( $handle, $config ) = @_;
+
+         my $user = $users{lc $handle};
+
+         $user->{nicks}     = [ $config->get_list( 'nick/text()' ) ];
+         $user->{hostmasks} = [ $config->get_list( 'hostmask/text()' ) ];
+
+         $user->{globaldata} = $config->get_map( 'flag', '@name', 'text()' );
+      },
+
+      remove => sub {
+         my ( $handle ) = @_;
+
+         delete $users{lc $handle};
+      },
+   );
+}
+
+sub describe
+{
+   my $self = shift;
+   return "Inline XML";
+}
+
+sub exists_handle
+{
+   my $self = shift;
+   my ( $handle ) = @_;
+
+   return exists $self->{users}->{lc $handle};
+}
+
+sub map_nick_to_handles
+{
+   my $self = shift;
+   my ( $nick ) = @_;
+
+   my @handles;
+
+   foreach my $u ( values %{ $self->{users} } ) {
+      push @handles, $u->{handle} if grep { $_ eq $nick } @{ $u->{nicks} };
+   }
+
+   return @handles;
+}
+
+sub list_handles
+{
+   my $self = shift;
+   # Can't use keys %users because they're casefolded
+   return map { $_->{handle} } values %{ $self->{users} };
+}
+
+sub get_all_data
+{
+   my $self = shift;
+   my ( $handle ) = @_;
+
+   $handle = lc $handle;
+
+   return undef unless exists $self->{users}->{$handle};
+
+   my $data = $self->{users}->{$handle};
+
+   return {
+      global    => $data->{globaldata},
+      nicks     => [ $data->{nicks}     ? @{ $data->{nicks}     } : () ],
+      hostmasks => [ $data->{hostmasks} ? @{ $data->{hostmasks} } : () ],
+   };
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugin/UserDB/YAMLfile.pm

@@ -0,0 +1,145 @@
+package CelBot::Plugin::UserDB::YAMLfile;
+
+use strict;
+use constant DB_TYPE => "yamlfile";
+use constant PLUGIN_TYPE => undef;
+
+use base qw( CelBot::Plugin::UserDB );
+
+BEGIN {
+   if( eval { require YAML::Syck } ) {
+      YAML::Syck->import( qw( LoadFile DumpFile ) );
+   }
+   elsif( eval { require YAML } ) {
+      YAML->import( qw( LoadFile DumpFile ) );
+   }
+   else {
+      die "Can't find YAML::Syck or YAML";
+   }
+}
+
+use Carp;
+
+sub init
+{
+   my $self = shift;
+   my ( $config ) = @_;
+
+   my $filename = $config->get_string( '@file' );
+
+   $self->{filename} = $filename;
+
+   $self->{users}   = [];
+   $self->{usermap} = {};
+
+   $self->reload;
+}
+
+sub reload
+{
+   my $self = shift;
+
+   return unless -e $self->{filename};
+
+   my @users = LoadFile( $self->{filename} );
+
+   undef @{ $self->{users} };
+   undef %{ $self->{usermap} };
+
+   foreach my $u ( @users ) {
+      my %udata = %$u;
+
+      push @{ $self->{users} }, \%udata;
+      $self->{usermap}->{lc $udata{handle}} = \%udata;
+   }
+}
+
+sub save
+{
+   my $self = shift;
+
+   my @users;
+
+   foreach my $u ( @{ $self->{users} } ) {
+      my %udata = %$u;
+
+      push @users, \%udata;
+   }
+
+   DumpFile( $self->{filename}, @users );
+}
+
+sub describe
+{
+   my $self = shift;
+   return "YAML file $self->{filename}";
+}
+
+sub exists_handle
+{
+   my $self = shift;
+   my ( $handle ) = @_;
+
+   return exists $self->{usermap}->{lc $handle};
+}
+
+sub map_nick_to_handles
+{
+   my $self = shift;
+   my ( $nick ) = @_;
+
+   my @handles;
+
+   foreach my $u ( @{ $self->{users} } ) {
+      push @handles, $u->{handle} if grep { $_ eq $nick } @{ $u->{nicks} };
+   }
+
+   return @handles;
+}
+
+sub list_handles
+{
+   my $self = shift;
+   # Can't use keys %usermap because they're casefolded
+   return map { $_->{handle} } values %{ $self->{usermap} };
+}
+
+sub get_all_data
+{
+   my $self = shift;
+   my ( $handle ) = @_;
+
+   $handle = lc $handle;
+
+   return undef unless exists $self->{usermap}->{$handle};
+
+   my $data = $self->{usermap}->{$handle};
+
+   return $data;
+}
+
+sub add_handle
+{
+   my $self = shift;
+   my ( $handle ) = @_;
+
+   $handle = lc $handle;
+
+   croak "Cannot add handle $handle - already exists" if $self->exists_handle( $handle );
+
+   my $data = {
+      handle => $handle,
+      global => {},
+      channel => {},
+   };
+
+   push @{ $self->{users} }, $data;
+   $self->{usermap}->{$handle} = $data;
+
+   $self->mark_dirty;
+
+   return $data;
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Plugins.pm

@@ -0,0 +1,168 @@
+package CelBot::Plugins;
+
+use strict;
+
+use base qw( Exporter );
+our @EXPORT_OK = qw(
+   construct_plugin
+   reload_plugins
+);
+
+BEGIN {
+   if( exists $INC{"constant.pm"} and not exists $INC{"Sub/Uplevel.pm"} ) {
+      die "Loading Sub::Uplevel AFTER constant is too late for it to take effect\n";
+   }
+
+   use Sub::Uplevel;
+}
+
+use B qw( walksymtable svref_2object );
+use Data::Compare;
+use Module::PluginFinder 0.02;
+
+my $pluginfinder = Module::PluginFinder->new(
+   search_path => "CelBot::Plugin",
+   typefunc    => "PLUGIN_TYPE",
+);
+
+sub get_subs_for_file
+{
+   my ( $file ) = @_;
+
+   my @subs;
+
+   # Avoid warning about 'Name B::GB::test_file_and_push used only once'
+   no warnings 'once';
+   local *B::GV::test_file_and_push = sub {
+      my $gvref = shift;
+
+      my $symname = $gvref->STASH->NAME . "::" . $gvref->NAME;
+
+      my $cvref = $gvref->CV;
+      defined $cvref or return;
+
+      $cvref->isa( "B::CV" ) or return;
+
+      # Don't find my own sub
+      $symname eq "B::GV::test_file_and_push" and return;
+
+      push @subs, $symname if $cvref->FILE eq $file;
+   };
+
+   walksymtable( \%::, 'test_file_and_push', sub { 1 }, "" );
+
+   return @subs;
+}
+
+sub construct_plugin
+{
+   my ( $type, @args ) = @_;
+
+   return $pluginfinder->construct( $type, @args );
+}
+
+our %last_mtime;
+
+sub reload_plugins
+{
+   my $class = shift;
+   $pluginfinder->rescan;
+
+   foreach my $key ( keys %INC ) {
+      next unless $key =~ m{^CelBot/};
+      # The console doesn't like being reloaded
+      next if $key =~ m{^CelBot/Console} or $key =~ m{^CelBot/Term};
+
+      my $path = $INC{$key};
+
+      my $mtime = (stat( $path ))[9];
+
+      # Seen it already
+      next if defined $last_mtime{$path} and $last_mtime{$path} == $mtime;
+
+      # Not seen it but it's not changed since we started
+      next if $mtime <= $^T;
+
+      my @functions = get_subs_for_file( $path );
+
+      no strict 'refs';
+
+      my %oldf;
+      foreach my $f ( @functions ) {
+         my ( $p, $n ) = $f =~ m/^(.*::)(.*?)$/ or next;
+
+         $oldf{$f} = *{$f}{CODE};
+         # TODO: This deletes the entire glob, not just the CODE
+         # Perhaps (if we wanted) we could preserve the other items?
+         delete ${$p}{$n};
+      }
+
+      delete $INC{$key};
+
+      eval {
+         # Since get_subs_for_file() gets confused by 'use constant' coming
+         # from the wrong file, we'll do something special when importing
+         # constants; namely, don't reload them. They're constant.
+
+         no warnings 'redefine';
+
+         my $constant_import = \&constant::import;
+
+         local *constant::import = sub {
+            my $class = shift;
+            return unless @_;
+
+            my $callerpkg = caller;
+
+            my %constants;
+            if( $_[0] eq "HASH" ) {
+               %constants = %{ $_[0] };
+            }
+            else {
+               my $n = shift;
+               $constants{$n} = @_ == 1 ? $_[0] : [ @_ ];
+            }
+
+            foreach my $n ( keys %constants ) {
+               my $f = "${callerpkg}::$n";
+
+               if( defined *{$f}{CODE} ) {
+                  my $oldvalue = *{$f}{CODE}->();
+                  unless( Compare( $oldvalue, $constants{$n} ) ) {
+                     ::console_print_err( "Redefining $f to a different value\n" );
+                     delete ${"${callerpkg}::"}{$n};
+                  }
+                  else {
+                     delete $constants{$n};
+                  }
+               }
+            }
+
+            return unless keys %constants;
+            
+            uplevel 1, $constant_import, $class, \%constants;
+         };
+
+         require $key;
+      };
+
+      if( $@ ) {
+         ::console_print_err( "Reloading $key failed - $@\n" );
+         $INC{$key} = $path;
+
+         # Put the old functions back
+         foreach my $f ( keys %oldf ) {
+            *{$f} = $oldf{$f};
+         }
+      }
+      else {
+         ::console_print_err( "Reloaded $key\n" );
+         $last_mtime{$path} = $mtime;
+
+         # %oldf will go out of scope anyway, so we don't need to do anything
+      }
+   }
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/RateLimiter.pm

@@ -0,0 +1,97 @@
+package CelBot::RateLimiter;
+
+use strict;
+
+use Time::HiRes qw( time );
+
+sub new
+{
+   my $class = shift;
+   my ( $loop, $count, $delay ) = @_;
+
+   my $self = bless {
+      loop  => $loop,
+      count => $count,
+      delay => $delay,
+
+      timequeue => [],
+      deferred => [],
+   }, $class;
+
+   return $self;
+}
+
+sub do
+{
+   my $self = shift;
+   my ( $code ) = @_;
+
+   my $now = time;
+
+   return if( $self->_try_immediate( $now, $code ) );
+
+   my $deferred = $self->{deferred};
+
+   $self->_install_timer() if !@$deferred;
+
+   push @$deferred, $code;
+}
+
+sub _try_immediate
+{
+   my $self = shift;
+   my ( $now, $code ) = @_;
+
+   my $earlier = $now - $self->{delay};
+
+   my $count = $self->{count};
+   my $timequeue = $self->{timequeue};
+
+   # Expire old times
+   shift @$timequeue while @$timequeue and $timequeue->[0] < $earlier;
+
+   if( @$timequeue < $count ) {
+      $code->();
+
+      push @$timequeue, $now;
+
+      return 1;
+   }
+   else {
+      return 0;
+   }
+}
+
+sub _install_timer
+{
+   my $self = shift;
+
+   my $until = $self->{timequeue}->[0] + $self->{delay};
+
+   $self->{loop}->enqueue_timer(
+      time => $until,
+      code => sub { eval { $self->_run_deferrals; 1 } or 
+                       ::console_print_err( "Deferred events failed - $@\n" ) },
+   );
+}
+
+sub _run_deferrals
+{
+   my $self = shift;
+
+   my $now = time;
+   my $deferred = $self->{deferred};
+
+   while( my $code = $deferred->[0] ) {
+      $self->_try_immediate( $now, $code ) or last;
+
+      shift @$deferred;
+   }
+
+   return if !@$deferred;
+
+   $self->_install_timer();
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Resolver.pm

@@ -0,0 +1,43 @@
+package CelBot::Resolver;
+
+use strict;
+
+sub resolve
+{
+   my %args = @_;
+
+   my $loop = $args{loop};
+
+   my $on_resolved = delete $args{on_resolved};
+   my $on_error    = delete $args{on_error};
+
+   $loop->resolve(
+      type => $args{type},
+      data => $args{data},
+
+      on_resolved => sub {
+         my @data = @_;
+
+         my $ret = eval { $on_resolved->( @data ); 1 };
+
+         if( !defined $ret and $@ ) {
+            ::console_print_err( "Callback on_resolved failed - $@\n" );
+         }
+      },
+
+      on_error  => sub {
+         my ( $err ) = @_;
+
+         chomp $err;
+
+         my $ret = eval { $on_error->( $err ); 1 };
+
+         if( !defined $ret and $@ ) {
+            ::console_print_err( "Callback on_error failed - $@\n" );
+         }
+      },
+   );
+}
+
+# Keep perl happy; keep Britain tidy
+1;

extern/cel-bot/CelBot/Settings.pm

@@ -0,0 +1,476 @@
+package CelBot::Settings;
+
+use strict;
+
+use CelBot::Commands;
+
+use Carp;
+
+sub new
+{
+   my $class = shift;
+   my ( $core ) = @_;
+
+   my $self = bless {
+      core => $core,
+   }, $class;
+
+   return $self;
+}
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   # First clear the existing settings
+   $self->{settings} = {};
+
+   my $helpargs = [
+      CelBot::Settings::ArgSpec->new( 'setting', settings => $self->{settings} ),
+   ];
+
+   my $core = $self->{core};
+   $core->run_plugins( "register_settings", $self );
+
+   if( keys %{ $self->{settings} } ) {
+      $commands_plugin->register(
+         plugin  => $self,
+         command => "get",
+         perm    => 'master',
+
+         args => [
+            CelBot::Settings::ArgSpec->new( 'setting', settings => $self->{settings} ),
+         ],
+
+         summary => "Get the value of a setting",
+
+         helpargs => $helpargs,
+      );
+   }
+
+   if( grep { exists $_->{set} } values %{ $self->{settings} } ) {
+      $commands_plugin->register(
+         plugin  => $self,
+         command => "set",
+         perm    => 'master',
+
+         args => [
+            CelBot::Settings::ArgSpec->new( 'setting', settings => $self->{settings} ),
+            CelBot::Commands::ArgSpec::Sugar->new( '=' ),
+            CelBot::Commands::ArgSpec->new( 'value', trailing => 1 ),
+         ],
+
+         summary => "Set the value of a setting",
+
+         helpargs => $helpargs,
+      );
+   }
+
+   if( grep { exists $_->{add} } values %{ $self->{settings} } ) {
+      $commands_plugin->register(
+         plugin  => $self,
+         command => "add",
+         perm    => 'master',
+
+         args => [
+            CelBot::Settings::ArgSpec->new( 'setting', settings => $self->{settings} ),
+            CelBot::Commands::ArgSpec::Sugar->new( '=' ),
+            CelBot::Commands::ArgSpec->new( 'value', trailing => 1 ),
+         ],
+
+         summary => "Add a value to a list setting",
+
+         helpargs => $helpargs,
+      );
+   }
+
+   if( grep { exists $_->{ins} } values %{ $self->{settings} } ) {
+      $commands_plugin->register(
+         plugin  => $self,
+         command => "ins",
+         perm    => 'master',
+
+         args => [
+            CelBot::Settings::ArgSpec->new( 'setting', settings => $self->{settings} ),
+            CelBot::Commands::ArgSpec::Bareword->new( 'index', match => qr/^\d+$/ ),
+            CelBot::Commands::ArgSpec::Sugar->new( '=' ),
+            CelBot::Commands::ArgSpec->new( 'value', trailing => 1 ),
+         ],
+
+         summary => "Insert a value into a list setting before the given index (0-based)",
+
+         helpargs => $helpargs,
+      );
+   }
+
+   if( grep { exists $_->{del} } values %{ $self->{settings} } ) {
+      $commands_plugin->register(
+         plugin  => $self,
+         command => "del",
+         perm    => 'master',
+
+         args => [
+            CelBot::Settings::ArgSpec->new( 'setting', settings => $self->{settings} ),
+            CelBot::Commands::ArgSpec::Bareword->new( 'index', match => qr/^\d+$/ ),
+         ],
+
+         summary => "Delete the value from a list setting at the given index (0-based)",
+
+         helpargs => $helpargs,
+      );
+   }
+}
+
+my %types = (
+   custom  => {}, # callbacks given at 'register' time
+
+   boolean => { print => \&print_boolean, parse => \&parse_boolean },
+   'int'   => { print => \&print_scalar,  parse => \&parse_int },
+   string  => { print => \&print_scalar,  parse => \&parse_string },
+);
+
+my %stores = (
+   SCALAR => {
+      get => sub {
+         my ( $setting ) = @_;
+         return ${ $setting->{storage} };
+      },
+      set => sub {
+         my ( $setting, $value ) = @_;
+         ${ $setting->{storage} } = $value;
+      },
+   },
+
+   ARRAY => {
+      get => sub {
+         my ( $setting ) = @_;
+         return @{ $setting->{storage} }
+      },
+      add => sub {
+         my ( $setting, $value ) = @_;
+         push @{ $setting->{storage} }, $value;
+      },
+      ins => sub {
+         my ( $setting, $index, $value ) = @_;
+         if( $index < scalar @{ $setting->{storage} } ) {
+            splice @{ $setting->{storage} }, $index, 0, $value;
+         }
+         else {
+            push @{ $setting->{storage} }, $value;
+         }
+      },
+      del => sub {
+         my ( $setting, $index ) = @_;
+         die "No value at index $index\n" unless $index < @{ $setting->{storage} };
+         splice @{ $setting->{storage} }, $index, 1, ();
+      },
+   },
+);
+
+sub register
+{
+   my $self = shift;
+   my %args = @_;
+
+   my $name = $args{name} or croak "Need a 'name'";
+
+   my $type = delete $args{type} or croak "Need a 'type'";
+   exists $types{$type} or croak "Unrecognised type '$type'";
+
+   $args{perm} or croak "Need 'perm'";
+
+   $self->{settings}->{$name} = \%args;
+
+   my $storagetype = ref $args{storage};
+
+   # Fetch parse/print and accessor methods, but let %args override
+   %args = (
+             %{ $types{$type} },
+             exists $stores{$storagetype} ? %{ $stores{$storagetype} } : (),
+             %args
+           );
+
+   $args{get} or croak "Need a 'get' method";
+}
+
+sub commandhelp_get
+{
+   my $self = shift;
+   my ( $context, $setting ) = @_;
+
+   my $name = $setting->{name};
+
+   return "Setting '$name': $setting->{desc}";
+}
+
+sub command_get
+{
+   my $self = shift;
+   my ( $context, $setting ) = @_;
+
+   my $name = $setting->{name};
+
+   unless( $context->allows_perm( $setting->{perm} ) ) {
+      return ( "You are not allowed to get setting '$name'" );
+   }
+
+   eval {
+      $setting->{before}->( 'get', $setting, $context ) if exists $setting->{before};
+   };
+   return "Cannot get $name: $@" if $@;
+
+   return "$name: " . $setting->{print}->( $setting->{get}->( $setting ) );
+}
+
+sub commandhelp_set
+{
+   my $self = shift;
+   my ( $context, $setting ) = @_;
+
+   my $name = $setting->{name};
+
+   if( !exists $setting->{set} ) {
+      return "Cannot set $name";
+   }
+
+   return "Setting '$name': $setting->{desc}";
+}
+
+sub command_set
+{
+   my $self = shift;
+   my ( $context, $setting ) = @_;
+
+   my $name = $setting->{name};
+
+   unless( $context->allows_perm( $setting->{perm} ) ) {
+      return ( "You are not allowed to set setting '$name'" );
+   }
+
+   if( !exists $setting->{set} ) {
+      return "Cannot set $name";
+   }
+
+   eval {
+      $setting->{before}->( 'set', $setting, $context ) if exists $setting->{before};
+      my $value = $setting->{parse}->( $context );
+      $setting->{set}->( $setting, $value );
+      $setting->{after}->( 'set', $setting, $context ) if exists $setting->{after};
+   };
+   return "Cannot set $name: $@" if $@;
+
+   return "$name: " . $setting->{print}->( $setting->{get}->( $setting ) );
+}
+
+sub commandhelp_add
+{
+   my $self = shift;
+   my ( $context, $setting ) = @_;
+
+   my $name = $setting->{name};
+
+   if( !exists $setting->{add} ) {
+      return "Cannot add to $name";
+   }
+
+   return "Setting '$name': $setting->{desc}";
+}
+
+sub command_add
+{
+   my $self = shift;
+   my ( $context, $setting ) = @_;
+
+   my $name = $setting->{name};
+
+   unless( $context->allows_perm( $setting->{perm} ) ) {
+      return ( "You are not allowed to add to setting '$name'" );
+   }
+
+   if( !exists $setting->{add} ) {
+      return "Cannot add to $name";
+   }
+
+   eval {
+      $setting->{before}->( 'add', $setting, $context ) if exists $setting->{before};
+      my $value = $setting->{parse}->( $context );
+      $setting->{add}->( $setting, $value );
+      $setting->{after}->( 'add', $setting, $context ) if exists $setting->{after};
+   };
+   return "Cannot add to $name: $@" if $@;
+
+   return "$name: " . $setting->{print}->( $setting->{get}->( $setting ) );
+}
+
+sub commandhelp_ins
+{
+   my $self = shift;
+   my ( $context, $setting ) = @_;
+
+   my $name = $setting->{name};
+
+   if( !exists $setting->{ins} ) {
+      return "Cannot ins into $name";
+   }
+
+   return "Setting '$name': $setting->{desc}";
+}
+
+sub command_ins
+{
+   my $self = shift;
+   my ( $context, $setting, $index ) = @_;
+
+   my $name = $setting->{name};
+
+   unless( $context->allows_perm( $setting->{perm} ) ) {
+      return ( "You are not allowed to insert into setting '$name'" );
+   }
+
+   if( !exists $setting->{ins} ) {
+      return "Cannot ins into $name";
+   }
+
+   eval {
+      $setting->{before}->( 'ins', $setting, $context ) if exists $setting->{before};
+      my $value = $setting->{parse}->( $context );
+      $setting->{ins}->( $setting, $index, $value );
+      $setting->{after}->( 'ins', $setting, $context ) if exists $setting->{after};
+   };
+   return "Cannot ins into $name: $@" if $@;
+
+   return "$name: " . $setting->{print}->( $setting->{get}->( $setting ) );
+}
+
+sub commandhelp_del
+{
+   my $self = shift;
+   my ( $context, $setting ) = @_;
+
+   my $name = $setting->{name};
+
+   if( !exists $setting->{del} ) {
+      return "Cannot del from $name";
+   }
+
+   return "Setting '$name': $setting->{desc}";
+}
+
+sub command_del
+{
+   my $self = shift;
+   my ( $context, $setting, $index ) = @_;
+
+   my $name = $setting->{name};
+
+   unless( $context->allows_perm( $setting->{perm} ) ) {
+      return ( "You are not allowed to delete from setting '$name'" );
+   }
+
+   if( !exists $setting->{del} ) {
+      return "Cannot del from $name";
+   }
+
+   eval {
+      $setting->{before}->( 'del', $setting, $context ) if exists $setting->{before};
+      $setting->{del}->( $setting, $index );
+      $setting->{after}->( 'del', $setting, $context ) if exists $setting->{after};
+   };
+   return "Cannot del from $name: $@" if $@;
+
+   return "$name: " . $setting->{print}->( $setting->{get}->( $setting ) );
+}
+
+### Handler methods for various types
+
+sub print_scalar { $_[0] }
+
+sub print_boolean { $_[0] ? "TRUE" : "FALSE" }
+
+sub parse_boolean
+{
+   my ( $context ) = @_;
+
+   my $value = $context->pull_token;
+   defined $value or die "No value given for boolean setting\n";
+
+   return 1 if $value eq "1" or lc $value eq "true";
+   return 0 if $value eq "0" or lc $value eq "false";
+   die "Unrecognised value '$value' for boolean setting\n";
+}
+
+sub parse_int
+{
+   my ( $context ) = @_;
+
+   my $value = $context->pull_token;
+   defined $value or die "No value given for integer setting\n";
+
+   no warnings 'numeric';
+   die "Unrecognised value '$value' for integer setting\n" unless $value eq int $value;
+
+   return $value;
+}
+
+sub parse_string
+{
+   my ( $context ) = @_;
+
+   my $value = $context->text;
+   defined $value or $value = "";
+
+   return $value;
+}
+
+
+# Keep perl happy, keep Britain tidy
+1;
+
+
+package CelBot::Settings::ArgSpec;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec::Bareword );
+
+sub pull
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $settingstruct = $self->SUPER::pull( $context );
+
+   if( my $opts = $settingstruct->{options} ) {
+      # Clone the settingstruct since we'll be modifying it
+      $settingstruct = { %$settingstruct };
+
+      while(1) {
+         my $optname = $context->peek_token;
+         last unless defined $optname;
+
+         last unless exists $opts->{$optname};
+         die "Cannot supply '$optname' option more than once\n" if exists $settingstruct->{$optname};
+
+         my $opt = $opts->{$optname};
+         die "You are not allowed to use the '$optname' option\n" if defined $opt->{perm} and not $context->allows_perm( $opt->{perm} );
+
+         $context->pull_token; # Eat the token we peeked at
+
+         $settingstruct->{$optname} = $opt->pull( $context );
+      }
+   }
+
+   return $settingstruct;
+}
+
+sub validate
+{
+   my $self = shift;
+   my ( $setting ) = @_;
+
+   die "'$setting' is not a valid setting\n" unless exists $self->{settings}->{$setting};
+   
+   return $self->{settings}->{$setting};
+}
+
+1;

extern/cel-bot/CelBot/User.pm

@@ -0,0 +1,304 @@
+package CelBot::User;
+
+use strict;
+
+use Carp;
+
+use CelBot::Resolver;
+
+use Socket qw( inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in AF_INET NI_NAMEREQD );
+
+sub new
+{
+   my $class = shift;
+   my ( $core, $nick ) = @_;
+
+   my $irc = $core->get_plugin( "irc" );
+
+   my $self = bless {
+      core => $core,
+      irc  => $irc,
+
+      nick => $nick,
+      nick_folded => $irc->casefold_name( $nick ),
+
+      ident => undef,
+      host_raw => undef, # Host as presented by IRCd, may be an IP address
+      host  => undef,    # Host as resolved by us; may be equal to {host_raw} 
+                         # or may have been resolved
+
+      is_me => $irc->is_me( $nick ),
+
+      module_data => {},
+   }, $class;
+
+   $core->run_plugins( "on_user_create", $self ) unless $self->{is_me};
+
+   return $self;
+}
+
+use overload '""' => "STRING";
+
+sub STRING
+{
+   my $self = shift;
+   return __PACKAGE__."[nick=$self->{nick}]";
+}
+
+sub quit
+{
+   my $self = shift;
+   my ( $reason ) = @_;
+
+   my $core = $self->{core};
+   $core->run_plugins( "on_user_quit", $self, $reason );
+}
+
+sub nick
+{
+   my $self = shift;
+   return $self->{nick};
+}
+
+sub nick_folded
+{
+   my $self = shift;
+   return $self->{nick_folded};
+}
+
+sub is_me
+{
+   my $self = shift;
+   my $irc = $self->{irc};
+   return $irc->is_me( $self->nick_folded );
+}
+
+sub ident
+{
+   my $self = shift;
+   # Trim a leading '~' if there is one
+   ( my $ident = $self->{ident} ) =~ s/^~//;
+   return $ident;
+}
+
+sub host
+{
+   my $self = shift;
+   return defined $self->{host} ? $self->{host} : $self->{host_raw};
+}
+
+sub location
+{
+   my $self = shift;
+
+   my $ident = $self->ident;
+   my $host  = $self->host;
+
+   return "$ident\@$host";
+}
+
+sub change_nick
+{
+   my $self = shift;
+   my ( $newnick ) = @_;
+
+   my $core = $self->{core};
+   my $irc = $self->{irc};
+
+   my $oldnick = $self->{nick};
+
+   return if $newnick eq $oldnick;
+
+   $self->{nick} = $newnick;
+   $self->{nick_folded} = $irc->casefold_name( $newnick );
+
+   $core->run_plugins( "on_user_rename", $self, $oldnick, $newnick );
+}
+
+sub advise_host
+{
+   my $self = shift;
+   my ( $ident, $host ) = @_;
+
+   # Do we already know this?
+   return if( (!$self->{rerecognise}) and 
+              defined $self->{ident} and ( $self->{ident} eq $ident ) and
+              defined $self->{host}  and ( $self->{host} eq $host or $self->{host_raw} eq $host ) );
+
+   $self->{ident} = $ident;
+   $self->{host_raw} = $host;
+
+   delete $self->{rerecognise};
+
+   my $core = $self->{core};
+
+   unless( $host =~ m/^\d+\.\d+\.\d+\.\d+$/ ) {
+      $self->_set_host( $host );
+      return;
+   }
+
+   my $ip = $host;
+
+   my $saddr = pack_sockaddr_in( 0, inet_aton( $ip ) );
+
+   my $loop = $core->get_loop;
+
+   CelBot::Resolver::resolve(
+      loop => $loop,
+
+      type => "getnameinfo",
+      data => [ $saddr, NI_NAMEREQD ],
+
+      on_resolved => sub {
+         my ( $host, $service ) = @{ $_[0] };
+
+         if( !defined $host ) {
+            $self->_set_host( $ip );
+            return;
+         }
+
+         CelBot::Resolver::resolve(
+            loop => $loop,
+
+            type => "getaddrinfo_hash",
+            data => [ host => $host, family => AF_INET ],
+
+            on_resolved => sub {
+               my @res = @_;
+
+               foreach my $res ( @res ) {
+                  my $addr = $res->{addr};
+                  my ( $saddr_port, $saddr_host ) = unpack_sockaddr_in( $addr );
+
+                  my $saddr_ip = inet_ntoa( $saddr_host );
+
+                  if( $saddr_ip eq $ip ) {
+                     $self->_set_host( $host );
+                     return;
+                  }
+               }
+
+               # No candidates matched - resort to IP
+               $self->_set_host( $ip );
+            },
+
+            on_error => sub {
+               $core->err( "Forward resolution error on $host - $_[0]" );
+               $self->_set_host( $ip );
+            },
+         );
+      },
+
+      on_error => sub {
+         $core->err( "Resolution error on $ip - $_[0]" );
+         $self->_set_host( $ip );
+      },
+   );
+}
+
+sub _set_host
+{
+   my $self = shift;
+   my ( $host ) = @_;
+
+   $self->{host} = $host;
+
+   my $core = $self->{core};
+
+   $core->run_plugins( "on_user_host", $self, $self->{ident}, $host );
+}
+
+sub store_module_data
+{
+   my $self = shift;
+   my ( $module, $data ) = @_;
+
+   $self->{module_data}->{$module} = $data;
+}
+
+sub retrieve_module_data
+{
+   my $self = shift;
+   my ( $module ) = @_;
+
+   return $self->{module_data}->{$module};
+}
+
+sub get_global_data
+{
+   my $self = shift;
+   my ( $key ) = @_;
+
+   my $core = $self->{core};
+   return $core->ask_plugins( "ask_user_global_data", $self, $key );
+}
+
+sub get_channel_data
+{
+   my $self = shift;
+   my ( $channel, $key ) = @_;
+
+   my $core = $self->{core};
+   return $core->ask_plugins( "ask_user_channel_data", $self, $channel, $key );
+}
+
+sub channels
+{
+   my $self = shift;
+
+   # Don't try to store this in the object, as keeping it uptodate and
+   # synchronised with the Channel objects is tricky. Instead, on the rare
+   # occasions when it's needed, look it up dynamically.
+
+   my $irc = $self->{irc};
+
+   my @channels;
+   foreach my $channel ( $irc->get_channels ) {
+       push @channels, $channel if defined $channel->get_userflag( $self );
+   }
+
+   return @channels;
+}
+
+sub privmsg
+{
+   my $self = shift;
+   my ( $text ) = @_;
+
+   my $irc = $self->{irc};
+   $irc->send_message( "PRIVMSG", undef, $self->{nick}, $text );
+}
+
+sub whois
+{
+   my $self = shift;
+   my %args = @_;
+
+   croak "Cannot whois - already in progress" if $self->{collect_whois};
+
+   $self->{collect_whois} = {};
+   $self->{on_whois} = $args{on_whois};
+
+   my $irc = $self->{irc};
+   $irc->send_message( "WHOIS", undef, $self->{nick} );
+}
+
+sub on_whois_message
+{
+   my $self = shift;
+   my ( $message, $hints ) = @_;
+
+   if( $self->{collect_whois} ) {
+      $self->{collect_whois}->{$message->command} = [ $message->args ];
+
+      if( $message->command eq "318" ) {
+         $self->{on_whois}->( %{ $self->{collect_whois} } );
+
+         delete $self->{collect_whois};
+         delete $self->{on_whois};
+      }
+   }
+}
+
+# Keep perl happy, keep Britain tidy
+1;

extern/cel-bot/CelBot/Users.pm

@@ -0,0 +1,290 @@
+package CelBot::Users;
+
+use strict;
+
+use CelBot::User;
+use CelBot::Commands;
+
+sub new
+{
+   my $class = shift;
+   my ( $core ) = @_;
+
+   my $self = bless {
+      core => $core,
+      irc  => $core->get_plugin( "irc" ),
+
+      users => {},
+   }, $class;
+
+   return $self;
+}
+
+sub get_user
+{
+   my $self = shift;
+   my ( $nick ) = @_;
+
+   my $irc = $self->{irc};
+   my $nick_folded = $irc->casefold_name( $nick );
+
+   return $self->{users}->{$nick_folded};
+}
+
+sub get_users
+{
+   my $self = shift;
+   return values %{ $self->{users} };
+}
+
+sub nick_to_user
+{
+   my $self = shift;
+   my ( $nick ) = @_;
+
+   my $irc = $self->{irc};
+   my $nick_folded = $irc->casefold_name( $nick );
+
+   return $self->{users}->{$nick_folded} ||= CelBot::User->new( $self->{core}, $nick );
+}
+
+sub hints_to_user
+{
+   my $self = shift;
+   my ( $hints ) = @_;
+
+   my $user = $self->nick_to_user( $hints->{prefix_nick} );
+
+   $user->advise_host( $hints->{prefix_user}, $hints->{prefix_host} );
+
+   return $user;
+}
+
+sub gen_argspec
+{
+   my $self = shift;
+
+   if( @_ ) {
+      my $name = shift;
+      return CelBot::Users::ArgSpec->new( $name, users => $self, @_ );
+   }
+   else {
+      # Cache a single one
+      return $self->{argspec} ||= CelBot::Users::ArgSpec->new( 'user', users => $self );
+   }
+}
+
+sub on_message_NICK
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   if( $hints->{prefix_is_me} ) {
+      return 0;
+   }
+
+   my $user = $self->hints_to_user( $hints );
+
+   my $oldnick_folded = $user->nick_folded;
+   my $newnick = $message->arg(0);
+
+   my $irc = $self->{irc};
+   my $newnick_folded = $irc->casefold_name( $newnick );
+
+   $self->{users}->{$newnick_folded} = delete $self->{users}->{$oldnick_folded};
+
+   $user->change_nick( $newnick );
+
+   return 1;
+}
+
+sub on_message_PRIVMSG
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my $core = $self->{core};
+   my $irc = $self->{irc};
+   my $target = $message->arg(0);
+
+   if( $irc->is_me( $target ) ) {
+      my $user = $self->hints_to_user( $hints );
+      $core->run_plugins( "on_user_privmsg", $user, $message->arg(1) );
+      return 1;
+   }
+
+   return 0;
+}
+
+sub on_message_QUIT
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   if( $hints->{prefix_is_me} ) {
+      return 0;
+   }
+
+   my $user = $self->hints_to_user( $hints );
+
+   my $reason = $message->arg(0);
+   defined $reason or $reason = "";
+
+   $user->quit( $reason );
+
+   delete $self->{users}->{$user->nick_folded};
+
+   return 1;
+}
+
+sub on_message_311
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   my $user = $self->nick_to_user( $message->arg(1) );
+
+   my $ident = $message->arg(2);
+   my $host  = $message->arg(3);
+
+   $user->advise_host( $ident, $host );
+
+   $user->on_whois_message( $message, $hints );
+
+   return 1;
+}
+
+# TODO: This list probably needs extending
+my %WHOIS = map { $_ => 1 } qw( 307 311 312 313 317 318 319 );
+
+sub on_message
+{
+   my $self = shift;
+   my ( $command, $message, $hints ) = @_;
+
+   if( $WHOIS{$command} ) {
+      my $user = $self->nick_to_user( $message->arg(1) );
+      $user->on_whois_message( $message, $hints );
+   }
+
+   return 0;
+}
+
+# If we're in channels, need some integration there
+
+sub on_channel_self_join
+{
+   my $self = shift;
+   my ( $channel ) = @_;
+
+   # Need the ident/hostname of every user in the channel - request a WHO list
+   $channel->start_who;
+
+   return 1;
+}
+
+###
+# Commands
+###
+
+sub register_commands
+{
+   my $self = shift;
+   my ( $commands_plugin ) = @_;
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "as",
+      perm    => 'owner',
+
+      args => [
+         $self->gen_argspec,
+         CelBot::Commands::ArgSpec->new( 'command', trailing => 1 ),
+      ],
+
+      summary => "Execute a command as another user",
+   );
+
+   $commands_plugin->register(
+      plugin  => $self,
+      command => "privately",
+
+      args => [
+         CelBot::Commands::ArgSpec->new( 'command', trailing => 1 ),
+      ],
+
+      summary => "Redirect output of a command to a PRIVMSG to the invoking user",
+   );
+}
+
+sub command_as
+{
+   my $self = shift;
+   my ( $context, $asuser ) = @_;
+
+   my $subcontext = $context->new_sub(
+      cmduser => $asuser,
+
+      cascade => 0,
+   );
+
+   my $core = $self->{core};
+
+   my $cmds_plugin = $core->get_plugin( "commands" );
+   $cmds_plugin->run_command( $subcontext );
+
+   return ();
+}
+
+sub command_privately
+{
+   my $self = shift;
+   my ( $context ) = @_;
+
+   my $cmduser = $context->cmduser;
+   unless( $cmduser ) {
+      $context->respond_noise( "Cannot run a command privately to no user" );
+      return ();
+   }
+
+   my $subcontext = $context->new_sub(
+      scope   => "privmsg",
+
+      max_spam => 10, # TODO: Per-user lookup?
+      allows_noise => 1,
+
+      responder => sub {
+         $cmduser->privmsg( $_[0] );
+      },
+   );
+
+   my $core = $self->{core};
+
+   my $cmds_plugin = $core->get_plugin( "commands" );
+   $cmds_plugin->run_command( $subcontext );
+
+   return ();
+}
+
+# Keep perl happy, keep Britain tidy
+1;
+
+
+package CelBot::Users::ArgSpec;
+
+use strict;
+use base qw( CelBot::Commands::ArgSpec::Bareword );
+
+sub validate
+{
+   my $self = shift;
+   my ( $username ) = @_;
+
+   my $user = $self->{users}->get_user( $username );
+
+   die "No such user '$username'\n" if !defined $user;
+
+   return $user;
+}
+
+1;

extern/cel-bot/SIGNALS

@@ -0,0 +1,76 @@
+SIGNALS
+=======
+
+Core:
+  connect
+  do_log $tag, $subject, $message
+
+Console:
+  on_console_line $tab, $line
+
+IRC:
+  on_message $message, \%hints
+  on_message_$COMMAND $message, \%hints
+
+Channels:
+  on_channel_ctcp_ACTION $channel, $user, $text
+  on_channel_join $channel, $user
+  on_channel_leave $channel, $user, $command, $reason, [ $kicker ]
+  on_channel_mode $channel, $modechar, $value
+  on_channel_names $channel, \%userflags
+  on_channel_privmsg $channel, $user, $text
+  on_channel_self_join $channel
+  on_channel_self_leave $channel, $command, $reason
+  on_channel_topic $channel, $topic, $user_prefix
+  on_channel_usermode $channel, $user, $flag
+  on_channel_user_rename $channel, $oldnick, $newnick
+  on_channel_who $channel, @wholist
+
+Recognition:
+  on_recognise_user $user, $handle
+
+Users:
+  on_user_create $user
+  on_user_host $user, $ident, $host
+  on_user_privmsg $user, $text
+  on_user_quit $user, $reason
+  on_user_rename $user, $oldnick, $newnick
+
+UserDB:
+  on_handle_sync_from_user $handle, $user, $commandcontext
+  do_handle_set_data $handle, $key, $data
+  do_handle_set_global_data $handle, $key, $data
+  do_handle_set_channel_data $handle, $channame, $key, $data
+
+Commands:
+  register_commands $commands_plugin
+
+Settings:
+  register_settings $settings_plugin
+
+
+QUERIES
+=======
+
+Commands:
+  $allow = permit_command_nonpublic $context
+  $allow = permit_command_perm $perm, $context
+  $allow = permit_command_scope $scope, $context
+
+Recognition:
+  @handles = ask_map_user_to_handles $user
+  @users = ask_map_handle_to_users $handle, $only_recognised
+
+Users:
+  $data = ask_user_global_data $user, $key
+  $data = ask_user_channel_data $user, $channel, $key
+
+UserDB:
+  $data = ask_handle_data $handle, $key
+  $data = ask_handle_global_data $handle, $key
+  $data = ask_handle_channel_data $handle, $channame, $key
+  $data = ask_handle_channels_data $handle, $key
+  @handles = ask_map_nick_to_handles $nick
+
+Plugins/AutoMode:
+  $allow = permit_user_channel_priv $user, $channel, $priv

extern/cel-bot/cel-bot

@@ -0,0 +1,106 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Carp;
+
+# Plugins has to come first because it pulls in Sub::Uplevel that needs to be
+# loaded before constant
+use CelBot::Plugins;
+use CelBot::Core;
+use CelBot::Control;
+
+use IO::Async::Loop;
+
+use Config::XPath::Reloadable 0.12;
+
+use Getopt::Long;
+
+my $CONFIGFILE = "cel-bot.xml";
+
+GetOptions(
+   'config|C=s' => \$CONFIGFILE,
+) or exit(1);
+
+my $config = Config::XPath::Reloadable->new( filename => $CONFIGFILE );
+
+my $loop = IO::Async::Loop->new();
+
+# Big hack so we can :: call this from elsewhere
+sub console_print_err
+{
+   my ( $message ) = @_;
+
+   chomp $message;
+
+   if( $CelBot::Core::globaltab ) {
+      $CelBot::Core::globaltab->add_line( "ERR: $message", indent => 5 );
+   }
+}
+
+$loop->attach_signal( 
+   HUP => sub {
+      CelBot::Control::global_reload;
+   }
+);
+
+# $loop->attach_signal( 
+#    INT => sub {
+#       $loop->loop_stop;
+#    }
+# );
+$SIG{INT} = sub {
+   $CelBot::Core::tickit->stop if $CelBot::Core::tickit;
+   confess "interrupted";
+};
+
+$loop->attach_signal( 
+   TERM => sub {
+      $loop->loop_stop;
+   }
+);
+
+# BIG TODO
+my $plugins = bless {}, "CelBot::Plugins";
+
+# This can't be an import or else when it gets reloaded it'll break
+push @CelBot::Control::ON_GLOBAL_RELOAD, sub { $plugins->reload_plugins };
+push @CelBot::Control::ON_GLOBAL_RELOAD, sub { $config->reload };
+
+my %networks;
+
+$config->associate_nodeset(
+   '/cel-bot/network',
+   '@tag',
+
+   add => sub {
+      my ( $tag, $config ) = @_;
+
+      $networks{$tag} = CelBot::Core->new(
+         tag     => $tag,
+         config  => $config,
+         loop    => $loop,
+      );
+   },
+
+   keep => sub {
+      my ( $tag, $config ) = @_;
+
+      $networks{$tag}->reconfigure( $config );
+
+      $config->reload;
+   },
+
+   remove => sub {
+      my ( $tag ) = @_;
+
+      $networks{$tag}->shutdown;
+      # TODO: $console->del_tab( $networks{$tag}->{tab} );
+
+      delete $networks{$tag};
+   },
+);
+
+eval { $loop->loop_forever };
+$CelBot::Core::tickit->teardown_term if $CelBot::Core::tickit;
+die $@ if $@;