#
# © Copyright 2009 Hewlett-Packard Development Company, L.P.
# EPL license http://www.eclipse.org/legal/epl-v10.html
#

## API for talking to HP Onboard Administrator

## NOTE:
## All parameters are passed by name!
## For example:
## 	hpoa->new(oaAddress => '16.129.49.209');

package xCAT::hpoa;

use strict;

#use SOAP::Lite;	# hpblade.pm requires SOAP::Lite before requiring hpoa.pm, so we can check for SOAP::Lite dynamically
use vars qw(@ISA);
@ISA = qw(SOAP::Lite);

# Constructor
# Input: oaAddress, the IP address of the OA
# Output: SOAP::SOM object (SOAP response)
sub new {
    my $class = shift;
    return $class if ref $class;

    my $self = $class->SUPER::new();

    my %args = @_;

    die "oaAddress is a required parameter"
      unless defined $args{oaAddress};

    # Some info we'll need
    $self->{HPOA_HOST} = $args{oaAddress};  # OA IP address
    $self->{HPOA_KEY}  = undef;             # oaSessionKey returned by userLogIn
    $self->{HPOA_SECURITY_XML}    = undef;  # key placed in proper XML
    $self->{HPOA_SECURITY_HEADER} = undef;  # XML translated to SOAP::Header obj

    bless($self, $class);

    # We contact the OA via this URL:
    my $proxy = "https://" . $self->{HPOA_HOST} . ":443/hpoa";

    # One of the cool things about SOAP::Lite is that almost every
    # method returns $self.  This allows you to string together
    # as many calls as you need, like this:
    $self

      # keep the XML formatted for human readability, in case
      # we ever have to look at it (unlikely)
      ->readable(1)

      # Need to tell SOAP about some namespaces.  I don't know if they
      # are all necessary or not, but I got them from the hpoa.wsdl
      ->ns("http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd", "wsu")
      ->ns('http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd', "wsse")
      ->ns('http://www.w3.org/2001/XMLSchema-instance', 'xsi')
      ->ns('http://www.w3.org/2003/05/soap-encoding',   'SOAP-ENC')
      ->ns('http://www.w3.org/2003/05/soap-envelope',   'SOAP-ENV')
      ->ns('http://www.w3.org/2001/XMLSchema',          'xsd')
      ->default_ns("hpoa.xsd", "hpoa")

      # Inform SOAP of the OA URL
      ->proxy($proxy);

    return $self;
}

