#!/usr/bin/perl -w
# http://slinky.scrye.com/~tkil/perl/port-forward
# by Tkil <tkil@scrye.com>, 1999-05-21
#
# released under the same terms as Perl itself.  please use and share.

use strict;

use IO::Socket;
use IO::Select;

my $debug = 1;
my %debug_info;

# ============================================================

# what protocol is this all running on?
use constant conn_proto => "tcp";

# how much data should we snarf at once?
use constant io_buf_size => 1024;

use constant server_host => 'slinky.scrye.com';
use constant server_port => 23; # telnet, how original

# we'll assume that we're running this on the local host.
use constant proxy_port => 8023;

use constant listen_max => 10;

# now some hashes to map client connections to server connections.
my (%client_of_server, %server_of_client);

# and one more hash, from socket name to real socket:
my %socket_of;

print STDERR "setting up listening socket on localhost:", proxy_port, "\n"
  if $debug;

# setup listening port
my $listen_sock = IO::Socket::INET->new(LocalAddr  => 'localhost',
					LocalPort  => proxy_port,
					Proto	   => conn_proto,
					Type	   => SOCK_STREAM, 
					Listen	   => listen_max,
					Reuse	   => 1);

# create the IO::Select that will control our universe.  add the
# listening socket.
my $sel = IO::Select->new($listen_sock);

# ============================================================

sub add_client_sock 
{
   my $client = shift;

   if ($debug) {
     $debug_info{$client} = $client->peerhost . ":" . $client->peerport;
     print STDERR "received client: $debug_info{$client}\n";
   }

   # open the proxied connection...
   my $server = IO::Socket::INET->new(PeerAddr	=> server_host,
				      PeerPort	=> server_port,
				      Proto	=> conn_proto)
     or die "opening server socket: $!";

   if ($debug) {
     $debug_info{$server} = $server->peerhost . ":" . $server->peerport;
     print STDERR "opened server: $debug_info{$server}\n";
   }

   # now populate the hashes.
   $socket_of{$client} = $client;
   $socket_of{$server} = $server;
   $client_of_server{$server} = $client;
   $server_of_client{$client} = $server;

   # and add both socket to the IO::Select object
   $sel->add($client);
   $sel->add($server);
}

# ============================================================

sub remove_socket
{
   my $sock = shift;

   if ($debug) {
     print STDERR "removing socket: $debug_info{$sock}\n";
     delete $debug_info{$sock};
   }

   # determine the "other half" of this socket, removing it from the
   # hash as we go.
   my $dest_sock;
   if (exists $client_of_server{$sock}) 
   {
      $dest_sock = delete $client_of_server{$sock};
      delete $server_of_client{$dest_sock};
   }
   elsif (exists $server_of_client{$sock})
   {
      $dest_sock = delete $server_of_client{$sock};
      delete $client_of_server{$dest_sock};
   }
   else 
   {
      warn "couldn't find sock in 'remove_socket'";
      return;
   }
   
   if ($debug) {
     print STDERR "removing socket: $debug_info{$dest_sock}\n";
     delete $debug_info{$dest_sock};
   }

   # remove them from the rest of the hashes, as well.
   delete $socket_of{$sock};
   delete $socket_of{$dest_sock};
   
   # and from the IO::Select object
   $sel->remove($sock);
   $sel->remove($dest_sock);

   # and close them.
   $sock->close;
   $dest_sock->close;
}

# ============================================================

sub process_data
{
   my $sock = shift;

   # determine the "other half" of this socket.
   my $dest_sock;
   if (exists $client_of_server{$sock}) 
   {
      $dest_sock = $client_of_server{$sock};
   }
   elsif (exists $server_of_client{$sock})
   {
      $dest_sock = $server_of_client{$sock};
   }
   else 
   {
      warn "couldn't find sock in 'process_data'";
      return;
   }

   # read the actual data.  punt if we error.
   my $buf;
   my $n_read = sysread($sock, $buf, io_buf_size);
   unless ($n_read) {
      remove_socket($sock);
      return;
   }

   ### if you have any modifications you want to make to the data,
   ### here's where to do it.  the only added complication is this: if
   ### you want to do stuff line-by-line, you have to split stuff up
   ### for yourself (and, incidentally, you have to keep fragments of
   ### lines across 'process_data' invocations).  using <$sock> is
   ### *BAD* when you're using select.
   
   # now forward it along
   syswrite($dest_sock, $buf, $n_read)
     or remove_socket($sock);
}

# ============================================================

# now for the actual loop.
while (my @handles = IO::Select::select($sel, undef, $sel)) 
{
   # remove any sockets that are in error
   my %removed;
   foreach ( @{ $handles[2] } ) 
   {
      remove_socket($_);
      $removed{$_} = 1;
   }

   # get input from each active socket
 READABLE_SOCKET:
   foreach my $sock ( @{ $handles[0] } ) 
   {

      # make sure that that socket hasn't gone *blammo* yet
      next READABLE_SOCKET
	if exists $removed{$sock};

      # any new sockets?
      if ($sock == $listen_sock) 
      {
	 my $new_sock = $listen_sock->accept
	   or die "accept: $!";
	 add_client_sock($new_sock);
      }
      else 
      {
	 # just move along.
	 process_data($sock);
      }
   }
}