File Coverage

blib/lib/Net/ILO.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package Net::ILO;

use strict;
use warnings;

use Carp;
use Data::Dumper;
use English qw(-no_match_vars);
use IO::Socket::SSL;
use XML::Simple;

our $VERSION = '0.54';


my $METHOD_UNSUPPORTED = 'Method not supported by this iLO version';


sub address {

    my $self = shift;

    if (@_) {
        $self->{address} = shift;
    }

    return $self->{address};

}


sub add_user {

    my $self = shift;

    if (@_) {

        my $arg_ref = shift;

        my $user_name     = $arg_ref->{name}     or croak 'name required';
        my $user_login    = $arg_ref->{username} or croak 'username required';
        my $user_password = $arg_ref->{password} or croak 'password required';

        my $user_admin          = $arg_ref->{admin}                    || 'No';
        my $user_can_remote     = $arg_ref->{remote_console_privilege} || 'No';
        my $user_can_reset      = $arg_ref->{reset_privilege}          || 'No';
        my $user_can_virtual    = $arg_ref->{virtual_media_privilege}  || 'No';
        my $user_can_config     = $arg_ref->{config_ilo_privilege}     || 'No';
        my $user_can_view_logs  = $arg_ref->{view_logs_privilege}      || 'No';
        my $user_can_clear_logs = $arg_ref->{clear_logs_privilege}     || 'No';
        my $user_can_update     = $arg_ref->{update_ilo_privilege}     || 'No';

        my $ilo_command = qq|












        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

    }
    else {

        croak 'add_user() requires parameters';

    }

    return 1;

}


sub biosdate {

    my $self = shift;

    if (!$self->{biosdate}) {
        $self->_populate_host_data or return;
    }

    return $self->{biosdate};

}


sub cpus {

    my $self = shift;

    if (!$self->{cpus}) {
        $self->_populate_host_data or return;
    }

    return $self->{cpus};

}


sub del_user {

    my $self = shift;

    if (@_) {

        my $user_login = shift;

        my $ilo_command = qq|



        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

    }
    else {

        croak 'del_user() requires the username to delete';

    }

    return 1;

}


sub dhcp_enabled {

    my $self = shift;

    if (!$self->{dhcp_enable}) {
        $self->_populate_network_settings or return;
    }

    return $self->{dhcp_enable};

}


sub domain_name {

    my $self = shift;

    if (!$self->{domain_name}) {
        $self->_populate_network_settings or return;
    }

    return $self->{domain_name};

}


sub error {

    my $self = shift;

    if (@_) {
        $self->{error} = shift;
    }

    return $self->{error};

}


sub fans {

    my $self = shift;

    if (!$self->{fans}) {
        $self->_populate_embedded_health or return;
    }

    return $self->{fans};

}


sub fw_date {

    my $self = shift;

    if (!$self->{fw_date}) {
        $self->_populate_fw_version or return;
    }

    return $self->{fw_date};

}


sub fw_type {

    my $self = shift;

    if (!$self->{fw_type}) {
        $self->_populate_fw_version or return;
    }

    return $self->{fw_type};

}


sub fw_version {

    my $self = shift;

    if (!$self->{fw_version}) {
        $self->_populate_fw_version or return;
    }

    return $self->{fw_version};

}


sub gateway {

    my $self = shift;

    if (!$self->{gateway_ip_address}) {
        $self->_populate_network_settings or return;
    }

    return $self->{gateway_ip_address};

}


sub hostname {

    my $self = shift;

    if (!$self->{dns_name}) {
        $self->_populate_network_settings or return;
    }

    return $self->{dns_name};

}


sub http_port {

    my $self = shift;

    if (@_) {

        my $http_port = shift;

        _port_is_valid($http_port) or croak "HTTP port must be an integer between 0 and 65535";

        my $ilo_command = qq|





        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

        $self->{http_port} = $http_port;

    }

    if (!$self->{http_port}) {
        $self->_populate_global_settings or return;
    }

    return $self->{http_port};

}


sub https_port {

    my $self = shift;

    if (@_) {

        my $https_port = shift;

        _port_is_valid($https_port) or croak "HTTPS port must be an integer between 0 and 65535";

        my $ilo_command = qq|





        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

        $self->{https_port} = $https_port;

    }

    if (!$self->{https_port}) {
        $self->_populate_global_settings or return;
    }

    return $self->{https_port};

}


