#!/usr/bin/perl
use 5.008008;
use strict;
use Carp;
use POSIX 'WNOHANG';
use IO::Socket;
use Socket;
use Data::Dumper;

our $VERSION = '0.01';

# some defaults
our %defaults = (
    localIP         => "127.0.0.1",
    max_connections => 1,                 # Not forking
    port            => "80",
    server          => "216.92.118.23",
);

__PACKAGE__->make_accessors(
    qw( localIP max_connections port server rules Alerter kids),
    keys %defaults );

my @kids;

new();

################################################################################
sub new {
    my $class = shift;

    my %params = @_;

    # non modifiable defaults
    my $self = bless {}, $class;

    # get attributes
    $self->{$_} = exists $params{$_} ? delete( $params{$_} ) : $defaults{$_}
      for keys %defaults;

    $self->{Socket} = IO::Socket::INET->new(
        Listen    => 1,
        Reuse     => 1,
        LocalAddr => $self->localIP,
        LocalPort => $self->port,
        Proto     => 'tcp'
    );

    die "Could not create socket: $!\n" unless $self->{Socket};

    #   $self->{Socket}->autoflush(1);

    while ( my $client = $self->{Socket}->accept() ) {
        if ( my $pid = fork() ) {    #Parent
            push @kids, $pid;
            next;
        }
        else {                       #Child handles this conection
            print "New Connection $$" . time() . "\n";
            $self->_handle_connection($client);
            exit();                  # Child exits
        }
    }
    reap_zombies();
}

#################################################################################
sub reap_zombies {
    my $self = shift;
    while (1) {
        my $pid = waitpid( -1, WNOHANG );
        last if $pid == 0 || $pid == -1;    # AS/Win32 returns negative PIDs
        @kids = grep { $_ != $pid } @kids;
        print "$pid PM child died\n";
        $self->Alerter->log( "debug",
            "PortManager $$ Socket pid $pid closed @kids remain active" );
    }
}

####################################################################################################
sub _pass_thru {

    # Default action when no rules hit or is an unknwon protocol.
    my $self       = shift;
    my $client     = shift;
    my $first_line = shift;
    my $client_ip  = $client->peerhost();
    my $out_handle;    # socket to the server
    $self->_connect_server( \$out_handle );

#    $self->Alerter->log( "info",
#        "Pass_Thru OPEN from $client_ip to " . $self->server );

    binmode $out_handle;
    binmode $client;

    $client->autoflush(1);
    $out_handle->autoflush(1);
    my $c;
    my $len = 1;

    if ( my $pid = fork() ) {    # parent sends from Server to Client
        undef $/;
        undef $|;

        while ( $len == 1 ) {
            $len = sysread( $out_handle, $c, 1 );
            syswrite( $client, $c, $len );
        }
    }

    else {                       # Child sends from Client to Server
        undef $/;
        undef $|;
        syswrite( $out_handle, $first_line, length($first_line) );
        while ( $len == 1 ) {
            $len = sysread( $client, $c, 1 );
            syswrite( $out_handle, $c, $len );
        }
    }
    close $client;
    close $out_handle;
    $self->Alerter->log( "info",
        "Pass_Thru CLOSE from $client_ip to " . $self->server );

    exit;
}

##########################################################################################
##########################################################################################
# Will be broken up later
##########################################################################################
##########################################################################################
sub _handle_connection {
    my $self   = shift;
    my $client = shift;
    my $REQUEST;
    my $REPLY;
    my $out_handle;    # Will be a handle to the server side of the socket.
    my $first_line;

    sysread( $client, $first_line, 4 );

    # Change this to use _pass_thru()
    #    if ($first_line =~ /^GET $|^POST$/)
    if ( $first_line !~ /^GET $|^POST$/ ) {
        $self->_pass_thru( $client, $first_line );
    }

    else {
        $REQUEST = $first_line . <$client>;
        while ( my $line = <$client> ) {
            $REQUEST .= $line;
            last if ( $line =~ /^\r\n/ );
        }
    }
    print "New Connection $$ READ" . time() . "\n";
    $REQUEST .= "\r\n\r\n";    # JUST TO BE SURE ITS THERE

    $REQUEST =~ s/HTTP\/1\.1/HTTP\/1\.0/;

    # print $REQUEST;

    $self->_connect_server( \$out_handle );
    print "New Connection $$ Connected " . time() . "\n";

    # Send
    select( ( select($out_handle), $| = 1 )[0] );
    syswrite( $out_handle, $REQUEST, length($REQUEST) );

    select( ( select(STDOUT), $| = 1 )[0] );
    print "New Connection $$ REQUEST SENT " . time() . "\n";

    #  print "URI: " .$object->{Request}->{URI}->{uri} ."\n";

### SLOW PART HERE
    select( ( select($out_handle), $| = 1 )[0] );

    my $bit;
    my $len = 1;
    until ( $len == 0 ) {
        $len = sysread( $out_handle, $bit, 1 );
        $REPLY .= $bit;
    }

## END SLOW PART

    print "New Connection $$ GOT DATA " . time() . "\n";



    select( ( select($client), $| = 1 )[0] );

    #     print $client $REPLY;
    syswrite( $client, $REPLY, length($REPLY) );
    print "New Connection $$ RCV SENT" . time() . "\n";

    close $client;
    close $out_handle;
    print "New Connection $$ DEAD" . time() . "\n";

    exit;
}

################################################################################
sub _connect_server {
    my $self   = shift;
    my $server = $self->server;
    my $port   = $self->port;
    my $sock   = shift;

    #my $proto = getprotobyname('tcp');
    #my $paddr = sockaddr_in($port, inet_aton($server));
    #socket($$sock, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
    #connect($$sock, $paddr) || die "connect: $!";

    $$sock = new IO::Socket::INET(
        PeerAddr => $server,
        PeerPort => $port,
        Proto    => 'tcp',
        Reuse    => 1
    );

    use Socket qw(IPPROTO_TCP TCP_NODELAY);
    setsockopt( $$sock, IPPROTO_TCP, TCP_NODELAY, 1 );

    if ( !$$sock ) {

        #        $self->Alerter->log("info", "Connec to Server failed. $!");
        exit;

    }
    $$sock->timeout(.001);

    #print "Timeout is " .$$sock->Timeout() ."\n";
    #$$sock->autoflush(1);

    return (1);

}

#################################################################################
# private reaper sub
sub reap_zombies {
    my $self = shift;
    my $kids = $self->kids;

    while (1) {
        my $pid = waitpid( -1, WNOHANG );
        last if $pid == 0 || $pid == -1;    # AS/Win32 returns negative PIDs
        @$kids = grep { $_ != $pid } @$kids;
        $self->{conn}++;    # Cannot use the interface for RO attributes
    }
}

#################################################################################
# class method
sub make_accessors {
    my $class = shift;

    for my $attr (@_) {
        no strict 'refs';
        *{"$class\::$attr"} = sub {
            $_[0]{$attr} = $_[1] if defined $_[1];
            $_[0]{$attr};
        };
    }
}

1;