mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-07 00:25:40 -04:00
103 lines
2.6 KiB
Perl
103 lines
2.6 KiB
Perl
package Bot::BB3::Roles::Evalpastebin;
|
|
|
|
use POE;
|
|
use POE::Component::Server::TCP;
|
|
use strict;
|
|
use Data::Dumper;
|
|
use JSON::MaybeXS;
|
|
|
|
sub new {
|
|
my( $class, $conf, $pm ) = @_;
|
|
|
|
my $self = bless { conf => $conf, pm => $pm }, $class;
|
|
|
|
$self->{session} = POE::Session->create(
|
|
object_states => [
|
|
$self => [ qw/_start receive_paste/ ]
|
|
]
|
|
);
|
|
|
|
return $self;
|
|
}
|
|
|
|
{
|
|
my $dbh;
|
|
sub dbh {
|
|
if( $dbh and $dbh->ping ) {
|
|
return $dbh;
|
|
}
|
|
|
|
$dbh = DBI->connect( "dbi:SQLite:dbname=var/allowpaste.db", "", "", { PrintError => 0, RaiseError => 1 } );
|
|
|
|
return $dbh;
|
|
}
|
|
}
|
|
|
|
sub get_status {
|
|
my ($chancon) = @_;
|
|
|
|
my $status = dbh()->selectrow_hashref('SELECT value FROM allowpaste WHERE channel = ?', {}, $chancon);
|
|
my $global_status = dbh()->selectrow_hashref('SELECT value FROM allowpaste WHERE channel = ?', {}, 'GLOBAL');
|
|
warn "GET_STATUS $chancon\n";
|
|
|
|
return ($global_status // {value => 1})->{value} && ($status // {})->{value};
|
|
}
|
|
|
|
sub _start {
|
|
my( $self, $kernel ) = @_[OBJECT,KERNEL];
|
|
my $conf = $self->{conf};
|
|
|
|
# TODO setup TCP server.
|
|
$self->{server} = POE::Component::Server::TCP->new(
|
|
Port => 1784,
|
|
Address =>'192.168.64.2',
|
|
ClientFilter => "POE::Filter::Line",
|
|
ClientInput => \&receive_paste,
|
|
);
|
|
|
|
$kernel->alias_set( "evalpastebin_role" );
|
|
|
|
system("netstat -pant");
|
|
$kernel->sig("DIE" => 'sig_DIE' );
|
|
}
|
|
|
|
sub receive_paste {
|
|
my ($kernel, $line) = @_[KERNEL, ARG0];
|
|
|
|
chomp $line;
|
|
|
|
if ($line eq 'GET_CHANNELS') {
|
|
my $channel_list = $kernel->call("Bot::BB3::Roles::IRC", "channel_list");
|
|
$_[HEAP]{client}->put(encode_json($channel_list));
|
|
} else {
|
|
my ($alert_channel, $link, $who, $summary) = split(/\x1E/, $line);
|
|
|
|
$who = "Anonymous" unless $who =~ /\S/;
|
|
|
|
if( $alert_channel !~ /^\s*---/ ) { # Ignore things like "---irc.freenode, skip server names
|
|
my($server,$nick,$channel) = split /:/,$alert_channel,3;
|
|
|
|
my $setting = get_status($alert_channel) // 1;
|
|
|
|
if ($setting) {
|
|
$_[KERNEL]->post( "Bot::BB3::Roles::IRC",
|
|
external_message =>
|
|
$server,
|
|
$nick,
|
|
$channel,
|
|
"$who pasted a new file at $link - $summary"
|
|
);
|
|
} else {
|
|
return; # we've been disallowed
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
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;
|