#!/usr/bin/perl -w
# a tiny http proxy ... (c) 2001 Heiko Hellweg (hellweg@snark.de)
# see http://www.snark.de/tools/
# LICENSE: public domain! no warranties whatsoever!
use IO::Socket ;
# this should avoid Zombies in fork mode (-f) (at least on linux):
$SIG{CHLD} ='IGNORE' ;
# print the verbose output immeadietly
$|=1 ;
# defaults:
my $port = 4444 ;
my $nofork = 1 ;
my $verbose = 0 ;
my $error = qq{HTTP/1.1 404 Not Found
Content-Type: text/html;
404 Not Found
Not Found
};
my $eclose = "\n" ;
sub rewriteHdr { # for requests
my ($hdr) = (@_) ;
# $hdr =~ s/(User-Agent\:.+)\)/$1 ...relayed\)/ ;
$hdr =~ s/(User-Agent\:\s).+\)/$1Mozilla\/4.76 \[en\] \(X11; U; Linux i686\)/;
$hdr =~ s/Connection\:\sKeep-Alive/Connection\: Close/ ;
$hdr =~ s/Cookie\:.+// ;
# add other rewrite rules for header modification or omission here
return $hdr ;
}
sub rewriteRespHdr { # for responses
my ($hdr) = (@_) ;
$hdr =~ s/Set-Cookie\:.+// ;
# add other rewrite rules for header modification or omission here
return $hdr ;
}
sub handleRequest {
my ($con, $req) = (@_) ;
if($req =~ /GET\s+http\:\/\/([^\:\/]+)\:?(\d+)*(\/\S*)\s(HTTP\/\d\.\d)/) {
my $host = $1 ;
my $port = $2 || 80 ;
my $path = $3 ;
my $httpver = $4 ;
print("relay $host:$port$path\n") if $verbose ;
my $sock = IO::Socket::INET->new(PeerAddr => $host,
PeerPort => $port,
Proto => 'tcp');
if(! defined($sock)) {
print("error handling $host:$port$path\n") if $verbose ;
$con->print("$error Host $host not reachable $eclose");
return ;
}
$sock->print("GET $path $httpver\r\n") ;
my $hdr ;
HDRLOOP:
while(defined($hdr = <$con>)) { # relay the request
last HDRLOOP if ($hdr =~ /^\s*$/) ;
$hdr = rewriteHdr($hdr) ;
$sock->print($hdr) unless($hdr =~ /^\s*$/) ; # dont relay eliminated headers
}
$sock->print("\r\n") ;
my $headermode = 1 ;
while(defined($hdr = <$sock>)) { # relay the response
$headermode = 0 if ($hdr =~ /^\s*$/) ;
$hdr = rewriteRespHdr($hdr) if $headermode ;
$con->print($hdr) unless($headermode && ($hdr =~ /^\s*$/)) ; # dont relay eliminated headers
}
$sock->close() ;
}
else {
$con->print("$error what kind of request is$req
???$eclose");
}
}
#################### main ##################
# get commandline options:
while(defined($par = shift)) {
$port = shift || die "-p" if($par eq "-p") ;
$nofork = 0 if($par eq "-f") ;
$verbose++ if($par eq "-v") ;
}
my $listener = IO::Socket::INET->new(Listen => 5,
LocalAddr => "127.0.0.1:$port",
Proto => "tcp",
Reuse => SO_REUSEADDR) ;
print("trelay up and listening on port $port\n") if $verbose ;
ACCEPTIT:
while(1) {
my $con ;
if(!defined($con = $listener->accept())) {
print(STDERR scalar(localtime(time)), " Accept failed...\n") ;
sleep(2) ;
next ACCEPTIT ;
}
my $req = <$con> ;
if ($req =~ /exit-trelay-now/) { # hack to exit remotely !!!
# (sometimes ^C kills just the ssh tunnel - not this script)
print("GOING DOWN!!\n") ;
exit 0 ;
}
$child = 0 ;
$child = fork() unless $nofork ;
if($child == 0) {
# this is the child proc.. or noforkMode: handle the request
handleRequest($con, $req) ;
$con->close() ;
exit 0 unless $nofork ;
}
}