Created
January 9, 2013 15:42
-
-
Save simonwistow/4494132 to your computer and use it in GitHub Desktop.
Version 2 (?) of the Slavorg op bot
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #!/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; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment