diff --git a/.gitignore b/.gitignore index 1947758..e0a1045 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ etc/bing_secret.txt etc/twitterkeys +etc/crypt.key inc/ META.yml MYMETA.json diff --git a/bin/decrypt_debug b/bin/decrypt_debug new file mode 100755 index 0000000..65a5cec --- /dev/null +++ b/bin/decrypt_debug @@ -0,0 +1,11 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use lib './lib'; +use Bot::BB3::DebugCrypt; + + +my $data = join ' ', @ARGV; +print "Decrypted: ", decrypt($data), "\n"; + diff --git a/cpanfile b/cpanfile index bae4833..f80eabe 100644 --- a/cpanfile +++ b/cpanfile @@ -154,3 +154,9 @@ requires 'Unicode::GCString'; requires 'Unicode::Util'; requires 'Unicode::Collate'; requires 'more'; +requires 'Data::Dumper::Compact'; +requires 'Carp::Always'; +requires 'V'; +requires 'Path::Tiny'; +requires 'CryptX'; +requires 'MIME::Base64'; diff --git a/lib/Bot/BB3/DebugCrypt.pm b/lib/Bot/BB3/DebugCrypt.pm new file mode 100644 index 0000000..f2c25ae --- /dev/null +++ b/lib/Bot/BB3/DebugCrypt.pm @@ -0,0 +1,30 @@ +package Bot::BB3::DebugCrypt; +use CryptX; +use Crypt::Mode::CBC; +use MIME::Base64; +use Path::Tiny; +use strict; +use warnings; + +use Exporter qw/import/; +our @EXPORT=qw/encrypt decrypt/; + +my $key = pack("H*", path('etc/crypt.key')->slurp_utf8 =~ s/\s//gr); +my $iv = 'TOTALLYSECURE!!!'; + +sub encrypt { + my $data = shift; + $data = pack("N", rand(2**32)) . $data; + my $cipher = Crypt::Mode::CBC->new('AES'); + return MIME::Base64::encode($cipher->encrypt($data, $key, $iv)); +} + +sub decrypt { + my $data = MIME::Base64::decode(shift); + my $cipher = Crypt::Mode::CBC->new('AES'); + my $plain = $cipher->decrypt($data, $key, $iv); + $plain = substr($plain, 4); + return $plain +} + +1; diff --git a/lib/Bot/BB3/Roles/Evalpastebin.pm b/lib/Bot/BB3/Roles/Evalpastebin.pm index 6b159ab..0b0fd2a 100644 --- a/lib/Bot/BB3/Roles/Evalpastebin.pm +++ b/lib/Bot/BB3/Roles/Evalpastebin.pm @@ -56,6 +56,8 @@ sub _start { ); $kernel->alias_set( "evalpastebin_role" ); + + system("netstat -pant"); $kernel->sig("DIE" => 'sig_DIE' ); } @@ -94,6 +96,8 @@ sub receive_paste { sub sig_DIE { # Do nothing, we're ignoring fatal errors from our child, poco-server-simplehttp. I think we don't need to respawn them. + use Data::Dumper; + print Dumper(\@_); } 1; diff --git a/plugins/geoip.pm b/plugins/geoip.pm index 8859b53..28aca2c 100644 --- a/plugins/geoip.pm +++ b/plugins/geoip.pm @@ -1,22 +1,34 @@ -use Geo::IP; +use GeoIP2::Database::Reader; +use Socket; +use strict; no warnings 'void', 'once'; sub { my( $said, $pm ) = @_; -# $Geo::IP::PP_OPEN_TYPE_PATH = "/usr/share/GeoIP/"; -# my $gi = Geo::IP->open_type(GEOIP_CITY_EDITION_REV0, GEOIP_STANDARD); - my $gi = Geo::IP->open("/usr/share/GeoIP/GeoIP.dat", GEOIP_STANDARD); + my $ip = $said->{body}; + + $ip =~ s/#.*//; + $ip =~ s/^\s+|\s+$//g; + + if ($ip =~ /\D/) { + my $packed = gethostbyname($ip); + $ip = inet_ntoa($packed); + } + + my $reader = GeoIP2::Database::Reader->new(file => '/home/ryan/bots/perlbuut/var/GeoLite2-City.mmdb'); + my $asn_reader = GeoIP2::Database::Reader->new(file => '/home/ryan/bots/perlbuut/var/GeoLite2-ASN.mmdb'); print "Record for $said->{body}: "; + my $record = $reader->city(ip => $ip); + my $asn_record = $asn_reader->asn(ip => $ip); - if( $said->{body} =~ /[a-zA-Z]/ ) { - print $gi->country_code_by_name( $said->{body} ); - } - else { - print $gi->country_code_by_addr( $said->{body} ); - } + my $subdiv = eval {($record->subdivisions)[0]->name}; + + my $location = join(', ', grep {!!$_} ($record->city->name, $subdiv, $record->country->name)); + + print $location, " ASN: ", $asn_record->autonomous_system_organization, "(", $asn_record->autonomous_system_number, ")"; }; __DATA__ diff --git a/plugins/help.pm b/plugins/help.pm index c3d5694..7c863bc 100644 --- a/plugins/help.pm +++ b/plugins/help.pm @@ -11,7 +11,11 @@ sub { my $plugin = $pm->get_plugin( $plugin_name, $said ); if( $plugin ) { - print $plugin->{help_text}; + if ($plugin->can("make_help")) { + print $plugin->make_help(); + } else { + print $plugin->{help_text}; + } } else { print "Sorry, no plugin named $plugin_name found." unless $said->{backdressed}; diff --git a/plugins/pastebinadmin.pm b/plugins/pastebinadmin.pm index 12b0b6b..61f7ca8 100644 --- a/plugins/pastebinadmin.pm +++ b/plugins/pastebinadmin.pm @@ -1,6 +1,7 @@ package Bot::BB3::Plugin::Pastebinadmin; use POE::Component::IRC::Common qw/l_irc/; use DBD::SQLite; +use Bot::BB3::DebugCrypt; use strict; sub new { @@ -48,7 +49,7 @@ sub add_ban_word { 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 = ?", {}, $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 = ? or p.id = ?", {}, $id, $id) || ['0.0.0.0']}; return sprintf("%03d.%03d.%03d.%03d", split(/\./,$ip)); } @@ -78,13 +79,14 @@ sub ban_user_paste { sub ban_asn_paste { my ($self, $env, $id, $who, $where) = @_; + my $ip = $self->get_ip_for_paste($env, $id); 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); return "ISP WAS BANNED FOR THIS POST"; } else { - return "Failed to find ISP for paste in db. yell at simcop2387"; + return "Failed to find ISP for paste in db. yell at simcop2387; ".encrypt("[$id][$ip][$asn]"); } } @@ -109,7 +111,11 @@ sub command { } elsif ($command eq 'banuser') { my $paste = $args[0]; - if (my ($id) = ($paste =~ m{^(?:(?:https?://(?:[a-z\.]+)?(?:perlbot\.pl|perl\.bot)/p(?:astebin)?/([^/]{6,})/?)|([^/]+))$}g)) { + my $id = $paste; + $id =~ s/^\s+|\s+$//g; + $id = $1 || $2 if ($paste =~ m{^(?:(?:https?://(?:[a-z\.]+)?(?:perlbot\.pl|perl\.bot)/p(?:astebin)?/([^/]{6,})/?)|([^/]+))$}g); + + if ($id) { my $response = $self->ban_user_paste($env, $id, $who, $where); return ("handled", $response); } else { @@ -118,7 +124,11 @@ sub command { } elsif ($command eq 'banasn') { my $paste = $args[0]; - if (my ($id) = ($paste =~ m{^(?:(?:https?://(?:[a-z\.]+)?perlbot.pl/p(?:astebin)?/([^/]{6,})/?)|([^/]+))$}g)) { + my $id = $paste; + $id =~ s/^\s+|\s+$//g; + $id = $1 || $2 if ($paste =~ m{^(?:(?:https?://(?:[a-z\.]+)?(?:perlbot\.pl|perl\.bot)/p(?:astebin)?/([^/]{6,})/?)|([^/]+))$}g); + + if ($id) { my $response = $self->ban_asn_paste($env, $id, $who, $where); return ("handled", $response); } else { diff --git a/plugins/supereval.pm b/plugins/supereval.pm index 3476fcd..f365196 100644 --- a/plugins/supereval.pm +++ b/plugins/supereval.pm @@ -37,7 +37,7 @@ sub make_pastebin { } sub make_pastebin_all { - my ($who, $input) = @_; + my ($who, $input, $type) = @_; my $ua = LWP::UserAgent->new(); @@ -45,7 +45,7 @@ sub make_pastebin_all { paste => $input, description => 'Evalall output for '.$who, username => $who, - language => 'evalall' + language => "eval${type}all", }); if ($res->is_success()) { @@ -58,7 +58,7 @@ sub make_pastebin_all { } } -my @versions = ('', qw(1 2 3 4 5.0 5.1 5.2 5.3 5.4 5.5 5.6 5.6t 5.8 5.8.8 5.10 5.10.0 5.12 5.14 5.16 5.18 5.20 5.22 5.24 5.26 5.28 5.8t 5.10t 5.12t 5.14t 5.16t 5.18t 5.20t 5.22t 5.24t 5.26t 5.28 tall all)); +my @versions = ('', 't', qw(1 2 3 4 5.0 5.1 5.2 5.3 5.4 5.5 tall all rall), map {$_, $_."t"} qw/5.6 5.8 5.8.4 5.8.8 5.10 5.10.0 5.12 5.14 5.16 5.18 5.20 5.22 5.24 5.26 5.28 5.30/); sub new { my( $class ) = @_; @@ -71,7 +71,7 @@ sub new { my @perl_aliases = map {("eval$_", "weval$_", "seval$_", "wseval$_", "sweval$_", "meval$_")} @versions; - $self->{aliases} = [ map {$_, "${_}nl", "${_}pb"} qw/jseval rkeval r jeval phpeval pleval perleval deparse swdeparse wsdeparse wdeparse sdeparse k20eval rbeval pyeval luaeval cpeval wscpeval swcpeval wcpeval scpeval bleval coboleval cbeval basheval/, @perl_aliases ]; + $self->{aliases} = [ map {$_, "${_}nl", "${_}pb"} qw/jseval rkeval r pleval perleval deparse swdeparse wsdeparse wdeparse sdeparse rbeval cpeval wscpeval swcpeval wcpeval scpeval bleval coboleval cbeval basheval/, @perl_aliases ]; $self->{dbh} = DBI->connect("dbi:SQLite:dbname=var/evallogs.db"); return $self; @@ -141,12 +141,20 @@ sub command { $type = "perl6" } + if ($command eq 'r' && (!$said->{addressed} && !$said->{nested} && $said->{channel} ne "#perl6")) { + return ("handled", ""); + } + + if ($code !~ /\S/) { + return ("handled", ""); + } + if( not $type ) { $type = 'perl'; } warn "Found $type: $code"; $code = eval {Encode::decode("utf8", $code)} // $code; - if ($command =~ /^([wsm]+)?(?:eval|deparse)(?:5\.(\d+))?(all)?/i) { + if ($command =~ /^([wsm]+)?(?:eval|deparse)(?:5\.(\d+))?t?(all)?/i) { my $c=$1; my $v=$2; my $all = $3; @@ -164,6 +172,10 @@ sub command { if ($type =~ /perlall/) { $resultstr = make_pastebin_all($said->{channel}, $code); + } elsif ($type =~ /perltall/) { + $resultstr = make_pastebin_all($said->{channel}, $code, "t"); + } elsif ($type =~ /perlrall/) { + $resultstr = make_pastebin_all($said->{channel}, $code, "r"); } elsif ($pbflag) { my $output = $self->do_singleeval($type, $code); $resultstr = make_pastebin($said->{channel}, $output); @@ -332,6 +344,13 @@ sub read_message { return $message; } +sub make_help { + my $self = shift; + + my $help = q{The eval plugin. Syntax, «eval: code». Prefixes: w=>warnings, s=>strict, m=>use Ojo. Suffixes: t=>threaded, pb=>pastebin it, nl=>turn \n to ␤. languages: }. join(', ', map {s/eval//r || 'bleed'} grep {!/^[wsm]|(t|nl|pb)$/} @{$self->{aliases}}); + return $help +} + "Bot::BB3::Plugin::Supereval"; __DATA__