#!/usr/bin/perl -w
# bdii-fwd -- act as proxy forwarder for BDII services
# derived from "fwdport.pl" by Tom Christiansen

use strict;                 # require declarations
use Getopt::Long;           # for option processing
use Net::hostent;           # by-name interface for host info
use IO::Socket;             # for creating server and client sockets
use POSIX ":sys_wait_h";    # for reaping our dead children
use POSIX qw(strftime);


my (
    %Children,              # hash of outstanding child processes
    $REMOTE,                # whom we connect to on the outside
    $LOCAL,                 # where we listen to on the inside
    $SERVICE,               # our service name or port number
    $REMOTESERVICE,         # remote service name or port number (if different)
    $proxy_server,          # the socket we accept() from
    $ME,                    # basename of this program
);

($ME = $0) =~ s,.*/,,;      # retain just basename of script name

check_args();               # processing switches
start_proxy();              # launch our own server
service_clients();          # wait for incoming
die "NOT REACHED";          # you can't get here from there

# process command line switches using the extended
# version of the getopts library.
sub check_args { 
    GetOptions(
        "remote=s"    => \$REMOTE,
        "local=s"     => \$LOCAL,
        "service=s"   => \$SERVICE,
        "remoteservice=s"   => \$REMOTESERVICE,
    ) or die <<EOUSAGE;
    usage: $0 [ --remote host ] [ --local interface ] [ --service service ]   
                [ --remoteservice service | file ]
EOUSAGE
    die "Need remote"                   unless $REMOTE;
    die "Need local or service"         unless $LOCAL || $SERVICE;
}

sub t {
    strftime "%Y%m%d_%H%M%S ", localtime;
}

# begin our server 
sub start_proxy {
    my @proxy_server_config = (
      Proto     => 'tcp',
      Reuse     => 1,
      Listen    => SOMAXCONN,
    );
    push @proxy_server_config, LocalPort => $SERVICE if $SERVICE;
    push @proxy_server_config, LocalAddr => $LOCAL   if $LOCAL;
    $proxy_server = IO::Socket::INET->new(@proxy_server_config)
                    or die "can't create proxy server: $@";
    print &t . "[Proxy server on ", ($LOCAL || $SERVICE), " initialized.]\n";
}


sub dummy {
}


sub service_clients { 
    my (
        $local_client,              # someone contacting the proxy service
        $lc_info,                   # local client's name/port information
        $remote_server,             # the socket for the real service
        @rs_config,                 # temp array for remote socket options
        $rs_info,                   # remote server's name/port information
        $kidpid,                    # spawned child for each connection
    );

    my $PrevPort = 0;		    # previous port
    my $curGenNr = 0;               # current generation number
    my %portGenNr;                  # generation number per port

    accepting();

    while (1) {
	$SIG{CHLD} = \&dummy;       # allow SIGCHLD to interrupt accept()
	$local_client = $proxy_server->accept();

        @rs_config = (
            Proto     => 'tcp',
            PeerAddr  => $REMOTE,
        );

	my $PeerPort = $SERVICE;

	if ($REMOTESERVICE =~ /^\d+$/) {
	    $PeerPort = $REMOTESERVICE;
	} elsif ($REMOTESERVICE =~ /\D/) {
	    open(RS, $REMOTESERVICE) or die "Cannot open '$REMOTESERVICE': $!\n";
	    $PeerPort = <RS>;
	    chomp($PeerPort);
	    close(RS);
	    die "Bad port in '$REMOTESERVICE': $PeerPort\n" unless $PeerPort =~ /^\d+$/;
	}

        push(@rs_config, PeerPort => $PeerPort);

	if ($PrevPort != $PeerPort) {
	    $PrevPort  = $PeerPort;

	    $portGenNr{$PeerPort} = 0 unless exists $portGenNr{$PeerPort};
	    my $minGen = $portGenNr{$PeerPort} + 1;
	    $portGenNr{$PeerPort} = ++$curGenNr;

	    print &t . "Now forwarding to port $PeerPort (genNr $curGenNr)\n";

	    # kill old clients that were serviced by previous instances

	    for (keys(%Children)) {
		my $pid = $_;
		my $gen = $Children{$_};

		if ($gen < $minGen) {
		    kill('KILL', $pid);
		    print &t . "Killed stale process $pid (genNr $gen)\n";
		}
	    }
	}

	my $child;

	while (($child = waitpid(-1, WNOHANG)) > 0) {
	    my $gen;

	    if ($gen = $Children{$child}) {
		print &t . "Reaped process $child (genNr $gen)\n";
		delete $Children{$child};
	    } else {
		print &t . "Bizarre kid $child exited $?\n";
	    } 
	}

	next if (!$local_client);

        $lc_info = peerinfo($local_client);
        set_state("servicing local $lc_info");
        print &t . "[Connect from $lc_info]\n";

        $kidpid = fork();
        die "Cannot fork" unless defined $kidpid;

        if ($kidpid) {
	    print &t . "Forked process $kidpid -> $PeerPort\n";
            $Children{$kidpid} = $curGenNr;         # remember the generation number
            close $local_client;                    # no use to master
            next;                                   # go get another client
        } 

        # at this point, we are the forked child process dedicated
        # to the incoming client.  but we want a twin to make i/o
        # easier.

        close $proxy_server;                        # no use to slave

        print &t . "[Connecting to $REMOTE...";
        set_state("connecting to $REMOTE");                 # see below
        $remote_server = IO::Socket::INET->new(@rs_config)
                         or die "remote server: $@";
        print "done]\n";

        $rs_info = peerinfo($remote_server);
        set_state("connected to $rs_info");

        $kidpid = fork(); 
        die "Cannot fork" unless defined $kidpid;

        # now each twin sits around and ferries chunks of data.
        # see how simple the algorithm is when you can have
        # multiple threads of control?

	my $bufsize = 65536;

        # this is the fork's parent, the master's child
        if ($kidpid) {              
            set_state("$lc_info --> $rs_info");
            select($remote_server); $| = 1;
            print while sysread($local_client,  $_, $bufsize);
	    shutdown($local_client,  0);  # we are done reading here
	    shutdown($remote_server, 1);  # we are done writing there
	} 
        # this is the fork's child, the master's grandchild
        else {                      
            set_state("$lc_info <-- $rs_info");
            select($local_client); $| = 1;
            print while sysread($remote_server, $_, $bufsize);
	    shutdown($remote_server, 0);  # we are done reading there
	    shutdown($local_client,  1);  # we are done writing here
        } 
        exit;                           # whoever's still alive bites it
    } continue {
        accepting();
    } 
}

# helper function to produce a nice string in the form HOST:PORT
sub peerinfo {
    my $sock = shift;
    return sprintf("%s:%s", $sock->peerhost, $sock->peerport);
} 

# reset our $0, which on some systems make "ps" report
# something interesting: the string we set $0 to!
sub set_state { $0 = "$ME [@_]" } 

# helper function to call set_state
sub accepting {
    set_state("accepting proxy for " . ($REMOTE || $SERVICE));
}

