File Coverage

blib/lib/FusionInventory/Agent/SOAP/VMware.pm

Criterion	Covered	Total	%
statement	24	136	17.6
branch	0	34	0.0
condition	0	5	0.0
subroutine	8	16	50.0
pod	4	4	100.0
total	36	195	18.4

package FusionInventory::Agent::SOAP::VMware;

use strict;
use warnings;

use English qw(-no_match_vars);
use XML::TreePP;
use LWP::UserAgent;
use HTTP::Cookies;

use FusionInventory::Agent;
use FusionInventory::Agent::SOAP::VMware::Host;

sub new {
    my ($class, %params) = @_;

    my $self = {
        url => $params{url},
        tpp => XML::TreePP->new(force_array => [qw(returnval propSet)]),
    };
    bless $self, $class;

    # create user agent
    $self->{ua} = LWP::UserAgent->new(
        requests_redirectable => ['POST', 'GET', 'HEAD'],
        agent                 => $FusionInventory::Agent::AGENT_STRING,
        timeout               => $params{timeout} || 180,
        ssl_opts              => { verify_hostname => 0 },
        cookie_jar            => HTTP::Cookies->new(ignore_discard => 1),
    );

    return $self;
}

sub _send {
    my ( $self, $action, $xmlToSend ) = @_;

    my $req = HTTP::Request->new( POST => $self->{url} );
    $req->content($xmlToSend);
    $req->{_headers}->{soapaction}       = "\"urn:vim25#" . $action . "\"";
    $req->{_headers}->{accept}           = [ 'text/xml', 'application/soap' ];
    $req->{_headers}->{'content-length'} = length($xmlToSend);
    $req->{_protocol}                    = 'HTTP/1.1';
    $req->content_type('text/xml; charset=utf-8');

    my $res = $self->{ua}->request($req);

    if ( $res->is_success ) {
        return $res->content;
    } else {
        my $err    = $res->content;
        my $tmpRef = {};

        eval {
            $err =~ s/.*(.*<\/faultstring>).*/$1/sg;
            $tmpRef = $self->{tpp}->parse($err);
        };

        my $errorString = $res->status_line;
        if ( $tmpRef && $tmpRef->{faultstring} ) {
            $errorString .= ": " . $tmpRef->{faultstring};
        }
        print STDERR $errorString . "\n";
        $self->{lastError} = $errorString;
        return;
    }

    return 1;
}

sub _parseAnswer {
    my ( $self, $answer ) = @_;

    return unless $answer;

    local $INPUT_RECORD_SEPARATOR; # Set input to "slurp" mode.

    # We simplify the XML structure
    my $pattern = '.*<\w+Response xmlns="urn:vim25">(.+).*$';
    $answer =~ s/$pattern/$1/sg,;
    $answer =~ s/ (xsi:|)type="[:\w]+"//sg;
    $answer =~ s/[[:cntrl:]]//g;
    my $tmpRef = $self->{tpp}->parse($answer);

    my $ref = [];
    foreach ( @{ $tmpRef->{returnval} } ) {
        if ( $_->{propSet} ) {
            my %tmp;
            foreach my $p ( @{ $_->{propSet} } ) {
                next unless $p->{val};
                $tmp{ $p->{name} } = $p->{val};
            }
            push @$ref, \%tmp;
        } else {
            push @$ref, $_;
        }
    }

    return $ref;

}

sub connect {
    my ( $self, $user, $password ) = @_;

    my $req = '

                     xmlns:xsd="http://www.w3.org/2001/XMLSchema"
                     xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

<_this type="ServiceInstance">ServiceInstance
';

    my $answer = $self->_send( 'ServiceInstance', $req );
    return unless $answer;

    my $serviceInstance = $self->_parseAnswer($answer);
    return unless $serviceInstance;

    if ( $serviceInstance->[0]{about}{apiType} eq 'VirtualCenter' ) {
        $self->{vcenter}           = 1;                     # TODO
        $self->{sessionManager}    = "SessionManager";
        $self->{propertyCollector} = "propertyCollector";
    } else {
        $self->{vcenter}           = 0;
        $self->{sessionManager}    = "ha-sessionmgr";
        $self->{propertyCollector} = "ha-property-collector";
    }

    $req = '

        xmlns:xsd="http://www.w3.org/2001/XMLSchema"
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

        <_this type="SessionManager">%s
        %s%s';

    $answer = $self->_send(
        'Login',
        sprintf( $req, $self->{sessionManager}, $user, $password )
    );
    return unless $answer;
    return if $answer =~ /ServerFaultCode/m;

    return $self->_parseAnswer($answer);

}

#sub getHostInfo {
#    my ($self) = @_;
#
#
#    my $req =
#        '<_this type="ServiceInstance">ServiceInstance';
#
#
#    my $answer = $self->_send('RetrieveServiceContent', 'RetrieveServiceContent', $req);
#    my $ref = $self->_parseAnswer($answer);
#
#    return $host;
#}

