alternativa ao thunder em perl

1 Anexo(s)

ai galera estou disponibilizando pra ver se o sistema rende.

aqui ta funfando legal, mais ainda tem que revisar e dar uma tunada.

proxy.pl

Código :

#!/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;

email/msn [email protected]

edit: segue arquivos em anexo. "comente"