sub ip_address {

    my $self = shift;

    if (!$self->{ip_address}) {
        $self->_populate_network_settings or return;
    }

    return $self->{ip_address};

}


sub license {

    my $self = shift;

    if (@_) {

        my $license_key = shift;

        my $ilo_command = qq|





        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

    }
    else {

        croak 'license() requires the license key as a paramater';

    }

    return 1;

}


sub mac01 {

    my $self = shift;

    if (!$self->{mac01}) {
        $self->_populate_host_data or return;
    }

    if ($self->{mac01}) {
        return $self->{mac01};
    }
    else {
        $self->error($METHOD_UNSUPPORTED);
        return;
    }

}


sub mac02 {

    my $self = shift;

    if (!$self->{mac02}) {
        $self->_populate_host_data or return;
    }

    if ($self->{mac02}) {
        return $self->{mac02};
    }
    else {
        $self->error($METHOD_UNSUPPORTED);
        return;
    }

}


sub mac03 {

    my $self = shift;

    # if mac01 is defined but mac03 isn't we aren't going to get it
    # this time around either

    if (!$self->{mac03} && !$self->{mac01}) {
        $self->_populate_host_data or return;
    }

    if ($self->{mac03}) {
        return $self->{mac03};
    }
    else {
        $self->error($METHOD_UNSUPPORTED);
        return;
    }

}


sub mac04 {

    my $self = shift;

    # see above

    if (!$self->{mac04} && !$self->{mac01}) {
        $self->_populate_host_data or return;
    }

    if ($self->{mac04}) {
        return $self->{mac04};
    }
    else {
        $self->error($METHOD_UNSUPPORTED);
        return;
    }

}


sub macilo {

    my $self = shift;

    if (!$self->{macilo}) {
        $self->_populate_host_data or return;
    }

    if ($self->{macilo}) {
        return $self->{macilo};
    }
    else {
        $self->error($METHOD_UNSUPPORTED);
        return;
    }

}


sub model {

    my $self = shift;

    if (!$self->{model}) {
        $self->_populate_host_data or return;
    }

    return $self->{model};

}


sub mod_user {

    my $self = shift;

    if (@_) {

        my $arg_ref = shift;

        my $mod_username = $arg_ref->{username} || $self->username;
        my $mod_password = $arg_ref->{password} || $self->password;

        if (!$mod_username && !$mod_password) {

            croak "mod_user requires username to modify and new password";

        }

        my $ilo_command = qq|





        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

        if ($self->username eq $mod_username) {

            $self->password($mod_password);

        }

    }
    else {

        croak "mod_user() requires parameters";

    }


    return 1;

}


sub network {

    my $self = shift;

    if (@_) {

        my $arg_ref = shift;

        my $domain_name = $arg_ref->{domain_name}   || $self->domain_name   or croak "domain_name not set";
        my $dns_name    = $arg_ref->{hostname}      || $self->hostname      or croak "name not set";
        my $dhcp_enable = $arg_ref->{dhcp_enabled}  || $self->dhcp_enabled  or croak "dhcp_enabled not set";
        my $ip_address  = $arg_ref->{ip_address}    || $self->ip_address    or croak "ip_address not set";
        my $subnet_mask = $arg_ref->{subnet_mask}   || $self->subnet_mask   or croak "subnet_mask not set";
        my $gateway     = $arg_ref->{gateway}       || $self->gateway       or croak "gateway not set";

        my $ilo_command = qq|










        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

        # force module to refresh new settings from the remote server
        foreach my $option_changed (keys %$arg_ref) {

            delete $self->{$option_changed};

        }

        # if IP was changed it should be updated, if not this won't hurt
        $self->address($ip_address);

    }

    return 1;

}


sub new {

    my ($class) = shift;

    # RT #65352: allow hash or hashref constructor args
    my %options = ref $_[0] ? %{$_[0]} : @_;

    my $self = {};

    bless($self, $class);

    $self->address(  $options{address}  );
    $self->username( $options{username} );
    $self->password( $options{password} );

    if ($options{port}) {
        $self->port($options{port});
    }
    else {
        $self->port(443);
    }

    # iLO version will be autodetected later if not specified
    $self->{_version} = $options{version} || undef;
    $self->{_debug}   = $options{debug}   || '0';

    return $self;

}


