#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use URI;
$SIG{CHLD} = 'IGNORE' ;

my $server=IO::Socket::INET->new(
    LocalAddr => shift(@ARGV) || 'localhost',
    LocalPort => shift(@ARGV) || 2258,
    Listen => 5,
    Proto => 'tcp' );
die "ERROR Create Server Socket\n" unless($server);

while (my $client = $server->accept())
{
  binmode($client);
  unless(fork)
  {
    $server->close();
    # Header vom Client lesen
    my ($head,$b_length)=read_head($client);
    # Die ZielURL herausschneiden
    my $url;
    $head =~s/\A(\w+\s+)(\S+)/
            $url = URI->new($2); $_=$1.$url->path_query/es;
    my $socket = IO::Socket::INET->new(
            PeerAddr => $url->host, PeerPort => $url->port );
    die "$$ ERROR Open $url" unless $socket;
    binmode($socket);
    # Wenn Content da ist, auslesen
    my $body= $b_length ? read_body($client,$b_length) : '';
    # alles an den Zielserver schicken
    print $socket $head.$body;
    # Head vom Server lesen
    ($head,$b_length)=read_head($socket);
    # Wenn Content da ist, auslesen
    $body= $b_length ? read_body($socket,$b_length) : '';
    # alles an den Client schicken
    print $client $head.$body;
    # sterben
    exit();
  }
}

sub read_body
{
  shift()->read(my $d,shift());
  return $d;
}

sub read_head
{
  my $sock=shift;
  local $/="\x0D\x0A";
  my ($data,$bl)=('',0);
  while (my $line = <$sock>)
  {
    $data.=$line;
    # Der Header endet einer leeren Zeile
    last if ($line=~m|^$/$|s);
    $bl=$1 if $line=~/Content-length: +(\d+)/i;
  }
  return ($data,$bl);
}