Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

bp (Bounce Port)

by tremere (Acolyte)
on Dec 11, 2004 at 18:55 UTC ( [id://414135]=sourcecode: print w/replies, xml ) Need Help??
Category: Networking Code
Author/Contact Info /msg tremere
Description: redirects a tcp or udp port to another tcp or udp port (only tcp to tcp tested), a file, or a program. (file and program not implemented yet, but shall be) At some point regexp replacement...
#!/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);

}
Replies are listed 'Best First'.
Re: bp (Bounce Port)
by cazz (Pilgrim) on Apr 05, 2005 at 22:24 UTC
    A few issues:
    1. Socat implements all of the features you are wanting to add but have not added yet, and more.
    2. I'm guessing the second "prog" is supposed to be "file"?
      } 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;
    3. Commandline Arguements?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://414135]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (3)
As of 2024-03-29 14:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found