# Method: call
# Input: method and a hash of method's input params (see below)
# Output: SOAP::SOM object (SOAP response)
#
# All methods in the OA API end up getting called by this routine,
# even though the user invokes them directly using the method name.
# For example, code that looks like this:
# 	$hpoa->userLogIn(username=>$name, password=>$pass)
# results in this call:
#	$hpoa->call('userLogIn', username=>$name, password=>$pass)
sub call {
    my ($self, $method, %args) = @_;

    #
    # Each item of %args is of the form:
    #    ($name => $value).
    #
    # $value is usually a scalar and SOAP::Lite infers a type.
    #
    # If the value needs to be explicitly typed, the $value should be a
    # reference to an array of the form:
    #    [ $scalar, $type ]
    # This should work for any parameter that you want to explicitly
    # type, but for some reason the OA was not having any of it the
    # last time I tried.
    #
    # If the method calls for an array of values, the $value should be
    # a reference to an array of the form:
    #    [ $itemName, $itemArrayRef, $itemType ]
    #
    # If the method calls for more complicated structure, the $value
    # should be a reference to a hash of the form:
    #    { name1 => value1, name2 => value2 ... }
    # The values can themselves be scalars, array refs or hash refs,
    # which will themselves be processed recursively.
    #

    # Put the params in a form SOAP likes.
    my @soapargs = ();
    while (my ($k, $v) = each %args) {
        push @soapargs, $self->process_args($k, $v);
    }

    # This is required if there are no params, otherwise SOAP::Lite
    # makes an XML construct that the OA doesn't like.
    @soapargs = SOAP::Data->type('xml' => undef)
      unless @soapargs;

    # Add the security header if it's not the login method.
    # I'm hoping that the header will be ignored by the few methods
    # that don't require security.
    push(@soapargs, $self->{HPOA_SECURITY_HEADER})
      unless ($method eq 'userLogIn') || !defined $self->{HPOA_SECURITY_HEADER};

    # Make sure we're using the correct version of SOAP, but
    # don't mess up packages that use a different version.
    my $version = xCAT::hpoa->soapversion();
    xCAT::hpoa->soapversion('1.2');

    # Call the method and put the response in $r
    my $r = $self->SUPER::call($method, @soapargs);

    # Reset the SOAP version
    xCAT::hpoa->soapversion($version);

    # If this was the login method and it was successful, then extract
    # the session key and remember it for subsequent calls.
    if ($method eq 'userLogIn' && !$r->fault) {

        my $key = $r->result()->{oaSessionKey};

        # Got this XML code from the HP Insight Onboard Administrator SOAP
        # Interface Guide 0.9.7
        my $xml = '
<wsse:Security xmlns:wsse="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-secext-1.0.xsd" SOAP-ENV:mustUnderstand="true">
  <hpoa:HpOaSessionKeyToken xmlns:hpoa="hpoa.xsd">
     <hpoa:oaSessionKey>'
          . $key .
          '</hpoa:oaSessionKey>
  </hpoa:HpOaSessionKeyToken>
</wsse:Security>';

        $self->{HPOA_KEY}             = $key;
        $self->{HPOA_SECURITY_XML}    = $xml;
        $self->{HPOA_SECURITY_HEADER} = SOAP::Header->type('xml' => $xml);
    }

    # Return the response
    return $r;
}

## Create the correct SOAP::Data structure for the given args
## $n is the argument name
## $v is the value and can be of the following 4 forms:
##   $scalar
##	- A scalar value.  No further processing takes place.
##	  Produces: <name>value</name>
##   [ $scalar, $type ]
##	- An array ref containing a scalar value and type.  No further
##	  will take place.
##	  Produces: <name type=aType>value</name>
##   [ $itemName, $aref, $type ]
##	- An array ref containing the name for the elements, the elements
##	  themselves in an array ref, and the type for the elements.  The
##	  elements themselves can be processed.
##	  Produces: <name>
##		      <item type=aType>value1</item>
##		      <item type=aType>value2</item>
##		    </name>
##   { $n1 => $v1, $n2 => $v2 ... }
##	- A hash ref containing name value pairs that can themselves
##	  be processed.
##	  Produces: <name>
##		      <n1>v1</n1>
##		      <n2>v2</n2>
##	 	    </name>

sub process_args {
    my ($self, $n, $v, $t) = @_;
    print "process args: $n => $v\n" if 0;

    if (!ref $v) {    # untyped scalar
        print "\nUNTYPED SCALAR: $n => $v\n" if 0;
        return SOAP::Data->new(name => $n, value => $v, type => '');
    }

    if (ref $v eq 'HASH') {    # structure
        my ($nn, $vv, @ar);
        while (($nn, $vv) = each %$v) {
            print "\nSTRUCTURE $n: $nn => $vv\n" if 0;
            unshift @ar, $self->process_args($nn, $vv);
        }
        return SOAP::Data->name($n => \SOAP::Data->value(@ar));
    }

    if (ref $v eq 'ARRAY') {

        if (scalar @$v == 2) {    # typed scalar
            my ($value, $type) = @$v;
            print "\nTYPED SCALAR: $n => $value ($type)\n" if 0;
            return SOAP::Data->new(name => $n, value => $value, type => $type);
        }

        # Else an array of values
        my ($itemName, $aref, $type) = @$v;
        my (@ar, $item);
        foreach $item (@$aref) {
            if (ref $item eq 'HASH') {
                print "\nSUB STRUCTURE $n: $itemName => $item ($type)\n" if 0;
                unshift @ar, $self->process_args("$itemName", $item);
            } else {
                print "\nARRAY $n: $itemName => $item ($type)\n" if 0;
                unshift @ar, $self->process_args($itemName, [ $item, $type ]);
            }
        }
        return SOAP::Data->name($n => \SOAP::Data->value(@ar));
    }

    die "Unexpected input parameter value: $n => $v\n";
}

