Perlbot/perlbuut
1
0
Fork 0
mirror of https://github.com/perlbot/perlbuut synced 2025-06-07 10:35:41 -04:00
Code Issues Releases Wiki Activity

Merge branch 'master' of github.com:perlbot/perlbuut

Browse source
This commit is contained in:
Ryan Voots 2022-06-22 19:35:02 -04:00
commit eb5528851d
9 changed files with 132 additions and 85 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
README.pod
View file

@ -13,8 +13,6 @@ This is the source code for perlbot, the resident infobot on Freenode’s
=over 4
=item * L<http://perl-begin.org/FAQs/freenode-perl/>
=item * L<https://github.com/simcop2387/perlbuut>
=back

58
etc/bb3.conf
View file

@ -37,46 +37,11 @@ http_plugin_port 1092
</plugin_manager>
<bot perlbot>
channel \#buubot
channel \#\#turtles
channel \#perlcafe
channel \#webgui
channel \#citadel
channel \#modperl
channel \#perl
channel \#ipv6
channel \#perlbot
channel \#mrtg
channel \#ipv6-fr
channel \#freebsd-fr
channel \#botpark
channel \#css
channel \#modus
channel \#perl-cats
channel \#cout.dev
channel \#web-locals
channel \#regex
channel \#regexen
ignore buubot
ignore avarbot
ignore jeval
ignore gumbybrain
ignore perlbot
ignore buubot3
ignore loudbot
ignore serfbot
ignore farnsworth
ignore frogbot
ignore EvanCarroll
ignore EvanCarrol
ignore EvanCaroll
ignore EvanCarol
ignore EC
channel \#\#perl
server 192.168.32.1
username perlbot
password sindarin
password UjecyickehumBevGixrejparpheyndoc
port 65432
root_mask p3m/member/simcop2387
</bot>
@ -84,6 +49,8 @@ http_plugin_port 1092
<bot perlbot-magnet>
channel \#freenode-perl-cabal
channel \#perl-help
channel \#perl
channel \#pdl
ignore purl
ignore perlbot
@ -119,3 +86,20 @@ http_plugin_port 1092
port 65432
root_mask ~simcop238@simcop2387.info
</bot>
<bot perlbot-libera>
channel \#buubot
channel \#perl
channel \#perlbot
channel \#botpark
channel \#perl-cats
server 192.168.32.1
username perlbot-libera
password AtlyeSlognakjabDatCujatyijFeach9
port 65432
root_mask perlbot/patrician/simcop2387
ignore lambdabot
ignore lambdabot2
</bot>

88
etc/plugins.conf
View file

