0

LWP::UserAgent を使用して自分で使用する小さなプロキシを構築し、HTML::TreeBuilder を使用して HTML を解析しています。

私がいるページに応じて、私のコードは情報を取得/表示を変更する小さなモジュールをロードしてから、HTMLを再度印刷します。

最初は、モジュール内に HTML::TreeBuilder をロードし、そこを変更し、そこから HTML を printint で戻していましたが、すべて問題ありませんでした。

今、私は小さなモジュールを呼び出すコードでツリーを構築しています (小さなモジュールはまだそれを変更しています)、ここから HTML を出力します。

これが私が使用する単純化されたコードです。

動作しないコード:

$info{content}=$response->content;
$info{tree} = HTML::TreeBuilder->new_from_content($info{content}) or die $!;

do module.pm #modify the tree

$info{content} = $info{tree}->as_HTML(undef,"\t");
$info{tree}->delete();

return \$info{content};

そしてmodule.pmで

my $elem = $info{tree}->look_down(_tag => "img");
$elem->attr('width', '240');
$elem->attr('height', '60');

そして作業コード

$info{content}=$response->content;

do module.pm #modify the tree

return \$info{content};

モジュール内：

use strict;
use warnings;
use HTML::TreeBuilder; # Ensure weak references in use

my $tree = HTML::TreeBuilder->new_from_content($awproxy::process::info{content}) or die $!;

my $elem = $tree->look_down(_tag => "img");
$elem->attr('width', '240');
$elem->attr('height', '60');

$awproxy::process::info{content} = $tree->as_HTML(undef,"\t");
$tree->delete();

1;

誰でもそれがどこから来たのか考えていますか?

両方のコードから返される HTML はまったく同じです。

編集：私が使用するすべてのコード。

perltranshandler によって呼び出される main.pm

package awproxy::main;
use strict;
use warnings;
use Apache2::Const qw(:common);
use Apache2::RequestRec;
use Apache2::RequestIO;
use awproxy::process;

my $destdomain="domain.com";
my $desthost="www1.domain.com";
my $wwwdesthost="www.domain.com";

sub handler {
   my ($r) = @_;
   $r->handler("perl-script");
   $r->set_handlers(PerlHandler => \&proxy_handler);
   return OK;
}

