#!/usr/bin/perl
#
#ALEXSANDRO [email protected]
#Raptor 1.0 Beta
#
#path dir
$homedir="/etc/raptor";
$cachedir="/cache/raptor";
$lockdir="/cache/raptor/locks";
#files
$logfile="/var/log/proxy.log";
$logerro="/var/log/proxy.err";
$begin=time;
open FILE, "$homedir/plugins.lst";
chomp( @plugins = <FILE> );
close FILE;
# Wait time in seconds for a lock to die.
$deadlink=120; # two minutes
### Code!
$ourver="1.0 beta - filtering/caching";
$d=$hard=$help=$log=$v=0; #debug
foreach $j (@ARGV)
{
$d++ if($j eq "-d");
$v++ if($j eq "-v");
$hard++ if($j eq "-a");
$help++ if($j eq "-h");
$log++ if($j eq "-l");
$rand++ if($j eq "-f");
$limit++ if($j eq "-r");
$cflush++ if($j eq "-c");
}
if($help)
{
print STDERR <<EOF;
$0 options:
-d debug
-v verbose
-a hard fail on banned URLs
-l log interaction
-f futz around with pulling images a bit
-r try to rate limit (not implemented)
-c Flush the TempCache and exit.
EOF
exit 1;
}
# Requirements
use Socket;
$|=1;
$log=1;
# Error subroutine. If we run into trouble, we do it here.
sub err {
my ($e,$r)=@_;
# Quickly suck in some junk just in case...
# BUG: It just delays netscape somehow.
# while(<>) {;}
print STDERR "$$: $e -- $r\n" if($v);
print "HTTP/1.0 $e\r\n";
print "Content-Type: text/html\r\n";
print "Connection: close\r\n\r\n";
print "<html><head><title>$e</title></head><body>\r\n";
print "<h1>$e</h1><BR><P>";
print "Raptor cannot fulfill your request -- $r<P>$req<P>\n";
print "<hr><br><i>Raptor version $ourver<br></I>\r\n";
exit 0;
}
sub nothing {
print STDERR "$$: Sending nothing\n" if($v);
print "HTTP/1.0 200 OK\r\n";
print "Content-Type: text/html\r\n";
print "Connection: close\r\n\r\n";
print "// Nothing. \r\n";
print "\r\n";
exit 0;
}
sub blank {
print STDERR "$$: Sending blank\n" if($v);
print "HTTP/1.0 200 OK\nConnection: close\n";
print "Content-type: image/gif\n\n", pack "H*", "47494638396101000100800000ffffff"."00000021f90401000000002c00000000"."010001000002024401003b";
exit 0;
}
# Generic file send routine.
sub sendthis {
my ($file)=@_;
while( -e "$lock" )
{
unlink "$lock" if(-M "$lock" > $deadlink);
sleep 3;
}
$file_size = -s $file;
open(IN,"<$file") || &err("500 Internal Server Error","Cannot open cached file ($!)");
while(<IN>)
{
print;
}
$begin=time - $begin;
$xfor="127.0.0.1" if (!$xfor);
print LOG time.".000 $begin $xfor TCP_HIT/$codi $file_size $type http://$url - NONE/- $xtype\n" if($log);
exit;
}
# Open up a logfile.
if($log)
{
$log='' unless(open(LOG,">>$logfile"));
$lerr='' unless(open(ERRO,">>$logerro"));
}
# Read the first line of the request and pharze it.
$_=$req=<STDIN>; tr/\n\r//d;
exit if(/^$/);
#print ERRO "$$: line: $_\n" if($log);
m#^(GET|POST|HEAD) http://([^/]+)(/.*) (HTTP\S+)$#i;
$type=$1; $site=$2; $page=$3; $ver=$4;
$url=$site.$page;
$line=$_;
#search cached
$cachethis=0;
$domain=0;
foreach $j (@plugins)
{
if($site =~ /$j/)
{
$domain = $j;
}
}
if($site =~ /^([^:]+):(\d+)$/)
{
$remote=$1; $port=$2;
} else {
$remote=$site; $port=80;
}
$iaddr = inet_aton($remote) ;
# Call out and strangle someone
&err("400 Bad Request","Site $remote can't be resolved ($!).") unless($iaddr);
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto) || &err("500 Internal Server Error","Something went wrong trying to connect to $remote ($!).");
connect(SOCK, $paddr) || &err("500 Internal Server Error","Cannot connect to $remote ($!)");
$old=select(SOCK); $|=1; select($old);
print SOCK "$type $page $ver\r\n"; # Xmission's webserver is funky
$lo=0;
while(<STDIN>)
{
$ok=1;
$l=$_;
tr/\r\n//d;
$lo=2 if(/^$/);
$cont=$1 if(/^Content-[lL]ength: (\d+)$/);
$nocache++ if(/^Pragma: no-cache/);
$ok=0 if(/^Proxy-Connection:/);
$ok=0 if(/^Range: bytes/);
$xfor=$1 if(/X-Forwarded-For:\s(.*)/);
print SOCK "Connection: close$l" if($lo);
print SOCK "$l" if($ok);
print STDERR "$$ >>> $l" if($ok && $d);
last if($lo);
}
if($cont)
{
while($cont)
{
$in=read STDIN, $buf, ($cont < 512 ? $cont : 512 );
$cont -= $in;
print SOCK $buf;
}
}
$conn=0; $lc=0;
while(<SOCK>)
{
$l=$_; $lc++;
tr/\r\n//d;
last if(/^$/);
$http=$1 if(/(^HTTP.*)\s([0-9])/);
$codi=$1 if(/^HTTP.*\s([0-9]{3})\s/);
$xtype=$1 if(/^Content-Type.*\s(.*)/);
$conn++ if(/^Connection:/);
$cont=$1 if(/^Content-[lL]ength: (\d+)$/);
print $l unless($conn);
}
$rsize=$cont;
print "Connection: close\r\n" if($codi =~ /304/);
print $l if ($codi =~ /304/);;
close SOCK if ($codi =~ /304/);
exit 0 if ($codi =~ /304/);
&err("500 Internal Server Error","Blank document returned. ($!)") unless($lc);
unless($url =~ /\?/ && !$domain)
{
$file=0;
if($domain)
{
#carrega plugin para tratar a $url
$plugin = "$homedir/plugins/$domain.pl";
if(-e $plugin)
{
print ERRO "$$: LOADING $domain.pl.\n" unless($xfor); #if($log);
do "$homedir/plugins/$domain.pl";
} else {
print ERRO "$$: plugin $domain.pl not found.\n" if($log);
}
}
if($file)
{
$file="$cachedir/$file";
$lock=$1 if ($file =~ /^.*\/(.*$)/);
$lock="$lockdir/$lock.LOCK";
if(-e $file)
{
if( -e $lock )
{
unlink "$lock" if(-M "$lock" > $deadlink);
}
unless( -e $lock )
{
$size = -s $file;
if($rsize > $size)
{
unlink "$file";
print ERRO "FILE ERROR: LSIZE: $size - RSIZE: $rsize arquivo corrompido ou incompleto $file.\n" if($log);
}
}
}
unless(-e $lock)
{
print "X-Cache: HIT from Raptor\r\n" if (-e $file && -s $file);
print "Connection: close\r\n";
print $l;
&sendthis($file) if (-e $file && -s $file);
$cachethis=$file;
}
else
{
print "Connection: close\r\n";
print $l;
}
} else {
}
} else {
print "Connection: close\r\n";
print $l;
}
if($cachethis)
{
$file=$cachethis;
$file=~m#^(.*/)[^/]+$#; $dir=$1;
$lsize=$cont;
if(! -e $dir)
{
system "mkdir -p $dir";
}
while(-e $lock)
{
# Hmmm... already being pulled.
unlink "$lock" if(-M "$lock" > $deadlink);
sleep 3;
}
if(open(OUT,">$lock"))
{
print OUT "$$\n";
print OUT "$url\n";
print OUT "$file\n";
close(OUT);
$cachethis=0 unless( open(OUT,">$file") );
unlink "$lock" unless($cachethis);
}
$xaddr=inet_ntoa($iaddr);
$begin=time - $begin;
$xfor="127.0.0.1" if (!$xfor);
$lsize=0 if(!$lsize);
print LOG time.".000 $begin $xfor TCP_MISS/$codi $lsize $type http://$url - DIRECT/$xaddr $xtype\n" if($log);
}
if($cont)
{
while($cont)
{
$in=read SOCK, $buf, ($cont < 512 ? $cont : 512 );
$cont -= $in;
print $buf;
print OUT $buf if($cachethis);
last if($count < 0);
}
} else {
$loop=0;
while(<SOCK>)
{
print;
print OUT if($cachethis);
$loop++ if (/^$/);
last if($loop == 100);
}
}
close(SOCK);
unlink "$lock" if($cachethis);
close(OUT);
exit;
alternativa ao thunder em perl
Re: alternativa ao thunder em perl
Re: alternativa ao thunder em perl
Citação
