#!c:/perl/bin/perl -w
$| = 1;

use strict;
use threads;
use IO::Socket;
use HTTP::Request;
use LWP::UserAgent;

my $proxy = IO::Socket::INET->new(
    Listen    => 1,
    LocalAddr => '127.0.0.1',
    LocalPort => 8090,
    ReuseAddr => 1
) or die( "Failed to start HTTP proxy: $!" );

while ( my $client = $proxy->accept() ) {
    threads->create( 'new_request', $client );
}

sub new_request {
    my $client = shift;

    my $page = <$client>;
    $page =~ s![\015\012]+\z!!;

    my ($method, $server, $url, $http_v) = $page
        =~ m!\A(GET|POST|HEAD)\s+http://([^/]+)(/.*)?\s+HTTP/(1.[01])\z!i;
    $url ||= '/';

    my %headers;
    while ( my $line = <$client> ) {
        goto( DISCONNECT ) unless ( defined($line) );

        $line =~ s![\015\012]+\z!!;
        last if ( $line eq "" );

        my ($k, $v) = $line =~ m!\A([^:]+):\s*(.+)\z!;
        $headers{ lc $k } = $v;
    }

    my $ua = LWP::UserAgent->new();
    my $req = HTTP::Request->new();
    $req->method( $method );
    $req->uri( "http://$server$url" );

    $req->header( $_ => $headers{$_} ) for ( keys %headers );

    if ( exists( $headers{'content-length'} ) ) {
        read( $client, my $buf, $headers{'content-length'} );
        $req->content( $buf );
    }

    my $res = $ua->request( $req );

    print $client "HTTP/$http_v ", $res->status_line(), "\015\012";
    $res->scan( sub { print $client "$_[0]: $_[1]\015\012"; } );
    print $client "\015\012", $res->content();

DISCONNECT:
    shutdown( $client, 2 );
    return();
}