Update plugins and databases

.gitignore

@@ -1,5 +1,6 @@
 etc/bing_secret.txt
 etc/twitterkeys
+etc/crypt.key
 inc/
 META.yml
 MYMETA.json

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"; 
+

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';

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;

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;

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]/ ) {
+  my $subdiv = eval {($record->subdivisions)[0]->name};
-		print $gi->country_code_by_name( $said->{body} );
+
-	}
+  my $location = join(', ', grep {!!$_} ($record->city->name, $subdiv, $record->country->name));
-	else {
+
-		print $gi->country_code_by_addr( $said->{body} );
+  print $location, " ASN: ", $asn_record->autonomous_system_organization, "(", $asn_record->autonomous_system_number, ")";
-	}
 };
 
 __DATA__

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};

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 {

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__