Question

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

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

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

现在我在调用小模块的代码中构建树，（小模块仍然修改它）并从这里打印HTML，并且所有图像都出错（来自firebug）图像损坏或截断，以及不要加载。

这是我使用的简化代码。

不工作代码：

$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完全相同

编辑：我使用的所有代码。

main.pm由perltranshandler调用

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中创建树并使用此创建的树或在其他模块中修改）< / p>

Answer 1

问题不在于您的代理如何处理HTML - 正如您所说，HTML与两种代码形式完全相同 - 但是如何处理图像数据。在浏览器为HTML完成GET后，它将继续执行相同的组成部分 - JavaScript，CSS，图像等 - 并且您的代理也必须正确地传递这些内容。显然它没有这样做。

值得一提的是，Perl *.pm模块应该是use d，而do并不是一个很好的方法。您应该决定是否希望模块是面向对象的，或者是Exporter的简单子类并且整理起来。

你也应该像这样打电话给as_HTML

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

因为必须至少对这些符号进行编码，并且标签对于缩进来说有点神秘。

Answer 2

我理解为什么它不起作用。

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

为了使其有效，我补充说：

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

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

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

if($r->content_type =~ /text\/html/i )
{
    return \$info{content};
}

HTML解析后（使用HTML :: TreeBuilder）图像被破坏

2 个答案: