0

我使用 LWP::UserAgent 构建一个小型代理供我自己使用，然后我使用 HTML::TreeBuilder 解析 HTML

根据我所在的页面，我的代码会加载一个获取信息/更改显示的小模块，然后我再次打印我的 HTML。

一开始，我只是在我的模块中加载 HTML::TreeBuilder，在那里进行修改，然后从那里打印回 HTML，一切都很好。

现在我在调用小模块的代码中构建树，（小模块仍然修改它）并从这里打印 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 是相同的——而是如何处理图像数据。在浏览器GET对 HTML 执行完 a 后，它将继续对组成部分（JavaScript、CSS、图像等）执行相同的操作，并且您的代理也必须正确传递这些内容。显然它没有这样做。

值得一提的是，Perl*.pm模块本来就是use​​d，do根本不是做很多事情的好方法。您应该决定是否希望您的模块是面向对象的，或者是一个简单的子类Exporter并整理东西。

as_HTML你也应该这样打电话

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

因为您必须至少对这些符号进行编码，并且制表符用作缩进有点神秘。

于 2012-07-09T17:29:45.473 回答
0

我明白为什么它不起作用。

在我的工作案例中，我只解析 html 页面。在我的非工作案例中，它试图解析所有被代理的东西（包括图像）。

所以为了让它工作，我添加了这个：

if($r->uri =~ /\.png$|\.jpg$/i) 
{
    return \$info{content};
}

所以现在，它不会尝试解析图像，并且工作正常。（可能需要在正则表达式中添加一些东西，但在我的情况下只有 png 和 jpg）

编辑：对内容类型的测试应该更好，类似的东西（未测试）

if($r->content_type =~ /text\/html/i )
{
    return \$info{content};
}
于 2012-07-30T12:13:24.350 回答