File Coverage

blib/lib/FusionInventory/Agent/SOAP/VMware.pm
Criterion Covered Total %
statement 96 136 70.5
branch 15 34 44.1
condition 1 5 20.0
subroutine 14 16 87.5
pod 4 4 100.0
total 130 195 66.6


line stmt bran cond sub pod time code
1             package FusionInventory::Agent::SOAP::VMware;
2              
3 4     4   4033340 use strict;
  4         19  
  4         149  
4 4     4   28 use warnings;
  4         14  
  4         169  
5              
6 4     4   18 use English qw(-no_match_vars);
  4         76  
  4         44  
7 4     4   4424 use XML::TreePP;
  4         18947  
  4         73  
8 4     4   1179 use LWP::UserAgent;
  4         50004  
  4         52  
9 4     4   4423 use HTTP::Cookies;
  4         39066  
  4         60  
10              
11 4     4   1338 use FusionInventory::Agent;
  4         10  
  4         133  
12 4     4   2644 use FusionInventory::Agent::SOAP::VMware::Host;
  4         11  
  4         57  
13              
14             sub new {
15 1     1 1 4014 my ($class, %params) = @_;
16              
17             my $self = {
18             url => $params{url},
19 1         13 tpp => XML::TreePP->new(force_array => [qw(returnval propSet)]),
20             };
21 1         10 bless $self, $class;
22              
23             # create user agent
24             $self->{ua} = LWP::UserAgent->new(
25             requests_redirectable => ['POST', 'GET', 'HEAD'],
26             agent => $FusionInventory::Agent::AGENT_STRING,
27 1   50     18 timeout => $params{timeout} || 180,
28             ssl_opts => { verify_hostname => 0 },
29             cookie_jar => HTTP::Cookies->new(ignore_discard => 1),
30             );
31              
32 1         35 return $self;
33             }
34              
35             sub _send {
36 7     7   18 my ( $self, $action, $xmlToSend ) = @_;
37              
38 7         68 my $req = HTTP::Request->new( POST => $self->{url} );
39 7         414 $req->content($xmlToSend);
40 7         166 $req->{_headers}->{soapaction} = "\"urn:vim25#" . $action . "\"";
41 7         29 $req->{_headers}->{accept} = [ 'text/xml', 'application/soap' ];
42 7         18 $req->{_headers}->{'content-length'} = length($xmlToSend);
43 7         17 $req->{_protocol} = 'HTTP/1.1';
44 7         31 $req->content_type('text/xml; charset=utf-8');
45              
46 7         201 my $res = $self->{ua}->request($req);
47              
48 7 50       13816 if ( $res->is_success ) {
49 7         86 return $res->content;
50             } else {
51 0         0 my $err = $res->content;
52 0         0 my $tmpRef = {};
53              
54 0         0 eval {
55 0         0 $err =~ s/.*(.*<\/faultstring>).*/$1/sg;
56 0         0 $tmpRef = $self->{tpp}->parse($err);
57             };
58              
59 0         0 my $errorString = $res->status_line;
60 0 0 0     0 if ( $tmpRef && $tmpRef->{faultstring} ) {
61 0         0 $errorString .= ": " . $tmpRef->{faultstring};
62             }
63 0         0 print STDERR $errorString . "\n";
64 0         0 $self->{lastError} = $errorString;
65 0         0 return;
66             }
67              
68 0         0 return 1;
69             }
70              
71             sub _parseAnswer {
72 7     7   64 my ( $self, $answer ) = @_;
73              
74 7 50       25 return unless $answer;
75              
76 7         21 local $INPUT_RECORD_SEPARATOR; # Set input to "slurp" mode.
77              
78             # We simplify the XML structure
79 7         15 my $pattern = '.*<\w+Response xmlns="urn:vim25">(.+).*$';
80 7         13819 $answer =~ s/$pattern/$1/sg,;
81 7         3800 $answer =~ s/ (xsi:|)type="[:\w]+"//sg;
82 7         3880 $answer =~ s/[[:cntrl:]]//g;
83 7         38 my $tmpRef = $self->{tpp}->parse($answer);
84              
85 7         2310552 my $ref = [];
86 7         17 foreach ( @{ $tmpRef->{returnval} } ) {
  7         26  
87 7 100       26 if ( $_->{propSet} ) {
88 5         21 my %tmp;
89 5         10 foreach my $p ( @{ $_->{propSet} } ) {
  5         18  
90 146 100       347 next unless $p->{val};
91 97         608 $tmp{ $p->{name} } = $p->{val};
92             }
93 5         26 push @$ref, \%tmp;
94             } else {
95 2         6 push @$ref, $_;
96             }
97             }
98              
99 7         142 return $ref;
100              
101             }
102              
103             sub connect {
104 1     1 1 57 my ( $self, $user, $password ) = @_;
105              
106 1         4 my $req = '
107            
108             xmlns:xsd="http://www.w3.org/2001/XMLSchema"
109             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
110            
111             <_this type="ServiceInstance">ServiceInstance
112             ';
113              
114 1         4 my $answer = $self->_send( 'ServiceInstance', $req );
115 1 50       26 return unless $answer;
116              
117 1         5 my $serviceInstance = $self->_parseAnswer($answer);
118 1 50       5 return unless $serviceInstance;
119              
120 1 50       4 if ( $serviceInstance->[0]{about}{apiType} eq 'VirtualCenter' ) {
121 0         0 $self->{vcenter} = 1; # TODO
122 0         0 $self->{sessionManager} = "SessionManager";
123 0         0 $self->{propertyCollector} = "propertyCollector";
124             } else {
125 1         3 $self->{vcenter} = 0;
126 1         2 $self->{sessionManager} = "ha-sessionmgr";
127 1         3 $self->{propertyCollector} = "ha-property-collector";
128             }
129              
130 1         3 $req = '
131            
132             xmlns:xsd="http://www.w3.org/2001/XMLSchema"
133             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
134            
135             <_this type="SessionManager">%s
136             %s%s';
137              
138             $answer = $self->_send(
139             'Login',
140 1         9 sprintf( $req, $self->{sessionManager}, $user, $password )
141             );
142 1 50       15 return unless $answer;
143 1 50       5 return if $answer =~ /ServerFaultCode/m;
144              
145 1         4 return $self->_parseAnswer($answer);
146              
147             }
148              
149             #sub getHostInfo {
150             # my ($self) = @_;
151             #
152             #
153             # my $req =
154             # '<_this type="ServiceInstance">ServiceInstance';
155             #
156             #
157             # my $answer = $self->_send('RetrieveServiceContent', 'RetrieveServiceContent', $req);
158             # my $ref = $self->_parseAnswer($answer);
159             #
160             # return $host;
161             #}
162              
163             sub _getVirtualMachineList {
164 0     0   0 my ($self) = @_;
165              
166 0         0 my $req =
167              
168             '
169            
170             xmlns:xsd="http://www.w3.org/2001/XMLSchema"
171             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
172            
173             <_this type="PropertyCollector">ha-property-collector
174             VirtualMachine0ha-folder-root
175             0folderTraversalSpecFolderchildEntity0folderTraversalSpecdatacenterHostTraversalSpecdatacenterVmTraversalSpecdatacenterDatastoreTraversalSpecdatacenterNetworkTraversalSpeccomputeResourceRpTraversalSpeccomputeResourceHostTraversalSpechostVmTraversalSpecresourcePoolVmTraversalSpecdatacenterDatastoreTraversalSpecDatacenterdatastoreFolder0folderTraversalSpecdatacenterNetworkTraversalSpecDatacenternetworkFolder0folderTraversalSpecdatacenterVmTraversalSpecDatacentervmFolder0folderTraversalSpecdatacenterHostTraversalSpecDatacenterhostFolder0folderTraversalSpeccomputeResourceHostTraversalSpecComputeResourcehost0computeResourceRpTraversalSpecComputeResourceresourcePool0resourcePoolTraversalSpecresourcePoolVmTraversalSpecresourcePoolTraversalSpecResourcePoolresourcePool0resourcePoolTraversalSpecresourcePoolVmTraversalSpechostVmTraversalSpecHostSystemvm0folderTraversalSpecresourcePoolVmTraversalSpecResourcePoolvm0
176             ';
177              
178 0         0 my $answer = $self->_send(
179             'RetrievePropertiesVMList',
180             $req
181             );
182 0         0 my $ref = $self->_parseAnswer($answer);
183 0         0 my @list;
184 0 0       0 if ( ref($ref) eq 'HASH' ) {
    0          
185 0         0 push @list, $ref;
186             }
187             elsif ($ref) {
188 0         0 @list = @{$ref};
  0         0  
189             }
190              
191 0         0 my @ids;
192 0         0 foreach (@list) {
193 0         0 push @ids, $_->{obj};
194             }
195              
196 0         0 return \@ids;
197              
198             }
199              
200             sub _getVirtualMachineById {
201 4     4   11 my ( $self, $id ) = @_;
202              
203 4         125 my $req = '
204            
205             xmlns:xsd="http://www.w3.org/2001/XMLSchema"
206             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
207            
208             <_this type="PropertyCollector">%s
209             VirtualMachine1%s
210            
211             ';
212              
213             my $answer = $self->_send(
214             'RetrieveProperties',
215 4         69 sprintf( $req, $self->{propertyCollector}, $id )
216             );
217 4 50       62 return [] unless $answer;
218              
219             # hack to preserve annotation / comment formating
220 4         283 $answer =~ s/\n/ /gm;
221              
222 4         13 my $ref = $self->_parseAnswer($answer);
223 4         17 return $ref;
224             }
225              
226             sub getHostFullInfo {
227 1     1 1 18926 my ( $self, $id ) = @_;
228              
229 1 50       5 $id = 'ha-host' unless $id;
230              
231 1         2 my $req = '
232            
233             xmlns:xsd="http://www.w3.org/2001/XMLSchema"
234             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
235            
236             <_this type="PropertyCollector">%s
237             HostSystem1%s
238            
239             ';
240              
241             my $answer = $self->_send(
242             'RetrieveProperties',
243 1         10 sprintf( $req, $self->{propertyCollector}, $id )
244             );
245 1         15 my $ref = $self->_parseAnswer($answer);
246 1         3 my $vms = [];
247 1         2 my $machineIdList;
248 1 50       5 if ( exists( $ref->[0]{vm}{ManagedObjectReference} ) ) { # ESX 3.5
249 1 50       5 if ( ref( $ref->[0]{vm}{ManagedObjectReference} ) eq 'ARRAY' ) {
250 1         4 $machineIdList = $ref->[0]{vm}{ManagedObjectReference};
251             } else {
252 0         0 push @$machineIdList, $ref->[0]{vm}{ManagedObjectReference};
253             }
254             } else {
255 0         0 $machineIdList = $self->_getVirtualMachineList();
256             }
257              
258             #$vm = $ref->[0]{vm};
259 1         4 foreach my $id (@$machineIdList) {
260 4         22 push @$vms, $self->_getVirtualMachineById($id);
261             }
262              
263 1         16 my $host = FusionInventory::Agent::SOAP::VMware::Host->new(
264             hash => $ref, vms => $vms
265             );
266 1         14 return $host;
267             }
268              
269             sub getHostIds {
270 0     0 1   my ($self) = @_;
271              
272 0 0         if ( !$self->{vcenter} ) {
273 0           return ['ha-host'];
274             }
275              
276 0           my $req = '
277            
278             xmlns:xsd="http://www.w3.org/2001/XMLSchema"
279             xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
280            
281             <_this type="PropertyCollector">propertyCollector
282             HostSystem0group-d1
283             0folderTraversalSpecFolderchildEntity0folderTraversalSpecdatacenterHostTraversalSpecdatacenterVmTraversalSpecdatacenterDatastoreTraversalSpecdatacenterNetworkTraversalSpeccomputeResourceRpTraversalSpeccomputeResourceHostTraversalSpechostVmTraversalSpecresourcePoolVmTraversalSpecdatacenterDatastoreTraversalSpecDatacenterdatastoreFolder0folderTraversalSpecdatacenterNetworkTraversalSpecDatacenternetworkFolder0folderTraversalSpecdatacenterVmTraversalSpecDatacentervmFolder0folderTraversalSpecdatacenterHostTraversalSpecDatacenterhostFolder0folderTraversalSpeccomputeResourceHostTraversalSpecComputeResourcehost0computeResourceRpTraversalSpecComputeResourceresourcePool0resourcePoolTraversalSpecresourcePoolVmTraversalSpecresourcePoolTraversalSpecResourcePoolresourcePool0resourcePoolTraversalSpecresourcePoolVmTraversalSpechostVmTraversalSpecHostSystemvm0folderTraversalSpecresourcePoolVmTraversalSpecResourcePoolvm0';
284              
285 0           my $answer = $self->_send('RetrieveProperties', sprintf($req) );
286 0           my $ref = $self->_parseAnswer($answer);
287              
288 0           my @ids;
289 0           foreach (@$ref) {
290 0           push @ids, $_->{obj};
291             }
292              
293 0           return \@ids;
294             }
295              
296             1;
297              
298             __END__