sub proxy_handler {
    my($r) = @_;
    $r->status(200);
    $r->content_type("text/plain");
    my $ourhost="aw.mydomain.fr.cr";
    my $wwwourhost="awww.mydomain.fr.cr";
    my $result=awproxy::process::process($r);

    my $dest;
    my $headers_in = $r->headers_in;
    my $host=$headers_in->get("Host");
    if($host=~/^www\.a/) { # matches $wwwourhost
        $dest=$wwwdesthost;
    } else {
        $dest=$desthost;
    }

# filter headers_out as with ProxyPassReverse
   my $h=$r->headers_out();
   foreach my $k (qw(Content-Location Location URI)) {
      my $l=$h->get($k);
      if($l && ( $l=~s!(http://)$desthost!$1$ourhost! || $l=~s!(http://)$wwwdesthost!$1$wwwourhost!)) {
         $h->set($k,$l);
      }
   }
# cookie reverse modification
   for my $k ("Set-Cookie") {
      my @l=$h->get($k);
      foreach my $cookie (@l) {
         if($cookie=~s/$desthost/$ourhost/ || $cookie=~s/$wwwdesthost/$wwwourhost/ || $cookie=~s/domain=$destdomain/host=$ourhost/) {
            $h->add($k, $cookie);
         }
      }
   }

    if($result) {
        $r->print($$result);
    }
    $_=undef; # clear private data
    undef %awproxy::process::info;
   return OK;
}

1;

前の関数によって呼び出されたプロセス

package awproxy::process;
use strict;
use warnings;
use Apache2::Connection; #permet de recup l'ip
use LWP::UserAgent; #pour les connexion
use APR::Table;
use DBI;
use HTML::TreeBuilder;


sub process {   
    my $desthost="www1.domain.com";
    my $wwwdesthost="www.domain.com";
    my $ourhost="aw.mydomain.fr.cr";
    my $wwwourhost="awww.mydomain.fr.cr";
    my $destdomain="aw.mydomain.fr.cr";
    my $dir="/usr/lib/perl5/awproxy/";
    our %info;

    my $r = shift;

    our $dbh=DBI->connect('DBI:mysql:XXXX', 'XXXX', 'XXXX'
               ) || die "Could not connect to database: $DBI::errstr";


    #pour recup l'ip
    my $c=$r->connection();
    my $ip=$c->remote_ip();

    # autodetect $ourhost value from input headers
    my $headers_in = $r->headers_in;
    my $host=$headers_in->get("Host");
    my $dest;
    if($host=~/^www\.a/) { # matches $wwwourhost
        $dest=$wwwdesthost;
    } else {
        $dest=$desthost;
    }

    #Pour creer la requete
    my $ua = LWP::UserAgent->new();
    $ua->agent('Mwoua/proxy');
    my $method = uc($r->method);
    my $request = HTTP::Request->new($method,"http://".$dest.$r->unparsed_uri); 


    while(my($key,$val) = each %$headers_in) {
      next if($key eq "Host"); # do not override host header
      next if($key eq "Accept-Encoding");
      $request->header($key,$val);
    }
    #on ajoute l'ip
    if(!$request->header("X-Forwarded-For"))
    {
        $request->header("X-Forwarded-For", $ip);
        $request->header("X-Forwarded-Host", $headers_in->{Host});
    }

    #on ajoute les donnees POST
    if($request->header("Content-Length")) {
        my $postdata;
        $r->read($postdata,$request->header("Content-Length"));
        $request->content($postdata);       
    }


    my $response = $ua->request($request);
    if(!$response)
    {
        $r->status(500);
        $r->print("sorry: something went wrong on the aw-side of proxy\n");
        return;
    }
    $r->content_type($response->header('Content-type'));
    my $headers_out=[];
    $response->scan(sub {
        if(lc $_[0] ne "connection") {
                $r->headers_out->add(@_);
                push(@$headers_out, \@_);
        }
    });
    #Ce dont les modules peuvent avoir besoin
    $info{setcookie}=$response->header('Set-Cookie');
    $info{content}=$response->content;  

    #On modifie les liens   
    $info{content}=~s!(http-equiv="refresh"[^>]*url=http://)$desthost!$1$ourhost!i;
    $info{content}=~s!(http-equiv="refresh"[^>]*url=http://)$wwwdesthost!$1$wwwourhost!i;
    $info{content}=~s!(<a[^>]* href="?http://)$desthost!$1$ourhost!gi;
    $info{content}=~s!(<a[^>]* href="?http://)$wwwdesthost!$1$wwwourhost!gi;
    $info{content}=~s!(<img[^>]* src="?http://)$desthost!$1$ourhost!gi;
    $info{content}=~s!(<form action="?http://)$desthost!$1$ourhost!gi;

    #$info{tree} = HTML::TreeBuilder->new_from_content($info{content}) or die $!;   

    #on regarde ou on est, et on applique les modifs
    my $include=$r->uri;

    if($info{content} =~ m!<b>Security Measure</b>! )
    {
        $include=$dir."security.pm";
    }
    else
    {
        $include =~ s/\.php$//i ;
        $include =~ s/\/$// ;
        $include=$dir.$dest.$include.'.pm';
    }
    #$info{content}=$include.$info{content};
    if(-e $include)
    {
        require $include; #same with do $include;
    }
    #$info{content} = $info{tree}->as_HTML(undef,"    ");
    $dbh->disconnect();
    undef $dbh;
    #$info{tree}->delete();
    #undef $info{tree};
    return \$info{content};
}
1;

そして、私が現在テストを行っているモジュール:

use strict;
use warnings;
use HTML::TreeBuilder; # Ensure weak references in use

my $tree = HTML::TreeBuilder->new_from_content($awproxy::process::info{content}) or die $!;

my $elem = $tree->look_down(_tag => "img");
$elem->attr('width', '240');
$elem->attr('height', '60');

$awproxy::process::info{content} = $tree->as_HTML(undef,"\t");
$tree->delete();

注：これは動作するバージョンです。最初に提供した情報を使用して、動作しないバージョンに簡単に変更できます（process.pmでツリーを作成し、この作成されたツリーまたは他のモジュールでの変更を使用します）

4

2 に答える 2

1

問題は、プロキシが HTML を処理する方法ではなく、HTML は両方のコード形式で同じですが、画像データがどのように処理されるかです。ブラウザがGETHTML に対して を行った後、構成要素 (JavaScript、CSS、画像など) に対しても同じことを行います。プロキシはこれらを正しく渡す必要があります。明らかにそうしていません。

また、Perl*.pmモジュールはused であることが意図されdoており、多くのことを行うのに適した方法ではありません。モジュールをオブジェクト指向にするか、単純なサブクラスにするかを決定する必要がありますExporter。

as_HTMLまた、このように呼び出す必要があります

$tree->as_HTML('<>&', '  ')

少なくともこれらの記号をエンコードする必要があり、タブはインデントとして使用するための少し不可解です。

于 2012-07-09T17:29:45.473 に答える