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..bda7dc4 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,18 @@ 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. 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. + 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..f8c9cc1 --- /dev/null +++ b/lib/OpenStack/MetaAPI/UserAgent.pm @@ -0,0 +1,68 @@ +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__ + +=for test_synopsis +my ($endpoint, %auth_args); + +=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_from_auth = 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. 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 + +=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..92e8002 --- /dev/null +++ b/t/useragent.t @@ -0,0 +1,83 @@ +#!/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 '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'); + 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;