sub password {

    my $self = shift;

    if ( @_ ) {
        $self->{password} = shift;
    }

    return $self->{password};

}


sub port {

    my $self = shift;

    if (@_) {
        my $port = shift;

        _port_is_valid($port) or croak "Port must be an integer between 0 and 65535";

        $self->{port} = $port;
    }

    return $self->{port};

}


sub power {

    my $self = shift;

    if ( @_ ) {

        my $state_requested = shift;

        my $ilo_command;

        if (lc($state_requested) eq 'on') {

            $ilo_command = $self->_generate_cmd('power_on');

        }
        elsif (lc($state_requested) eq 'off') {

            $ilo_command = $self->_generate_cmd('power_off');

        }
        elsif (lc($state_requested) eq 'reset') {

            $ilo_command = $self->_generate_cmd('power_reset');

        }
        else {

            croak "State '$state_requested' is not valid";

        }

        my $response = $self->_send($ilo_command)   or return;
        my $xml      = $self->_serialize($response) or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

        return $state_requested;

    }

    my $ilo_command = $self->_generate_cmd('power_status');

    my $response    = $self->_send($ilo_command)   or return;
    my $xml         = $self->_serialize($response) or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return;
    }

    my $state = $xml->{GET_HOST_POWER}->{HOST_POWER};

    if (!$state) {
        $self->error('Invalid response from remote ilo');
        return;
    }

    return lc($state);

}


sub power_consumption {

    my $self = shift;

    my $ilo_command = $self->_generate_cmd('power_consumption');

    my $response    = $self->_send($ilo_command)    or return;
    my $xml         = $self->_serialize($response)  or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return unless $errmsg =~ /^Syntax error/;
    }

    if ($self->{power_consumption} = $xml->{GET_POWER_READINGS}->{PRESENT_POWER_READING}->{VALUE}) {

        return $self->{power_consumption};

    }
    else {

        $self->error($METHOD_UNSUPPORTED);
        return;

    }

}


sub power_supplies {

    my $self = shift;

    if (!$self->{power_supplies}) {
        $self->_populate_embedded_health or return;
    }

    return $self->{power_supplies};

}


sub ramslots {

    my $self = shift;

    if (!$self->{ramslots}) {
        $self->_populate_host_data or return;
    }

    return $self->{ramslots};

}


sub reset {

    my $self = shift;

    my $ilo_command = $self->_generate_cmd('reset');

    my $response    = $self->_send($ilo_command)   or return;
    my $xml         = $self->_serialize($response) or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return;
    }

    return 1;

}


sub serialID {

    my $self = shift;

    if (!$self->{serialID}) {
        $self->_populate_host_data or return;
    }

    return $self->{serialID};

}


sub session_timeout {

    my $self = shift;

    if (!$self->{session_timeout}) {
        $self->_populate_global_settings or return;
    }

    return $self->{session_timeout};

}


sub ssh_port {

    my $self = shift;

    if (@_) {

        my $ssh_port = shift;

        _port_is_valid($ssh_port) or croak "ssh_port must be an integer between 0 and 65535";

        my $ilo_command = qq|





        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

        $self->{ssh_port} = $ssh_port;

    }

    if (!$self->{ssh_port}) {
        $self->_populate_global_settings or return;
    }

    return $self->{ssh_port};

}


sub ssh_status {

    my $self = shift;

    if (@_) {

        my $ssh_status = shift;

        my $ilo_command = qq|





        |;

        $ilo_command    = $self->_wrap($ilo_command);
        my $response    = $self->_send($ilo_command)    or return;
        my $xml         = $self->_serialize($response)  or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

        $self->{ssh_status} = $ssh_status;

    }

    if (!$self->{ssh_status}) {
        $self->_populate_global_settings or return;
    }

    return $self->{ssh_status};

}


sub subnet_mask {

    my $self = shift;

    if (!$self->{subnet_mask}) {
        $self->_populate_network_settings or return;
    }

    return $self->{subnet_mask};

}


