LWP::UserAgent or LWPx::ParanoidAgent + Crypt::SSLeay でオレオレ証明書の検出

結論から言うと、オレオレ証明書を使った場合に LWP::UserAgent + Crypt::SSLeay は明示的なエラーを吐き出すのではなく、レスポンスヘッダ Client-SSL-Warning を付与してアクセス結果を返します。*1

簡単にテストする場合

$ lwp-request -e -d https://badcert.example.com/

のようにすると、

Client-SSL-Warning: Peer certificate not verified

プログラムで確認

use Carp;
use LWP::UserAgent;

my $ua = LWP::UserAgent->new;
my $res = $ua->get("https://badcert.example.com/");

unless ($res->is_success) {
  croak $res->status_line;
}
elsif (defined $res->header("Client-SSL-Warning")) {
  croak "Bad certs";
}
else {
  print $res->content;
}

とか、そういう感じになる。

LWPx::ParanoidAgent の場合

てっきりチェックしてくれるのかと思いきや LWP::UserAgent と同じ方式だった件＞＜

対策

あとで真面目に書く

こんな感じかなー。えーっと、Net::OpenID::* なモジュールは結局の所 HTTP::Response::is_success() でのみチェックしているので、こういうケースも落としたい場合は以下のようなコードにすればいいんじゃないかと思います。
ステータスコードはだいぶ適当です。

#!/usr/bin/perl

use strict;
use warnings;

use Carp;
use Data::Dump qw(dump);
use Hook::WrapSub;
use HTTP::Date;
use HTTP::Response;
use LWPx::ParanoidAgent;
use Perl6::Say;

Hook::WrapSub::wrap_subs(
    'LWPx::ParanoidAgent::send_request',
    sub {
        my ($self, $req, $arg, $size) = @_;

        my $res = shift @Hook::WrapSub::result;

        if ($res->header('Client-SSL-Warning')) {
            my $err_res = HTTP::Response->new(403, 'Unauthorized access to no verified certification');
            $err_res->header("Client-Date" => HTTP::Date::time2str(time));
            $err_res->header("Client-Warning" => "Internal response");
            $err_res->header("Content-Type" => "text/plain");
            $err_res->content("403 Unauthorized access to blocked host\n");

            @Hook::WrapSub::result = ($err_res);
        }
    }
);

my $url = $ARGV[0];
my $ua = LWPx::ParanoidAgent->new(
    blocked_hosts => [],
    whitelisted_hosts => [],
);

my $res = $ua->get($url);

unless ($res->is_success) {
    say dump($res->headers);
    carp $res->status_line;
}
else {
    say dump $res;
}

まとめ

Client-SSL-Warning をチェックしてないと SSL/TLS にした意味がほとんど無くなるので、このヘッダ値が含まれたら不正なアクセスだと思うべし。

*1: と言うのを id:kazuhooku さんに教えて貰いました＾＾；