#!/usr/bin/perl
#
package P5EvalBot;

use base 'Bot::BasicBot';
use POE;
use POE::Component::SSLify;
use BSD::Resource;
use Data::Dumper;
use Carp::Heavy; #chroot
use POSIX;
use Symbol qw/delete_package/;
use Cwd qw/getcwd/;
use strict;
$|++;

my $pass="";

open my $log, ">>/home/epoch/eb/jail/eb.log" or die $!;
my %fork_output;

sub new
{
        my $class = shift;
        my( $nick, $channels, $server, $ignore ) = @_;
        my $self = $class->SUPER::new(
                usessl => 1,
                nick => $nick,
                channels => $channels,
                server => $server,
                port => 6697,
                username => $nick,
                name => $nick,
                ignore_list => $ignore,
        );

        setrlimit( RLIMIT_CPU, RLIM_INFINITY, RLIM_INFINITY); #load auto/BSD/Resource/setrlimit.al
        POSIX::close(6000); #load POSIX::close.al, unavailable when chrooted
        POSIX::setgid(0); #load setgid.al
        print "I am: $$\n";
        print getcwd,"\n";

        $self->load_plugins;
        return $self;
}

sub load_plugins
{
        my $self = shift;

        my @plugins;

        chdir "plugins" or return;

        for( glob( "*.pm" ) )
        {
                my $ret = do $_;
                if( ref $ret eq 'HASH' or ref $ret eq 'ARRAY' ) #Array reference of plugins..
                {
                        for my $ret ( ref $ret eq 'ARRAY' ? @$ret : $ret )
                        {
                                push @plugins, { file => $_, %{ $ret } };
                                if( $ret->{ destroy_handler } )
                                {
                                        push @{ $self->{ death_handlers } }, $ret->{ destroy_handler };
                                }
                        }

                        print "Added $_, $plugins[-1], $@\n";
                }
                else
                {
                        warn "ZOMG ERROR: got an invalid result from $_, $!, $@";
                }
        }

        chdir ".." or die $!;

        $self->{ plugins } = \@plugins;
}

sub call_plugin
{
        my $self = shift;
        my $said = shift;
        my $plugin_name = shift;
                if( $plugin_name !~ /\.pm$/ ) { $plugin_name .= ".pm" }

        for( @{ $self->{ plugins } } )
        {
                if( $_->{ file } eq $plugin_name )
                {
                        $_->{ code }->( $self, $said, @_ );
                        last; #Only one name can match.. I hope
                }
        }
}