sub _getVirtualMachineList {
    my ($self) = @_;

    my $req =

      '

        xmlns:xsd="http://www.w3.org/2001/XMLSchema"
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

        <_this type="PropertyCollector">ha-property-collector
        VirtualMachine0ha-folder-root
        0folderTraversalSpecFolderchildEntity0folderTraversalSpecdatacenterHostTraversalSpecdatacenterVmTraversalSpecdatacenterDatastoreTraversalSpecdatacenterNetworkTraversalSpeccomputeResourceRpTraversalSpeccomputeResourceHostTraversalSpechostVmTraversalSpecresourcePoolVmTraversalSpecdatacenterDatastoreTraversalSpecDatacenterdatastoreFolder0folderTraversalSpecdatacenterNetworkTraversalSpecDatacenternetworkFolder0folderTraversalSpecdatacenterVmTraversalSpecDatacentervmFolder0folderTraversalSpecdatacenterHostTraversalSpecDatacenterhostFolder0folderTraversalSpeccomputeResourceHostTraversalSpecComputeResourcehost0computeResourceRpTraversalSpecComputeResourceresourcePool0resourcePoolTraversalSpecresourcePoolVmTraversalSpecresourcePoolTraversalSpecResourcePoolresourcePool0resourcePoolTraversalSpecresourcePoolVmTraversalSpechostVmTraversalSpecHostSystemvm0folderTraversalSpecresourcePoolVmTraversalSpecResourcePoolvm0
        ';

    my $answer = $self->_send(
        'RetrievePropertiesVMList',
        $req
    );
    my $ref = $self->_parseAnswer($answer);
    my @list;
    if ( ref($ref) eq 'HASH' ) {
        push @list, $ref;
    }
    elsif ($ref) {
        @list = @{$ref};
    }

    my @ids;
    foreach (@list) {
        push @ids, $_->{obj};
    }

    return \@ids;

}

sub _getVirtualMachineById {
    my ( $self, $id ) = @_;

    my $req = '

        xmlns:xsd="http://www.w3.org/2001/XMLSchema"
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

        <_this type="PropertyCollector">%s
        VirtualMachine1%s

        ';

    my $answer = $self->_send(
        'RetrieveProperties',
        sprintf( $req, $self->{propertyCollector}, $id )
    );
    return [] unless $answer;

    # hack to preserve  annotation / comment formating
    $answer =~ s/\n/
/gm;

    my $ref = $self->_parseAnswer($answer);
    return $ref;
}

sub getHostFullInfo {
    my ( $self, $id ) = @_;

    $id = 'ha-host' unless $id;

    my $req = '

        xmlns:xsd="http://www.w3.org/2001/XMLSchema"
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

        <_this type="PropertyCollector">%s
        HostSystem1%s

        ';

    my $answer = $self->_send(
        'RetrieveProperties',
        sprintf( $req, $self->{propertyCollector}, $id )
    );
    my $ref = $self->_parseAnswer($answer);
    my $vms = [];
    my $machineIdList;
    if ( exists( $ref->[0]{vm}{ManagedObjectReference} ) ) {    # ESX 3.5
        if ( ref( $ref->[0]{vm}{ManagedObjectReference} ) eq 'ARRAY' ) {
            $machineIdList = $ref->[0]{vm}{ManagedObjectReference};
        } else {
            push @$machineIdList, $ref->[0]{vm}{ManagedObjectReference};
        }
    } else {
        $machineIdList = $self->_getVirtualMachineList();
    }

    #$vm = $ref->[0]{vm};
    foreach my $id (@$machineIdList) {
        push @$vms, $self->_getVirtualMachineById($id);
    }

    my $host = FusionInventory::Agent::SOAP::VMware::Host->new(
        hash => $ref, vms => $vms
    );
    return $host;
}

sub getHostIds {
    my ($self) = @_;

    if ( !$self->{vcenter} ) {
        return ['ha-host'];
    }

    my $req = '

                     xmlns:xsd="http://www.w3.org/2001/XMLSchema"
                     xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">

<_this type="PropertyCollector">propertyCollector
HostSystem0group-d1
0folderTraversalSpecFolderchildEntity0folderTraversalSpecdatacenterHostTraversalSpecdatacenterVmTraversalSpecdatacenterDatastoreTraversalSpecdatacenterNetworkTraversalSpeccomputeResourceRpTraversalSpeccomputeResourceHostTraversalSpechostVmTraversalSpecresourcePoolVmTraversalSpecdatacenterDatastoreTraversalSpecDatacenterdatastoreFolder0folderTraversalSpecdatacenterNetworkTraversalSpecDatacenternetworkFolder0folderTraversalSpecdatacenterVmTraversalSpecDatacentervmFolder0folderTraversalSpecdatacenterHostTraversalSpecDatacenterhostFolder0folderTraversalSpeccomputeResourceHostTraversalSpecComputeResourcehost0computeResourceRpTraversalSpecComputeResourceresourcePool0resourcePoolTraversalSpecresourcePoolVmTraversalSpecresourcePoolTraversalSpecResourcePoolresourcePool0resourcePoolTraversalSpecresourcePoolVmTraversalSpechostVmTraversalSpecHostSystemvm0folderTraversalSpecresourcePoolVmTraversalSpecResourcePoolvm0';

    my $answer = $self->_send('RetrieveProperties', sprintf($req) );
    my $ref = $self->_parseAnswer($answer);

    my @ids;
    foreach (@$ref) {
        push @ids, $_->{obj};
    }

    return \@ids;
}

1;

__END__