sub temperatures {

    my $self = shift;

    if (!$self->{temperatures}) {
        $self->_populate_embedded_health or return;
    }

    return $self->{temperatures};

}


sub uid {

    my $self = shift;

    if (@_) {

        my $state_requested = shift;

        my $ilo_command;

        if ($state_requested eq 'on') {

            $ilo_command = $self->_generate_cmd('uid_on');

        }
        elsif ($state_requested eq 'off') {

            $ilo_command = $self->_generate_cmd('uid_off');

        }
        else {

            $self->error("State '$state_requested' is not valid");
            return;

        }

        my $response = $self->_send($ilo_command)   or return;
        my $xml      = $self->_serialize($response) or return;

        if ( my $errmsg = _check_errors($xml) ) {
            $self->error($errmsg);
            return;
        }

        return $state_requested;

    }

    my $ilo_command = $self->_generate_cmd('uid_status');

    my $response    = $self->_send($ilo_command)    or return;
    my $xml         = $self->_serialize($response)  or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return;
    }

    my $uid_status = $xml->{GET_UID_STATUS}->{UID};

    return lc($uid_status);

}


sub username {

    my $self = shift;

    if (@_) {
        $self->{username} = shift;
    }

    return $self->{username};

}


sub _check_errors {

    my $xml = shift;

    my $errcode = $xml->{RESPONSE}->{STATUS};
    my $errmsg  = $xml->{RESPONSE}->{MESSAGE};

    if ($errcode ne '0x0000') {
        return $errmsg;
    }
    else {
        return;
    }

}


sub _connect {

    my $self = shift;

    if ($self->{_client}) {
        return $self->{_client};
    }

    my $address = $self->address or croak "Can't connect: address not set";
    my $port    = $self->port    or croak "Can't connect: port not set";

    $self->{_client} = IO::Socket::SSL->new(
        PeerAddr => "$address:$port",
    );

    if (!$self->{_client}) {
        $self->error( "Unable to establish SSL connection with $address:$port [" . IO::Socket::SSL::errstr() . "]" );
        return;
    }

    return $self->{_client};

}


sub _debug {

    my $self = shift;

    if (@_) {
        $self->{_debug} = shift;
    }

    return $self->{_debug};

}


sub _detect_version {

    my $self = shift;

    # iLO 3 has a slightly different interface; it requires that
    # you preface commands with an HTTP header

    my $ilo_command = qq(
        POST /ribcl HTTP/1.1
        HOST: localhost
        Content-length: 30
        Connection: Close


    );

    my $response = $self->_send($ilo_command) or return;

    if ($response =~ /^HTTP\/1.1 200 OK/) {
        return 3;
    }
    else {
        return 2;
    }

}


sub _disconnect {

    my $self = shift;

    my $client = $self->{_client} or return;

    $client->close;

    delete $self->{_client};

    return 1;

}


sub _generate_cmd {

    my ($self, $command) = @_;

    my %commands = (

        'get_embedded_health'   => qq(

                                        ),

        'get_fw_version'        => qq(

                                        ),

        'get_global_settings'   => qq(

                                        ),

        'get_host_data'         => qq(

                                        ),

        'get_network_settings'  => qq(

                                        ),

        'power_consumption'     => qq(

                                        ),

        'power_off'             => qq(

                                        ),

        'power_on'              => qq(

                                        ),

        'power_reset'           => qq(

                                        ),

        'power_status'          => qq(

                                        ),

        'reset'                 => qq(

                                        ),

        'uid_off'               => qq(

                                        ),

        'uid_on'                => qq(

                                        ),

        'uid_status'            => qq(

                                        ),

    );

    my $ilo_command = $commands{$command} or die "Internal error: command '$command' doesn't exist";

    $ilo_command = $self->_wrap($ilo_command);

    return $ilo_command;

}


sub _length {

    # for iLO 3 we need to know the length of the XML for the
    # Content-length field in the http header

    my ($self, $ilo_command) = @_;

    my $length = 0;

    foreach my $line (split(/\n/, $ilo_command)) {

        $line =~ s/^\s+//;
        $line =~ s/\s+$//;

        # each line has \r\n appended when sending, so + 2
        $length += length($line) + 2;

    }

    return $length;

}


