—

              
package OpenStack::MetaAPI;
use strict;
use warnings;
use OpenStack::Client::Auth    ();
use OpenStack::MetaAPI::Routes ();
use Scalar::Util qw/weaken/;
use Moo;
# ABSTRACT: Perl5 OpenStack API abstraction on top of OpenStack::Client
our $VERSION = '0.003'; # VERSION: generated by DZP::OurPkgVersion
has 'debug' => (is => 'rw', default => 0);
has 'auth' => (is => 'ro', required => 1, handles => [qw/services/]);
has 'route' => (
    is      => 'ro',
    default => sub {
        my ($self) = @_;
        # weaken our circular dependency
        my $auth = $self->auth;
        weaken($auth);
        weaken($self);
        return OpenStack::MetaAPI::Routes->new(
            auth => $auth,
            api  => $self);
    },
    handles => [OpenStack::MetaAPI::Routes->list_all()],
);
# for create server
has 'create_max_timeout' => (is => 'rw', default => 5 * 60);
has 'create_loop_sleep'  => (is => 'rw', default => 5);
around BUILDARGS => sub {
    my ($orig, $class, @args) = @_;
    die "Missing arguments to create Auth object" unless scalar @args;
    # automagically build the OpenStack::Client::Auth from existing args
    return {auth => OpenStack::Client::Auth->new(@args)};
};
sub create_vm {
    my ($self, %opts) = @_;
    die "'flavor' name or id is required by create_vm"
      unless defined $opts{flavor};
    die "'network' name or id is required by create_vm"
      unless defined $opts{network};
    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'
    # get the flavor by id or name
    my $flavor = $self->look_by_id_or_name(flavors => $opts{flavor});
    # 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});
    my $image;
    if (_looks_valid_id($opts{image})) {
        $image = $self->image_from_uid($opts{image});
    }
    $image //= $self->image_from_name($opts{image});
    my $security_group =
      $self->look_by_id_or_name(security_groups => $opts{security_group});
    my @extra;
    if (defined $opts{key_name}) {
        push @extra, (key_name => $opts{key_name});
    }
    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}}],
        networks        => [{uuid => $network->{id}}],
        @extra,
    );
    my $server_uid = $server->{id};
    die "Failed to create server" unless _looks_valid_id($server_uid);
    # we are going to wait for 5 minutes fpr the server
    my $wait_time_limit = $opts{wait_time_limit} // $self->create_max_timeout;
    my $now      = time();
    my $max_time = $now + $wait_time_limit;
    my $server_is_ready;
    my $server_status;
    # TODO: maybe add one alarm...
    while (time() < $max_time) {
        $server_status = $self->server_from_uid($server_uid);
        if (   ref $server_status
            && $server_status->{status}
            && $server_status->{status}
            && lc($server_status->{status}) eq 'active') {
            $server_is_ready = 1;
            last;
        }
        sleep $self->create_loop_sleep if $self->create_loop_sleep;
    }
    die "Failed to create server: never came back as active"
      unless $server_is_ready;
    # now add one IP to the server
    {
        # create a floating IP
        my $floating_ip =
          $self->create_floating_ip($network_for_floating_ip->{id});
        die "Failed to create floating ip"
          unless ref $floating_ip && _looks_valid_id($floating_ip->{id});
        # add the floating IP to the server
        my $added =
          $self->add_floating_ip_to_server($floating_ip->{id}, $server_uid);
        $server_status->{floating_ip_address} =
          $floating_ip->{floating_ip_address};
        $server_status->{floating_ip_id} = $floating_ip->{id};
    }
    return $server_status;
}
sub look_by_id_or_name {
    my ($self, $helper, $id_or_name) = @_;
    my $entry;
    if (_looks_valid_id($id_or_name)) {
        $entry = $self->can($helper)->($self, id => $id_or_name);
    }
    $entry //= $self->can($helper)->($self, name => $id_or_name);
    if (ref $entry ne 'HASH' || !_looks_valid_id($entry->{id})) {
        die "Cannot find '$helper' for id/name '$id_or_name'";
    }
    return $entry;
}
sub _looks_valid_id {
    my ($id) = @_;
    return unless defined $id;
    return if ref $id;
    my $VALID_ID = qr{^[a-f0-9\-]+$}i;
    return $id =~ $VALID_ID;
}
1;
__END__
HideShow 236 lines of Pod
=pod
=encoding utf-8
=head1 NAME
OpenStack::MetaAPI - Perl5 OpenStack API abstraction on top of OpenStack::Client
=head1 VERSION
version 0.003
=head1 SYNOPSIS
 #!/usr/bin/env perl
  
 use strict;
 use warnings;
  
 use OpenStack::MetaAPI ();
  
 use Test::More;
  
 SKIP: {
     skip "OS_AUTH_URL unset, please source one openrc.sh file before."
       unless $ENV{OS_AUTH_URL} && $ENV{AUTHOR_TESTING};
  
     # create one OpenStack::MetaAPI object
     #  this is using OpenStack::Client::Auth
     my $api = OpenStack::MetaAPI->new(
         $ENV{OS_AUTH_URL},
         username => $ENV{'OS_USERNAME'},
         password => $ENV{'OS_PASSWORD'},
         version  => 3,
         scope    => {
             project => {
                 name   => $ENV{'OS_PROJECT_NAME'},
                 domain => {id => 'default'},
             }
         },
     );
  
    # OpenStack API documentation:
    #   https://developer.openstack.org/api-guide/quick-start/#current-api-versions
  
     #
     # You can call most routes direclty on the main API object
     #   without the need to know which service is providing it
     #
  
     # list all flavors
     my @flavors      = $api->flavors();
     my $small        = $api->flavors(name => 'small');
     my @some_flavors = $api->flavors(name => qr{^(?:small|medium)});
  
     # list all servers
     my @servers = $api->servers();
  
     # filter the server result using any keys
     # Note: known API valid request arguments are used as part of the request
     @servers = $api->servers(name => 'foo');
  
     # can also use a regex
     @servers = $api->servers(name => qr{^foo});
  
     # get a single server by one id
     my $SERVER_ID = q[aaaa-bbbb-cccc-dddd];
     my $server    = $api->server_from_uid($SERVER_ID);
  
     # delete a server [also delete associated floating IPs]
     $api->delete_server($SERVER_ID);
  
     # listing floating IPs
     my @floatingips = $api->floatingips();
  
     # listing all images is currently not supported
     #  [slow as multiple requests are require 'next']
     # prefer selecting one image using one of these two helpers
     my $IMAGE_UID  = '1111-2222-3456';
     my $image      = $api->image_from_uid($IMAGE_UID);
     my $IMAGE_NAME = 'MyCustomImage';
     $image = $api->image_from_name($IMAGE_NAME);
  
     my @security_groups = $api->security_groups();
  
     my $SECURITY_GROUP_ID = '12345';
  
     my $security_group = $api->security_groups(id => $SECURITY_GROUP_ID);
     $security_group = $api->security_groups(name => 'default');
  
     # you can also create one server using the create_vm helper
  
     my $vm = $api->create_vm(
         name     => 'SERVER_NAME',
         image    => 'IMAGE_UID or IMAGE_NAME',    # image used to create the VM
         flavor   => 'small',
         key_name => 'your ssh key name',          # optional key to set
         security_group =>
           'default',    # security group to use, by default use 'default'
         network => 'NETWORK_NAME or NETWORK_ID',    # network group to use
         network_for_floating_ip => 'NETWORK_NAME or NETWORK_ID',
     );
  
 }
  
 1;
