Version 2 (?) of the Slavorg op bot

slavorg2.pl

#!/usr/bin/perl

use warnings;
use strict;
use POE;
use POE::Component::IRC;

use IO::Handle;
open DEBUG, ">>slavorg.log" or die "Can't open log file: $!\n";
DEBUG->autoflush(1);

POE::Component::IRC->new('slavorg');

POE::Session->new(
    _start=>\&startup,

    rejoin=>\&rejoin,
    told=>\&told,

    load_state=>\&load_state,
    save_state=>\&save_state,
    do_op=>\&do_op,

    trust=>\&trust,
    distrust=>\&distrust,
    believe=>\&believe,
    disbelieve=>\&disbelieve,

    irc_001=>\&on_connect,
    irc_public=>\&on_public,
    irc_join=>\&on_join,
    irc_msg=>\&on_private,
    irc_nick=>\&on_nick,
    irc_kick=>\&on_kick,
    irc_invite=>\&on_invite,
    irc_mode=>\&on_mode,
    irc_ping=>\&ping,
    irc_353=>\&on_names,
    irc_366=>\&on_names_done,
    irc_332=>\&on_topicraw,
    irc_topic=>\&on_topic,
    irc_disconnected=>\&rejoin,
);

$poe_kernel->run();

exit(0);

sub debug {
    my @list = @_;
    for (@list) {
        my $var = $_ || '<null>';
        chomp($var);
        print DEBUG  "[ ".localtime(time)." ] $var\n";
    }
}

############################################################################
############################################################################