sub _populate_embedded_health {

    my $self = shift;

    my $ilo_command = $self->_generate_cmd('get_embedded_health');

    my $response    = $self->_send($ilo_command)    or return;
    my $xml         = $self->_serialize($response)  or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return;
    }

    my $fans            = $xml->{GET_EMBEDDED_HEALTH_DATA}->{FANS}->{FAN};
    my $power_supplies  = $xml->{GET_EMBEDDED_HEALTH_DATA}->{POWER_SUPPLIES}->{SUPPLY};
    my $temperatures    = $xml->{GET_EMBEDDED_HEALTH_DATA}->{TEMPERATURE}->{TEMP};

    foreach my $fan (@$fans) {

        my $location = $fan->{ZONE}->{VALUE};
        my $name     = $fan->{LABEL}->{VALUE};
        my $speed    = $fan->{SPEED}->{VALUE};
        my $status   = $fan->{STATUS}->{VALUE};
        my $unit     = $fan->{SPEED}->{UNIT};

        next unless $speed && $speed =~ /^\d+$/;

        push( @{$self->{fans}}, {
            'location'  => $location,
            'name'      => $name,
            'speed'     => $speed,
            'status'    => $status,
            'unit'      => $unit,
        });

    }

    foreach my $power_supply (@$power_supplies) {

        my $name     = $power_supply->{LABEL}->{VALUE};
        my $status   = $power_supply->{STATUS}->{VALUE};

        next if $status eq 'Not Installed';

        push( @{$self->{power_supplies}}, {
            'name'   => $name,
            'status' => $status,
        });

    }

    foreach my $temperature (@$temperatures) {

        my $name     = $temperature->{LABEL}->{VALUE};
        my $location = $temperature->{LOCATION}->{VALUE};
        my $value    = $temperature->{CURRENTREADING}->{VALUE};
        my $unit     = $temperature->{CURRENTREADING}->{UNIT};
        my $caution  = $temperature->{CAUTION}->{VALUE};
        my $critical = $temperature->{CRITICAL}->{VALUE};
        my $status   = $temperature->{STATUS}->{VALUE};

        next unless $value && $value =~ /^\d+$/;

        push( @{$self->{temperatures}}, {
            'name'      => $name,
            'location'  => $location,
            'value'     => $value,
            'unit'      => $unit,
            'caution'   => $caution,
            'critical'  => $critical,
            'status'    => $status,
        });

    }

    return 1;

}


sub _populate_fw_version {

    my $self = shift;

    my $ilo_command = $self->_generate_cmd('get_fw_version');

    my $response    = $self->_send($ilo_command)    or return;
    my $xml         = $self->_serialize($response)  or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return;
    }

    $self->{fw_type}    = $xml->{GET_FW_VERSION}->{MANAGEMENT_PROCESSOR};
    $self->{fw_date}    = $xml->{GET_FW_VERSION}->{FIRMWARE_DATE};
    $self->{fw_version} = $xml->{GET_FW_VERSION}->{FIRMWARE_VERSION};

    return 1;

}


sub _populate_global_settings {

    my $self = shift;

    my $ilo_command = $self->_generate_cmd('get_global_settings');

    my $response    = $self->_send($ilo_command)    or return;
    my $xml         = $self->_serialize($response)  or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return;
    }

    my @fields = qw( session_timeout    https_port      http_port
                     ssh_port           ssh_status                );

    foreach my $field (@fields) {

        $self->{$field} = $xml->{GET_GLOBAL_SETTINGS}->{uc($field)}->{VALUE};

    }

    return 1;

}


