#!/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 forma
+t:
                #{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, f
+ile
                #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)," di
+ed: $!\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}{ty
+pe}\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 cont
+ypes
$sel->add($con);

}

[download]

In reply to bp (Bounce Port) by tremere

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.