sub startup {
    my($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my @args = @_[ARG0..$#_];
    
    open(CONFIG, "Config")
      or die "Can't open Config file - move Config.sample and change\n";
    my %config;
    while(<CONFIG>) {
        chomp;
        next if /^\s*#/;
        next if /^\s*$/;
        my ($param, $value) = split(/\s+/, $_, 2);
        $config{lc($param)} = $value;
    }
    
    print "Config:\n";
    for (keys(%config)) {
        print "$_: $config{$_}\n";
    }
    
    croak("Need nick") unless $config{nick};
    croak("Need server") unless $config{server};
    croak("Need state_file") unless $config{state_file};
    croak("need channels_file") unless $config{channels_file};

    $heap->{config} = \%config;

    $heap->{connect} = {
        Nick => $config{nick},
        Server => $config{server},
        Port => $config{port} || 6667,
        Ircname => $config{ircname},
    };

    $kernel->post(slavorg=>register=>'all');
    $kernel->post(slavorg=>connect=>$heap->{connect});

}

sub load_state {
    my($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my @args = @_[ARG0..$#_];

    debug("Loading state\n");
    $heap->{state} = {};
    if (open FILE, "<$heap->{config}{state_file}") {
        while (<FILE>) {
            chomp;
            my ($channel, $nick, $type) = split(/\s+/);
            $nick =~ s!_*$!!g;
            $heap->{state}{$channel}{lc($nick)} = $type;
        }
        close FILE;
    } else {
        debug("Cannot open state file $heap->{config}{state_file}: $!\n");
    }

    $heap->{channels} = {};
    if (open FILE, "<$heap->{config}{channels_file}") {
        while (<FILE>) {
            chomp;
            $heap->{channels}{lc($_)}++;
            $kernel->post(slavorg=>join=>lc($_));
        }
        close FILE;
    } else {
        debug("Cannot open channels file $heap->{config}{channels_file}: $!\n");
    }

    $kernel->yield('trust', 'all', $heap->{config}{owner}, 1);
}

sub save_state {
    my($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my @args = @_[ARG0..$#_];

    debug("Saving state\n");
    open FILE, ">$heap->{config}{state_file}"
        or croak("Cannot save state file $heap->{config}{state_file}: $!\n");
    for my $channel (keys(%{$heap->{state}})) {
        for my $nick (keys(%{$heap->{state}{$channel}})) {
            my $type = $heap->{state}{$channel}{lc($nick)};
            next if ($channel ne 'all'
                 and $heap->{state}{all}{lc($nick)}
                 and $heap->{state}{all}{lc($nick)} eq $type);
            print FILE "$channel $nick $type\n";
        }
    }
    close FILE;

    open FILE, ">$heap->{config}{channels_file}"
        or croak("Cannot save channels file $heap->{config}{channels_file}:"
                 ."$!\n");
    for (keys(%{$heap->{channels}})) {
        print FILE lc($_)."\n";
    }
    close FILE;

}

sub trust {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($channel, $nick, $state) = @_[ARG0..$#_];

    $nick =~ s!_*$!!;

    if ($state) {
        $heap->{state}{$channel}{lc($nick)} = 'trust';
        $kernel->yield('save_state');
        return 1;
    } else {
        if ($heap->{state}{$channel}{lc($nick)}
        and $heap->{state}{$channel}{lc($nick)} eq 'trust') {
            return 1;
        } elsif ($heap->{state}{all}{lc($nick)}
            and $heap->{state}{all}{lc($nick)} eq 'trust') {
            return 1;
        } else {
            return 0;
        }
    }
}

sub distrust {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($channel, $nick, $state) = @_[ARG0..$#_];

    $nick =~ s!_*$!!;

    if ($state) {
        delete $heap->{state}{$channel}{lc($nick)};
        $kernel->yield('save_state');
        return;
    } else {
        return !$kernel->call($session, 'trust', $channel, $nick, $state);
    }
}

sub believe {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($channel, $nick, $state) = @_[ARG0..$#_];

    $nick =~ s!_*$!!;

    # if we trust the person, we automatically believe them, and shoudn't
    # change their state;
    return 1 if $kernel->call($session, 'trust', $channel, $nick);

    if ($state) {
        $heap->{state}{$channel}{lc($nick)} = 'believe';
        $kernel->yield('save_state');
        return 1;
    } else {
        if ($heap->{state}{$channel}{lc($nick)}) {
            return 1;
        } elsif ($heap->{state}{all}{lc($nick)}) {
            return 1;
        } else {
            return 0;
        }
    }
}

sub disbelieve {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($channel, $nick, $state) = @_[ARG0..$#_];

    $nick =~ s!_*$!!;

    # if we trust the person, we automatically believe them, and shoudn't
    # change their state;
    return 0 if $kernel->call($session, 'trust', $channel, $nick);

    if ($state) {
        delete $heap->{state}{$channel}{lc($nick)};
        $kernel->yield('save_state');
        return;
    } else {
        return !$kernel->call($session, 'believe', $channel, $nick, $state);
    }
}


sub get_nick {
    my ($nick) = @_;
    return unless $nick;
    $nick =~ /^(.*)!(.*)@(.*)$/;
    $nick = $1 || $nick;
    $nick =~ s!_*$!!;
    return $nick;
}

sub told {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($nick, $channel, $message) = @_[ARG0..$#_];  

    $message =~ s/^\s*//;
    $message =~ s/\s*$//;

    my $sender = $channel || $nick;
    
    my ($command, $param) = split(/\s+/, $message, 2);
    $command = lc($command);
    
    $kernel->post('slavorg', 'names', $param || $channel)
      if ($command eq 'names' and ($channel or $param));
    
    if ($command eq 'trust' or $command eq 'believe'
     or $command eq 'distrust' or $command eq 'disbelieve') {

        my ($target_nick, $target_channel);
        if ($param =~ /^(\S+)\s+in\s+#?(\S+)$/) {
            ($target_nick, $target_channel) = (lc($1), '#'.lc($2));
        } elsif ($param =~ /^(\S+) everywhere$/) {
            ($target_nick, $target_channel) = (lc($1), 'all');
        } elsif ($channel) {
            unless ($param =~ /^(\S+)$/) {
                $kernel->post(slavorg=>privmsg=>$sender, 'huh?');
                return;
            }
            ($target_nick, $target_channel) = (lc($1), lc($channel));
        } else {
            $kernel->post(slavorg=>privmsg=>$sender, 'sure, but where?');
            return;
        }

        debug("Told to $command $target_nick in $target_channel by $nick in ".($channel || 'privmsg')."\n");

        if (!$kernel->call($session, 'trust', $target_channel, $nick)) {
            $kernel->post('slavorg', 'privmsg', $sender,
                "But I don't trust you there, $nick");

        } elsif ($kernel->call($session, $command, $target_channel, $target_nick)) {
            $kernel->post('slavorg', 'privmsg', $sender,
                "But I already $command $target_nick");

        } else {
            debug("${command}ing $target_nick in $target_channel\n");
            $kernel->call($session, $command, $target_channel, $target_nick, 1);
            $kernel->post('slavorg', 'privmsg', $sender,
                "Ok");

            if ($kernel->call($session, 'trust', $target_channel, $target_nick)) {
                $heap->{to_op}{lc($target_channel)}{lc($target_nick)}++;
            } elsif ($kernel->call($session, 'believe', $target_channel, $target_nick)) {
                $heap->{to_voice}{lc($target_channel)}{lc($target_nick)}++;
            }

        }
    } elsif ($command eq 'leave') {
        my $c = $param || $channel;
        if ($c) {
            $kernel->post('slavorg', 'part', $c);
            delete $heap->{channels}{lc($c)};
            $kernel->yield("save_state");
        }
    } elsif ($command eq 'join') {
        if ($param) {
            debug("told to join $param");
            if ($kernel->call($session, 'trust', $param, $nick)) {
              $kernel->post('slavorg', 'join', $param);
            } else {
              $kernel->post('slavorg', 'privmsg', $sender,
                "I won't join there, because I don't trust you there.");
            }
        }
    } elsif ($command eq 'help') {
        $kernel->post('slavorg', 'privmsg', $sender, "I'm slavorg, an op-bot."
          ."Commands: trust, distrust, believe, disbelieve, leave, join. "
          ."See also http://jerakeen.org/programming/slavorg");
    }
}


#############################################################################
## Event handlers
#############################################################################

sub on_public {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($nickstring, $channels, $message) = @_[ARG0..$#_];  
    my $nick = get_nick($nickstring);

    debug("<$nick\@$channels->[0]> $message");
    if ($message =~ /^\s*$heap->{config}{nick}\s*[\:\,\;\.]?\s*(.*)$/) {
        $kernel->yield('told', $nick, $channels->[0], $1);
    } elsif ($message =~ /^\s*opbots\s*[\:\,\;\.]?\s*(.*)$/) {
        $kernel->yield('told', $nick, $channels->[0], $1);

    # what? It's my fucking bot.
    } elsif ($message =~ /summon\s*jerakeen/i) {
        my $jab = $ENV{HOME}."/bin/jab";
        system($jab, "Summoned by $nick in $channels->[0]") if (-x $jab);
    }
}    

sub on_private {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($nickstring, $recipients, $message) = @_[ARG0..$#_];  
    my $nick = get_nick($nickstring);

    debug("<$nick> $message");
    $kernel->yield('told', $nick, undef, $message);
}

sub on_connect {
    my($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my @args = @_[ARG0..$#_];

    debug("Connected to server\n");

    $kernel->yield('load_state');
    $kernel->delay("rejoin", 800);
    $kernel->delay("do_op", 30);
}

# we have joined a channel
sub on_join {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($nickstring, $channel) = @_[ARG0..$#_];
    my $nick = get_nick($nickstring);

    if (lc($nick) eq lc($heap->{config}{nick})) {
        debug("Joined $channel");

        unless ($heap->{channels}{$channel}) {
            $heap->{channels}{$channel}++;
            $kernel->yield('save_state');
        }

    } else {
        if ($kernel->call($session, 'trust', $channel, $nick)) {
            debug("$nick just joined $channel and needs opping");
            $heap->{to_op}{lc($channel)}{lc($nick)}++;
        } elsif ($kernel->call($session, 'believe', $channel, $nick)) {
            debug("$nick just joined $channel and needs voicing");
            $heap->{to_voice}{lc($channel)}{lc($nick)}++;
        }
    }
}

# we're invited to a channel
sub on_invite {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($nickstring, $channel) = @_[ARG0..$#_];
    my $nick = get_nick($nickstring);

    debug("Invited to $channel by $nick\n");
    $kernel->post(slavorg=>join=>$channel);
}

# we've been kicked.
sub on_kick {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($nickstring, $channel, $kicked, $reason) = @_[ARG0..$#_];
    my $nick = get_nick($nickstring);

    if (lc($kicked) eq lc($heap->{config}{nick})) {
        debug("Kicked from $channel by $nickstring ($reason)\n");

        # remember we were kicked.
        delete $heap->{channels}{$channel};
        $kernel->yield('save_state');

        # Try to join again anyway.
        #$kernel->post(slavorg=>join=>$channel);
    }
}

sub on_mode {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($nickstring, $channel, $mode, @ops) = @_[ARG0..$#_];
    my $nick = get_nick($nickstring) || "<bad nick>";
    warn "no channel!" and return unless $channel;
    
    debug("$nick set mode $mode in $channel for ".join(",", @ops));

    my @modes = split(//, $mode);
    my $type = shift(@modes); # + or -?
    @modes = grep(/[ovm]/, @modes); # the ones that affect people.
    
    # we don't really do much useful unless a mode got added.
    return unless $type eq "+";
    for my $nick (@ops) {
        $nick = lc($nick);
        my $m = shift(@modes) || '';
        if ($nick eq lc($heap->{config}{nick}) and $m eq 'o') {
            debug("Hey! I got opped!");
            $kernel->post('slavorg', 'names', $channel) if $channel;
        } elsif ($m eq 'o') {
#            debug("I don't need to op $nick any more, then");
            delete $heap->{to_op}{$channel}{lc($nick)};
        } elsif ($m eq 'v') {
#            debug("I don't need to voice $nick any more, then");
            delete $heap->{to_voice}{$channel}{lc($nick)};
        }
        
    }

}


sub on_nick {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
    my ($from, $nick) = @_[ARG0..$#_];
    # If people change nicks, we should notice if they need opping.

    # This is commented out because I need to figure out a way of checking if
    # they're already opped before trying to op them again, or I get shouted
    # at.
#     for my $channel (keys(%{$heap->{channels}})) {
#         if ($kernel->call($session, 'trust', $channel, $nick)) {
#             $heap->{to_op}{$channel}{lc($nick)}++;
#         } elsif ($kernel->call($session, 'believe', $channel, $nick)) {
#             $heap->{to_voice}{$channel}{lc($nick)}++;
#         }
#     }
}

sub on_names {
    my ($kernel, $heap, $session, $server, $message)
      = @_[KERNEL, HEAP, SESSION, ARG0, ARG1];
    my (undef, $channel, @names) = split(/\s/, $message);
    $names[0] =~ s/^\://; # FFS
#    debug("People in $channel: ".join(",", @names));
    $heap->{names}{$channel}{$_}++ for (@names);
    
}

sub on_names_done {
    my ($kernel, $heap, $session, $server, $message)
      = @_[KERNEL, HEAP, SESSION, ARG0, ARG1];
    my ($channel) = split(/\s/, $message);
    for (keys(%{$heap->{names}{$channel}})) {
        my $op = 1 if s!^@!!;
        my $voice = 1 if s!^\+!!;
        if (!$op and $kernel->call($session, 'trust', $channel, $_)) {
            $heap->{to_op}{lc($channel)}{lc($_)}++;
        } elsif (!$op and !$voice
                 and $kernel->call($session, 'believe', $channel, $_)) {
            $heap->{to_voice}{lc($channel)}{lc($_)}++;
        }
    }
    delete $heap->{names}{$channel};
}

sub on_topicraw {
    my ($kernel, $heap, $session, $server, $raw)
      = @_[KERNEL, HEAP, SESSION, ARG0, ARG1];
    my ($channel, $topic) = split(/ :/, $raw, 2);
    $kernel->call($session, 'irc_topic', undef, $channel, $topic);
}

sub on_topic {
    my ($kernel, $heap, $nickraw, $channel, $topic)
      = @_[KERNEL, HEAP, ARG0, ARG1, ARG2];
    my $nick = get_nick($nickraw) || '<noone>';
    debug("$nick changed topic of $channel to $topic");
}

sub do_op {
    my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
#    debug("op?");

    my @all_ops = keys(%{$heap->{to_op}{all}});
    for my $c (keys(%{$heap->{channels}})) {
        $heap->{to_op}{$c}{$_}++ for (@all_ops);
    }

    foreach my $channel (keys(%{$heap->{to_op}})) {
        my @nicks = keys(%{$heap->{to_op}{$channel}});
        next unless $nicks[0];
        debug("In $channel, I need to op ".join(",", @nicks));
        while (@nicks) {
            my @s = splice(@nicks, 0, 3);
            $kernel->post(slavorg=>mode=>"$channel +ooo ".join(" ", @s));
#            debug("  /mode $channel +ooo ".join(" ", @s));
        }
    }
    delete $heap->{to_op};

    foreach my $channel (keys(%{$heap->{to_voice}})) {
        my @nicks = keys(%{$heap->{to_voice}{$channel}});
        next unless $nicks[0];
        debug("In $channel, I need to voice ".join(",", @nicks));
        while (@nicks) {
            my @s = splice(@nicks, 0, 3);
            $kernel->post(slavorg=>mode=>"$channel +vvv ".join(" ", @s));
#            debug("  /mode $channel +vvv ".join(" ", @s));
        }
    }
    delete $heap->{to_voice};

    $kernel->delay("do_op", $heap->{config}{delay} || 3);
}

# as long as we're getting PING messages, we're still connected. Keep putting
# off the reconnect event every time we get one.
sub ping {
    my ($kernel, $heap) = @_[KERNEL, HEAP];
    debug("PING");
    $kernel->delay('rejoin', 800);
}

# We'll only get here if there hasn't been a ping in the last 200 secs. We can
# assume we've lost the connection.
sub rejoin {
    my ($kernel, $heap) = @_[KERNEL, HEAP];
    debug("REJOIN: I think I lost my server connection");
    debug("  disconnecting..");
    $kernel->call('slavorg', 'disconnect');
    debug("  shutting down..");
    $kernel->call('slavorg', 'shutdown');
    debug("  creating new Poco::IRC");
    POE::Component::IRC->new('slavorg');
    debug("  registering..");
    $kernel->post(slavorg=>register=>'all');
    $kernel->post(slavorg=>connect=>$heap->{connect});
    $kernel->delay('rejoin', 400); # Try quite frequently till we get somewhere.
}

1;