sub _populate_host_data {

    my $self = shift;

    my $ilo_command = $self->_generate_cmd('get_host_data');

    my $response    = $self->_send($ilo_command)    or return;
    my $xml         = $self->_serialize($response)  or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return;
    }

    # SMBIOS data is stored in a big fat array
    #
    # data is not guaranteed to be in any particular index, so we have to
    # iterate through all the data looking for certain fields.
    #
    # thankfully, SMBIOS *types* are standard (eg. CPU data is type 4)
    # so we have a starting point
    #
    # this really sucks but I don't know of a better way

    for my $fieldnum (0 .. scalar @{$xml->{GET_HOST_DATA}->{SMBIOS_RECORD}}) {

        my $smbios_data = $xml->{GET_HOST_DATA}->{SMBIOS_RECORD}[$fieldnum]->{FIELD};
        my $smbios_type = $xml->{GET_HOST_DATA}->{SMBIOS_RECORD}[$fieldnum]->{TYPE};

        next unless defined $smbios_type;

        if ($smbios_type == 0) {

            for my $entry (0 .. scalar @$smbios_data) {

                my $field_name  = $smbios_data->[$entry]->{NAME};
                my $field_value = $smbios_data->[$entry]->{VALUE};

                next unless $field_name && $field_value;

                if ($field_name eq 'Date') {
                    $self->{biosdate} = $field_value;
                }

            }

        }
        elsif ($smbios_type == 1) {

            for my $entry (0 .. scalar @$smbios_data) {

                my $field_name  = $smbios_data->[$entry]->{NAME};
                my $field_value = $smbios_data->[$entry]->{VALUE};

                next unless $field_name && $field_value;

                if ($field_name eq 'Product Name') {
                    $self->{model}      = $field_value;
                }
                elsif ($field_name eq 'Serial Number') {
                    $self->{serialID}   = $field_value;
                }
                elsif ($field_name eq 'UUID') {
                    $self->{UUID}       = $field_value;
                }

            }

        }
        elsif ($smbios_type == 4) {

            my ($name, $speed, $cores);

            for my $entry (0 .. scalar @$smbios_data) {

                my $field_name  = $smbios_data->[$entry]->{NAME};
                my $field_value = $smbios_data->[$entry]->{VALUE};

                next unless $field_name && $field_value;

                if ($field_name eq 'Label') {
                    $name  = $field_value;
                }
                elsif ($field_name eq 'Speed') {
                    $speed = $field_value;
                }
                elsif ($field_name eq 'Execution Technology') {
                    $cores = $field_value || 'single core';
                }

            }

            # otherwise slot is empty
            next unless $speed && $speed =~ /^[1-9]/;

            push( @{$self->{cpus}}, {
                'name'  => $name,
                'speed' => $speed,
                'cores' => $cores }
            );

        }
        elsif ($smbios_type == 17) {

            my ($location, $size, $speed);

            for my $entry (0 .. scalar @$smbios_data) {

                my $field_name  = $smbios_data->[$entry]->{NAME};
                my $field_value = $smbios_data->[$entry]->{VALUE};

                next unless $field_name && $field_value;

                if ($field_name eq 'Label') {
                    $location = $field_value;
                }
                elsif ($field_name eq 'Size') {
                    $size     = $field_value;
                }
                elsif ($field_name eq 'Speed') {
                    $speed    = $field_value;
                }

            }

            push( @{$self->{ramslots}}, {
                'location'  => $location,
                'size'      => $size,
                'speed'     => $speed }
            );

        }
        elsif ($smbios_type == 209) {

            for my $entry (0 .. scalar @$smbios_data) {

                my $field_name  = $smbios_data->[$entry]->{NAME};
                my $field_value = $smbios_data->[$entry]->{VALUE};

                next unless $field_name && $field_value;
                next unless $field_name eq 'Port';

                # MAC address is offset by one from port label

                my $current_mac = $smbios_data->[$entry + 1]->{VALUE};

                if ($field_value eq '1') {
                    $self->{mac01} = $current_mac;
                }
                elsif ($field_value eq '2') {
                    $self->{mac02} = $current_mac;
                }
                elsif ($field_value eq '3') {
                    $self->{mac03} = $current_mac;
                }
                elsif ($field_value eq '4') {
                    $self->{mac04} = $current_mac;
                }
                elsif ($field_value eq 'iLO') {
                    $self->{macilo} = $current_mac;
                }

            }

        }

    }

    ($self->{mac01}  = lc($self->{mac01}))  =~ tr/-/:/;
    ($self->{mac02}  = lc($self->{mac02}))  =~ tr/-/:/;
    ($self->{mac03}  = lc($self->{mac03}))  =~ tr/-/:/;
    ($self->{mac04}  = lc($self->{mac04}))  =~ tr/-/:/;
    ($self->{macilo} = lc($self->{macilo})) =~ tr/-/:/;

    return 1;

}


