File Coverage

blib/lib/VMware/API/vCloud.pm
Criterion Covered Total %
statement 15 410 3.6
branch 0 200 0.0
condition 0 20 0.0
subroutine 5 48 10.4
pod 36 36 100.0
total 56 714 7.8


line stmt bran cond sub pod time code
1             package VMware::API::vCloud;
2              
3             # ABSTRACT: VMware vCloud Director
4              
5 2     2   7 use Data::Dumper;
  2         2  
  2         81  
6 2     2   841 use LWP;
  2         59936  
  2         56  
7 2     2   1390 use XML::Simple;
  2         11979  
  2         11  
8              
9 2     2   127 use warnings;
  2         3  
  2         38  
10 2     2   7 use strict;
  2         2  
  2         8508  
11              
12             our $VERSION = '2.404'; # VERSION
13             our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY
14              
15             # ADMIN OPTS - http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/landing-admin_operations.html
16             # USER OPTS - http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/landing-user_operations.html
17              
18              
19             sub new {
20 0     0 1   my $class = shift @_;
21 0           my $self = {};
22              
23 0           $self->{hostname} = shift @_;
24 0           $self->{username} = shift @_;
25 0           $self->{password} = shift @_;
26 0           $self->{orgname} = shift @_;
27              
28 0           $self->{debug} = 0; # Defaults to no debug info
29 0           $self->{die_on_fault} = 1; # Defaults to dieing on an error
30 0           $self->{ssl_timeout} = 3600; # Defaults to 1h
31              
32 0 0         $self->{orgname} = 'System' unless $self->{orgname};
33              
34 0 0 0       $self->{conf} = shift @_ if defined $_[0] and ref $_[0];
35 0 0         $self->{debug} = $self->{conf}->{debug} if defined $self->{conf}->{debug};
36              
37 0           bless( $self, $class );
38              
39 0           $self->_regenerate();
40              
41 0 0         $self->_debug( "Loaded VMware::vCloud v" . our $VERSION . "\n" ) if $self->{debug};
42 0           return $self;
43             }
44              
45              
46             sub config {
47 0     0 1   my $self = shift @_;
48              
49 0           my %input = @_;
50 0           my @config_vals = qw/debug die_on_fault hostname orgname password ssl_timeout username/;
51 0           my %config_vals = map { $_, 1; } @config_vals;
  0            
52              
53 0           for my $key ( keys %input ) {
54 0 0         if ( $config_vals{$key} ) {
55 0           $self->{$key} = $input{$key};
56             }
57             else {
58 0           warn
59             'Config key "$key" is being ignored. Only the following options may be configured: '
60             . join( ", ", @config_vals ) . "\n";
61             }
62             }
63              
64 0           $self->_regenerate();
65              
66 0           my %out;
67 0           map { $out{$_} = $self->{$_} } @config_vals;
  0            
68              
69 0 0         return wantarray ? %out : \%out;
70             }
71              
72             ### Internal methods
73              
74             # $self->{raw}->{version} - Full data on the API version from login (populated on api_version() call)
75             # $self->{raw}->{login}
76             # $self->{learned}->{version} - API version number (populated on api_version() call)
77             # $self->{learned}->{url}->{login} - Authentication URL (populated on api_version() call)
78             # $self->{learned}->{url}->{orglist}
79              
80             sub DESTROY {
81 0     0     my $self = shift @_;
82 0           my @dump = split "\n", Dumper( $self->{learned} );
83 0           pop @dump;
84 0           shift @dump;
85 0           $self->_debug_with_level( 2, "Learned variables: \n" . join( "\n", @dump ) );
86             }
87              
88             sub _debug {
89 0     0     my $self = shift @_;
90 0 0         return unless $self->{debug};
91 0           while ( my $debug = shift @_ ) {
92 0           chomp $debug;
93 0           print STDERR "DEBUG: $debug\n";
94             }
95             }
96              
97             sub _debug_with_level {
98 0     0     my $self = shift @_;
99 0           my $value = shift @_;
100 0 0         return if $self->{debug} < $value;
101 0           $self->_debug(@_);
102             }
103              
104             sub _fault {
105 0     0     my $self = shift @_;
106 0           my @error = @_;
107              
108 0           my $message = "\nERROR: ";
109              
110 0 0 0       if ( scalar @error and ref $error[0] eq 'HTTP::Response' ) {
111 0 0         if ( $error[0]->content ) {
112 0           $self->_debug( Dumper( \@error ) );
113 0           $self->_debug( 'ERROR Status Line: ' . $error[0]->status_line );
114 0           $self->_debug( 'ERROR Content: ' . $error[0]->content );
115              
116 0           my $ret; # Try parsing as XML, or fallback to content as message
117 0           eval { $ret = $self->_parse_xml( $error[0]->content ); };
  0            
118             $message
119 0 0         .= ( $@ ? $error[0]->content : $error[0]->status_line . ' : ' . $ret->{message} );
120             }
121 0           die $message;
122             }
123              
124 0           while ( my $error = shift @error ) {
125 0 0         if ( ref $error eq 'SCALAR' ) {
126 0           chomp $error;
127 0           $message .= $error;
128             }
129             else {
130 0           $message .= Dumper($error);
131             }
132             }
133             }
134              
135             sub _regenerate {
136 0     0     my $self = shift @_;
137 0           $self->{ua} = LWP::UserAgent->new;
138 0           $self->_debug_with_level( 2, "VMware::API::vCLoud::_regenerate()" );
139              
140 0           $self->{api_version} = $self->api_version();
141 0           $self->_debug("API Version: $self->{api_version}");
142              
143             $self->{url_base} =
144 0           URI->new( 'https://' . $self->{hostname} . '/api/v' . $self->{api_version} . '/' );
145 0           $self->_debug("API URL: $self->{url_base}");
146             }
147              
148             sub _xml_response {
149 0     0     my $self = shift @_;
150 0           my $response = shift @_;
151 0           $self->_debug_with_level( 3, "Received XML Content: \n\n" . $response->content . "\n\n" );
152 0 0         if ( $response->is_success ) {
153 0 0         return unless $response->content;
154 0           return $self->_parse_xml( $response->content );
155             }
156             else {
157 0           $self->_fault($response);
158             }
159             }
160              
161             sub _parse_xml {
162 0     0     my $self = shift @_;
163 0           my $xml = shift @_;
164 0           my $data = XMLin( $xml, ForceArray => 1 );
165 0           return $data;
166             }
167              
168              
169             sub delete {
170 0     0 1   my $self = shift @_;
171 0           my $url = shift @_;
172 0 0         $self->_debug("API: delete($url)\n") if $self->{debug};
173 0           my $req = HTTP::Request->new( DELETE => $url );
174 0           $req->header( Accept => $self->{learned}->{accept_header} );
175 0           my $response = $self->{ua}->request($req);
176 0           return $self->_xml_response($response);
177             }
178              
179              
180             sub get {
181 0     0 1   my $self = shift @_;
182 0   0       my $url = shift @_ || '';
183 0 0         $self->_debug("API: get($url)\n") if $self->{debug};
184 0           my $req = HTTP::Request->new( GET => $url );
185 0           $req->header( Accept => $self->{learned}->{accept_header} );
186              
187             #$self->_debug_with_level(3,"Sending GET: \n\n" . $req->as_string . "\n");
188 0           my $response = $self->{ua}->request($req);
189 0           my $check = $response->request;
190 0           $self->_debug_with_level( 3, "Sent GET:\n\n" . $check->as_string . "\n" );
191 0           $self->_debug_with_level( 3, "GET returned:\n\n" . $response->as_string . "\n" );
192 0           return $self->_xml_response($response);
193             }
194              
195              
196             sub get_raw {
197 0     0 1   my $self = shift @_;
198 0           my $url = shift @_;
199 0 0         $self->_debug("API: get($url)\n") if $self->{debug};
200 0           my $req = HTTP::Request->new( GET => $url );
201 0           $req->header( Accept => $self->{learned}->{accept_header} );
202              
203             #$self->_debug_with_level(3,"Sending GET: \n\n" . $req->as_string . "\n");
204 0           my $response = $self->{ua}->request($req);
205 0           my $check = $response->request;
206 0           $self->_debug_with_level( 3, "Sent GET:\n\n" . $check->as_string . "\n" );
207 0           $self->_debug_with_level( 3, "GET returned:\n\n" . $response->as_string . "\n" );
208 0           return $response->content;
209             }
210              
211              
212             sub post {
213 0     0 1   my $self = shift @_;
214 0           my $href = shift @_;
215              
216 0           my $type = shift @_;
217 0           my $content = shift @_;
218              
219 0 0         $self->_debug("API: post($href)\n") if $self->{debug};
220 0           my $req = HTTP::Request->new( POST => $href );
221              
222 0 0         $req->content($content) if $content;
223 0 0         $req->content_type($type) if $type;
224 0           $req->header( Accept => $self->{learned}->{accept_header} );
225              
226 0           $self->_debug_with_level(
227             3,
228             "Posting with XML Content-Type: $type",
229             "Posting XML content:\n\n$content\n\n"
230             );
231              
232 0           my $response = $self->{ua}->request($req);
233 0           my $data = $self->_xml_response($response);
234              
235 0           my @ret = ( $response->message, $response->code, $data );
236              
237 0 0         return wantarray ? @ret : \@ret;
238             }
239              
240              
241             sub put {
242 0     0 1   my $self = shift @_;
243 0           my $href = shift @_;
244              
245 0           my $type = shift @_;
246 0           my $content = shift @_;
247              
248 0 0         $self->_debug("API: post($href)\n") if $self->{debug};
249 0           my $req = HTTP::Request->new( PUT => $href );
250              
251 0 0         $req->content($content) if $content;
252 0 0         $req->content_type($type) if $type;
253 0           $req->header( Accept => $self->{learned}->{accept_header} );
254              
255 0           $self->_debug_with_level(
256             3,
257             "Posting with XML Content-Type: $type",
258             "Posting XML content:\n\n$content\n\n"
259             );
260              
261 0           my $response = $self->{ua}->request($req);
262 0           my $data = $self->_xml_response($response);
263              
264 0           my @ret = ( $response->message, $response->code, $data );
265              
266 0 0         return wantarray ? @ret : \@ret;
267             }
268              
269              
270             sub api_version {
271 0     0 1   my $self = shift @_;
272             my $url =
273 0           URI->new( 'https://' . $self->{hostname} . '/api/versions' ); # Check API version first!
274              
275 0           $self->_debug("Checking $url for supported API versions");
276              
277 0           my $req = HTTP::Request->new( GET => $url );
278 0           my $response = $self->{ua}->request($req);
279 0 0         if ( $response->status_line eq '200 OK' ) {
280 0           my $info = XMLin( $response->content );
281              
282             #die Dumper($info);
283              
284 0           $self->{learned}->{version} = 0;
285 0           for my $verblock ( @{ $info->{VersionInfo} } ) {
  0            
286 0 0         if ( $verblock->{Version} > $self->{learned}->{version} ) {
287 0           $self->{raw}->{version} = $verblock;
288 0           $self->{learned}->{version} = $verblock->{Version};
289 0           $self->{learned}->{url}->{login} = $verblock->{LoginUrl};
290             }
291             }
292              
293 0           return $self->{learned}->{version};
294             }
295             else {
296 0           $self->_fault($response);
297             }
298             }
299              
300              
301             sub login {
302 0     0 1   my $self = shift @_;
303              
304 0           $self->_debug( 'Login URL: ' . $self->{learned}->{url}->{login} );
305 0           my $req = HTTP::Request->new( POST => $self->{learned}->{url}->{login} );
306              
307 0           $req->authorization_basic( $self->{username} . '@' . $self->{orgname}, $self->{password} );
308             $self->_debug( "Attempting to login: "
309             . $self->{username} . '@'
310             . $self->{orgname} . ' '
311 0           . $self->{password} );
312              
313 0           $self->{learned}->{accept_header} = 'application/*+xml;version=' . $self->{learned}->{version};
314 0           $self->_debug( 'Accept header: ' . $self->{learned}->{accept_header} );
315 0           $req->header( Accept => $self->{learned}->{accept_header} );
316              
317 0           my $response = $self->{ua}->request($req);
318              
319 0           my $token = $response->header('x-vcloud-authorization');
320 0           $self->{ua}->default_header( 'x-vcloud-authorization', $token );
321              
322 0           $self->_debug( "Authentication status: " . $response->status_line );
323 0 0         if ( $response->status_line =~ /^4\d\d/ ) {
324 0           die "ERROR: Login Error: " . $response->status_line;
325             }
326              
327 0           $self->_debug( "Authentication token: " . $token );
328              
329 0           $self->{raw}->{login} = $self->_xml_response($response);
330              
331 0           for my $link ( @{ $self->{raw}->{login}->{Link} } ) {
  0            
332 0 0         next if not defined $link->{type};
333             $self->{learned}->{url}->{admin} = $link->{href}
334 0 0         if $link->{type} eq 'application/vnd.vmware.admin.vcloud+xml';
335             $self->{learned}->{url}->{entity} = $link->{href}
336 0 0         if $link->{type} eq 'application/vnd.vmware.vcloud.entity+xml';
337             $self->{learned}->{url}->{extensibility} = $link->{href}
338 0 0         if $link->{type} eq 'application/vnd.vmware.vcloud.apiextensibility+xml';
339             $self->{learned}->{url}->{extension} = $link->{href}
340 0 0         if $link->{type} eq 'application/vnd.vmware.admin.vmwExtension+xml';
341             $self->{learned}->{url}->{orglist} = $link->{href}
342 0 0         if $link->{type} eq 'application/vnd.vmware.vcloud.orgList+xml';
343             $self->{learned}->{url}->{query} = $link->{href}
344 0 0         if $link->{type} eq 'application/vnd.vmware.vcloud.query.queryList+xml';
345              
346             #die Dumper($self->{raw}->{login}->{Link});
347             }
348              
349 0           $self->{have_session} = 1;
350 0           return $self->{raw}->{login};
351             }
352              
353              
354             # http://pubs.vmware.com/vcd-51/topic/com.vmware.vcloud.api.doc_51/GUID-FBAA5B7D-8599-40C2-8081-E6D77DF18D5F.html
355              
356             sub logout {
357 0     0 1   my $self = shift @_;
358 0 0         $self->_debug("API: logout()\n") if $self->{debug};
359 0           $self->{have_session} = 0;
360              
361 0           my $url = $self->{learned}->{url}->{login};
362 0           $url =~ s/sessions/session/;
363 0           my $req = HTTP::Request->new( DELETE => $self->{learned}->{url}->{login} );
364 0           $req->header( Accept => $self->{learned}->{accept_header} );
365              
366 0           my $response = $self->{ua}->request($req);
367 0 0         return 1 if $response->code() == 401; # No content is a successful logout
368 0           return $self->_xml_response($response);
369             }
370              
371             ### API methods
372              
373              
374             sub admin {
375 0     0 1   my $self = shift @_;
376 0 0         $self->_debug("API: admin()\n") if $self->{debug};
377 0 0         return $self->{learned}->{admin} if defined $self->{learned}->{admin};
378              
379 0           my $parsed = $self->get( $self->{learned}->{url}->{admin} );
380              
381 0           $self->{learned}->{admin}->{networks} = $parsed->{Networks}->[0]->{Network};
382 0           $self->{learned}->{admin}->{rights} = $parsed->{RightReferences}->[0]->{RightReference};
383 0           $self->{learned}->{admin}->{roles} = $parsed->{RoleReferences}->[0]->{RoleReference};
384             $self->{learned}->{admin}->{orgs} =
385 0           $parsed->{OrganizationReferences}->[0]->{OrganizationReference};
386             $self->{learned}->{admin}->{pvdcs} =
387 0           $parsed->{ProviderVdcReferences}->[0]->{ProviderVdcReference};
388              
389 0           return $self->{learned}->{admin};
390             }
391              
392              
393             sub admin_extension_get {
394 0     0 1   my $self = shift @_;
395 0 0         $self->_debug("API: admin_extension_get()\n") if $self->{debug};
396 0           return $self->get( $self->{learned}->{url}->{admin} . 'extension' );
397             }
398              
399              
400             sub admin_extension_vimServer_get {
401 0     0 1   my $self = shift @_;
402 0           my $url = shift @_;
403 0 0         $self->_debug("API: admin_extension_vimServer_get($url)\n") if $self->{debug};
404 0           return $self->get($url);
405             }
406              
407              
408             sub admin_extension_vimServerReferences_get {
409 0     0 1   my $self = shift @_;
410 0 0         $self->_debug("API: admin_extension_vimServerReferences_get()\n") if $self->{debug};
411 0           return $self->get( $self->{learned}->{url}->{admin} . 'extension/vimServerReferences' );
412             }
413              
414              
415             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Foperations%2FPOST-CreateCatalog.html
416              
417             # Add catalog item http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Foperations%2FPOST-CreateCatalogItem.html
418              
419             sub catalog_create {
420 0     0 1   my $self = shift @_;
421 0           my $url = shift @_;
422 0           my $conf = shift @_;
423              
424 0 0         $conf->{is_published} = 0 unless defined $conf->{is_published};
425              
426 0 0         $url .= '/catalogs' unless $url =~ /\/catalogs$/;
427 0 0         $self->_debug("API: catalog_create($url)\n") if $self->{debug};
428              
429             my $xml = '
430             ' . $conf->{description} . '
431 0           ' . $conf->{is_published} . '
432             ';
433              
434 0           my $ret = $self->post( $url, 'application/vnd.vmware.admin.catalog+xml', $xml );
435              
436 0 0         return $ret->[2]->{href} if $ret->[1] == 201;
437 0           return $ret;
438             }
439              
440              
441             sub catalog_get {
442 0     0 1   my $self = shift @_;
443 0           my $cat = shift @_;
444 0 0         $self->_debug("API: catalog_get($cat)\n") if $self->{debug};
445 0 0         return $self->get( $cat =~ /^[^\/]+$/ ? $self->{url_base} . 'catalog/' . $cat : $cat );
446             }
447              
448              
449             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Ftypes%2FControlAccessParamsType.html
450              
451             sub catalog_get_access {
452 0     0 1   my $self = shift @_;
453 0           my $cat_href = shift @_;
454 0           my $org_href = shift @_;
455              
456 0 0         die 'Bad Catalog HREF' unless $cat_href =~ /(\/catalog\/[^\/]+)$/;
457 0           my $href = $org_href . $1 . '/controlAccess';
458 0           $href =~ s/admin\///;
459              
460 0 0         $self->_debug("API: catalog_get_access($href)\n") if $self->{debug};
461 0           return $self->get($href);
462             }
463              
464              
465             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Ftypes%2FControlAccessParamsType.html
466              
467             sub catalog_set_access {
468 0     0 1   my $self = shift @_;
469 0           my $cat_href = shift @_;
470 0           my $org_href = shift @_;
471 0           my $is_shared = shift @_;
472 0           my $level = shift @_;
473              
474 0 0         die 'Bad Catalog HREF' unless $cat_href =~ /(\/catalog\/[^\/]+)$/;
475 0           my $href = $org_href . $1 . '/action/controlAccess';
476 0           $href =~ s/admin\///;
477              
478 0 0         $self->_debug("API: catalog_set_access($href)\n") if $self->{debug};
479              
480 0           my $xml = '
481             ' . $is_shared . '
482             ' . $level . '
483             ';
484              
485 0           my $ret = $self->post( $href, 'application/vnd.vmware.vcloud.controlAccess+xml', $xml );
486              
487 0 0         return $ret->[2]->{href} if $ret->[1] == 201;
488 0           return $ret;
489             }
490              
491              
492             sub datastore_list {
493 0     0 1   my $self = shift @_;
494 0           my $query_url = $self->{learned}->{url}->{query} . '?type=datastore&format=idrecords';
495 0           return $self->get($query_url);
496             }
497              
498              
499             # http://pubs.vmware.com/vcd-51/topic/com.vmware.vcloud.api.doc_51/GUID-439C57EA-859C-423C-B21B-22B230395600.html
500             # http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/operations/PUT-Organization.html
501              
502             sub org_create {
503 0     0 1   my $self = shift @_;
504 0           my $conf = shift @_;
505              
506 0 0         $self->_debug("API: org_create()\n") if $self->{debug};
507 0           my $url = $self->{learned}->{url}->{admin} . 'orgs';
508              
509 0 0         $conf->{ldap_mode} = 'NONE' unless defined $conf->{ldap_mode};
510              
511 0           my $vapp_lease = '
512             0
513             0
514             0
515             ';
516              
517 0           my $tmpl_lease = '
518             0
519             0
520             ';
521              
522 0           my $vdcs;
523 0 0 0       if ( defined $conf->{vdc} and ref $conf->{vdc} ) {
    0          
524 0           for my $vdc ( @{ $conf->{vdc} } ) {
  0            
525 0           $vdcs .= ' ';
526             }
527             }
528             elsif ( defined $conf->{vdc} ) {
529 0           $vdcs = ' ';
530             }
531 0           $vdcs .= "\n";
532              
533             my $xml = '
534            
535             ' . $conf->{desc} . '
536             ' . $conf->{fullname} . '
537             ' . $conf->{is_enabled} . '
538            
539            
540             ' . $conf->{can_publish} . '
541             ' . $conf->{deployed} . '
542             ' . $conf->{stored} . '
543             false
544             1
545            
546             ' . $vapp_lease . '
547             ' . $tmpl_lease . '
548            
549 0           ' . $conf->{ldap_mode} . '
550            
551            
552            
553             ' . $vdcs . '
554            
555            
556             ';
557              
558 0           my $ret = $self->post( $url, 'application/vnd.vmware.admin.organization+xml', $xml );
559              
560 0 0         return $ret->[2]->{href} if $ret->[1] == 201;
561 0           return $ret;
562             }
563              
564              
565             sub org_get {
566 0     0 1   my $self = shift @_;
567 0           my $org = shift @_;
568 0           my $req;
569              
570 0 0         $self->_debug("API: org_get($org)\n") if $self->{debug};
571 0 0         return $self->get( $org =~ /^[^\/]+$/ ? $self->{url_base} . 'org/' . $org : $org );
572             }
573              
574              
575             sub org_list {
576 0     0 1   my $self = shift @_;
577 0 0         $self->_debug("API: org_list()\n") if $self->{debug};
578 0           return $self->get( $self->{learned}->{url}->{orglist} );
579             }
580              
581              
582             sub org_network_create {
583 0     0 1   my $self = shift @_;
584 0           my $url = shift @_;
585 0           my $conf = shift @_;
586              
587 0 0         $conf->{is_shared} = 0 unless defined $conf->{is_shared};
588              
589 0 0         $self->_debug("API: org_network_create()\n") if $self->{debug};
590              
591             # my $xml = '
592             #
593             # '.$desc.'
594             #
595             #
596             #
597             # false
598             # '.$gateway .'
599             # '.$netmask.'
600             # '.$dns1.'
601             # '.$dns2.'
602             # '.$dnssuffix.'
603             #
604             #
605             # '.$start_ip.'
606             # '.$end_ip.'
607             #
608             #
609             #
610             #
611             # natRouted
612             #
613             #
614             # href="https://vcloud.example.com/api/admin/gateway/2000" />
615             # true
616             #
617             # ';
618              
619             my $xml = '
620             name="' . $conf->{name} . '"
621             xmlns="http://www.vmware.com/vcloud/v1.5">
622             ' . $conf->{desc} . '
623            
624            
625             href="' . $conf->{parent_net_href} . '" />
626             bridged
627            
628 0           ' . $conf->{is_shared} . '
629             ';
630              
631 0           $url .= '/networks';
632              
633 0           my $ret = $self->post( $url, 'application/vnd.vmware.vcloud.orgVdcNetwork+xml', $xml );
634              
635 0 0         return $ret->[2]->{href} if $ret->[1] == 201;
636 0           return $ret;
637             }
638              
639              
640             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Ftypes%2FCreateVdcParamsType.html
641              
642             sub org_vdc_create {
643 0     0 1   my $self = shift @_;
644 0           my $url = shift @_;
645 0           my $conf = shift @_;
646              
647 0 0         $self->_debug("API: org_vdc_create()\n") if $self->{debug};
648              
649             my $networkpool =
650 0 0         $conf->{np_href} ? '' : '';
651              
652 0           my $sp;
653 0 0 0       if ( defined $conf->{sp} and ref $conf->{sp} ) {
    0          
654 0           for my $ref ( @{ $conf->{sp} } ) {
  0            
655             $sp .= '
656             ' . $ref->{sp_enabled} . '
657             ' . $ref->{sp_units} . '
658             ' . $ref->{sp_limit} . '
659             ' . $ref->{sp_default} . '
660 0          
661             ';
662             }
663             }
664             elsif ( defined $conf->{sp_enabled} ) {
665             $sp = '
666             ' . $conf->{sp_enabled} . '
667             ' . $conf->{sp_units} . '
668             ' . $conf->{sp_limit} . '
669             ' . $conf->{sp_default} . '
670 0          
671             ';
672             }
673              
674             my $xml = '
675            
676             ' . $conf->{desc} . '
677             ' . $conf->{allocation_model} . '
678            
679            
680             ' . $conf->{cpu_unit} . '
681             ' . $conf->{cpu_alloc} . '
682             ' . $conf->{cpu_limit} . '
683            
684            
685             ' . $conf->{mem_unit} . '
686             ' . $conf->{mem_alloc} . '
687             ' . $conf->{mem_limit} . '
688            
689            
690             ' . $conf->{nic_quota} . '
691             ' . $conf->{net_quota} . '
692             ' . $sp . '
693             ' . $conf->{ResourceGuaranteedMemory} . '
694             ' . $conf->{ResourceGuaranteedCpu} . '
695             ' . $conf->{VCpuInMhz} . '
696             ' . $conf->{is_thin_provision} . '
697             ' . $networkpool . '
698            
699             name="' . $conf->{pvdc_name} . '"
700             href="' . $conf->{pvdc_href} . '" />
701 0           ' . $conf->{use_fast_provisioning} . '
702            
703             ';
704              
705 0           $url .= '/vdcsparams';
706              
707 0           my $ret = $self->post( $url, 'application/vnd.vmware.admin.createVdcParams+xml', $xml );
708              
709 0 0         return $ret->[2]->{href} if $ret->[1] == 201;
710 0           return $ret;
711             }
712              
713              
714             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Ftypes%2FAdminVdcType.html
715              
716             sub org_vdc_update {
717 0     0 1   my $self = shift @_;
718 0           my $url = shift @_;
719 0           my $conf = shift @_;
720 0 0         $self->_debug("API: org_vdc_update()\n") if $self->{debug};
721              
722 0           my $desc = '' . $conf->{desc} . "\n";
723             my $alloc =
724             $conf->{allocation_model}
725 0 0         ? '' . $conf->{allocation_model} . "\n"
726             : '';
727 0           my $compute;
728             my $nicquota =
729 0 0         defined $conf->{nic_quota} ? '' . $conf->{nic_quota} . "\n" : '';
730             my $netquota =
731             defined $conf->{net_quota}
732 0 0         ? '' . $conf->{net_quota} . "\n"
733             : '';
734 0           my $sp;
735             my $networkpool =
736 0 0         $conf->{np_href} ? '' : '';
737             my $res_mem =
738             defined $conf->{ResourceGuaranteedMemory}
739             ? ''
740             . $conf->{ResourceGuaranteedMemory}
741 0 0         . "\n"
742             : '';
743             my $res_cpu =
744             defined $conf->{ResourceGuaranteedCpu}
745 0 0         ? '' . $conf->{ResourceGuaranteedCpu} . "\n"
746             : '';
747             my $vcpu =
748 0 0         defined $conf->{VCpuInMhz} ? '' . $conf->{VCpuInMhz} . "\n" : '';
749             my $thin =
750             defined $conf->{is_thin_provision}
751 0 0         ? '' . $conf->{is_thin_provision} . "\n"
752             : '';
753             my $pvdc =
754             $conf->{pvdc_href}
755             ? ' 756             . $conf->{pvdc_name}
757             . '" href="'
758             . $conf->{pvdc_href}
759 0 0         . "\" />\n"
760             : '';
761             my $fast =
762             defined $conf->{use_fast_provisioning}
763 0 0         ? '' . $conf->{use_fast_provisioning} . "\n"
764             : '';
765              
766 0 0 0       if ( defined $conf->{sp} and ref $conf->{sp} ) {
    0          
767 0           for my $ref ( @{ $conf->{sp} } ) {
  0            
768             $sp .= '
769             ' . $ref->{sp_enabled} . '
770             ' . $ref->{sp_units} . '
771             ' . $ref->{sp_limit} . '
772             ' . $ref->{sp_default} . '
773 0          
774             ';
775             }
776             }
777             elsif ( defined $conf->{sp_enabled} ) {
778             $sp = '
779             ' . $conf->{sp_enabled} . '
780             ' . $conf->{sp_units} . '
781             ' . $conf->{sp_limit} . '
782             ' . $conf->{sp_default} . '
783 0          
784             ';
785             }
786              
787 0 0 0       if ( defined $conf->{cpu_unit} or defined $conf->{mem_unit} ) {
788             $compute = '
789            
790             ' . $conf->{cpu_unit} . '
791             ' . $conf->{cpu_alloc} . '
792             ' . $conf->{cpu_limit} . '
793            
794            
795             ' . $conf->{mem_unit} . '
796             ' . $conf->{mem_alloc} . '
797 0           ' . $conf->{mem_limit} . "
798            
799             \n";
800             }
801              
802 0 0         my $href = $conf->{href} ? 'href="' . $conf->{href} . '"' : '';
803              
804             my $xml =
805             '
806             . $href
807             . ' name="'
808 0           . $conf->{name} . "\">\n"
809             . $desc
810             . $alloc
811             . $compute
812             . $nicquota
813             . $netquota
814             . $sp
815             . $res_mem
816             . $res_cpu
817             . $vcpu
818             . $thin
819             . $networkpool
820             . $pvdc
821             . $fast
822             . "\n";
823              
824 0           my $ret = $self->put( $url, 'application/vnd.vmware.admin.vdc+xml', $xml );
825              
826 0 0         return $ret->[2]->{href} if $ret->[1] == 201;
827 0           return $ret;
828             }
829              
830              
831             sub pvdc_get {
832 0     0 1   my $self = shift @_;
833 0           my $tmpl = shift @_;
834 0 0         $self->_debug("API: pvdc_get($tmpl)\n") if $self->{debug};
835 0 0         return $self->get( $tmpl =~ /^[^\/]+$/ ? $self->{url_base} . 'tmpl/' . $tmpl : $tmpl );
836             }
837              
838              
839             # http://pubs.vmware.com/vcd-51/topic/com.vmware.vcloud.api.reference.doc_51/doc/operations/GET-Task.html
840              
841             sub task_get {
842 0     0 1   my $self = shift @_;
843 0           my $href = shift @_;
844 0 0         $self->_debug("API: task_get($href)\n") if $self->{debug};
845 0           return $self->get($href);
846             }
847              
848              
849             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Foperations%2FGET-VAppTemplate.html
850              
851             sub template_get {
852 0     0 1   my $self = shift @_;
853 0           my $tmpl = shift @_;
854 0 0         $self->_debug("API: template_get($tmpl)\n") if $self->{debug};
855 0 0         return $self->get( $tmpl =~ /^[^\/]+$/ ? $self->{url_base} . 'tmpl/' . $tmpl : $tmpl );
856             }
857              
858              
859             # http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/operations/GET-VAppTemplateMetadata.html
860              
861             sub template_get_metadata {
862 0     0 1   my $self = shift @_;
863 0           my $href = shift @_;
864 0 0         $self->_debug("API: template_get_metadata($href)\n") if $self->{debug};
865 0           return $self->get( $href . '/metadata' );
866             }
867              
868              
869             sub vdc_get {
870 0     0 1   my $self = shift @_;
871 0           my $vdc = shift @_;
872 0 0         $self->_debug("API: vdc_get($vdc)\n") if $self->{debug};
873 0 0         return $self->get( $vdc =~ /^[^\/]+$/ ? $self->{url_base} . 'vdc/' . $vdc : $vdc );
874             }
875              
876              
877             sub vdc_list {
878 0     0 1   my $self = shift @_;
879 0 0         $self->_debug("API: vdc_list()\n") if $self->{debug};
880 0           return $self->get( $self->{learned}->{url}->{admin} . 'vdcs/query' );
881             }
882              
883              
884             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Ftypes%2FInstantiateVAppTemplateParamsType.html
885              
886             sub vapp_create_from_template {
887 0     0 1   my $self = shift @_;
888 0           my $url = shift @_;
889              
890 0           my $name = shift @_;
891 0           my $netid = shift @_;
892 0           my $fencemode = shift @_;
893 0           my $template_href = shift @_;
894 0           my $IpAddressAllocationMode = shift @_;
895              
896 0           my $vdcid = shift @_;
897 0           my $tmplid = shift @_;
898              
899 0 0         $self->_debug("API: vapp_create($url)\n") if $self->{debug};
900              
901             # XML to build
902              
903 0           my $xml =
904             ' 905             . $name
906             . '" xmlns="http://www.vmware.com/vcloud/v1.5" xmlns:ovf="http://schemas.dmtf.org/ovf/envelope/1" >
907             Example FTP Server vApp
908            
909            
910             Configuration parameters for vAppNetwork
911            
912            
913            
914             ' . $fencemode . '
915            
916            
917            
918            
919            
920             ';
921              
922 0           my $ret =
923             $self->post( $url, 'application/vnd.vmware.vcloud.instantiateVAppTemplateParams+xml',
924             $xml );
925 0           my $task_href = $ret->[2]->{Tasks}->[0]->{Task}->{task}->{href};
926 0 0         return wantarray ? ( $task_href, $ret ) : \( $task_href, $ret );
927             }
928              
929              
930             # http://pubs.vmware.com/vcd-51/topic/com.vmware.vcloud.api.doc_51/GUID-9E04772F-2BA9-42A9-947D-4EE7A05A6EE0.html
931              
932             sub vapp_create_from_sources {
933 0     0 1   my $self = shift @_;
934 0           my $url = shift @_;
935              
936 0           my $name = shift @_;
937 0           my $netid = shift @_;
938 0           my $fencemode = shift @_;
939 0           my $template_href = shift @_;
940 0           my $IpAddressAllocationMode = shift @_;
941              
942 0           my $vdcid = shift @_;
943 0           my $tmplid = shift @_;
944              
945 0 0         $self->_debug("API: vapp_create($url)\n") if $self->{debug};
946              
947             # XML to build
948 0           my $xml = '
949             950             . '" xmlns="http://www.vmware.com/vcloud/v1.5" xmlns:ovf="http://schemas.dmtf.org/ovf/envelope/1" >
951             Example FTP Server vApp
952            
953            
954             Configuration parameters for vAppNetwork
955            
956            
957            
958             ' . $fencemode . '
959            
960            
961            
962            
963            
964            
965             ';
966              
967 0           return $self->post( $url, 'application/vnd.vmware.vcloud.instantiateVAppTemplateParams+xml',
968             $xml );
969             }
970              
971              
972             sub vapp_get {
973 0     0 1   my $self = shift @_;
974 0           my $vapp = shift @_;
975 0           my $req;
976              
977 0 0         $self->_debug("API: vapp_get($vapp)\n") if $self->{debug};
978 0 0         return $self->get( $vapp =~ /^[^\/]+$/ ? $self->{url_base} . 'vApp/vapp-' . $vapp : $vapp );
979             }
980              
981              
982             # http://pubs.vmware.com/vcd-51/index.jsp?topic=%2Fcom.vmware.vcloud.api.reference.doc_51%2Fdoc%2Foperations%2FGET-VAppMetadata.html
983              
984             sub vapp_get_metadata {
985 0     0 1   my $self = shift @_;
986 0           my $href = shift @_;
987 0 0         $self->_debug("API: vapp_get_metadata($href)\n") if $self->{debug};
988 0           return $self->get( $href . '/metadata' );
989             }
990              
991              
992             # POST /vApp/{id}/action/recomposeVApp
993             # http://www.vmware.com/support/vcd/doc/rest-api-doc-1.5-html/types/RecomposeVAppParamsType.html
994              
995             sub vapp_recompose_add_vm {
996 0     0 1   my $self = shift @_;
997 0           my $vapp_name = shift @_;
998 0           my $vapp_href = shift @_;
999 0           my $vm_name = shift @_;
1000 0           my $vm_href = shift @_;
1001              
1002 0           my $network = shift @_;
1003 0           my $storageProfile = shift @_;
1004              
1005 0           my $desc = '';
1006              
1007 0           my $xml =
1008             '
1009             ' . $desc . '
1010            
1011            
1012            
1013             1
1014            
1015             ".$desc."
1016            
1017            
1018             ';
1019              
1020 0           return $self->post( $vapp_href . '/action/recomposeVApp',
1021             'application/vnd.vmware.vcloud.recomposeVAppParams+xml', $xml );
1022             }
1023              
1024             1;
1025              
1026             __END__