#!/usr/bin/perl -w
##################
# relay
#
# is a socket io debuggging tool
# that listens/talks to both ends of 
# a client/server interaction and prints 
# what happens to the screen or a file, so you can see just
# what's going on.  
#
# First you start the relay running.
# 
# Then the client connects to the relay
# which in turn opens a connection to the server.
# The relay then passes packets in both directions, and 
# also prints a record of what's going to standard output.
#
# client    <=>   relay   <=>   server 
#
# Syntax:
#     relay server_host server_port client_port logfilename &
#
# based on several recipes and ideas in the Cookbook;
# 17.2, 17.10, 19.9, 17:fwdport
#
# For example, run
#      relay bob 80 8897 capture.txt
# and then point netscape at http://zonorus:8997
#
# The first three command line arguments have defaults,
# namely bob.marlboro.edu, 80, 8897.
# The logfilename defaults to "", which sends the output
# to stdout.
#
# bugs:
#   When used as a relay between a browser and apache, this
#   stalls occacionally, especially on binary stuff like image files.
#   I expect there's a problem in the buffering, in that I'm 
#   doing "line by line" echoing, which isn't a great model 
#   for things like pictures.  Not to mention how unhappy the 
#   terminal gets when you print one out.
#   
####################
use strict;
use IO::Socket;
my ($server_host, $server_port, $client_port, $logfilename) = @ARGV;
$client_port = 8997                unless $client_port;
$server_host = "bob.marlboro.edu"  unless $server_host;
$server_port = 80                  unless $server_port;

my ($client_socket, $client, $server, $kidpid, $line);

# If we want to write to a logfile, close STDOUT and 
# reopen it to write to that file.  (Typical filehandles
# will _not_ be open when we fork later; STDOUT is, so 
# we use that.)
if ($logfilename) {
  close STDOUT;
  open STDOUT, ">$logfilename" 
    or die "oops - couldn't open '$logfilename' for writing: $!";
}

# listen for connections
$client_socket = IO::Socket::INET->new( Proto  => 'tcp',
					LocalPort => $client_port,
					Listen    => 10, 
					Reuse     => 1,
				      )
    or die "Couldn't listen on port ${client_port} : $@\n";
print "     Listening for client connection on port ${client_port} ... \n";

while (my $client = $client_socket->accept()) {
  $client->autoflush(1);
  #$client->blocking(0);
  print "     Client connection established.\n";

  # we now have a client who wants us to relay his messages

  # create a tcp connection to the specified host and port
  $server = IO::Socket::INET->new( Proto     => "tcp",
				   PeerAddr  => $server_host,
				   PeerPort  => $server_port,
				 )
    or die "can't connect to server port $server_port on $server_host: $!";
  $server->autoflush(1);		# so output gets there right away
  #$server->blocking(0);		# and so we don't wait for reads
  print "     Server connection to $server_host : $server_port established.\n";
  
  # now we fork into two processes, 
  # one to read from client and send to server (and print out to us),
  # another to read from server and sed to client (and also print out to us)
  die "can't fork: $!" unless defined ($kidpid = fork());

  if ($kidpid){
    select STDOUT; $|=1;  # make sure we autoflush.
    # parent copies client->server
    while (defined ($line = <$client>)){
      print $server $line;
      chomp $line;
      print STDOUT "client: " . $line . "\n";
    }
    kill("TERM" => $kidpid);  #send SIGTERM to child
  }
  else {
    select STDOUT; $|=1;  # make sure we autoflush.
    # child copies server->client
    while (defined ($line = <$server>)){
      print $client $line;
      chomp $line;
      print STDOUT "server: " . $line . "\n";
    }
  }

  close($client);
  close($server);

}
close($client_socket);