Here is a simple solution using select (although it will only process one connection at a time). I added comments to the code that I added. You may want to add more error checking.
use IO::Socket;
use IO::Select;
$local_port = 5000;
$proxy_host = "localhost";
$proxy_port = 6000;
$server = IO::Socket::INET->new(
Listen => 5,
LocalAddr => 'localhost',
LocalPort => $local_port,
Proto => 'tcp') or die "Cant create server socket: !";
# Create a select object
$read = new IO::Select;
while ($client = $server->accept)
{
$proxy = IO::Socket::INET->new(
PeerAddr => $proxy_host,
PeerPort => $proxy_port,
Proto => 'tcp')
or die "cannot create proxy socket: $!";
# Unbuffer our output
$oldfh = select ($proxy);
$| = 1;
select ($client);
$| = 1;
select ($oldfh);
# Add our filehandles to our select object
$read->add($client);
$read->add($proxy);
# This will wait until one of the filehandles has something to read
while (defined (($readable) = IO::Select->select($read,undef , und
+ef, 0))){
foreach $fh (@$readable) {
# The client has something to say
if ($fh == $client) {
$buf = <$client>;
if ($buf){
# Lets tell the proxy
print $proxy $buf;
} else {
# The client closed
last;
}
# The proxy has something to say
} else {
$buf = <$proxy>;
if ($buf){
# Lets tell the client
print $client $buf;
} else {
# The proxy closed
last;
}
}
}
}
# Remove our file handles from select and close them
$read->remove($client);
$read->remove($proxy);
$client->close;
$proxy->close;
}
# Now we go onto the next client
UPDATE: Below is a piece of code that will handle multiple clients, has use strict, and $|=1 taken off.
use strict;
use IO::Socket;
use IO::Select;
my $local_port = 5000;
my $proxy_host = "localhost";
my $proxy_port = 6000;
# Used to store client and proxy connections
my %client_proxy;
my $server = IO::Socket::INET->new(
Listen => 5,
LocalAddr => 'localhost',
LocalPort => $local_port,
Proto => 'tcp') or die "Cant create server socket: !";
# Create a select object
my $read = new IO::Select;
$read->add($server);
while (1){
my ($readable) = IO::Select->select($read, undef, undef, 0);
foreach my $fh (@$readable){
if ($fh == $server){
# We got a new client, so set up it's configuration
my $client = $server->accept;
my $proxy = IO::Socket::INET->new(
PeerAddr => $proxy_host,
PeerPort => $proxy_port,
Proto => 'tcp')
or die "cannot create proxy socket: $!"; # You probabl
+y don't really want to die here.
$read->add($client);
$read->add($proxy);
$client_proxy{$client} = $proxy;
$client_proxy{$proxy} = $client;
} else {
my $buf = <$fh>;
if ($buf){
# We need to send some information
my $fh2 = $client_proxy{$fh};
print $fh2 $buf;
} else {
# We need to close our connections
my $fh2 = $client_proxy{$fh};
$read->remove($fh2);
close ($fh2);
delete $client_proxy{$fh2};
$read->remove($fh);
close ($fh);
delete $client_proxy{$fh};
}
}
}
}
<SARCASIM>Some people will pick apart the above code because they are jealous that they could write it ; )</SARCASIM>
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.