@ -1,7 +1,7 @@
server "*" {
channel "*" {
plugin "*" { addressed: true }
plugin "join" { access: op; addressed: true }
plugin "join" { access: root; addressed: true }
plugin "allowpaste" { access: op; addressed: true }
plugin "pastebinadmin" { access: op; addressed: true }
plugin "part" { access: op }
@ -13,6 +13,20 @@ server "*" {
plugin "karma_modify" { addressed: false; }
plugin "seen" {addressed: false; }
}
channel "##perl" {
plugin "factoids" {
addressed: false;
}
plugin "eval" {addressed: true; }
plugin "deparse" {addressed: true; }
plugin "perldoc" {addressed: true; }
plugin "corelist" {addressed: true; }
plugin "default" {plugin: "factoids";}
}
channel "#pdl" {
plugin "eval" {addressed: false; }
plugin "deparse" {addressed: false; }
}
channel "#perl" {
plugin "eval" {addressed: false; }
plugin "deparse" {addressed: false; }
@ -50,6 +64,24 @@ server "*" {
plugin "eval" {addressed: false; }
plugin "deparse" {addressed: false; }
}
channel "#regex" {
plugin "factoids" {
addressed: false;
}
plugin "default" {plugin: "factoids"; }
}
channel "#regexen" {
plugin "factoids" {
addressed: false;
}
plugin "default" {plugin: "factoids"; }
}
channel "#reg3x" {
plugin "factoids" {
addressed: false;
}
plugin "default" {plugin: "factoids"; }
}
}
server "discord.gg" {
channel "*" {
@ -65,12 +97,34 @@ server "matrix.org" {
}
}
server "*.freenode.net" {
channel {
plugin "*" { addressed: true }
plugin "join" { access: root; addressed: true }
plugin "allowpaste" { access: op; addressed: true }
plugin "pastebinadmin" { access: op; addressed: true }
plugin "part" { access: op }
plugin "reload_plugins" { access: root }
plugin "restart" { access: root }
plugin "conf_dump" { access: root; }
plugin "save_config" { access: root; }
plugin "conf" { access: root; }
plugin "karma_modify" { addressed: false; }
plugin "seen" {addressed: false; }
}
channel "##perl" {
plugin "factoids" {
addressed: false;
}
plugin "default" {plugin: "factoids";}
plugin "eval" {addressed: true; }
plugin "deparse" {addressed: true; }
plugin "perldoc" {addressed: true; }
plugin "corelist" {addressed: true; }
}
}
server "*.libera.chat" {
channel "#perlbot" {
plugin "factoids" {
namespaced: true;
prefix_command: "!";
chanspace: "#perlbot";
serverspace: "freenode.net";
filtersep: true;
addressed: false;
}
@ -79,31 +133,19 @@ server "*.freenode.net" {
channel "#regex" {
plugin "factoids" {
addressed: false;
namespaced: true;
chanspace: "#regex";
serverspace: "freenode.net";
prefix_command: "!";
filtersep: true;
}
plugin "default" {plugin: "factoids"; }
}
channel "#regexen" {
plugin "factoids" {
addressed: false;
namespaced: true;
chanspace: "#regex";
serverspace: "freenode.net";
prefix_command: "!";
filtersep: true;
}
plugin "default" {plugin: "factoids"; }
}
channel "#lpmc" {
plugin "eval" {addressed: false; }
plugin "deparse" {addressed: false; }
channel "#reg3x" {
plugin "factoids" {
addressed: false;
}
plugin "default" {plugin: "factoids"; }
}
channel "#learnprogramming" {
plugin "eval" {addressed: false; }
plugin "deparse" {addressed: false; }
}
}
}

8
lib/Bot/BB3/PluginManager.pm
View file

@ -7,6 +7,7 @@ use Data::Dumper;
use Text::Glob qw/match_glob/;
use Memoize;
use Regexp::Assemble;
use Scalar::Util qw/blessed/;
use strict;
sub new {
@ -453,6 +454,13 @@ sub _execute_plugin_chain {
for my $command ( @$commands ) {
local $@;
unless (blessed($command)) {
use Data::Dumper;
warn "Unblessed command! ".Dumper($command);
next;
};
my( $return, $output ) = eval { $command->command( $said, $self ) };
use Data::Dumper;

2
lib/Bot/BB3/Roles/Evalpastebin.pm
View file

@ -50,7 +50,7 @@ sub _start {
# TODO setup TCP server.
$self->{server} = POE::Component::Server::TCP->new(
Port => 1784,
Address =>'192.168.32.1',
Address =>'192.168.196.2',
ClientFilter => "POE::Filter::Line",
ClientInput => \&receive_paste,
);

3
plugins/factoids.pm
View file

@ -224,7 +224,10 @@ sub handle ($self, $said, $pm) {
$said->{body} =~ s/^\s*(what|who|where|how|when|why)\s+($COPULA_RE)\s+(?<fact>.*?)\??\s*$/$+{fact}/i;
my $prefix = $conf->{command_prefix};
warn "Checking for prefix: $prefix in ".Dumper($conf);
return unless $prefix;
$said->{nosuggest} = 1;

22
plugins/pastebinadmin.pm
View file

@ -22,11 +22,12 @@ sub dbh {
return $self->{$env . "dbh"};
}
if ($env =~ /^www|dev$/) {
$self->{$env . "dbh"} = DBI->connect( "dbi:SQLite:dbname=/var/www/domains/perl.bot/".$env."/pastes.db", "", "", { PrintError => 0, RaiseError => 1 } );
} elsif ($env eq 'asn') {
$self->{$env . "dbh"} = DBI->connect( "dbi:SQLite:dbname=var/asn.db", "", "", { PrintError => 0, RaiseError => 1 } );
}
my $dbnames = {
www => "perlbot_pastes",
dev => "perlbot_pastes_dev",
};
$self->{$env . "dbh"} = DBI->connect( "dbi:Pg:dbname=".$dbnames->{$env}, "perlbot_pastebin", "ignored", { PrintError => 2, RaiseError => 1 } );
return $self->{$env."dbh"};
}
@ -35,7 +36,6 @@ sub postload {
delete $self->{wwwdbh}; # UGLY HAX GO.
delete $self->{devdbh};
delete $self->{asndbh};
# Basically we delete the dbh we cached so we don't fork
# with one active
}
@ -43,13 +43,13 @@ sub postload {
sub add_ban_word {
my ($self, $env, $who, $where, $word) = @_;
$self->dbh($env)->do("INSERT INTO banned_words (word, who, 'where') VALUES (?, ?, ?)", {}, $word, $who, $where);
$self->dbh($env)->do(q{INSERT INTO banned_words (word, who, "where") VALUES (?, ?, ?)}, {}, $word, $who, $where);
}
sub get_ip_for_paste {
my ($self, $env, $id) = @_;
my ($ip) = @{$self->dbh($env)->selectrow_arrayref("SELECT ip FROM posts p JOIN slugs s ON s.post_id = p.id WHERE s.slug = ? or p.id = ?", {}, $id, $id) || ['0.0.0.0']};
my ($ip) = @{$self->dbh($env)->selectrow_arrayref("SELECT ip FROM posts p JOIN slugs s ON s.post_id = p.id WHERE s.slug = ?", {}, $id) || ['0.0.0.0']};
return sprintf("%03d.%03d.%03d.%03d", split(/\./,$ip));
}
@ -59,7 +59,7 @@ sub get_asn_for_paste {
my $ip = $self->get_ip_for_paste($env, $id);
my ($asn) = @{$self->dbh('asn')->selectrow_arrayref("SELECT asn FROM asn WHERE ? >= start AND ? <= end", {}, $ip, $ip) || []}[0];
my ($asn) = @{$self->dbh('www')->selectrow_arrayref('SELECT asn FROM asn WHERE ? >= start AND ? <= "end"', {}, $ip, $ip) || []}[0];
return $asn;
}
@ -69,7 +69,7 @@ sub ban_user_paste {
my $ip = $self->get_ip_for_paste($env, $id);
if ($ip) {
$self->dbh($env)->do("INSERT INTO banned_ips (ip, who, 'where') VALUES (?, ?, ?);", {}, $ip, $who, $where);
$self->dbh($env)->do(q{INSERT INTO banned_ips (ip, who, "where") VALUES (?, ?, ?);}, {}, $ip, $who, $where);
return "USER WAS BANNED FOR THIS POST";
} else {
return "Failed to find IP for paste in db";
@ -83,7 +83,7 @@ sub ban_asn_paste {
my $asn = $self->get_asn_for_paste($env, $id);
if ($asn) {
$self->dbh($env)->do("INSERT INTO banned_asns (asn, who, 'where') VALUES (?, ?, ?);", {}, $asn, $who, $where);
$self->dbh($env)->do(q{INSERT INTO banned_asns (asn, who, "where") VALUES (?, ?, ?);}, {}, $asn, $who, $where);
return "ISP WAS BANNED FOR THIS POST";
} else {
return "Failed to find ISP for paste in db. yell at simcop2387; ".encrypt("[$id][$ip][$asn]");

7
plugins/supereval.pm
View file

@ -170,6 +170,11 @@ sub command {
if (($said->{channel} eq "#perl6" || $said->{channel} eq "#raku") && $said->{addressed} && !$said->{nested} && $orig_type =~ /^[ws]*$/) {
$type = "perl6"
}
# we were addressed, but not nested, in #perl6. Switch to perl6, otherwise use perl5
if ($said->{channel} eq "#pdl" && !$said->{nested} && $orig_type =~ /^[ws]*$/) {
$type = "perl5.34"
}
if ($command eq 'r' && (!$said->{addressed} && !$said->{nested} && ($said->{channel} ne "#perl6" && $said->{channel} eq '#raku'))) {
return ("handled", "");
@ -264,7 +269,7 @@ sub command {
"Columbus Day" => {prob => 0.00, chars => []},
"Confederate Memorial Day" => {prob => 0.00, chars => []},
"Earth Day" => {prob => 0.50, chars => ["\x{1F30E}", "\x{1F30D}", "\x{1F30F}"]},
"Election Day" => {prob => 1.00, chars => ["\x{1F5F3}"]},
"Election Day" => {prob => 1.00, chars => ["\x{1F5F3}\x{FE0F}"]},
"Emancipation Day" => {prob => 0.00, chars => []},
"Fathers Day" => {prob => 0.00, chars => []},
"Flag Day" => {prob => 0.00, chars => []}, # TODO all country flags

27
plugins/translate.pm
View file

@ -1,23 +1,30 @@
use strict;
use warnings;
#use Bing::Translate;
use LWP::UserAgent;
use JSON::MaybeXS qw/decode_json encode_json/;
use Data::Dumper;
my $ua = LWP::UserAgent->new();
return sub {
my( $said ) = @_;
open(my $fh, "<etc/bing_secret.txt") or die "Couldn't read $!";
my $cid = "Perlbot";
my $secret = <$fh>;
chomp $secret;
close($fh);
my $tro = Bing::Translate->new($cid, $secret);
if ($said->{body} =~ /^\s*(?<from>\S+)\s+(?<to>\S+)\s+(?<text>.*)$/) {
# print $secret;
print $tro->translate($+{text}, $+{from}, $+{to});
my $json = {
source_language => $+{from},
target_language => $+{to},
text => $+{text}
};
my $resp = $ua->post("http://192.168.1.229:10000/translate_text", Content => encode_json($json));
my $cont = $resp->decoded_content();
my $output = decode_json($cont);
print Dumper $output;
} else {
print "help text";
}