sub _populate_network_settings {

    my $self = shift;

    my $ilo_command = $self->_generate_cmd('get_network_settings');

    my $response    = $self->_send($ilo_command)    or return;
    my $xml         = $self->_serialize($response)  or return;

    if ( my $errmsg = _check_errors($xml) ) {
        $self->error($errmsg);
        return;
    }

    my @fields = qw( dhcp_dns_server     dhcp_gateway    dns_name
                     dhcp_domain_name    ip_address      domain_name
                     dhcp_enable         subnet_mask     gateway_ip_address );

    foreach my $field (@fields) {

        $self->{$field} = $xml->{GET_NETWORK_SETTINGS}->{uc($field)}->{VALUE};

    }

    return 1;

}


sub _send {

    my ($self, $ilo_command) = @_;

    my $client = $self->_connect or return;

    foreach my $line ( split(/\n/, $ilo_command) ) {

        $line =~ s/^\s+//;
        $line =~ s/\s+$//;

        if ($self->_debug > 0) {
            print "'$line'\n";
        }

        my $ok = print {$client} $line . "\r\n";

        if (!$ok) {
            $self->error("Error transmitting command to server");
            return;
        }

    }

    chomp( my $response = join('', <$client>) );

    # iLO 3 returns a chunked http response
    # rather than parse it, just filter out the chunking data
    # janky, but a lightweight solution which works for all iLO versions

    $response =~ s/[\r\n]+[0-9a-f]{3}[\r\n]+//gs;

    $self->_disconnect or die "Internal error: disconnect failed, wtf!";

    if (!$response) {
        $self->error("No response received from remote machine");
        return;
    }

    if ($self->_debug > 0) {
        print Dumper $response;
    }

    return $response;

}


sub _serialize {

    my ($self, $data) = @_;

    if (!$data) {
        $self->error('Error parsing response: no data received');
        return;
    }

    # iLO returns multiple XML stanzas, all starting with a standard header.
    # We first need to break this glob of data into individual XML components,
    # while ignoring the HTTP header returned by iLO 3.

    chomp( my @stanzas = grep { !/HTTP\/1.1/ } split(/<\?xml.*?\?>/, $data) );

    # @stanzas now contains a number of valid XML sequences.
    # All but one is unnecessary; they contain short status messages and
    # nothing else. So, we want to parse only the longest message.
    #
    # NB: The same status codes are also included in the longest stanza.

    my $longest = ( sort {length($b) <=> length($a)} @stanzas )[0];

    if ($self->_debug > 3) {
        print Dumper $longest;
    }

    # XML::Simple croaks if it can't parse the data properly.
    # We want to capture any errors and propagate them on our own terms.

    my $xml;

    eval { $xml = XMLin( $longest, NormaliseSpace => 2 ) };

    if ($EVAL_ERROR) {
        $self->error("Error parsing response: $EVAL_ERROR");
        return;
    }

    if ($self->_debug >= 2) {
        print Dumper $xml;
    }

    return $xml;

}


sub _port_is_valid {

    my $port = shift;

    return unless defined $port && $port =~ /^\d{1,5}$/ && $port <= 65535;

    return 1;

}


sub _version {

    my $self = shift;

    if (@_) {
        $self->{_version} = shift;
    }

    return $self->{_version};

}


sub _wrap {

    my $self = shift;

    my $body = shift or die "Internal error: no data passed to _wrap()";

    my $username = $self->username or croak "Username not set";
    my $password = $self->password or croak "Password not set";

    if (!$self->_version) {

        my $ilo_version = $self->_detect_version or return;

        print "Detected iLO version $ilo_version\n" if $self->_debug > 2;

        $self->_version($ilo_version);

    }

    my $header = qq|




    |;

    my $footer = qq|


    |;

    my $ilo_command = $header . $body . $footer;

    if ($self->_version == 3) {

        my $command_length = $self->_length($ilo_command);

        my $http_header = qq|
            POST /ribcl HTTP/1.1
            HOST: localhost
            Content-length: $command_length
            Connection: Close

        |;

        $ilo_command = $http_header . $ilo_command;

    }

    return $ilo_command;

}


sub DESTROY {

    my $self = shift;

    my $client = $self->{_client} or return;
    $client->close;

    return;
}

1;
__END__