#!/usr/bin/perl -w -T
#
# This code is public domain, and has NO WARRANTY. It's barely tested.
#
# Run this as root (really), and let it listen on port 80 (root privs are
# dropped after opening the port). It then passes data through to a port on
# the localhost. This lets you run UT2003 dedicated servers as regular users
# but still use WebAdmin on port 80.
#
# Either put it in your /etc/inetd.conf or run it with --daemonize to put it
#  in the background.
#
# Tweak the below vars to your liking.
#
#  --ryan. (ryan@epicgames.com)
#

use strict;
use warnings;
use IO::Socket::INET;
use IO::Select;

my $version = "1.1";

my $daemonize = 0;   # can be changed on cmdline.
my $use_syslog = 1;  # can be changed on cmdline.
my $wanted_uid = 99;  # "nobody" on my box.
my $wanted_gid = 98;  # "nobody" on my box.
my $server_port = 80; # port we listen on. 80 is standard HTTP.
my $passthru_host = 'localhost'; # host to passthru to.
my $passthru_port = 8080; # port to connect to for passthrough.
my $max_connects = 10; # maximum connections we accept at once.


my $safe_path = "";

sub syslog_and_die {
    my $err = shift;
    $err .= "\n";
    syslog("info", $err) if ($use_syslog);
    die($err);
}


sub telluser {
    my $text = shift;
    if ($use_syslog) {
	syslog("info", "$text\n");
    }
}


sub passthru_mainline {
    my $sock = IO::Socket::INET->new(PeerAddr => $passthru_host,
				     PeerPort => $passthru_port,
                                     Type => SOCK_STREAM,
                                     Proto => 'tcp');

    telluser("couldn't create passthru socket: $!"), return 1 if (not $sock);

    my $bufsize = 512 * 1024;

    # FIXME: This is probably the wrong way to do this.
    my $sel1 = new IO::Select();
    my $sel2 = new IO::Select();
    $sel1->add(fileno(STDIN));
    $sel2->add($sock);

    my $data;
    my $br;
    my $rc;

    while (1) {
        if (scalar($sel1->can_read(0))) {
            $br = sysread(STDIN, $data, $bufsize);
            last if ((not defined $br) or ($br == 0));
            while ($br > 0) {
                $rc = syswrite($sock, $data, $br);
                last if (not defined $rc);
                $br -= $rc;
            }
        } elsif (scalar($sel2->can_read(0))) {
            $br = sysread($sock, $data, $bufsize);
            last if ((not defined $br) or ($br == 0));
            while ($br > 0) {
                $rc = syswrite(STDOUT, $data, $br);
                last if (not defined $rc);
                $br -= $rc;
            }
	} else {
	    select(undef, undef, undef, 0.01) # sleep 10 or so milliseconds.
	}
    }

    telluser("ending passthru");
    close($sock);
}


sub go_to_background {
    use POSIX 'setsid';
    chdir('/') or syslog_and_die("Can't chdir to '/': $!");
    open STDIN,'/dev/null' or syslog_and_die("Can't read '/dev/null': $!");
    open STDOUT,'>/dev/null' or syslog_and_die("Can't write '/dev/null': $!");
    defined(my $pid=fork) or syslog_and_die("Can't fork: $!");
    exit if $pid;
    setsid or syslog_and_die("Can't start new session: $!");
    open STDERR,'>&STDOUT' or syslog_and_die("Can't duplicate stdout: $!");
    telluser("Daemon process is now detached");
}


sub drop_privileges {
    delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
    $ENV{'PATH'} = $safe_path;
    $) = $wanted_gid if (defined $wanted_gid);
    $> = $wanted_uid if (defined $wanted_uid);
}


sub signal_catcher {
    my $sig = shift;
    telluser("Got signal $sig. Shutting down.");
    exit 0;
}


my @kids;
use POSIX ":sys_wait_h";
sub reap_kids {
    my $i = 0;
    my $x = scalar(@kids);
    while ($i < scalar(@kids)) {
        my $rc = waitpid($kids[$i], &WNOHANG);
        if ($rc != 0) {  # reaped a zombie.
            splice(@kids, $i, 1); # take it out of the array.
        } else {  # still alive, try next one.
            $i++;
        }
    }

    $SIG{CHLD} = \&reap_kids;  # make sure this works on crappy SysV systems.
}



# Mainline.

foreach (@ARGV) {
    $daemonize = 1, next if $_ eq '--daemonize';
    $daemonize = 1, next if $_ eq '-d';
    $daemonize = 0, next if $_ eq '--no-daemonize';
    $use_syslog = 1, next if $_ eq '--syslog';
    $use_syslog = 1, next if $_ eq '-s';
    $use_syslog = 0, next if $_ eq '--no-syslog';
    die("Unknown command line \"$_\".\n");
}

if ($use_syslog) {
    use Sys::Syslog qw(:DEFAULT setlogsock);
    setlogsock("unix");
    openlog("ip_passthru", "user") or die("Couldn't open syslog: $!\n");
}


my $retval = 0;
if (not $daemonize) {
    drop_privileges();
    exit passthru_mainline();
}


# The daemon.

telluser("$0 $version starting up...");

go_to_background() if ($daemonize);

# reap zombies from client forks...
$SIG{CHLD} = \&reap_kids;
$SIG{TERM} = \&signal_catcher;
$SIG{INT} = \&signal_catcher;

my $listensock = IO::Socket::INET->new(LocalPort => $server_port,
                                       Type => SOCK_STREAM,
                                       ReuseAddr => 1,
                                       Listen => $max_connects);

syslog_and_die("couldn't create listen socket: $!") if (not $listensock);

my $selection = new IO::Select( $listensock );
drop_privileges();

telluser("Now accepting connections (max $max_connects" .
	 " simultaneous on port $server_port).");

while (1)
{
    # prevent connection floods.
    sleep(1) while (scalar(@kids) >= $max_connects);

    $selection->can_read();  # block until we get a connection.

    # we've got a connection!
    my $client = $listensock->accept();
    if (not $client) {
        telluser("accept() failed: $!");
        next;
    }

    my $ip = $client->peerhost();
    telluser("connection from $ip");

    my $kidpid = fork();
    if (not defined $kidpid) {
        telluser("fork() failed: $!");
        close($client);
        next;
    }

    if ($kidpid) {  # this is the parent process.
        close($client);  # parent has no use for client socket.
        push @kids, $kidpid;
    } else {
        $ENV{'TCPREMOTEIP'} = $ip;
        close($listensock);   # child has no use for listen socket.
        local *FH = $client;
        open(STDIN, "<&FH") or syslog_and_die("no STDIN reassign: $!");
        open(STDERR, ">&FH") or syslog_and_die("no STDERR reassign: $!");
        open(STDOUT, ">&FH") or syslog_and_die("no STDOUT reassign: $!");
        my $retval = passthru_mainline();
        close(*FH);
        exit $retval;  # kill child.
    }
}

close($listensock);  # shouldn't ever hit this.
exit $retval;

# end of finger.pl ...


