+ Responder ao Tópico



  1. #1

    Wink alternativa ao thunder em perl

    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"
    Arquivos Anexos Arquivos Anexos

  2. #2

    Padrão Re: alternativa ao thunder em perl

    Este script roda junto ao Squid/Lusca, como implementa-lo.

  3. #3

    Padrão Re: alternativa ao thunder em perl

    os arquivos de configuração estão no arquivo em anexo é só adicionar como no exemplo.
    qq coisa tamo aqui.

  4. #4

    Padrão Re: alternativa ao thunder em perl

    pelo que pude ver nestes scripts o squid chama o script que roda em uma determinada porta?

    todos os downloads feitos por ele são gravados em apenas um diretório? ou para cada plugin será criado um diretório distinto?

    ele terá controle de idade do arquivo?

    aqui tenho 22GB de arquivos do windows update, no caso seria apenas ter ester arquivos no diretório que ele mandará para o cliente sem precisar baixar novamente?

    valeu

  5. #5

    Padrão Re: alternativa ao thunder em perl

    seria interessante colocar algumas variáveis no script como por exemplo para especificar os caminhos de onde estão os arquivos, seria mais fácil para manutenção e implementação.

  6. #6
    MODERADOR-CHEFE Avatar de osmano807
    Ingresso
    Aug 2008
    Localização
    Araguari - Minas Gerais
    Posts
    1.980
    Posts de Blog
    5

    Padrão Re: alternativa ao thunder em perl

    Humm, interessante.

  7. #7

    Padrão Re: alternativa ao thunder em perl

    as variaveis existem nos plugins, todos os diretórios são separados por plugins e podem ser customizados.
    o script é só uma parte do codigo, o restante está no anexo.

    no caso do windowsupdate eu deixei as pastas separadas como no url acessado
    ex www.windowsupdate.com/arquivo/file/x.exe
    ele pega o endereço do arquivo e gava na pasta do plugin nesse nite
    /cache/raptor/windowsupdate/arquivo/file/x.exe
    no caso de deixar na mesma pasta, percebi que existe arquivos diferentes com o mesmo nome tipo setup.exe etc..

    bem, analizem e me deem uma força no desenvolvimento.

  8. #8

    Padrão Re: alternativa ao thunder em perl

    Amigo interessante esse seu projeto, mas poderia expor maiores detalhes assim o pessoal da comunidade poderiam ter mais entusiasmo no mesmo.
    Cria um tutorial e posta aqui no forum, mostrando:
    instalação
    personalização
    plugins
    modelo de plugins (quem quiser podera criar novos e te enviar, assim ampliando seu soft)
    Um cara que talvez poderia te dar um apoio no seu sistema é o OSMANO, ele se nao me engano era o bicho para criar os plugins no thunder em php

    Parabens e boa sorte.

  9. #9

    Talking Re: alternativa ao thunder em perl

    UM RELATORIO DIARIO APOS UMA LIGEIRA ATUALIZAÇÃO
    ------------------------------------------------

    CACHE: 78.75% 2182.151 MB | OUT: 21.25% 588.741 MB | windowsupdate
    CACHE: 40.10% 283.949 MB | OUT: 59.90% 424.168 MB | orkut.com
    CACHE: 91.34% 19.221 MB | OUT: 8.66% 1.822 MB | avast
    CACHE: 28.12% 2010.688 MB | OUT: 71.88% 5139.218 MB | youtube.com
    CACHE: 30.04% 10.718 MB | OUT: 69.96% 24.961 MB | globo.com
    CACHE: 3.68% 29.617 MB | OUT: 96.32% 774.700 MB | 4shared.com
    CACHE: 62.18% 8.637 MB | OUT: 37.82% 5.254 MB | pop6.com
    CACHE: 39.34% 10.551 MB | OUT: 60.66% 16.272 MB | pornotube.com
    CACHE: 16.49% 8.769 MB | OUT: 83.51% 44.410 MB | redtubefiles.com
    CACHE: 98.14% 441.721 MB | OUT: 1.86% 8.385 MB | microsoft.com
    CACHE: 27.91% 80.971 MB | OUT: 72.09% 209.173 MB | palco.fm
    CACHE: 5.50% 0.080 MB | OUT: 94.50% 1.381 MB | jogosdemenina.com
    CACHE: 95.53% 116.873 MB | OUT: 4.47% 5.473 MB | google.com
    CACHE: 97.62% 84.542 MB | OUT: 2.38% 2.057 MB | mentez.com
    CACHE: 98.04% 150.761 MB | OUT: 1.96% 3.009 MB | vostu.com
    CACHE: 99.90% 20.133 MB | OUT: 0.10% 0.020 MB | symantecliveupdate.com
    CACHE: 41.00% 1.704 MB | OUT: 59.00% 2.453 MB | avg.com
    CACHE: 0.01% 0.001 MB | OUT: 99.99% 7.327 MB | dailymotion.com
    CACHE: 0.12% 0.002 MB | OUT: 99.88% 1.642 MB | sourceforge.net
    CACHE: 69.53% 482.203 MB | OUT: 30.47% 211.285 MB | ggpht.com
    CACHE: 16.32% 26.900 MB | OUT: 83.68% 137.926 MB | fbcdn.net
    CACHE: 42.98% 0.154 MB | OUT: 57.02% 0.205 MB | facebook.com
    CACHE: 53.44% 61.167 MB | OUT: 46.56% 53.300 MB | googlesyndication.com
    CACHE: 28.06% 26.874 MB | OUT: 71.94% 68.884 MB | ytimg.com

    TOTAL CACHE: 43.93% 6058.386 MB | TOTAL OUT: 56.07% 7732.066 MB