sub unload_plugin
{
        my $self = shift;
        my $plugin = shift;

warn "Attempting to unload $plugin";
        my $index;
        for( 0 .. $#{ $self->{ plugins } } )
        {
                if( $self->{ plugins }->[ $_ ]->{ file } eq $plugin )
                {
                        $index = $_;
                warn "Found plugin $plugin at $_";
                        last;
                }
        }

        if( defined $index )
        {
                splice @{ $self->{ plugins } }, $index, 1;
        warn "Dropped plugin";
                return 1;
        }

        else
        {
                return;
        }
}

sub DESTROY
{
        my $self = shift;

        for( @{ $self->{ death_handlers } } )
        {
                $_->( $self );
        }
}

sub connected
{
        my( $self ) = shift;

        warn "Connected to: ", $self->server,"\n";

        if( $self->server eq 'irc.fake.net' )
        {
                warn "IDENTIFYING with SECRET PASSWORD";
                $self->say( who => 'nickserv', channel => 'msg', body => "identify " );
        }
}

sub said
{
        my $self = shift;
        my $said = shift;

        my $a_superuser = ( ( $said->{ raw_nick } =~ 'epoch' ) );

        if( $self->ignored( $said ) and not $a_superuser )
        {
                warn "Skipping ignored user: $said->{who} on $said->{channel}";
                return;
        }

        my @matched;
        for( @{ $self->{ plugins } } )
        {
                if( my @matches = $said->{ body } =~ $_->{ syntax } )
                {
                        push @matched, $_;
                        #ok, yeah, this is silly.
                        if( $_->{ superuser } and not $a_superuser )
                        {
                                warn "Error, $said->{who} is not a super user for $_->{file}\n";
                                next;
                        }

                        if( $_->{ addressed } and not $said->{ address } )
                        {
                                next;
                        }

                        warn "Triggering: $_->{file}";

                        local $@;
                        eval { $_->{ code }->( $self, $said, @matches ); };

                        if( $@ )
                        {
                                warn "Error with $_->{file}, $@";
                        }
                }
        }

        if( $said->{ address } and not @matched )
        {
                $self->reply( $said, "fail" );
        }
}
sub forkit
{
        my $self = shift;
        my %args = @_;

        $poe_kernel->state( $args{handler}, $self );

        my $run;

        if( ref $args{run} eq 'CODE' )
        {
                my @args = @{ $args{arguments} }; #Closure problems?
                my $ref = $args{run};

                print "args: '@args'\n";
                $run = sub{ $ref->( @args ) };
        }

        else
        {
                $run = $args{run};
        }

        my $wheel = POE::Wheel::Run->new(
                Program => $run,
                StdoutFilter => POE::Filter::Stream->new,
                StderrFilter => POE::Filter::Stream->new,
                StdoutEvent => $args{handler},
                StderrEvent => $args{handler},
                CloseEvent => "fork_close"
        );

        $poe_kernel->sig( CHLD => 'fork_close' );

        $self->{ wheels }->{ $wheel->ID } = {
                wheel => $wheel,
                start => time,
                args => {
                        channel => $args{channel},
                        who     => $args{who},
                        address => $args{address},
                }
        };

        if( $self->{ __fork_ret } )
        {
                $self->{ wheels }->{ $wheel->ID }->{ ret_sub } = $self->{ __fork_ret };
                $self->{ __fork_ret } = 0;
        }

        $self->schedule_tick(10);

        return $wheel;
}

sub tick
{
        my $self = shift;

        for( keys %{ $self->{ wheels } } )
        {
                my $wheel_dat = $self->{ wheels }->{ $_ };

                if( time - $wheel_dat->{ start } > 9 )
                {
                        print "Killing: wheel $_\n";
                        $wheel_dat->{ wheel }->kill(9);

                        $wheel_dat->{args}->{body} = "Killing $_ Due To Run Time.";
                        $self->say( $wheel_dat->{args} );

                        delete $self->{ wheels }->{ $_ };
                        delete $fork_output{ $_ };
                }
        }

        if( not keys %{ $self->{ wheels } } )
        {
                return 0;
        }

        else
        {
                return 10; #time till next tick
        }
}

sub fork_close_state
{
        my( $self, $wheel_id ) = @_[ 0, ARG0 ];
        print $log "Called: $self, $wheel_id\n";
        my $ref = delete $self->{wheels}->{$wheel_id};

        my $output = delete $fork_output{$wheel_id};
        $output =~ s/\r?\n/ /g;
        $output =~ s/[^\x20-\x7f]/ /g;
        print $log "output: $output";

        $ref->{args}->{body} = substr( $output, 0, 200 );

        if( $ref->{ ret_sub } )
        {
                $ref->{ ret_sub }->( $ref->{args}->{body} );
        }
        else
        {
                $self->say( $ref->{args} );
        }
}

sub fork_error_state
{
        print "Zomg! Fatal error:\n";
}

sub safe_execute
{
        my( $self, $code ) = @_;

        chdir("/home/epoch/eb/jail") or die $!;
        chroot("/home/epoch/eb/jail") or die $!;

        $<=$>=65534;
        POSIX::setgid(65534);

        setrlimit(RLIMIT_CPU, 10,10);
        setrlimit(RLIMIT_DATA, 5*1024,5*1024 );
        setrlimit(RLIMIT_STACK, 5*1024, 5*1024 );
        setrlimit(RLIMIT_NPROC, 1,1);
        setrlimit(RLIMIT_NOFILE, 0,0);
        setrlimit(RLIMIT_OFILE, 0,0);
        setrlimit(RLIMIT_OPEN_MAX,0,0);
        setrlimit(RLIMIT_LOCKS, 0,0);
        setrlimit(RLIMIT_AS,5*1024,5*1024);
        setrlimit(RLIMIT_VMEM,5*1024,5*1024);
        setrlimit(RLIMIT_MEMLOCK,100,100);
        #setrlimit(RLIMIT_MSGQUEUE,100,100);

        die "Failed to drop root: $<" unless $<;
        close STDIN;

        local $@;

        for( qw/Socket IO::Socket::INET/ )
        {
                delete_package( $_ );
        }

        local @INC;

        $code->();
}

my %line_counter;

sub fork_handler
{
        my( $self,  $body, $wheel_id ) = @_[0, ARG0, ARG1];

        print "Got '$body' from $wheel_id\n";

        $fork_output{ $wheel_id } .= "$body";

        #$self->say(channel=>"#buubot", body => "Received line from $wheel_id" );
}

sub hush
{
        my( $self, $channel ) = @_;

        $self->{ __EB_HUSH }->{ $channel } = 1;
}

sub unhush
{
        my( $self, $channel ) = @_;

        delete $self->{ __EB_HUSH}->{ $channel };
}

sub ignore
{
        if( @_ == 3 )
        {
                my( $self, $channel, $nick ) = @_;
                $self->{ _ignore_list }->{ $channel }->{ $nick } = 1;
        }

        elsif( @_ == 2)
        {
                my( $self, $said ) = @_;
                $self->{ _ignore_list }->{ $said->{ channel } }->{ $said->{ who } } = 1;
        }

        else
        {
                warn "sub ignored called with odd number of arguments, ",scalar(@_)," @_";
        }

        warn "ignored @_";
        warn Dumper( $_[0]->{_ignore_list} );
}

sub ignored
{
        if( @_ == 3 )
        {
                my( $self, $channel, $nick ) = @_;

                warn "Returning: $self->{ _ignore_list }->{ $channel }->{ $nick };";

                return $self->{ _ignore_list }->{ $channel }->{ $nick };
        }
        elsif( @_ == 2 )
        {
                my( $self, $said ) = @_;
                warn "Returning: $self->{ _ignore_list }->{ $said->{ channel } }->{ $said->{ who } }";
                return $self->{ _ignore_list }->{ $said->{ channel } }->{ $said->{ who } };
        }

        else
        {
                warn "sub ignored called with odd number of arguments, ",scalar(@_)," @_";
        }
}

sub unignore
{
        if( @_ == 3 )
        {
                my( $self, $channel, $nick ) = @_;
                delete $self->{ _ignore_list }->{ $channel }->{ $nick };
        }

        elsif( @_ == 2 )
        {
                my( $self, $said ) = @_;
                delete $self->{ _ignore_list }->{ $said->{ channel } }->{ $self->{ who } };
        }

        else
        {
                warn "sub ignored called with odd number of arguments, ",scalar(@_)," @_";
        }
}

sub say
{
        my $self = shift;
        my $args;
        if (ref($_[0]))
        {
                $args = shift;
        }

        else
        {
                my %args = @_;
                $args = \%args;
        }

        if( not exists $self->{ __EB_HUSH }->{ $args->{channel} } )
        {
                $self->SUPER::say( $args );
        }
}

package main;
my $first = P5EvalBot->new("perldoc",[qw/#ninjas/],"the.fake.us");
#my $second = P5EvalBot->new("perldoc",[qw/#darkscience/],"irc.darkscience.ws");
$first->run;
#$second->run;