Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Remote port forward with core modules only

by ruoso (Curate)
on Feb 03, 2009 at 13:44 UTC ( #740988=CUFP: print w/ replies, xml ) Need Help??

This is one thing that is very well solved by Perlbal in a much more elegant way. But I had a pretty messed up environment to play with, so I decided to reimplement it using core modules only, in this case IO::Socket::INET, IO::Select and IO::Handle.

#!/usr/bin/perl use strict; use warnings; my ($listen_host, $listen_port, $connect_host, $connect_port) = @ARGV; die 'Missing parameters' unless $listen_host && $listen_port && $connect_host && $connect_port; use IO::Handle; use IO::Select; use IO::Socket::INET; my %connections; my %reverse_in; my %reverse_ou; my $conn_id = 0; my $main_connection = IO::Socket::INET->new ( Listen => 100, LocalHost => $listen_host, LocalPort => $listen_port, Blocking => 0 ) or die $!; my $select_r = IO::Select->new($main_connection); my $select_w = IO::Select->new; while (1) { my ($read, $write) = IO::Select->select($select_r, $select_w, undef +, 100) or warn "error in select: ".$!; foreach my $conn (@{$read}) { if ($conn == $main_connection) { accept_new_connection($conn); } else { # this is a regular connection read_data($conn); } } foreach my $conn (@{$write}) { write_data($conn); } } sub accept_new_connection { my $conn = shift; my $incoming = $conn->accept; my $outgoing = IO::Socket::INET->new ( PeerHost => $connect_host, PeerPort => $connect_port, Blocking => 0 ); $outgoing->blocking(0); $incoming->blocking(0); my $id = $conn_id++; $connections{$id} = { incoming => $incoming, outgoing => $outgoing, in_bf => '', ou_bf => '', id => $id }; $reverse_in{$incoming} = $id; $reverse_ou{$outgoing} = $id; # now we add the $incoming and $outgoing as read, and only # modify it if some data comes in. $select_r->add($incoming); $select_r->add($outgoing); } sub read_data { use bytes; my $conn = shift; my ($type, $id); if (exists $reverse_in{$conn}) { $type = 'in'; $id = $reverse_in{$conn}; } elsif (exists $reverse_ou{$conn}) { $type = 'ou'; $id = $reverse_ou{$conn}; } my $data = $connections{$id}; if (!$conn->connected) { eval { remove_connection($data); }; return; } my $buf; my $read = sysread $conn, $buf, 4096; if (!$read) { remove_connection($data); return; } $data->{$type.'_bf'} .= $buf; if ($type eq 'in') { $select_w->add($data->{outgoing}); } else { $select_w->add($data->{incoming}); } } sub write_data { use bytes; my $conn = shift; my ($type, $id); if (exists $reverse_in{$conn}) { $type = 'ou'; $id = $reverse_in{$conn}; } elsif (exists $reverse_ou{$conn}) { $type = 'in'; $id = $reverse_ou{$conn}; } my $data = $connections{$id}; if (!$conn->connected) { eval { remove_connection($data); }; return; } my $buf = $data->{$type.'_bf'}; my $wrote = syswrite $conn, $buf, length($buf); substr($data->{$type.'_bf'}, 0, $wrote, ''); $select_w->remove($conn) unless $data->{$type.'_bf'}; } sub remove_connection { my $data = shift; $select_r->remove($data->{incoming}, $data->{outgoing}); $select_w->remove($data->{incoming}, $data->{outgoing}); delete $reverse_in{$data->{incoming}}; delete $reverse_ou{$data->{outgoing}}; $data->{incoming}->close; $data->{outgoing}->close; delete $connections{$data->{id}}; }


Comment on Remote port forward with core modules only
Download Code
Re: Remote port forward with core modules only
by merlyn (Sage) on Feb 03, 2009 at 16:03 UTC
    Heh, there's code very similar to this (but written in Perl 4 and a lot shorter) as part of the State's evidence in my criminal trial. Larry Wall commented that it was Perl, but not very good Perl. {sigh}
      I was wondering, did it ever cross your mind that you were a scapegoat, in a conspiracy between Intel and Microsoft, to discourage Perl and taint the Perl crowd as hackers and pirates? Or that you may have been setup?

      I'm not really a human, but I play one on earth Remember How Lucky You Are

        /me thinks it would be fun to be a pirate!

        Maybe not as fun as a ninja, but still fun.

        And you didn't even know bears could type.

      is there a link to that specific code? it would be cool to have a CUFP titled "Perl code for getting arrested" ;) (yeah, bad joke, I know)


        This text file references programs named 'Gate' and 'Door': State's Exhibits 16,19 and Defendant's Exhibits 151,152,153,154. Not sure if they're available online anywhere though...

        Life is denied by lack of attention,
        whether it be to cleaning windows
        or trying to write a masterpiece...
        -- Nadia Boulanger
Re: Remote port forward with core modules only
by Discipulus (Curate) on Feb 04, 2009 at 09:02 UTC
    may someone explain why this code is criminal? and some words about the microsoft vs intel war about perl?

    from the border of the digital matrix
    best regards

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://740988]
Approved by Corion
Front-paged by Arunbear
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (9)
As of 2014-10-21 07:19 GMT
Find Nodes?
    Voting Booth?

    For retirement, I am banking on:

    Results (98 votes), past polls