#!/usr/bin/perl
#########################################################################################
#DESCRIPTION:
#  Perl HTTP proxy that modifies or adds an HTTP header for all outgoing HTTP 
#  traffic. Listens on 127.0.0.1:8080 by default, and can handle multiple requests,
#  but HTTP only (no HTTPS).
#
#USAGE:
#  ./httprox <Header Title> <Header Value> [-a]
#
#  *Header Title is the specific header you wish to modify/add, such as Cookie, 
#   User-Agent, etc. Header keywords are case-sensitive.
#
#  *Header Value is the value to assign to that header.
#
#  *Specifying the -a argument will cause the header to be added at the end of the 
#   existing HTTP request.
#
#EXAMPLES:
#  ./httprox User-Agent "None of your business..."
#  ./httprox Cookie SOMECOOKIEDATA
#  ./httprox Test-Header "This is a test header" -a
#
#SCRIPT CUSTOMIZATION:
#  There are three main variables listed at the beginning of the script that may
#  come of interest to the user: $ip, $port and $host_port. 
#
#  $ip and $port specify which local socket will be used to listen for connections 
#  from the web browser, and are set to 127.0.0.1:8080 by default. 
#
#  $host_port specifies the port on the server to connect to; this is port 80 by 
#  default, but can be changed if you need to connect to a server that runs on a 
#  non-standard port.
#
#BUGS:
#  This script is meant to be used for testing purposes, not as a full-fleged proxy;
#  that being said, it has been tested and works with Firefox, IE and Opera, and 
#  should work with any other HTTP/1.1 compliant browser out there. 
#
#  When manually entering a web address in your web browser, it is best to include the 
#  'www' along with the domain you wish to navigate to (i.e., 'www.google.com' instead
#  of just 'google.com').
#
#  Please report any problems to heffnercj [at] gmail.com.
#
#AUTHOR:
#  Craig Heffner 
#  http://www.craigheffner.com
#  heffnercj [at] gmail.com
#  10/09/06
##########################################################################################

use IO::Socket;

#######Change these variables to specify different IP address and port values########

$ip = '127.0.0.1';
$port = '8080';
$host_port = '80';

#####################################################################################

#Check usage
if(!$ARGV[0] || !$ARGV[1]){
  print "\nUsage: ./httprox <Header Title> <Header Value> [-a]\n\nSee the script comments for more details.\n\n";
  exit;
}

#Header to replace
$header=$ARGV[0] .":";

#Value to subsitute
$substitute=$ARGV[1];

#Do we want to add the header instead of replacing it?
if($ARGV[2] eq "-a"){
  $add = 1;
} else {
  $add = 0;
}

#Create a socket listening on $ip:$port
my $sock = new IO::Socket::INET (
      LocalHost => $ip,
      LocalPort => $port,
      Proto => 'tcp',
      Listen => 65535,
      Reuse => 1,
      );
die "Failed to create socket: $!\n" unless $sock;
print "Socket created - listening for connections on $ip:$port\n\n";

#Loop to listen for connections and fork when one is established
do {
  my $conn = $sock->accept();

  #Fork the process
  my $pid = fork(); 
  print "Recieved request - ";

  #If this is a child process, process the request
  if($pid == 0){ 
    #Read the request into $request until CRLF is encountered
    while(<$conn>){
      if($_ eq "\r\n"){
        last;
      }
      $request .= $_;
    }
    
    #Get the destination host name and store it in $host
    ($junk, $host1) = split('Host: ',$request);
    ($host, $junk) = split("\r\n",$host1);
  
    if($add == 1){
      #Add the header to the end of the request sting
      $request .= $header . " " . $substitute . "\r\n";
    } else {
      #Replace the specified header with the appropriate substitute
      $request =~ s/^$header.+\r$/$header $substitute\r/m;
    }

    #Add the final CRLF to the HTTP request
    $request .= "\r\n";

    #Create connection to the host server
    print "request processed, connecting to $host - ";
    my $host_sock = IO::Socket::INET->new(
          Proto => 'tcp',
          PeerAddr => $host,
          PeerPort => $host_port,
          );
    die "Failed to connect to $host: $!\n" unless $host_sock;  
    
    #Retrieve requested data from host server
    $host_sock->autoflush(1);
    print $host_sock $request;
    while(<$host_sock>){
      $reply .= $_;
    }
    
    #Send data back to browser
    print $conn $reply;

    #Clean up
    print "transfer complete, closing socket.\n";
    close($host_sock);
    close($sock);

    #Kill the child process
    exit; 
  } 

} while(1);
exit;