File Coverage

lib/Rex/Cloud/OpenStack.pm
Criterion Covered Total %
statement 35 239 14.6
branch 0 28 0.0
condition 0 19 0.0
subroutine 12 36 33.3
pod 0 22 0.0
total 47 344 13.6


line stmt bran cond sub pod time code
1             #
2             # (c) Ferenc Erki
3             #
4              
5             package Rex::Cloud::OpenStack;
6              
7 1     1   15 use v5.12.5;
  1         6  
8 1     1   6 use warnings;
  1         4  
  1         40  
9              
10             our $VERSION = '1.14.3'; # VERSION
11              
12 1     1   5 use Rex::Logger;
  1         2  
  1         6  
13              
14 1     1   32 use base 'Rex::Cloud::Base';
  1         5  
  1         103  
15              
16             BEGIN {
17 1     1   10 use Rex::Require;
  1         2  
  1         8  
18 1     1   119 JSON::MaybeXS->use;
19 1         9 HTTP::Request::Common->use(qw(:DEFAULT DELETE));
20 1         9 LWP::UserAgent->use;
21             }
22 1     1   7 use Data::Dumper;
  1         1  
  1         42  
23 1     1   6 use Carp;
  1         3  
  1         83  
24 1     1   7 use MIME::Base64 qw(decode_base64);
  1         2  
  1         86  
25 1     1   8 use Digest::MD5 qw(md5_hex);
  1         5  
  1         73  
26 1     1   10 use File::Basename;
  1         3  
  1         296  
27              
28             sub new {
29 0     0 0   my $that = shift;
30 0   0       my $proto = ref($that) || $that;
31 0           my $self = {@_};
32              
33 0           bless( $self, $proto );
34              
35 0           $self->{_agent} = LWP::UserAgent->new;
36 0           $self->{_agent}->env_proxy;
37              
38 0           return $self;
39             }
40              
41             sub set_auth {
42 0     0 0   my ( $self, %auth ) = @_;
43              
44 0           $self->{auth} = \%auth;
45             }
46              
47             sub _request {
48 0     0     my ( $self, $method, $url, %params ) = @_;
49 0           my $response;
50              
51 0           Rex::Logger::debug("Sending request to $url");
52 0           Rex::Logger::debug(" $_ => $params{$_}") for keys %params;
53              
54             {
55 1     1   8 no strict 'refs';
  1         3  
  1         3083  
  0            
56 0           $response = $self->{_agent}->request( $method->( $url, %params ) );
57             }
58              
59 0           Rex::Logger::debug( Dumper($response) );
60              
61 0 0         if ( $response->is_error ) {
62 0           Rex::Logger::info( 'Response indicates an error', 'warn' );
63 0           Rex::Logger::debug( $response->content );
64             }
65              
66 0 0         return decode_json( $response->content ) if $response->content;
67             }
68              
69             sub _authenticate {
70 0     0     my $self = shift;
71              
72             my $auth_data = {
73             auth => {
74             tenantName => $self->{auth}{tenant_name} || '',
75             passwordCredentials => {
76             username => $self->{auth}{username},
77             password => $self->{auth}{password},
78             }
79             }
80 0   0       };
81              
82             my $content = $self->_request(
83 0           POST => $self->{__endpoint} . '/tokens',
84             content_type => 'application/json',
85             content => encode_json($auth_data),
86             );
87              
88 0           $self->{auth}{tokenId} = $content->{access}{token}{id};
89              
90 0           $self->{_agent}->default_header( 'X-Auth-Token' => $self->{auth}{tokenId} );
91              
92 0           $self->{_catalog} = $content->{access}{serviceCatalog};
93             }
94              
95             sub get_nova_url {
96 0     0 0   my $self = shift;
97              
98 0 0         $self->_authenticate unless $self->{auth}{tokenId};
99              
100             my @nova_services =
101 0           grep { $_->{type} eq 'compute' } @{ $self->{_catalog} };
  0            
  0            
102              
103 0           return $nova_services[0]{endpoints}[0]{publicURL};
104             }
105              
106             sub get_cinder_url {
107 0     0 0   my $self = shift;
108              
109 0 0         $self->_authenticate unless $self->{auth}{tokenId};
110              
111             my @cinder_services =
112 0           grep { $_->{type} eq 'volume' } @{ $self->{_catalog} };
  0            
  0            
113 0           return $cinder_services[0]{endpoints}[0]{publicURL};
114             }
115              
116             sub run_instance {
117 0     0 0   my ( $self, %data ) = @_;
118 0           my $nova_url = $self->get_nova_url;
119              
120 0           Rex::Logger::debug('Trying to start a new instance with data:');
121 0           Rex::Logger::debug(" $_ => $data{$_}") for keys %data;
122              
123             my $request_data = {
124             server => {
125             flavorRef => $data{plan_id},
126             imageRef => $data{image_id},
127             name => $data{name},
128             key_name => $data{key},
129             }
130 0           };
131              
132 0           my $content = $self->_request(
133             POST => $nova_url . '/servers',
134             content_type => 'application/json',
135             content => encode_json($request_data),
136             );
137              
138 0           my $id = $content->{server}{id};
139 0           my $info;
140              
141 0           until ( ($info) = grep { $_->{id} eq $id } $self->list_running_instances ) {
  0            
142 0           Rex::Logger::debug('Waiting for instance to be created...');
143 0           sleep 1;
144             }
145              
146 0 0         if ( exists $data{volume} ) {
147             $self->attach_volume(
148             instance_id => $id,
149             volume_id => $data{volume},
150 0           );
151             }
152              
153 0 0         if ( exists $data{floating_ip} ) {
154             $self->associate_floating_ip(
155             instance_id => $id,
156             floating_ip => $data{floating_ip},
157 0           );
158              
159 0           ($info) = grep { $_->{id} eq $id } $self->list_running_instances;
  0            
160             }
161              
162 0           return $info;
163             }
164              
165             sub terminate_instance {
166 0     0 0   my ( $self, %data ) = @_;
167 0           my $nova_url = $self->get_nova_url;
168              
169 0           Rex::Logger::debug("Terminating instance $data{instance_id}");
170              
171 0           $self->_request( DELETE => $nova_url . '/servers/' . $data{instance_id} );
172              
173 0           until ( !grep { $_->{id} eq $data{instance_id} }
  0            
174             $self->list_running_instances )
175             {
176 0           Rex::Logger::debug('Waiting for instance to be deleted...');
177 0           sleep 1;
178             }
179             }
180              
181             sub list_instances {
182 0     0 0   my $self = shift;
183 0           my %options = @_;
184              
185 0   0       $options{private_network} ||= "private";
186 0   0       $options{public_network} ||= "public";
187 0   0       $options{public_ip_type} ||= "floating";
188 0   0       $options{private_ip_type} ||= "fixed";
189              
190 0           my $nova_url = $self->get_nova_url;
191 0           my @instances;
192              
193 0           my $content = $self->_request( GET => $nova_url . '/servers/detail' );
194              
195 0           for my $instance ( @{ $content->{servers} } ) {
  0            
196 0           my %networks;
197 0           for my $net ( keys %{ $instance->{addresses} } ) {
  0            
198 0           for my $ip_conf ( @{ $instance->{addresses}->{$net} } ) {
  0            
199 0           push @{ $networks{$net} },
200             {
201             mac => $ip_conf->{'OS-EXT-IPS-MAC:mac_addr'},
202             ip => $ip_conf->{addr},
203 0           type => $ip_conf->{'OS-EXT-IPS:type'},
204             };
205             }
206             }
207              
208             push @instances, {
209             ip => (
210             [
211             map {
212             $_->{"OS-EXT-IPS:type"} eq $options{public_ip_type}
213             ? $_->{'addr'}
214             : ()
215             } @{ $instance->{addresses}{ $options{public_network} } }
216             ]->[0]
217             || undef
218             ),
219             id => $instance->{id},
220             architecture => undef,
221             type => $instance->{flavor}{id},
222             dns_name => undef,
223             state => ( $instance->{status} eq 'ACTIVE' ? 'running' : 'stopped' ),
224             __state => $instance->{status},
225             launch_time => $instance->{'OS-SRV-USG:launched_at'},
226             name => $instance->{name},
227             private_ip => (
228             [
229             map {
230             $_->{"OS-EXT-IPS:type"} eq $options{private_ip_type}
231             ? $_->{'addr'}
232             : ()
233             } @{ $instance->{addresses}{ $options{private_network} } }
234             ]->[0]
235             || undef
236             ),
237             security_groups =>
238 0 0 0       ( join ',', map { $_->{name} } @{ $instance->{security_groups} } ),
  0   0        
  0            
239             networks => \%networks,
240             };
241             }
242              
243 0           return @instances;
244             }
245              
246             sub list_running_instances {
247 0     0 0   my $self = shift;
248              
249 0           return grep { $_->{state} eq 'running' } $self->list_instances;
  0            
250             }
251              
252             sub stop_instance {
253 0     0 0   my ( $self, %data ) = @_;
254 0           my $nova_url = $self->get_nova_url;
255              
256 0           Rex::Logger::debug("Suspending instance $data{instance_id}");
257              
258             $self->_request(
259 0           POST => $nova_url . '/servers/' . $data{instance_id} . '/action',
260             content_type => 'application/json',
261             content => encode_json( { suspend => 'null' } ),
262             );
263              
264 0           while ( grep { $_->{id} eq $data{instance_id} }
  0            
265             $self->list_running_instances )
266             {
267 0           Rex::Logger::debug('Waiting for instance to be stopped...');
268 0           sleep 5;
269             }
270             }
271              
272             sub start_instance {
273 0     0 0   my ( $self, %data ) = @_;
274 0           my $nova_url = $self->get_nova_url;
275              
276 0           Rex::Logger::debug("Resuming instance $data{instance_id}");
277              
278             $self->_request(
279 0           POST => $nova_url . '/servers/' . $data{instance_id} . '/action',
280             content_type => 'application/json',
281             content => encode_json( { resume => 'null' } ),
282             );
283              
284 0           until ( grep { $_->{id} eq $data{instance_id} }
  0            
285             $self->list_running_instances )
286             {
287 0           Rex::Logger::debug('Waiting for instance to be started...');
288 0           sleep 5;
289             }
290             }
291              
292             sub list_flavors {
293 0     0 0   my $self = shift;
294 0           my $nova_url = $self->get_nova_url;
295              
296 0           Rex::Logger::debug('Listing flavors');
297              
298 0           my $flavors = $self->_request( GET => $nova_url . '/flavors' );
299 0 0         confess "Error getting cloud flavors." if ( !exists $flavors->{flavors} );
300 0           return @{ $flavors->{flavors} };
  0            
301             }
302              
303 0     0 0   sub list_plans { return shift->list_flavors; }
304              
305             sub list_images {
306 0     0 0   my $self = shift;
307 0           my $nova_url = $self->get_nova_url;
308              
309 0           Rex::Logger::debug('Listing images');
310              
311 0           my $images = $self->_request( GET => $nova_url . '/images' );
312 0 0         confess "Error getting cloud images." if ( !exists $images->{images} );
313 0           return @{ $images->{images} };
  0            
314             }
315              
316             sub create_volume {
317 0     0 0   my ( $self, %data ) = @_;
318 0           my $cinder_url = $self->get_cinder_url;
319              
320 0           Rex::Logger::debug('Creating a new volume');
321              
322             my $request_data = {
323             volume => {
324             size => $data{size} || 1,
325             availability_zone => $data{zone},
326             }
327 0   0       };
328              
329 0           my $content = $self->_request(
330             POST => $cinder_url . '/volumes',
331             content_type => 'application/json',
332             content => encode_json($request_data),
333             );
334              
335 0           my $id = $content->{volume}{id};
336              
337 0 0         until ( grep { $_->{id} eq $id and $_->{status} eq 'available' }
  0            
338             $self->list_volumes )
339             {
340 0           Rex::Logger::debug('Waiting for volume to become available...');
341 0           sleep 1;
342             }
343              
344 0           return $id;
345             }
346              
347             sub delete_volume {
348 0     0 0   my ( $self, %data ) = @_;
349 0           my $cinder_url = $self->get_cinder_url;
350              
351 0           Rex::Logger::debug('Trying to delete a volume');
352              
353 0           $self->_request( DELETE => $cinder_url . '/volumes/' . $data{volume_id} );
354              
355 0           until ( !grep { $_->{id} eq $data{volume_id} } $self->list_volumes ) {
  0            
356 0           Rex::Logger::debug('Waiting for volume to be deleted...');
357 0           sleep 1;
358             }
359              
360             }
361              
362             sub list_volumes {
363 0     0 0   my $self = shift;
364 0           my $cinder_url = $self->get_cinder_url;
365 0           my @volumes;
366              
367 0           my $content = $self->_request( GET => $cinder_url . '/volumes' );
368              
369 0           for my $volume ( @{ $content->{volumes} } ) {
  0            
370             push @volumes,
371             {
372             id => $volume->{id},
373             status => $volume->{status},
374             zone => $volume->{availability_zone},
375             size => $volume->{size},
376             attached_to => join ',',
377 0           map { $_->{server_id} } @{ $volume->{attachments} },
  0            
  0            
378             };
379             }
380              
381 0           return @volumes;
382             }
383              
384             sub attach_volume {
385 0     0 0   my ( $self, %data ) = @_;
386 0           my $nova_url = $self->get_nova_url;
387              
388 0           Rex::Logger::debug('Trying to attach a new volume');
389              
390             my $request_data = {
391             volumeAttachment => {
392             volumeId => $data{volume_id},
393             name => $data{name},
394             }
395 0           };
396              
397             $self->_request(
398             POST => $nova_url
399             . '/servers/'
400             . $data{instance_id}
401 0           . '/os-volume_attachments',
402             content_type => 'application/json',
403             content => encode_json($request_data),
404             );
405             }
406              
407             sub detach_volume {
408 0     0 0   my ( $self, %data ) = @_;
409 0           my $nova_url = $self->get_nova_url;
410              
411 0           Rex::Logger::debug('Trying to detach a volume');
412              
413             $self->_request( DELETE => $nova_url
414             . '/servers/'
415             . $data{instance_id}
416             . '/os-volume_attachments/'
417 0           . $data{volume_id} );
418             }
419              
420             sub get_floating_ip {
421 0     0 0   my $self = shift;
422 0           my $nova_url = $self->get_nova_url;
423              
424             # look for available floating IP
425 0           my $floating_ips = $self->_request( GET => $nova_url . '/os-floating-ips' );
426              
427 0           for my $floating_ip ( @{ $floating_ips->{floating_ips} } ) {
  0            
428 0 0         return $floating_ip->{ip} if ( !$floating_ip->{instance_id} );
429             }
430 0           confess "No floating IP available.";
431             }
432              
433             sub associate_floating_ip {
434 0     0 0   my ( $self, %data ) = @_;
435 0           my $nova_url = $self->get_nova_url;
436              
437             # associate available floating IP to instance id
438             my $request_data = {
439             addFloatingIp => {
440             address => $data{floating_ip}
441             }
442 0           };
443              
444 0           Rex::Logger::debug('Associating floating IP to instance');
445              
446             my $content = $self->_request(
447 0           POST => $nova_url . '/servers/' . $data{instance_id} . '/action',
448             content_type => 'application/json',
449             content => encode_json($request_data),
450             );
451             }
452              
453             sub list_keys {
454 0     0 0   my $self = shift;
455 0           my $nova_url = $self->get_nova_url;
456              
457 0           my $content = $self->_request( GET => $nova_url . '/os-keypairs' );
458              
459             # remove ':' from fingerprint string
460 0           foreach ( @{ $content->{keypairs} } ) {
  0            
461 0           $_->{keypair}->{fingerprint} =~ s/://g;
462             }
463 0           return @{ $content->{keypairs} };
  0            
464             }
465              
466             sub upload_key {
467 0     0 0   my ($self) = shift;
468 0           my $nova_url = $self->get_nova_url;
469              
470 0           my $public_key = glob( Rex::Config->get_public_key );
471 0           my ( $public_key_name, undef, undef ) = fileparse( $public_key, qr/\.[^.]*/ );
472              
473 0           my ( $type, $key, $comment );
474              
475             # read public key
476 0           my $fh;
477 0 0         unless ( open( $fh, "<", glob($public_key) ) ) {
478 0           Rex::Logger::debug("Cannot read $public_key");
479 0           return;
480             }
481              
482 0           { local $/ = undef; ( $type, $key, $comment ) = split( /\s+/, <$fh> ); }
  0            
  0            
483 0           close $fh;
484              
485             # calculate key fingerprint so we can compare them
486 0           my $fingerprint = md5_hex( decode_base64($key) );
487 0           Rex::Logger::debug("Public key fingerprint is $fingerprint");
488              
489             # upoad only new key
490             my $online_key = pop @{
491 0           [
492 0 0         map { $_->{keypair}->{fingerprint} eq $fingerprint ? $_ : () }
  0            
493             $self->list_keys()
494             ]
495             };
496 0 0         if ($online_key) {
497 0           Rex::Logger::debug("Public key already uploaded");
498 0           return $online_key->{keypair}->{name};
499             }
500              
501 0           my $request_data = {
502             keypair => {
503             public_key => "$type $key",
504             name => $public_key_name,
505             }
506             };
507              
508 0           Rex::Logger::info('Uploading public key');
509 0           $self->_request(
510             POST => $nova_url . '/os-keypairs',
511             content_type => 'application/json',
512             content => encode_json($request_data),
513             );
514              
515 0           return $public_key_name;
516             }
517              
518             1;