From 21e0a42ea84d82c6d3069707cbfa157301af7871 Mon Sep 17 00:00:00 2001 From: Andy Baugh Date: Fri, 18 Sep 2026 17:22:25 +0000 Subject: [PATCH 1/2] fix: check the hostname of each OpenStack endpoint's certificate OpenStack::Client makes every user agent with ssl_opts => { verify_hostname => 0 }, and no argument changes it. So each request, and the X-Auth-Token in it, went to whichever server answered for the endpoint. OpenStack::Client does let a caller name the class it calls new on, as package_ua. OpenStack::MetaAPI::UserAgent is an LWP::UserAgent that removes verify_hostname from the ssl_opts it is given, so LWP decides as it does for any user agent: the check is on unless PERL_LWP_SSL_VERIFY_HOSTNAME is 0. new() gives it to OpenStack::Client::Auth unless the caller names another package_ua. A caller that builds its own auth object is not changed, and the POD of the class says what to pass. Co-Authored-By: Claude Opus 5 (1M context) --- .github/cpanfile | 1 + Changes | 11 +++++ Makefile.PL | 1 + dist.ini | 1 + lib/OpenStack/MetaAPI.pm | 17 +++++-- lib/OpenStack/MetaAPI/UserAgent.pm | 63 ++++++++++++++++++++++++++ t/useragent.t | 73 ++++++++++++++++++++++++++++++ 7 files changed, 163 insertions(+), 4 deletions(-) create mode 100644 lib/OpenStack/MetaAPI/UserAgent.pm create mode 100644 t/useragent.t diff --git a/.github/cpanfile b/.github/cpanfile index 38dd607..8cf0e51 100644 --- a/.github/cpanfile +++ b/.github/cpanfile @@ -1,6 +1,7 @@ requires 'OpenStack::Client', '1.0006'; requires 'YAML::XS'; requires 'JSON'; +requires 'LWP::UserAgent'; requires 'Moo'; requires 'Moo::Role'; diff --git a/Changes b/Changes index 89c3df0..ce14500 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,17 @@ OpenStack::MetaAPI Changes {{$NEXT}} + [ Security ] + - Check the hostname of the TLS certificate of each OpenStack endpoint. + OpenStack::Client makes its user agents with verify_hostname => 0, so + the X-Auth-Token of every request went to whichever server answered. + new() now gives OpenStack::Client::Auth the new class + OpenStack::MetaAPI::UserAgent as package_ua, which leaves the check to + LWP: on, unless PERL_LWP_SSL_VERIFY_HOSTNAME=0. A caller that builds + its own auth object passes package_ua => 'OpenStack::MetaAPI::UserAgent' + to get the same. A cloud with a self-signed certificate now needs + PERL_LWP_SSL_CA_FILE, or PERL_LWP_SSL_VERIFY_HOSTNAME=0. + 0.004 2026-09-10 20:02:40-06:00 America/Denver [ New features ] diff --git a/Makefile.PL b/Makefile.PL index ae4cc97..85ba64b 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -18,6 +18,7 @@ my %WriteMakefileArgs = ( "NAME" => "OpenStack::MetaAPI", "PREREQ_PM" => { "JSON" => 0, + "LWP::UserAgent" => 0, "Moo" => 0, "Moo::Role" => 0, "OpenStack::Client" => "1.0006", diff --git a/dist.ini b/dist.ini index 470ed1e..e906529 100644 --- a/dist.ini +++ b/dist.ini @@ -38,6 +38,7 @@ push_to = gh HEAD:refs/heads/released ; also push to released branch ;[Prereqs / RuntimeRecommends] [Prereqs / RuntimeRequires] OpenStack::Client = 1.0006 +LWP::UserAgent = 0 YAML::XS = 0 JSON = 0 Moo = 0 diff --git a/lib/OpenStack/MetaAPI.pm b/lib/OpenStack/MetaAPI.pm index 80dbad5..30ba870 100644 --- a/lib/OpenStack/MetaAPI.pm +++ b/lib/OpenStack/MetaAPI.pm @@ -4,8 +4,9 @@ use strict; use warnings; use MIME::Base64 (); -use OpenStack::Client::Auth (); -use OpenStack::MetaAPI::Routes (); +use OpenStack::Client::Auth (); +use OpenStack::MetaAPI::Routes (); +use OpenStack::MetaAPI::UserAgent (); use Scalar::Util qw/blessed weaken/; use Moo; @@ -65,8 +66,12 @@ around BUILDARGS => sub { && ref $args[0] eq 'HASH' && blessed($args[0]->{'auth'}); - # automagically build the OpenStack::Client::Auth from existing args - return {auth => OpenStack::Client::Auth->new(@args)}; + # OpenStack::Client turns off the check of the server's hostname unless + # its user agent class puts it back. See OpenStack::MetaAPI::UserAgent. + my ($endpoint, %args) = @args; + $args{package_ua} //= 'OpenStack::MetaAPI::UserAgent'; + + return {auth => OpenStack::Client::Auth->new($endpoint, %args)}; }; sub create_vm { @@ -263,6 +268,10 @@ Feel free to report issues to the Bug Tracker or contribute. Create one OpenStack::MetaAPI object. For now all arguments passed to C are used to create one L. +Its user agent checks the hostname of each server it talks to, unless you pass +another C. See L, which also tells +what to do when you build the auth object yourself. + =head2 $api->flavors( [ %filter ] ) List all flavors from the compute service. [view synopsis for some sample usage] diff --git a/lib/OpenStack/MetaAPI/UserAgent.pm b/lib/OpenStack/MetaAPI/UserAgent.pm new file mode 100644 index 0000000..b8ec6b7 --- /dev/null +++ b/lib/OpenStack/MetaAPI/UserAgent.pm @@ -0,0 +1,63 @@ +package OpenStack::MetaAPI::UserAgent; + +use strict; +use warnings; + +use parent 'LWP::UserAgent'; + +# ABSTRACT: an LWP::UserAgent that leaves TLS hostname verification to LWP + +# VERSION: generated by DZP::OurPkgVersion + +sub new { + my ($class, %opts) = @_; + + # A copy, so that the caller's hash keeps what it passed. + my %ssl_opts = %{$opts{ssl_opts} // {}}; + delete $ssl_opts{verify_hostname}; + $opts{ssl_opts} = \%ssl_opts; + + return $class->SUPER::new(%opts); +} + +1; + +__END__ + +=head1 SYNOPSIS + + # OpenStack::MetaAPI uses this class unless you name another one. + my $api = OpenStack::MetaAPI->new($endpoint, %auth_args); + + # An auth object that you build yourself has to be given it. + my $auth = OpenStack::Client::Auth->new( + $endpoint, %auth_args, + package_ua => 'OpenStack::MetaAPI::UserAgent', + ); + my $api = OpenStack::MetaAPI->new({auth => $auth}); + +=head1 DESCRIPTION + +L makes each of its user agents with + + ssl_opts => { verify_hostname => 0 } + +and no argument changes that. So without this class, every request goes to +whichever server answers for the endpoint, with the C of the +session in its headers. + +This class removes C from the C it is given, and +passes everything else to L. LWP then decides, as it does for +any user agent: the check is on, unless the environment variable +C is set to 0. To trust a private certificate +authority, set C or C. To change +anything else, subclass this class and give yours as C. + +=head1 METHODS + +=head2 new( %opts ) + +Returns a new user agent, as L does, from C<%opts> with +C taken out of C. + +=cut diff --git a/t/useragent.t b/t/useragent.t new file mode 100644 index 0000000..c405773 --- /dev/null +++ b/t/useragent.t @@ -0,0 +1,73 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test2::Bundle::Extended; +use Test2::Plugin::NoWarnings; +use Test::MockModule; + +use OpenStack::Client (); +use OpenStack::Client::Auth (); +use OpenStack::MetaAPI (); +use OpenStack::MetaAPI::UserAgent (); + +# LWP reads these when a user agent is made without verify_hostname. HTTPS_CA_* +# turn the check off, for compatibility with Crypt::SSLeay. +local %ENV = %ENV; +delete @ENV{qw{PERL_LWP_SSL_VERIFY_HOSTNAME HTTPS_CA_FILE HTTPS_CA_DIR}}; + +my $ENDPOINT = 'https://keystone.test.test:5000/v3'; + +subtest 'OpenStack::Client alone turns the check off' => sub { + my $client = OpenStack::Client->new($ENDPOINT); + is $client->{ua}->ssl_opts('verify_hostname'), 0, + 'which is the reason this class exists'; +}; + +subtest 'new() leaves the decision to LWP' => sub { + my %ssl_opts = (verify_hostname => 0, SSL_ca_file => '/bogus/ca.pem'); + my $ua = OpenStack::MetaAPI::UserAgent->new(ssl_opts => \%ssl_opts); + + isa_ok $ua, 'LWP::UserAgent'; + is $ua->ssl_opts('verify_hostname'), 1, + 'verify_hostname => 0 is dropped, and LWP turns the check on'; + is $ua->ssl_opts('SSL_ca_file'), '/bogus/ca.pem', + 'the other ssl_opts reach LWP'; + is \%ssl_opts, {verify_hostname => 0, SSL_ca_file => '/bogus/ca.pem'}, + "the caller's hash is not changed"; + + is(OpenStack::MetaAPI::UserAgent->new->ssl_opts('verify_hostname'), 1, + 'with no ssl_opts at all, the check is on'); + + local $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0; + is(OpenStack::MetaAPI::UserAgent->new(ssl_opts => {verify_hostname => 1}) + ->ssl_opts('verify_hostname'), + 0, 'PERL_LWP_SSL_VERIFY_HOSTNAME=0 turns it off'); +}; + +subtest 'OpenStack::Client with this class checks the hostname' => sub { + my $client = OpenStack::Client->new($ENDPOINT, + package_ua => 'OpenStack::MetaAPI::UserAgent'); + isa_ok $client->{ua}, 'OpenStack::MetaAPI::UserAgent'; + is $client->{ua}->ssl_opts('verify_hostname'), 1, 'the check is on'; +}; + +subtest 'OpenStack::MetaAPI->new gives the auth object this class' => sub { + my @got; + my $mock = Test::MockModule->new('OpenStack::Client::Auth'); + $mock->redefine(new => sub { shift; @got = @_; return bless {}, 'Test::Auth' }); + + OpenStack::MetaAPI->new($ENDPOINT, username => 'u', version => 3); + my ($endpoint, %args) = @got; + is $endpoint, $ENDPOINT, 'the endpoint is passed first, as before'; + is \%args, + {username => 'u', version => 3, package_ua => 'OpenStack::MetaAPI::UserAgent'}, + 'package_ua defaults to this class, and the other arguments are unchanged'; + + OpenStack::MetaAPI->new($ENDPOINT, package_ua => 'LWP::UserAgent'); + ($endpoint, %args) = @got; + is $args{package_ua}, 'LWP::UserAgent', 'a package_ua that the caller names wins'; +}; + +done_testing; From 04f1382366b2acb9c0755cdeac75aa0dbf0a63cd Mon Sep 17 00:00:00 2001 From: Andy Baugh Date: Sat, 19 Sep 2026 16:11:12 +0000 Subject: [PATCH 2/2] fix: declare the SYNOPSIS variables, and document HTTPS_CA_* The SYNOPSIS of OpenStack::MetaAPI::UserAgent used $endpoint and %auth_args without a declaration, and declared $api twice. The xt/author/synopsis.t that [Test::Synopsis] makes compiles it under strict, so dzil test and dzil release failed. A =for test_synopsis block now declares the variables. LWP also turns the hostname check off when HTTPS_CA_FILE or HTTPS_CA_DIR is set and PERL_LWP_SSL_VERIFY_HOSTNAME is not. The POD and the Changes entry now say so, and t/useragent.t tests it. Co-Authored-By: Claude Opus 5 (1M context) --- Changes | 5 +++-- lib/OpenStack/MetaAPI/UserAgent.pm | 11 ++++++++--- t/useragent.t | 10 ++++++++++ 3 files changed, 21 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index ce14500..bda7dc4 100644 --- a/Changes +++ b/Changes @@ -8,8 +8,9 @@ OpenStack::MetaAPI Changes the X-Auth-Token of every request went to whichever server answered. new() now gives OpenStack::Client::Auth the new class OpenStack::MetaAPI::UserAgent as package_ua, which leaves the check to - LWP: on, unless PERL_LWP_SSL_VERIFY_HOSTNAME=0. A caller that builds - its own auth object passes package_ua => 'OpenStack::MetaAPI::UserAgent' + LWP: on, unless PERL_LWP_SSL_VERIFY_HOSTNAME=0. If that variable is + not set, HTTPS_CA_FILE or HTTPS_CA_DIR also turns it off. A caller that + builds its own auth object passes package_ua => 'OpenStack::MetaAPI::UserAgent' to get the same. A cloud with a self-signed certificate now needs PERL_LWP_SSL_CA_FILE, or PERL_LWP_SSL_VERIFY_HOSTNAME=0. diff --git a/lib/OpenStack/MetaAPI/UserAgent.pm b/lib/OpenStack/MetaAPI/UserAgent.pm index b8ec6b7..f8c9cc1 100644 --- a/lib/OpenStack/MetaAPI/UserAgent.pm +++ b/lib/OpenStack/MetaAPI/UserAgent.pm @@ -24,6 +24,9 @@ sub new { __END__ +=for test_synopsis +my ($endpoint, %auth_args); + =head1 SYNOPSIS # OpenStack::MetaAPI uses this class unless you name another one. @@ -34,7 +37,7 @@ __END__ $endpoint, %auth_args, package_ua => 'OpenStack::MetaAPI::UserAgent', ); - my $api = OpenStack::MetaAPI->new({auth => $auth}); + my $api_from_auth = OpenStack::MetaAPI->new({auth => $auth}); =head1 DESCRIPTION @@ -49,8 +52,10 @@ session in its headers. This class removes C from the C it is given, and passes everything else to L. LWP then decides, as it does for any user agent: the check is on, unless the environment variable -C is set to 0. To trust a private certificate -authority, set C or C. To change +C is set to 0. If C +is not set, the older variables C and C also turn +the check off, for compatibility with L. To trust a private +certificate authority, set C or C. To change anything else, subclass this class and give yours as C. =head1 METHODS diff --git a/t/useragent.t b/t/useragent.t index c405773..92e8002 100644 --- a/t/useragent.t +++ b/t/useragent.t @@ -46,6 +46,16 @@ subtest 'new() leaves the decision to LWP' => sub { 0, 'PERL_LWP_SSL_VERIFY_HOSTNAME=0 turns it off'); }; +subtest 'HTTPS_CA_FILE turns the check off, as the POD says' => sub { + local $ENV{HTTPS_CA_FILE} = '/bogus/ca.pem'; + is(OpenStack::MetaAPI::UserAgent->new->ssl_opts('verify_hostname'), 0, + 'without PERL_LWP_SSL_VERIFY_HOSTNAME'); + + local $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 1; + is(OpenStack::MetaAPI::UserAgent->new->ssl_opts('verify_hostname'), 1, + 'PERL_LWP_SSL_VERIFY_HOSTNAME=1 wins over it'); +}; + subtest 'OpenStack::Client with this class checks the hostname' => sub { my $client = OpenStack::Client->new($ENDPOINT, package_ua => 'OpenStack::MetaAPI::UserAgent');