###
### Special fault info for OAs
###

# The OA uses it's own fault data structures.  The simple
# fault methods provided by SOAP::Lite are usually undef.
# The OA's fault data looks like this:
# {
#   'Detail' => {
#      'faultInfo' => {
#         'operationName' => 'userLogIn',
#         'errorText' => 'The user could not be authenticated.',
#         'errorCode' => '150',
#         'errorType' => 'USER_REQUEST'
#      }
#   },
#   'Reason' => {
#      'Text' => 'User Request Error'
#   },
#   'Code' => {
#      'Value' => 'SOAP-ENV:Sender'
#   }
#}
#
# In your code, you should generally check that $response->fault
# is defined, then print $response->oaErrorMessage.
# If you know the codes, you can act on $response->oaErrorCode
#

# The OA's fault structure
sub SOAP::SOM::oaFaultInfo {
    my ($self, @args) = @_;

    return $self->fault->{Detail}->{faultInfo}
      if (defined $self->fault &&
        defined $self->fault->{Detail} &&
        defined $self->fault->{Detail}->{faultInfo});

    return undef;
}

# The name of the method producing the fault
sub SOAP::SOM::oaOperationName {
    my ($self, @args) = @_;

    my $oafi = $self->oaFaultInfo;

    return $oafi->{operationName}
      if defined $oafi &&
      defined $oafi->{operationName};

    return undef;
}

# Text of the OA fault
sub SOAP::SOM::oaErrorText {
    my ($self, @args) = @_;

    my $oafi = $self->oaFaultInfo;

    return $oafi->{errorText}
      if defined $oafi &&
      defined $oafi->{errorText};

    return undef;
}

# Numeric code of the OA fault
sub SOAP::SOM::oaErrorCode {
    my ($self, @args) = @_;

    my $oafi = $self->oaFaultInfo;

    if (defined $oafi) {

        return $oafi->{errorCode}
          if defined $oafi->{errorCode};

        return $oafi->{internalErrorCode}
          if defined $oafi->{internalErrorCode};
    }

    return undef;
}

# Bay Number of the OA fault
sub SOAP::SOM::oaOperationBayNumber {
    my ($self, @args) = @_;

    my $oafi = $self->oaFaultInfo;

    return $oafi->{operationBayNumber}
      if defined $oafi &&
      defined $oafi->{operationBayNumber};

    return undef;
}

# Sometimes there's extra fault information
# (Haven't seen any yet!)
sub SOAP::SOM::oaExtraFaultData {
    my ($self, @args) = @_;

    my $oafi = $self->oaFaultInfo;

    return $oafi->{extraData}
      if defined $oafi &&
      defined $oafi->{extraData};

    return undef;
}

# Nicely formatted error message for human consumption.
# Tries to use the oaErrorText and oaErrorCode, if defined,
# else uses the reason text.
sub SOAP::SOM::oaErrorMessage {
    my ($self, @args) = @_;

    my $errorText = $self->oaErrorText;

    # Reason text is either an error message from SOAP (as when
    # the method or argument doesn't exist), or it's a formatted
    # form of the faultInfo->errorType enumeration.
    my $reasonText = $self->fault->{Reason}->{Text};

    return $reasonText
      unless defined $errorText;

    my $operationName = $self->oaOperationName;
    my $operationBay  = $self->oaOperationBayNumber;
    my $errorCode     = $self->oaErrorCode;
    my $extraData     = $self->oaExtraFaultData;

    my $operation = "'$operationName' call";
    $operation .= " on bay $operationBay"
      if $operationBay;

    my $completeText =
      "$reasonText $errorCode during $operation: $errorText";
    $completeText .= "\n\t$extraData" if $extraData;

    return $completeText;
}

1;
