#!/usr/bin/perl -w
#
#Bounce Port v0.3
#

use strict;
use diagnostics;
use IO::Socket;
use IO::Select;

#globalish stuff
my $buffer = 65535;
my %conlist;    #forward read from $handle to $conlist{fileno($handle)}
                #unless $conlist{fileno($handle)}{scon} in which case
                #set up new connection...if a server sub-hash in format:
                #{sock}         the socket refering to the server
                #{scon}         information for the server
                #{scon}{addr}   LocalAddr
                #{scon}{port}   LocalPort
                #{scon}{proto}  Proto
                #{pcon}         information for the file to set up
                #{pcon}{type}   type of peer connection: sock, prog, file
                #sock:
                #{pcon}{addr}   address to connect to
                #{pcon}{port}   port to connect to
                #{pcon}{proto}  protocal
                #prog:
                #{pcon}{name}   program name/file
                #{pcon}{args}   program arguments (in array)
                #file:
                #{pcon}{read}   file to read from and send
                #{pcon}{write}  file to write to and recive
my $sel = IO::Select->new();
my (@rcon, $rc);

&createServer($sel,"0.0.0.0", 5269, 'tcp', 'sock', ('localhost', 2200, 'tcp'));

#mainLoop
#does a select then manages and calls correct sub
#
while (@rcon = $sel->can_read) {
    foreach $rc (@rcon) {
        if (exists $conlist{fileno($rc)}{scon}) {
            my ($cona, $conb);
            #accept connection
            $cona = $rc->accept;
            $cona->autoflush(1);
            #figure new handle to open
            if ($conlist{fileno($rc)}{pcon}{type} eq 'sock') {
                #client socket
                $conb = IO::Socket::INET->new(
                    PeerAddr    =>  $conlist{fileno($rc)}{pcon}{addr},
                    PeerPort    =>  $conlist{fileno($rc)}{pcon}{port},
                    Proto       =>  $conlist{fileno($rc)}{pcon}{proto},
                );
                unless ($conb) {
                    print STDERR "new client bounce:",fileno($rc)," died: $!\n";
		    print STDERR $conlist{fileno($rc)}{pcon}{addr},"\n";
		    print STDERR $conlist{fileno($rc)}{pcon}{port},"\n";
		    print STDERR $conlist{fileno($rc)}{pcon}{proto},"\n";
                    close $cona;
                    next;
                }
                $conb->autoflush(1);

            } elsif ($conlist{fileno($rc)}{pcon}{type} eq 'prog') {
                #program stdin/out
                print STDERR "io to program not yet implemented\n";
                $cona->close;
                next;

            } elsif ($conlist{fileno($rc)}{pcon}{type} eq 'prog') {
                #read from file1, write to file2
                print STDERR "io to file not yet implemented\n";
                $cona->close;
                next;

            } else {
                #none of the above
                print STDERR "bad type: $conlist{fileno($rc)}{pcon}{type}\n";
                $cona->close;
                next;
            }
            
            $sel->add($cona,$conb);
            $conlist{fileno($cona)}{sock} = $cona;
            $conlist{fileno($cona)}{pcon} = $conb;
            $conlist{fileno($conb)}{sock} = $conb;
            $conlist{fileno($conb)}{pcon} = $cona;
            print STDERR $cona->peerhost,":",$cona->peerport,
		"<->",$conb->peerhost,":",$conb->peerport, "\n";


        } else {
            my $data;
            my $pc = $conlist{fileno($rc)}{pcon};
            #check if closed
            unless (sysread($rc, $data, $buffer)) {
		print STDERR $rc->peerhost,":",$rc->peerport,
		    "<->",$pc->peerhost,":",$pc->peerport, " closed by ",
		    $rc->peerhost,":",$rc->peerport,"\n";
		$sel->remove($rc);
		$sel->remove($pc);
		close $rc;
		close $pc;
		next;
            } else {
                unless (syswrite($pc, $data)) {
		    print STDERR $rc->peerhost,":",$rc->peerport,
			"<->",$pc->peerhost,":",$pc->peerport, " closed by ",
			$pc->peerhost,":",$pc->peerport,"\n";
		    $sel->remove($pc);
		    $sel->remove($rc);
                    close $pc;
                    close $rc;
                    next;
                }
	    }
        }
    }
}

#mainLoop

sub createServer {

my ($sel, $laddr, $lport, $lproto, $ptype, @pinfo) = @_;
print STDERR "new listener on $laddr:$lport ($lproto)\n";
my $con = IO::Socket::INET->new(
    Listen      =>  SOMAXCONN,
    LocalAddr   =>  $laddr,
    LocalPort   =>  $lport,
    Proto       =>  $lproto,
    Reuse       =>  1,
)   or print STDERR "new server creation failed\n";

$conlist{fileno($con)} = {
    sock    =>	$con,
    scon    => {
	addr	=>  $con->sockhost,
	port	=>  $con->sockport,
	proto	=>  $lproto},
    pcon    => {
	type	=>  $ptype,
	addr	=>  $pinfo[0],
	port	=>  $pinfo[1],
	proto	=>  $pinfo[2]}
    };				    ##FIXME make if statments for different contypes
$sel->add($con);

}