=head1 DESCRIPTION
OpenStack::MetaAPI
Using OpenStack::MetaAPI you can call routes from any service directly on the main object.
Helpers are defined from the specs defined https://developer.openstack.org/api-guide/quick-start/#current-api-versions
Currently only a very small part of the specs have been imported to this project.
This software is currently in C<PRE-ALPHA> stage... use it at your own risk!
Feel free to report issues to the Bug Tracker or contribute.
=head1 Available functions / methods
=head2 new( [ Arguments for OpenStack::Client::Auth ] )
Create one OpenStack::MetaAPI object.
For now all arguments passed to C<new> are used to create one L<OpenStack::Client::Auth>.
=head2 $api->flavors( [ %filter ] )
List all flavors from the compute service. [view synopsis for some sample usage]
=head2 $api->servers( [ %filter ] )
List all servers from the compute service. [view synopsis for some sample usage]
=head2 $api->floatingips( [ %filter ] )
List all floatingips from the network service. [view synopsis for some sample usage]
=head2 $api->security_groups( [ %filter ] )
List all security_groups from the network service. [view synopsis for some sample usage]
=head2 $api->image_from_uid( $image_uid )
Select one image from its UID. [view synopsis for some sample usage]
=head2 $api->image_from_name( $image_name )
Select one image from its name. [view synopsis for some sample usage]
=head2 $api->create_vm( %args )
Create one server from one image with one floating IP, wait for the server to be ready.
        my $vm = $api->create_vm(
            name     => 'SERVER_NAME',
            image    => 'IMAGE_UID or IMAGE_NAME',   # image used to create the VM
            flavor   => 'small',
            key_name => 'your ssh key name',         # optional key to set
            security_group => 'default',    # security group to use, by default use 'default'
            network => 'NETWORK_NAME or NETWORK_ID',    # network group to use
            network_for_floating_ip => 'NETWORK_NAME or NETWORK_ID',
        );
=head2 $api->delete_server( $server_id );
Delete a server from its id. Note floating IP linked to the server are also deleted.
=head1 SEE ALSO
This module is a wrapper around L<OpenStack::Client> and L<OpenStack::Client::Auth>
=over
=item L<OpenStack::Client> - OpenStack API client.
=back
=head1 TODO
=over
=item refactor/clean existing prototype
=item increase API Specs defintion
=item plug methods to route from API Specs
=item helper to purge unused floatingips
=item helper to purge unused servers
=item increase POD & add some extra examples
=item POD for using filtering: using RegExp, ...
=item improve filtering on the request when described by the specs
=back
=head1 LICENSE
This software is copyright (c) 2019 by cPanel, L.L.C.
This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming
language system itself.
=head1 DISCLAIMER OF WARRANTY
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE
OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR, OR CORRECTION.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY
WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS
BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
=head1 AUTHOR
Nicolas R <atoomic@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2019 by cPanel, Inc.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut