Add several features missing from OpenStack::MetaAPI

lib/OpenStack/MetaAPI.pm

@@ -3,9 +3,10 @@ package OpenStack::MetaAPI;
 use strict;
 use warnings;
 
+use MIME::Base64              ();
 use OpenStack::Client::Auth    ();
 use OpenStack::MetaAPI::Routes ();
-use Scalar::Util qw/weaken/;
+use Scalar::Util qw/blessed weaken/;
 
 use Moo;
 
@@ -43,6 +44,27 @@ around BUILDARGS => sub {
 
     die "Missing arguments to create Auth object" unless scalar @args;
 
+    # A caller that has already built its auth object hands it straight over.
+    #
+    # Keystone can be talked to by methods OpenStack::Client::Auth does not
+    # implement -- an application credential, for one -- and the only way to use
+    # one is to construct the auth object yourself.  Building a fresh one from
+    # the args regardless left no way to do that, so such a caller could not use
+    # this module at all.
+    #
+    # Normal construction is new($endpoint, %args), whose first argument is a
+    # URL rather than a reference, so it does not match this.
+    #
+    # The 'auth' has to be a blessed object, not merely a reference: a
+    # clouds.yaml cloud entry is a plain hashref with an 'auth' key of its own
+    # (auth_url, username, password, ...), and letting that through would store
+    # an unblessed hash as the auth object -- construction would succeed and the
+    # first delegated call would die far from here on an unblessed reference.
+    return $args[0]
+      if scalar @args == 1
+      && 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)};
 };
@@ -57,8 +79,6 @@ sub create_vm {
     die "'image' name or id is required by create_vm"
       unless defined $opts{image};
     die "'name' field is required by create_vm" unless defined $opts{name};
-    die "'network_for_floating_ip' field is required by create_vm"
-      unless defined $opts{network_for_floating_ip};
 
     $opts{security_group} //=
       'default';    # optional argument fallback to 'default'
@@ -69,9 +89,14 @@ sub create_vm {
     # get the network by id or name
     my $network = $self->look_by_id_or_name(networks => $opts{network});
 
-    # get the network used to add the floating up later
-    my $network_for_floating_ip =
-      $self->look_by_id_or_name(networks => $opts{network_for_floating_ip});
+    # Optional: not every cloud has a tenant network to escape from.  Where the
+    # only network is external and shared, a server on it is given a routable
+    # address directly -- reported as 'fixed' -- and there is no floating IP to
+    # attach.  Requiring one made such a cloud impossible to build on at all.
+    my $network_for_floating_ip;
+    $network_for_floating_ip =
+      $self->look_by_id_or_name(networks => $opts{network_for_floating_ip})
+      if defined $opts{network_for_floating_ip};
 
     my $image;
     if (_looks_valid_id($opts{image})) {
@@ -87,13 +112,31 @@ sub create_vm {
         push @extra, (key_name => $opts{key_name});
     }
 
+    # Nova wants user_data base64 encoded, and every caller has cloud-config
+    # rather than base64, so encode it here instead of making each of them
+    # remember to.  Without this there is no way to hand a new server its
+    # cloud-init payload at all, which is most of the point of creating one.
+    if (defined $opts{user_data} && length $opts{user_data}) {
+        push @extra,
+          (user_data => MIME::Base64::encode_base64($opts{user_data}, ''));
+    }
+
+    # Pass-throughs.  Each is a plain server-create field that had no way of
+    # being set: which availability zone to build in, the metadata a later
+    # lookup finds the server by, and the volumes it boots or carries.
+    foreach my $field (qw{availability_zone metadata block_device_mapping_v2}) {
+        push @extra, ($field => $opts{$field}) if defined $opts{$field};
+    }
+
     my $server = $self->create_server(
         name            => $opts{name},
         imageRef        => $image->{id},
         flavorRef       => $flavor->{id},
         min_count       => 1,
         max_count       => 1,
-        security_groups => [{name => $security_group->{id}}],
+        # By name, which is what the field is.  This passed the id, which
+        # some clouds resolve anyway and others do not.
+        security_groups => [{name => $security_group->{name} // $security_group->{id}}],
         networks        => [{uuid => $network->{id}}],
         @extra,
     );
@@ -129,7 +172,7 @@ sub create_vm {
       unless $server_is_ready;
 
     # now add one IP to the server
-    {
+    if ($network_for_floating_ip) {
         # create a floating IP
         my $floating_ip =
           $self->create_floating_ip($network_for_floating_ip->{id});

lib/OpenStack/MetaAPI/API/Compute.pm

@@ -56,4 +56,96 @@ sub create_server {
 
 ### helpers
 
+# What this project may have, and what it is already using.
+#
+# Both halves arrive in one response, which is what makes this the right thing
+# to ask when deciding whether another guest fits.  /os-quota-sets gives only
+# the allowance, leaving you to add the usage up yourself from the server list.
+sub limits {
+    my ($self) = @_;
+
+    my $out = $self->get($self->root_uri('/limits'));
+
+    return ref $out ? $out->{limits} : $out;
+}
+
+# Everything Nova models as an action on an existing server: snapshots, power
+# state, rebuild.  They are all one POST to the same place with a different
+# single-key body, so they are all this.
+sub server_action {
+    my ($self, $uid, $action) = @_;
+
+    die "server id is required by server_action" unless defined $uid && length $uid;
+    die "action must be a hash reference"        unless ref $action eq 'HASH';
+
+    return $self->post($self->root_uri("/servers/$uid/action"), $action);
+}
+
+# Snapshot a server into a Glance image.
+#
+# Nova returns the new image's id in the Location header, and only puts it in
+# the body from microversion 2.45 on -- so neither is worth relying on.  Ask
+# Glance for the name afterwards instead.
+sub create_image {
+    my ($self, $uid, %opts) = @_;
+
+    my $name = delete $opts{name};
+    die "'name' is required by create_image" unless defined $name && length $name;
+
+    return $self->server_action($uid, {createImage => {name => $name, %opts}});
+}
+
+# The flavor list is names and ids; this is the one that knows how many CPUs.
+sub flavors_detail {
+    my ($self, %filter) = @_;
+
+    my $out = $self->get($self->root_uri('/flavors/detail'));
+    my @all = ref $out ? @{$out->{flavors} // []} : ();
+
+    foreach my $key (sort keys %filter) {
+        @all = grep { defined $_->{$key} && $_->{$key} eq $filter{$key} } @all;
+    }
+
+    return @all;
+}
+
+# What the guest wrote to its serial console.  When a guest never comes up this
+# is usually the only thing that says why.
+sub console_output {
+    my ($self, $uid, $length) = @_;
+
+    my $out = $self->server_action($uid, {'os-getConsoleOutput' => {length => $length}});
+
+    return ref $out ? $out->{output} : $out;
+}
+
+# Volumes are Cinder's, but attaching one to a server is Nova's.
+sub server_volumes {
+    my ($self, $uid) = @_;
+
+    my $out = $self->get($self->root_uri("/servers/$uid/os-volume_attachments"));
+
+    return ref $out ? @{$out->{volumeAttachments} // []} : ();
+}
+
+sub attach_volume {
+    my ($self, $uid, $volume_id, %opts) = @_;
+
+    die "volume id is required by attach_volume" unless defined $volume_id && length $volume_id;
+
+    my $out = $self->post(
+        $self->root_uri("/servers/$uid/os-volume_attachments"),
+        {volumeAttachment => {volumeId => $volume_id, %opts}});
+
+    return ref $out ? $out->{volumeAttachment} : $out;
+}
+
+sub detach_volume {
+    my ($self, $uid, $volume_id) = @_;
+
+    die "volume id is required by detach_volume" unless defined $volume_id && length $volume_id;
+
+    return $self->delete($self->root_uri("/servers/$uid/os-volume_attachments/$volume_id"));
+}
+
 1;

lib/OpenStack/MetaAPI/API/Images.pm

@@ -27,7 +27,28 @@ either by its 'exact name' or its 'UID'
 sub images {
     my ($self, @args) = @_;
 
-    die "Please use image_from_uid image_from_name";
+    die "Please use image_from_uid, image_from_name or list_images";
+}
+
+# Every image matching %query, pagination followed.
+#
+# The warning above is about listing images *unfiltered*, which really can take
+# fifty requests -- but there was no way to ask for a filtered list either, and
+# some questions have no single-image answer.  "Which snapshots does this
+# instance have" is one: Glance holds them as ordinary images, and the only way
+# to find them is to ask for the ones matching.
+#
+# %query goes to Glance as request parameters, so the filtering happens there
+# rather than here: name, owner, visibility, status, and any image property --
+# Nova stamps its snapshots with image_type and instance_uuid, which is the
+# narrow way to ask that question.
+#
+# Pagination is OpenStack::Client's; all() follows the 'next' link until there
+# is not one.
+sub list_images {
+    my ($self, %query) = @_;
+
+    return $self->client->all($self->root_uri('/images'), 'images', \%query);
 }
 
 # API doc

lib/OpenStack/MetaAPI/API/Volume.pm

@@ -0,0 +1,79 @@
+package OpenStack::MetaAPI::API::Volume;
+
+use strict;
+use warnings;
+
+use Moo;
+
+extends 'OpenStack::MetaAPI::API::Service';
+
+with 'OpenStack::MetaAPI::Roles::Listable';
+
+# Block storage is in the catalogue under whichever versions the cloud still
+# offers, and 'volume' unadorned is not always one of them -- a current
+# deployment may list only volumev3 and volumev2.  So the type is whatever is
+# actually there, newest first, rather than a name we picked in advance.
+has '+name' => (
+    required => 0,
+    lazy     => 1,
+    default  => sub {
+        my ($self) = @_;
+
+        my %offered = map { $_ => 1 } $self->auth->services;
+        foreach my $type (qw{volumev3 volumev2 volume}) {
+            return $type if $offered{$type};
+        }
+
+        die "This cloud offers no block storage service (looked for volumev3, volumev2, volume)\n";
+    },
+);
+
+# Declared here rather than in a Specs data block.
+#
+# The spec package a service loads is named after its catalogue type -- so a
+# cloud offering volumev3 would want Specs::Volumev3, and one offering volume
+# would want Specs::Volume, for the same two routes.  Writing them out once is
+# less work than one spec file per spelling.
+sub volumes {
+    my ($self, @args) = @_;
+
+    return $self->_list(['/volumes', 'volumes'], \@args);
+}
+
+sub volume_from_uid {
+    my ($self, $uid) = @_;
+
+    die "volume id is required by volume_from_uid" unless defined $uid && length $uid;
+
+    my $out = $self->get($self->root_uri("/volumes/$uid"));
+
+    return ref $out ? $out->{volume} : $out;
+}
+
+sub create_volume {
+    my ($self, %opts) = @_;
+
+    die "'size' is required by create_volume" unless $opts{size};
+
+    my $out = $self->post($self->root_uri('/volumes'), {volume => {%opts}});
+
+    return ref $out ? $out->{volume} : $out;
+}
+
+sub delete_volume {
+    my ($self, $uid) = @_;
+
+    die "volume id is required by delete_volume" unless defined $uid && length $uid;
+
+    return $self->delete($self->root_uri("/volumes/$uid"));
+}
+
+sub volume_limits {
+    my ($self) = @_;
+
+    my $out = $self->get($self->root_uri('/limits'));
+
+    return ref $out ? $out->{limits} : $out;
+}
+
+1;

lib/OpenStack/MetaAPI/Routes.pm

@@ -112,5 +112,33 @@ image_from_uid:
   service: images
 image_from_name:
   service: images
+list_images:
+  service: images
+limits:
+  service: compute
+server_action:
+  service: compute
+create_image:
+  service: compute
+flavors_detail:
+  service: compute
+console_output:
+  service: compute
+server_volumes:
+  service: compute
+attach_volume:
+  service: compute
+detach_volume:
+  service: compute
+volumes:
+  service: volume
+volume_from_uid:
+  service: volume
+create_volume:
+  service: volume
+delete_volume:
+  service: volume
+volume_limits:
+  service: volume