#!/usr/bin/perl

use strict;
use Socket;
use Carp;
my $EOL = "\015\012";

sub spawn;  # forward declaration

my $port = shift || 2345;
my $proto = getprotobyname('tcp');
$port = $1 if $port =~ /(\d+)/; # untaint port number

socket(Server, PF_INET, SOCK_STREAM, $proto)                || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,pack("l", 1))   || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))                || die "bind: $!";
listen(Server,SOMAXCONN)                                    || die "listen: $!";

my $waitedpid = 0;
my $paddr;

sub REAPER {
    $waitedpid = wait;
    $SIG{CHLD} = \&REAPER;  # loathe sysV
}


$SIG{CHLD} = \&REAPER;

for ( $waitedpid = 0;
      ($paddr = accept(Client,Server)) || $waitedpid;
      $waitedpid = 0, close Client)
{
    next if $waitedpid and not $paddr;
    my($port,$iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr,AF_INET);

    spawn sub {
        # start
        my $cmd = "";
        my $line;
        
        while ((defined($line = <Client>)) && (($cmd .= $line) !~ /\n[\t\s]*\n/s)) {
        }
        
        my ($remote,$port, $iaddr, $paddr, $proto, $line);

	($remote) = ($cmd =~ /http:\/\/(.*?)\//s);
        if ($remote =~ /^(.*):(.*?)$/) {
          $remote = $1;
          $port   = $2;
        } else {
          $port   = 80;
        }
        if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
        die "No port" unless $port;
        $iaddr   = inet_aton($remote)               || die "no host: $remote";
        $paddr   = sockaddr_in($port, $iaddr);

        $proto   = getprotobyname('tcp');
        socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
        connect(SOCK, $paddr)    || die "connect: $!";

        send(SOCK,"$cmd\n",0);
        while (defined($line = <SOCK>)) {
            send(Client,$line,0);
        }
        close (SOCK)            || die "close: $!";
        # end
    };
}

sub spawn {
    my $coderef = shift;

    unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
        confess "usage: spawn CODEREF";
    }

    my $pid;
    if (!defined($pid = fork)) {
        print "cannot fork: $!";
        return;
    } elsif ($pid) {
        return; # I'm the parent
    }
    # else I'm the child -- go spawn
    exit &$coderef();
}