grande_piddle_bot

irc.pl

#!/usr/bin/env perl

use strict;
use warnings;

my $bot = GrandePiddleBot->new();
$bot->run;

package GrandePiddleBot;

use strict;
use warnings;

use 5.14.0;

use AnyEvent;
use AnyEvent::IRC::Client;

use DBM::Deep;
use String::Random qw/random_regex/;
use Digest::SHA1 qw/sha1/;

sub new {
  my $class = shift;
  my %opts = ref $_[0] ? %{ shift() } : @_;

  my $self = {
    condvar => AnyEvent->condvar(),
    client  => AnyEvent::IRC::Client->new(),
    chan    => $opts{chan}   || '#pdl',
    mynick  => $opts{mynick} || 'grande_piddle_bot',
    server  => $opts{server} || 'irc.perl.org',
    port    => $opts{port}   || 6667,
    opfile  => $opts{opfile} || 'ops.dat',
    private => 0,
  };

  $self->{ophash} = DBM::Deep->new( $self->{opfile} );

  bless $self, $class;

  # register client callbacks

  $self->client->reg_cb( connect => sub {
    my ($client, $err) = @_;
    if (defined $err) {
      warn "connect error: $err\n";
      return;
    }
  });

  $self->client->reg_cb( registered => sub { 
    my ($client) = @_;
    print "All systems go!\n"; 

    unless ($client->is_my_nick( $self->mynick )) {
      my $nick = $self->mynick( $client->nick );
      warn "Nick was taken, using $nick instead\n";
    }

    my $chan = $self->chan;
    $client->send_msg( join => $chan );
    $self->send_chan( "Hello $chan." );
  });

  $self->client->reg_cb( publicmsg => sub {
    my ($client, undef, $msg) = @_;
    my $mynick = $self->mynick;

    my ($sender, $sender_info) = split( /!/, $msg->{prefix}, 2);
    my $message = $msg->{params}[1];

    if ($message =~ s/^$mynick\S*?\s+//) {
      $self->do_task($sender, $message);
    }
  });

  $self->client->reg_cb( privatemsg => sub {
    my ($client, undef, $msg) = @_;
    my $mynick = $self->mynick;

    my ($sender, $sender_info) = split( /!/, $msg->{prefix}, 2);
    my $message = $msg->{params}[1];

    local $self->{private} = $sender;

    $message =~ s/^$mynick\S*?\s+//;
    $self->do_task($sender, $message);

  });

  $self->client->reg_cb( join => sub {
    my ($nick, $chan, $is_myself) = @_;
    if ($is_myself or $chan ne $self->chan) {
      return
    }

    if (defined $self->opfile->{$nick}) {
      $self->send_private($nick, "Hey $nick, I'll op you, but you're gonna hafta refresh my memory. Send me 'op <password>', and I'll let you in.");
    }
  });

  return $self;
}

# Methods

sub do_task {
  my ($self, $sender, $message) = @_;
  my $client = $self->client;

  $message =~ s/\s+$//;

  # dispatch table
  given ($message) {
    when ( /make me a sandwich/ ) {
      $self->sandwich($sender, $message);
    }
    when (/^op\s+(.*)/) {
      $self->check_make_op($sender, $1);
    }
    when (/^trust\s+(.*)/) {
      $self->trust( $sender, $1 );
    }
    when (/^pass\s+(\S*)\s+(.*)/) {
      $self->set_pass( $sender, $1, $2 );
    }
    when (/^eval/) {
      $self->send_private( $sender, "F*** you, $sender" );
    }
    default {
      $self->send_chan( "$sender: You talkin' to me?" );
    }
  }
}

sub sandwich {
  my ($self, $sender, $message) = @_;
  if ($self->is_oper($sender) or $message =~ /sudo/) {
    $self->send_chan("Okay");
  } else {
    $self->send_chan("What? Make it yourself!");
  }
}

sub trust {
  my ($self, $op, $to_trust) = @_;

  if ($to_trust eq 'opkick') {
    $self->send_chan("A wise-guy eh?");
    return;
  }

  unless ($self->is_oper($op)) {
    $self->send_private($op, "Silly $op, only an Op can tell me to trust someone!");
    return;
  }

  if (defined $self->ophash->{$to_trust}) {
    $self->send_private($op, "Silly $op, I already trust $to_trust");
    return;
  }

  unless (defined $self->is_oper($to_trust) ) {
    $self->send_private($op, "I gotta say $op, I don't know who you are talking about.");
    return;
  }

  unless ($self->is_oper) {
    $self->send_private($op, "Darn. I can't trust anyone, I'm not an Op!");
    return;
  }

  my $new_pass = random_regex('\w{6}');
  $self->ophash->{$to_trust} = $self->_hash($to_trust, $new_pass);

  $self->send_private($to_trust, "Well, you look shady to me, but I guess $op trusts you. Ok, I'll put you on the list. Your new password is '$new_pass'. If you want to change it, send me a message like 'pass <old password> <new password>'.");

  $self->make_op($to_trust);
  
}

sub set_pass {
  my ($self, $nick, $old_pass, $new_pass) = @_;

  unless (defined $self->ophash->{$nick}) {
    $self->send_private($nick, "You tryin' to pull a fast one?! I don't trust you, kid!");
    return;
  }

  unless ($self->check_pass($nick, $old_pass)) {
    return;
  } 

  $self->ophash->{$nick} = $self->_hash($nick, $new_pass);

  $self->send_private($nick, "Gotcha, you're all set.");
}

sub check_pass {
  my ($self, $nick, $pass) = @_;

  if ($self->ophash->{$nick} eq $self->_hash($nick, $pass)) {
    $self->send_private($nick, "Ok you check out, but I'm keepin' my eye on you.");
    return 1;
  } else {
    $self->send_private($nick, "Hey Mac, we got a rat!");
    return 0;
  }
}

sub check_make_op {
  my ($self, $nick, $pass) = @_;

  unless ($self->check_pass($nick, $pass)) {
    return;
  }

  $self->make_op($nick);
}

sub _hash {
  my ($self, $nick, $pass) = @_;
  return sha1( sha1($nick) . $pass );
}

# AnyEvent::IRC mapper methods

sub make_op {
  my ($self, $nick) = @_;
  my $chan = $self->chan;
  $self->client->send_msg( mode => "$chan +o", $nick);
}

sub send_private {
  my ($self, $nick, $message) = @_;
  $self->client->send_msg( privmsg => $nick, $message );
}

sub send_chan {
  my ($self, $message) = @_;
  if ($self->{private}) {
    $self->send_private($self->{private}, $message);
  } else {
    $self->client->send_chan( 
      $self->chan, 
      privmsg => $self->chan, 
      $message
    );
  }
}

sub is_oper {
  my ($self, $nick) = @_;

  $nick //= $self->mynick; #/# highlight fix

  my $user = $self->client->nick_modes(
    $self->chan,
    $nick,
  );

  unless (defined $user) {
    return undef;
  }

  my $is_op = $user->{'o'} || 0;

  return $is_op;
}

sub run {
  my $self = shift;
  $self->client->connect(
    $self->server, 
    $self->port, 
    { nick => $self->mynick }
  );
  $self->condvar->wait;
  $self->client->disconnect;
}

# RO accessors
sub client  { return shift->{client}  }
sub condvar { return shift->{condvar} }
sub chan    { return shift->{chan}    }
sub server  { return shift->{server}  }
sub port    { return shift->{port}    }
sub ophash  { return shift->{ophash}  }

# RW accessors
sub mynick {
  my $self = shift;
  $self->{mynick} = shift if @_;
  return $self->{mynick};
}