perl - 需要重写这个 perl 函数。因为 libperl UserAgent 被阻止

Question

与我打交道的其中一位主机阻止我从他们的站点下载图像。我已经和他们谈过，他们要求我将用户代理 libwww-perl/ 更改为 Mozilla/5.0。图片链接为http和https。

我尝试过各种选择，比如

my $ua = LWP::UserAgent->new();
$ua->ssl_opts( verify_hostnames => 0 );

但我无法让它与 getstore 一起工作。非常感谢任何帮助。

    sub storeimage {
  my $image = shift;
  if ($image =~ m#^https?://.+\/(.+\.)([a-z]+)$#i) {
    my $ext = $2;
    my $filename = "$1$2";
    if (exists $wantedfiles{$ext}) {
      my $savepath = $localwantedpath.$wantedfiles{$ext};
      if (!-f $savepath.$filename) {
        unless (is_success(getstore($image, $savepath.$filename))) {
          _warn("Couldn't download file $image to $savepath.");
          return '';
        }

    if ( $ext =~ /jpg|jpeg/oi ) {
      system("mogrify -resize '800>' -quality 70 $savepath$filename");

      #mogrify -resize 800x800  -quality 70 -format jpg $imageloc
    }

      }
      return $wantedfiles{$ext}.$filename;

    }
  }
  return '';
}

Answer 1

我不确定您为什么要乱用 SSL 选项。主机名验证与 HTTP header 无关。

你需要的是类似的东西

my $ua = LWP::UserAgent->new(agent => 'Mozilla/5.0');

设置agent属性。

复制getstore函数(来自 LWP::Simple )与你的 $ua 对象，你需要做这样的事情:

unless ($ua->request(HTTP::Request->new('GET' => $image), $savepath.$filename)->is_success) {
    ...
}

参见 request方法。

或者考虑使用 mirror :

$ua->mirror($your_url, $your_filename)

不过，它的行为有点不同。