package PowerEdge::RAC;
# $Id: RAC.pm,v 1.72 2003/11/21 16:20:11 build Exp build $
# Copyright 2002,2003 Harold van Oostrom <rac@lanceerplaats.nl>
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

require 5.005;
require Exporter;
@ISA = qw(Exporter);
use strict;
use vars qw($VERSION $DEBUG @EXPORT_OK);
@EXPORT_OK = qw(prompt);

$VERSION = '0.17';
$DEBUG ||= 0;

use Digest::MD5 qw(md5);
use MIME::Base64;
use LWP::UserAgent;
use XML::Simple;
#use Data::Dumper;
# These come with standard Perl
use POSIX qw(strftime);
use Socket;

# Static variables
# Disable compression for LWP::UserAgent
use vars (@LWP::Protocol::http::EXTRA_SOCK_OPTS);
push(@LWP::Protocol::http::EXTRA_SOCK_OPTS, SendTE => 0);
my $timeout = 20;

my $EVENTS_PER_REQUEST = 10;
my $please_report_unknown_code = 'Please report to <rac at lanceerplaats dot nl> ';

my %RAC_CODE = (
	'x'        => 'Unknown error. '. $please_report_unknown_code,
	'0x0'      => 'Success',
	'0x4'      => 'Number of arguments does not match',
	'0xc'      => 'Syntax error in xml2cli command',
	'0x408'    => 'Session Timeout',
	'0x43'     => 'No such subfunction',
	'0x62'     => 'Command not supported on this platform for this firmware',
	'0xb0002'  => 'Invalid handle',
	'0x140000' => 'Too many sessions',
	'0x140002' => 'Logout',
	'0x140004' => 'Invalid password',
	'0x140005' => 'Invalid username',
	'0x150008' => 'Too many requests',
	'0x15000a' => 'No such event',
	'0x15000c' => 'No such function',
	'0x15000d' => 'Unimplemented',
	'0x170003' => 'Missing content in POST ?',
	'0x170007' => 'Dont know yet',
	'0x1a0004' => 'Invalid sensorname',
	'0x10150006' => 'Unknown sensor error',
	'0x10150009' => 'Too many sensors in sensorlist',
	'0x20308'  => 'Console not available',
	'0x30003'  => 'Console not active',
	'0x3000a'  => 'Console is in text mode',
	'0x3000b'  => 'Console is in VGA graphic mode',
	'0x30011'  => [ 'Console is in Linux mode (no ctrl+alt+del)',
					'Console is in Windows or Netware mode' ],
	'0xe0003'  => 'Unknown serveraction',
	'0xf0001'  => 'Offset exceeds number of entries in eventlog',
	'0xf0003'  => 'Request exceeds number of entries in eventlog',
	'0xf0004'  => 'Invalid number of events requested',
);

my %SEVERITY = (
	'x'     =>  'Unknown severity. '. $please_report_unknown_code,
	# Lame firmware returns empty string in SEVERITY
	#''		=>	'Unknown',
	''		=>	'-',
	'0x1'	=>	'Unknown',
	'0x2'	=>	'OK',
	'0x3'	=>	'Information',
	'0x4'	=>	'Recoverable',
	'0x5'	=>	'Non-Critical',
	'0x6'	=>	'Critical',
	'0x7'	=>	'Non-Recoverable',
);

# These sensorids, returned by the sensorlist command, are troublesome. 
# Most do not reflect actual hardware found in a 1650, some have no values,
# some cause long (up to 200 seconds) timeouts when queried for.
my @BOGUS_IDS_1650 = (
'0x1010018',
'0x1020010',
'0x1020018',
'0x1020062',
'0x1030010',
'0x1030018',
'0x1030062',
'0x1040010',
'0x1040018',
'0x1050018',
'0x1060010',
'0x1060018',
'0x1060062',
'0x1070018',
'0x1070062',
'0x1080010',
'0x1080062',
'0x1090010',
'0x10a0010',
'0x10f0062',
'0x1100010',
'0x1110010',
'0x1120010',
'0x1120062',
'0x1130010',
'0x1140010',
'0x1150010',
'0x13b0010',
'0x13c0010',
'0x13f0010',
'0x14b0010',
'0x14d0010',
'0x20e0062',
'0x2110062',
'0x2160061',
'0x2160062',
'0x2170061',
'0x2170062',
'0x2180061',
'0x2180062',
'0x2190061',
'0x2190062',
'0x21a0061',
'0x21a0062',
'0x21b0061',
'0x21b0062',
'0x21e0010',
'0x21e0061',
'0x21e0062',
'0x21f0061',
'0x21f0062',
'0x2210010',
'0x2220010',
'0x2230010',
'0x2240010',
'0x2250010',
'0x2260010',
'0x2270010',
'0x2280010',
'0x2290010',
'0x22a0010',
'0x22b0010',
'0x22c0010',
'0x22d0010',
'0x22e0010',
'0x22f0010',
'0x2300010',
'0x2310010',
'0x2320010',
'0x2330010',
'0x2340010',
'0x2350010',
'0x2360010',
'0x2370010',
'0x2380010',
'0x2390010',
'0x23a0010',
'0x23e0010',
'0x2410010',
'0x2420010',
'0x2430010',
'0x2440010',
'0x2450010',
'0x2460010',
'0x2470010',
'0x2480010',
'0x2530010',
);

# These sensorids, returned by the sensorlist command, are troublesome. 
# Most do not reflect actual hardware found in a 2650, some have no values,
# some may cause long (up to 200 seconds) timeouts when queried for.
# This list is based on feedback from users. the author doesn't have any 2650 
# to test so if you find other ids causing problems be sure to let him know.
my @BOGUS_IDS_2650 = (
'0x1350010',
'0x1360010',
'0x2160061',
'0x2170061',
'0x2180061',
'0x2190061',
'0x21a0061',
'0x21b0061',
'0x21c0061',
'0x21d0061',
'0x21e0060',
'0x21e0061',
'0x21f0060',
'0x21f0061',
'0x2d00010',
);

# These sensorids, returned by the sensorlist command, are troublesome. 
# Most do not reflect actual hardware found in a 1750, some have no values,
# some may cause long (up to 200 seconds) timeouts when queried for.
my @BOGUS_IDS_1750 = (
'0x1060062',
'0x1070062',
'0x1080062',
'0x10f0062',
'0x1120062',
'0x1030062',
'0x1020062',
'0x20e0062',
'0x2110062',
'0x2160062',
'0x2170062',
'0x2180062',
'0x2190062',
'0x21a0062',
'0x21b0062',
'0x21f0062',
'0x21e0062',
'0x2160061',
'0x2170061',
'0x2180061',
'0x2190061',
'0x21a0061',
'0x21b0061',
'0x21f0061',
'0x21e0061',
'0x1010010',
'0x1020010',
'0x1030010',
'0x1040010',
'0x1080010',
'0x1090010',
'0x10a0010',
'0x1100010',
'0x1110010',
'0x1120010',
'0x1130010',
'0x1140010',
'0x1150010',
'0x21e0010',
'0x2210010',
'0x2220010',
'0x2230010',
'0x2240010',
'0x2250010',
'0x2260010',
'0x2290010',
'0x22a0010',
'0x22b0010',
'0x22c0010',
'0x22d0010',
'0x22e0010',
'0x22f0010',
'0x2300010',
'0x2310010',
'0x2320010',
'0x2330010',
'0x2340010',
'0x2350010',
'0x2360010',
'0x2370010',
'0x2380010',
'0x2390010',
'0x23a0010',
'0x13b0010',
'0x13c0010',
'0x13f0010',
'0x2440010',
'0x2450010',
'0x2460010',
'0x2470010',
'0x2480010',
'0x14a0010',
'0x14d0010',
'0x14e0010',
'0x1500010',
'0x1510010',
'0x2000010',
'0x2570010',
'0x10f0060',
'0x1120060',
'0x1020060',
'0x1010018',
'0x1020018',
'0x1030018',
'0x1040018',
'0x1050018',
'0x1060018',
'0x1070018',
);

# These sensorids, returned by the sensorlist command, are troublesome. 
# Most do not reflect actual hardware found in a 4600, some have no values,
# some may cause long (up to 200 seconds) timeouts when queried for.
my @BOGUS_IDS_4600 = (
'0x1010018',
'0x1020018',
'0x1020062',
'0x1030018',
'0x1030062',
'0x1040018',
'0x1050018',
'0x1060018',
'0x1060062',
'0x1070018',
'0x1070062',
'0x1080062',
'0x10f0062',
'0x1120062',
'0x20e0062',
'0x2110062',
'0x2160062',
'0x2170062',
'0x2180062',
'0x2190062',
'0x21a0062',
'0x21b0062',
'0x21e0062',
'0x21f0062',
'0x2160060',
'0x2170060',
'0x2180060',
'0x2190060',
'0x21a0060',
'0x21b0060',
'0x2160061',
'0x2170061',
'0x2180061',
'0x2190061',
'0x21a0061',
'0x21b0061',
'0x21f0060',
'0x21f0061',
'0x21e0060',
'0x21e0061',
'0x2410010',
'0x2420010',
'0x2430010',
'0x2440010', # XXX actually present, but needs code changes
'0x2450010', # XXX actually present, but needs code changes
'0x14b0010',
);

# The order is important here
my @PROPNAMES = (
'NAME',
'SEVERITY',
'LOW_CRITICAL',
'LOW_NON_CRITICAL',
'VAL',
'UNITS',
'UPPER_NON_CRITICAL',
'UPPER_CRITICAL',
'SENSOR_TYPE',
);

my %DRIVE_SLOT_CODES = (
	  '0'	=>	'Good',
	  '1'	=>	'No Error',
	  '2'	=>	'Faulty Drive',
	  '4'	=>	'Drive Rebuilding',
	  '8'	=>	'Drive In Failed Array',
	 '16'	=>	'Drive In Critical Array',
	 '32'	=>	'Parity Check Error',
	 '64'	=>	'Predicted Error',
	'128'	=>	'No Drive',
);

my %POWER_UNIT_CODES = (
	 '0'	=>	'AC Power Unit',
	 '1'	=>	'DC Power Unit',
);

my %BUTTON_CODES = (
	 '0'	=>	'Power Button Disabled',
	 '1'	=>	'Power Button Enabled',
);

my %FAN_CONTROL_CODES = (
	 '0'	=>	'Normal Operation',
	 '1'	=>	'Unknown',
	 #'1'	=>	'Error',
);

my %INSTRUSION_CODES = (
	 '0'	=>	'No Intrusion',
	 '1'	=>	'Cover Intrusion Detected',
	 '2'	=>	'Bezel Intrusion Detected',
);

my %POWER_SUPPLY_CODES = (
	 '1'	=>	'Good',
	 '2'	=>	'Failure Detected',
	 '4'	=>	'Failure Predicted',
	 '8'	=>	'Power Lost',
	'16'	=>	'Not Present',
);

my %PROCESSOR_CODES = (
	 '0'	=>	'Good',
	 '1'	=>	'CPU Missing',
	 '2'	=>	'CPU VID Mismatch',
	 '4'	=>	'CPU Thermal Trip',
	 '8'	=>	'CPU Hot'
);

my %CODES = (
	'button'		=>	\%BUTTON_CODES,
	'drive slot'	=>	\%DRIVE_SLOT_CODES,
	'fan control'	=>	\%FAN_CONTROL_CODES,
	'intrusion'		=>	\%INSTRUSION_CODES,
	'power supply'	=>	\%POWER_SUPPLY_CODES,
	'power unit'	=>	\%POWER_UNIT_CODES,
	'processor'		=>	\%PROCESSOR_CODES,
);

my $xs = new XML::Simple(forcearray=>1, suppressempty => '');

# Public API

sub new {
	my $proto = shift;
	my $class   = ref($proto) || $proto;
	my $self = {
		host	 => '192.168.0.120',
		user	 => 'root',
		password => 'calvin',
		session_id => '',
		protocol => '',
		handle   => '0x0',
		name_to_sensorid => {},
		@_,		# Override previous attributes
	};
	$self->{'_ua'} = new LWP::UserAgent(timeout => $timeout, keep_alive => 1);
	return bless $self, $class;
};

sub session_id {
	my $self = shift;
	if (@_) { $self->{session_id} = shift }
	return $self->{session_id};
};

sub establish_session {
	my $self = shift;
	my $sid = $self->{session_id};
	$sid = $self->_login() unless ($sid && $self->_verifysession($sid));
	return $sid;
};

# info
sub sysinfo {
	my ($self, $what) = @_;
	my $rawout = $self->_send_command('xml2cli', 'getsysinfo -A');
	# The getsysinfo output is a bit of mess, clean it up somewhat
    # so we can parse it more easily.
	my $c = 0;
	my $si = '';
	while ($rawout) {
	    if ($rawout =~ s/^\"([^"]*)\"//s) { $si .= $1 . '#'; };
	    if ($rawout =~ s/^([^\n" ]+)//) { $si .= $1 . '#'; };
	    if ($rawout =~ s/^(\n)//) { $si .= $1;} ;
	    $rawout =~ s/^(\s+)//;
	    die("Could not parse sysinfo [$rawout]\n") if ($c++ > 25);
	};
	
	my @txt;
	
	# The first element in each array has to match the 
	# the string that the firmware returns.
	$txt[0] = [
	"RAC Info",
	"RAC Date/Time",
	"Firmware Version",
	"Firmware Updated",
	"Hardware Version",
	"Current IP Address",
	"Current IP Gateway",
	"Current IP Netmask",
	"DHCP Enabled",
	"PCMCIA Enabled",
	];
	
	$txt[1] = [
	"System Info",
	"System ID",
	"System Model",
	"BIOS Version",
	"Asset Tag",
	"Service Tag",
	"OS Type",
	"Host Name",
	"OS Name",
	"ESM Version",
	];
	
	$txt[2] = [
	"Watchdog Info",
	"Recovery Action",
	"Present Countdown Value",
	"Initial Countdown Value",
	];
	
	$txt[3] = [
	"RAC Flags",
	"RAC Flags",
	];
	
	my $ostype = sub {
		my $x = hex(shift);
		my @os = ('Microsoft Windows','Linux','Novell Netware' );
		my @flavor = ('NT','2000', 'XP', '', '2003');
		my @arch = ( '32bit', '64bit');
		my $arch = $x & 0x1;
		my $os = ($x & 0xfe) >> 1;
		my $flavor = ($x & 0xff00) >> 8;
		my $s = 'none installed';
		unless ($os == '127') {
			$s = ($arch[$arch] || 'Unknown').' '.($os[$os] || 'Unknown');
			$s .= ' '. ($flavor[$flavor] || 'Unknown') if ($os == 0);
		};
		return $s;
	};

	my %action = (
		0 => 'No action',
		1 => 'Hard reset',
		2 => 'Power down',
		3 => 'Power cycle',
	);

	my $i = 0;
	my %s;
	my @s;
	for my $line (split(/\n/, $si)) {
	    my @info = split(/#/, $line);
		my $nf = scalar(@{ $txt[$i] });
	    my $desc = $txt[$i]->[0];
 		warn("Trouble parsing $desc line: $line\n")
	      unless($info[0] =~ m/$desc/i && scalar(@info) == $nf);
	
	    for my $j (1..$nf-1) {
			my $name = $txt[$i]->[$j];
			my $value = $info[$j];
			if ($name eq 'OS Type') {
				$value = $ostype->($value) || 'Unknown';
			};
			if ($name eq 'Recovery Action') {
				$value = $action{$value} || 'Unknown';
			};
	        $s{$name} = $value;
	        push(@s, sprintf("%-24s %-24s\n", $name, $value));
	    };
    	$i++;
	};

	if (defined($what)) {
		if (!exists($s{$what})) {
			my $s = join("\n", sort keys %s);
			die ("Item not found: $what\nPossible values are: \n$s\n");
		};
		return $s{$what};
	} else {
    	if (wantarray()) {
    	    	return @s;
    	} else {
			return \%s;
    	};
	};
};

sub multi_info {
	my $self = shift;
	my $href = $self->_send_command('multiinfo');
	return $href;
};

sub firmware_version {
	my $self = shift;
	my $s = $self->sysinfo('Firmware Version');
	$s =~ s/^\s//g;
	my ($v, @build) = split(/\s/,$s);
	warn join(' ', @build), "\n" if ($DEBUG);
	return $v;
};

sub system_model {
	my $self = shift;
	my $s = $self->sysinfo('System Model');
	$s =~ s/^\s//g;
	$s =~ s/\s$//g;
	return $s;
};

sub read_sensors_by_id {
	my ($self, @sensor_ids) = @_;
	my $s = $self->read_sensors(@sensor_ids);
	return $s;
};

sub read_sensors_by_name {
	my ($self, @sensor_names) = @_;
	my $s = $self->read_sensors(@sensor_names);
	return $s;
};

sub sensorid_to_name {
	my ($self, @sensor_ids) = @_;

	return {} unless ($self->is_powered_on());

	my @e = grep { $_ !~ m/^0x[0-9a-f]{7}$/i } @sensor_ids;
	die ('Invalid sensorids: '.join(' ', @e)."\n") if scalar(@e);

	$self->read_sensors_by_id() unless ($self->_has_map());
	die ("No sensor(s). System powered off ?\n") unless ($self->_has_map());
	
	my $sensorid_to_name = _checked_reverse($self->{name_to_sensorid});

	if (scalar(@sensor_ids)) {
		my @r;
		for my $sid (@sensor_ids) {
			my $name = $sensorid_to_name->{$sid};
			die ("Sensorid not found in map: $sid\n") unless defined ($name);
			push(@r, $sensorid_to_name->{$sid});
		};
		return @r;
	} else {
		return $sensorid_to_name;
	};
};

sub read_sensors {
	my ($self, @sensor_codes) = @_;

	# Turns out that trying to query for sensors while the server is 
    # powered off can cause the RAC to hang (at least /cgi/bin) ...
	return {} unless ($self->is_powered_on());

	# We go to considerable lengths to avoid needlessly querying the RAC 
	my $queries_by_name = 0;
	foreach my $c (@sensor_codes) {
		next if ($c =~ m/^0x[0-9a-f]{7}/i);
		$queries_by_name = 1;
		last;
	};

	my @to_query;
	if (scalar(@sensor_codes) && ($self->_has_map() || !$queries_by_name)) {
		# Ugly hack. Even though we already know which sensors to
		# query we still need to get a valid handle ..
		$self->sensorlist();
		@to_query = @sensor_codes;
	} else {
		# No other option but to query them all
		@to_query = $self->sensorlist();
	};

	if ($queries_by_name) {
		if ($self->_has_map()) {
			@to_query = ();
			foreach my $c (@sensor_codes) {
				my $sid = $c;
				unless ($c =~ m/^0x[0-9a-f]{7}/i) {
					$sid = $self->{name_to_sensorid}->{_canonic($c)};
				};
				die ("Sensorname not found in map: $c\n") unless defined($sid);
				push(@to_query, $sid);
			};
		} else {
			die("Programmer error\n") unless (@to_query);
		};
	};

	my %query_result;
	my $handle = $self->{handle};
	while (@to_query) {
		my $sxml = '';
		foreach my $sensor (splice (@to_query, 0, 16)) {
			$sxml .= '<SENSOR KEY="'. $sensor .'"/>';
		};
		my $href = $self->_send_command('sensorpropget', $sxml, $handle);
		while (my ($k, $v) = each(%$href)) { 
			$query_result{$k} = $v;
		};
	};

	my $sensorid_to_name = {};
	my $name_to_sensorid = $self->{name_to_sensorid};
	unless ($self->_has_map()) {
		foreach my $sensor_id (keys %query_result) {
			my $sref = $query_result{$sensor_id};
			my $name = _canonic($sref->{NAME});
			if ($name =~ m/^CPU/ && $sref->{SENSOR_TYPE} =~ m/Temperature/i) {
				$name .= '_TEMP'; # hack, avoid duplicates 
			};
			$sensorid_to_name->{$sensor_id} = $name;
		};
		$name_to_sensorid = _checked_reverse($sensorid_to_name);
		$self->{name_to_sensorid} = $name_to_sensorid;
	};

	my $s = \%query_result;
	if ($queries_by_name || !$self->_has_map()) {
		my %only_wanted;
		foreach my $c (@sensor_codes) {
				if ($c =~ m/^0x[0-9a-f]{7}/i) {
					$only_wanted{$c} = $query_result{$c};
				} else {
					my $sid = $name_to_sensorid->{ _canonic($c) }; 
					die ("Sensor not found: $c\n") unless defined($sid);
					$only_wanted{$c} = $query_result{$sid};
				};
		};
		$s = \%only_wanted;
	};
	return $s;
};

sub read_sensors_txt {
	my ($self, @sensor_codes) = @_;
	my $href = $self->read_sensors(@sensor_codes);
	my %output = %$href;
	my $s;
	my @s;
	foreach my $sensor_id (keys %output) {
		my $sref = $output{$sensor_id};
		$sref = _interpret_codes($sref);
		my %sensor = %$sref;
		for my $k (keys %sensor) {
			$s .= "[$sensor_id] $k = " . $sensor{$k} . "\n";
		};
		my @values = ();
		for my $propname (@PROPNAMES) {
			push(@values, $sensor{$propname});
		}
		my $fmt;
		if ($sensor{UNITS}) {
			$fmt = '%-16s%-10s%8s%8s [%7s%-3s]%8s%8s %s';
		} else {
			$fmt = '%-16s%-10s%8s%8s [%10s%s]%8s%8s %s';
		};
		my $sline = sprintf($fmt, @values) . "\n";
		push (@s, $sline);
    };

    if (wantarray()) {
        return @s;
    } else {
        return $s;
    };
};

sub sensorlist() {
	my $self = shift;
	# It turns out that trying to query for sensors while the server 
    # is powered off can cause the RAC to hang (at least /cgi/bin)
	return () unless ($self->is_powered_on());
	my @output = $self->_send_command('sensorlist');

	my @s;
	my %is_bogus = ();
	my $model = $self->system_model();
	if ($model =~ m/1650/) {
		@is_bogus{@BOGUS_IDS_1650} = ();
	} elsif ($model =~ m/1750/) {
		@is_bogus{@BOGUS_IDS_1750} = ();
	} elsif ($model =~ m/2650/) {
		@is_bogus{@BOGUS_IDS_2650} = ();
	} elsif ($model =~ m/4600/) {
		@is_bogus{@BOGUS_IDS_4600} = ();
	};
	foreach my $sensor_id (@output) {
		push (@s, $sensor_id) unless exists $is_bogus{$sensor_id};
	};

    if (wantarray()) {
        return @s;
    } elsif (defined wantarray()) {
        return join(' ', @s);
    } else {
	# Called in void context just to set the handle for any subsequent requests
		return; 
	};
};

sub getniccfg {
	my $self = shift;
	my $s;
	eval { $s = $self->_send_command('xml2cli', 'getniccfg'); };
	if ($@ && $@ =~ m/Command not supported/) {
		my $fw = $self->sysinfo('Firmware Version');
		my $msg = qq{
Dell or the ERA card manufacturer has disabled this function in firmware 
version $fw. Just use older firmware if you need it. 
The 2.0 firmware actually has more features than the 2.2x versions ;-)
};
		die($msg);
	} elsif ($@) {
		die($@)
	};
	return $s;
};

sub setniccfg {
	my ($self, $ip, $netmask, $gateway) = @_;
	die ("Invalid IP address $ip\n") unless defined(inet_aton($ip));
	die ("Invalid IP address $gateway\n") unless defined(inet_aton($gateway));
	my $s; 
	eval { $self->_send_command('xml2cli',
                                "setniccfg -s $ip $netmask $gateway"); };
	if ($@ && $@ =~ m/Command not supported/) {
		my $fw = $self->sysinfo('Firmware Version');
		my $msg = qq{
Dell or the ERA card manufacturer has disabled this function in firmware 
version $fw. Just use older firmware if you need it. 
The 2.0 firmware actually has more features than the 2.2x versions ;-)
};
		die($msg);
	} elsif ($@) {
		die($@)
	};
	return $s;
};

sub fwupdate {
    my ($self, $ip, $dir) = @_;
	# get defaults from rac if ip and dir where not passed as arguments
	unless (defined($ip) && defined($dir)) {
		my $r =	$self->config('TFTP_ADDR_FIRMWARE', 'TFTP_FIRMWARE_FILE');
		$ip ||= $r->{'TFTP_ADDR_FIRMWARE'};
		$dir ||= $r->{'TFTP_FIRMWARE_FILE'};
        die('IP address of TFTP server not set.'."\n") unless defined($ip);
        die('TFTP directory not set.'."\n") unless defined($dir);
	};

    die ("Invalid IP address $ip\n") unless defined(inet_aton($ip));
    my $r = $self->_send_command('xml2cli2', "d_fwupdate -g -a $ip -d $dir");  
	my $done = 0;
	my $ISA_TTY = -t STDIN && -t STDOUT;

	$| = 1 if ($ISA_TTY);
	until ($done == 1) {
		for ($self->fwupdate_status()) {
			/^0x2$/ and do { print('.') if ($ISA_TTY); last };
			/^0x3$/ and do { 
					print(' done.'."\n") if ($ISA_TTY); $done = 1; last;
				};
			/^0x82$/ and do {
					die ("\n".'TFTP error. Bad IP address or path.'. "\n"); 
				};
			/^0x(0|4|84|89)$/  and do {
					die ("\n".'Unexpected status: '. $1. "\n");
				};
		};
		sleep 1;
	};
	print('Flashing image ...') if ($ISA_TTY);
    $r = $self->_send_command('xml2cli2', 'd_fwupdate -u -i root -w');  
	my $href = $self->config('D_FWUPD_WAITTIME');
	my $waittime = hex($href->{'D_FWUPD_WAITTIME'});
	$done = 0;
	my $i = 0;
	until ($done == 1) {
		# There is no risk in calling die here. If the image is correct
		# the update while go through anyway.
		die('Timeout flashing firmware. '. "\n") if ($i++ > $waittime);
		sleep 1;
		eval { $r = $self->fwupdate_status() };
		if ($@ && $@ =~ m/While trying to get/) {
			$done = 1;
		} elsif ($@) {
			die($@);
		} elsif ($r eq '0x4') {
			print('.') if ($ISA_TTY);
		} elsif ($r eq '0x84') {
			die('failed.'."\n".'Failed checksum. Error ['."$r]\n");
		} elsif ($r eq '0x89') {
			die('failed.'."\n".'Incorrect or corrupt image file. ['."$r]\n");
		} else {
			die("\n".'Unknown error. '.$please_report_unknown_code."\n$r\n");
		};
	};
	if ($ISA_TTY) {
		print ' done.'."\n";
		print 'Please wait another two minutes while the RAC resets.'."\n";
	} else {
		sleep 140;
	};
    return;
};

sub fwupdate_status {
	my $self = shift;
	my $r = $self->_send_command('xml2cli2', 'd_fwupdate -s');
	# 0x0 FWUPD_STATUS_OK fwupdate completed successfully
	# 0x2 FWUPD_STATUS_WORK_LOADING FTP/TFTP/MBOX loading update file
	# 0x3 FWUPD_STATUS_WORK_VERIFIED update file checksummed ok
	# 0x4 FWUPD_STATUS_WORK_UPDATE update file execution started
	# 0x82 FWUPD_STATUS_ERROR_TFTP transmission error(bad IP/path)
	# 0x84 FWUPD_STATUS_ERROR_CHKSUM update file failed checksum
	# 0x89 FWUPD_STATUS_ERROR_TOKEN image token at offset 0xXX is incorrect
	die("\n".'Unknown format. '. $please_report_unknown_code."\n$r\n")
		unless ($r =~ m/(0x[0-9]+) (FWUPD_[A-Z_]+) (.*)$/);
	my ($code, $tag, $description) = ($1, $2, $3);
	die("\n".'Unknown status. '. $please_report_unknown_code."\n$r\n")
		unless ($code =~ /^0x(0|2|3|4|82|84|89)$/);
	return $code;
};

sub enable_dhcp {
	my $self = shift;
	my $s = $self->_send_command('xml2cli', 'setniccfg -d');
	return $s;
};

sub sessions {
	my $self = shift;
	my $s = $self->_send_command('xml2cli', 'getssninfo -A');
	return $s;
};

# logs
sub post_log {
	my $self = shift;
	my $s = $self->_send_command('xml2cli', 'getpostcodetext');
	return $s;
};

# This RAC function is probably being obsoleted by selgetentry and selgetinfo
#sub getsel {
#	my $self = shift;
#	my $s = $self->_send_command('xml2cli2', 'getsel');
#	return $s;
#};

# returns information about the size of the system event log
sub selgetinfo {
	my $self = shift;
	my $href = $self->_send_command('selgetinfo');
    if (wantarray()) {
        return %$href;
    } else {
        return $href;
    };
};

sub event_log {
	my $self = shift;
	my %selinfo = %{ $self->_send_command('selgetinfo') };
	my $s;
	my @s;
	my $offset = 0;
	my $handle = $selinfo{HANDLE};
	while ($offset < $selinfo{ENTRIES}) {
		my $remaining = $selinfo{ENTRIES} - $offset;
		my $n;
		if ($remaining > $EVENTS_PER_REQUEST) {
			$n = $EVENTS_PER_REQUEST;
		} else {
			$n = $remaining; 
		};
		my $xo = sprintf("0x%x", $offset);
		my $xn = sprintf("0x%x", $n);
		push (@s, $self->_send_command('selgetentry', $xo, $handle, $xn));
		$offset += $n;
	};
	if (wantarray()) {
		return @s;
	} else {
		my ($date, $sev, $sensor,$msg);
		foreach my $eref (@s) {
			$date = _date($$eref{date});
			$sev  = $$eref{severity};
			$sensor = $$eref{sensor_id};
			$msg  = $$eref{message};
			$s .= sprintf("%21s %9s %16s - ", $date, $sensor, $sev).$msg."\n";
		};
		return $s;
	};
};

sub get_gmt {
	my $self = shift;
	# Next no longer works in firmware version 2.20
	# my $s = $self->_send_command('xml2cli2', 'getgmt');
	my $s = $self->sysinfo('RAC Date/Time') . "\n";
	return $s;
};

sub set_gmt {
	my ($self, $t, $offset) = @_;
	$t ||= time();
	$offset ||= 0;
	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = localtime($t);
    my $rac_t = sprintf("%04d%02d%02d%02d%02d%02d", $year+1900, 
                        $mon+1, $mday, $hour, $min, $sec). '.000000+000';
	my $s = $self->_send_command('xml2cli2', "setgmt -d $rac_t -o $offset");
	return $s;
};

sub clear_event_log {
	my $self = shift;
	my $s = $self->_send_command('xml2cli2', 'd3debug clearsel');
	return $s;
};

sub rac_log {
	my ($self, $lines) = @_;
	my $LINES_PER_REQUEST = 40;
	$lines ||= $LINES_PER_REQUEST;
	my $s;
	my $nextrecord = 0;
	while ($nextrecord ne '0x00000000' && ($lines > 0)) {
		my $count = $LINES_PER_REQUEST;
		if ($lines < $LINES_PER_REQUEST) { $count = $lines };
       	print "Retrieving $count records starting at $nextrecord\n" if ($DEBUG);
		$count++;
		my $cmd =  'getdraclog -A -s' . $nextrecord . ' -c '. $count;
		my $cmdoutput = $self->_send_command('xml2cli2', $cmd);
		$nextrecord = '0x00000000';
		if ($cmdoutput =~ s/\n^NEXTRECORD=(0x[0-9a-f]*)$//m) {
        	$nextrecord = $1;
		}; 
		$s .= $cmdoutput;
		$lines -= ($cmdoutput =~ tr/\n//);
	};
	return $s;
};

sub clear_rac_log {
	my $self = shift;
	my $s = $self->_send_command('xml2cli2', 'd3debug cleardraclog');
	return $s;
};

# network
sub netstat {
	my ($self, $iface) = @_;
	$iface ||= "";
	my $s = $self->_send_command('xml2cli2', 'netstat ' . $iface);
	return $s;
};

sub ping {
	my ($self, $ip) = @_;
	$ip ||= $self->{host};
	die ("Invalid IP address $ip\n") unless defined(inet_aton($ip));
	my $s = $self->_send_command('xml2cli2', 'ping ' . $ip);
	return $s;
};

sub arp {
	my $self = shift;
	my $s = $self->_send_command('xml2cli2', 'arp');
	return $s;
};

# status
sub console_status {
	my $self = shift;
	my $s = $self->_send_command('getconstatus');
	# Ouch this is ugly, $RAC_CODE{'0x30011'} is an arrayref
	if (ref($s) eq 'ARRAY') {
		if ($self->sysinfo('OS Type') =~ m/Linux/i) {
			$s = $s->[0];
		} else {
			$s = $s->[1];
		};
	}
	$s .= "\n";
	return $s;
};

sub is_powered_on {
	my $self = shift;
	my $s = '';
	my $r = 0;
	if ($self->firmware_version() < 2) {
		$s = $self->_send_command('fwconfig', 'D_SYS_PWR_STATUS');
		$r = 1 if ($s =~ m/D_SYS_PWR_STATUS=ON/s);
	} else {
		$s = $self->_send_command('xml2cli', 'serverstatus');
		$r = 1 if ($s =~ m/SYSPWR_STATUS=0x2/s);
	};
};

sub config {
	my ($self, @propnames) = @_;
my @all = ( 
'D_SYS_PWR_STATUS',
'D_SYS_EVSVR_STATUS',
'HWMON_BATTERY_RULE',
'HWMON_EXTPWRSRC_RULE',
'DHCP0_WAS_USED',
'DIALOUT_MODEM_CONNECT_TIMEOUT',
'DIALIN_AUTH_TYPE',
'DIALIN_MINOR',
'MODEM_BAUD',
'PPP_INIT',
'DIAL_TYPE',
'DIALIN_MAX_CONNECT',
'DIALIN_TIMEOUT',
'DFLT_PPP_IP_ADDR',
'ENABLE_PPP_DHCP',
'ENABLE_DIALOUT',
'ENABLE_DIALIN',
'ENABLE_FW_UPDATE',
'RHOST_GROUP_CAPABILITIES',
'D_SSN_MAX_SSN_PER_USER',
'D_SSN_NO_CONCURRENT_LOGINS',
'VNC_MAX_USERS',
'VT100_IDLEWAIT',
'VT100_QUITKEY',
'ENABLE_VT100_CONSOLE',
'VT100_BAUD',
'TCPTV_MSL',
'IPFRAGTTL',
'SUBNETSARELOCAL',
'TCP_REXMTMAX',
'TCPTV_MIN',
'TCPTV_SRTTDFLT',
'TCPTV_SRTTBASE',
'IPDEFTTL',
'NIC_MTU',
'ENABLE_SNMP_AGENT',
'ENABLE_TRAPS',
'MN_KEY_SEQ',
'ENABLE_REM_DRSCADM',
'ENABLE_D3DEBUG',
'DIALOUT_CONNECTTIME',
'DIALOUT_IDLETIMEOUT',
'D_FWUPD_WAITTIME',
'GENERIC_FTP_PASSWD',
'GENERIC_FTP_PASSWD_TYPE',
'GENERIC_FTP_USERNAME',
'VNC_PASSWORD_TYPE',
'MANAGED_NODE_IP',
'GENPLATTYPE',
'OEM_PLATFORM_TYPE',
'ENABLE_REMOTE_FLOPPY_BOOT',
'MAC_ADDRESS',
'RFB_NEED_IMAGE',
'RFB_RESET_ENABLE',
'RFB_WRITE_PROTECT',
'SERVER_CODEPAGE',
'TFTP_ADDR_REBOOT',
'TFTP_ADDR_FIRMWARE',
'TFTP_FIRMWARE_FILE',
'TFTP_REBOOT_FILE',
'ALLOWED_EN_DIS',
'GUI_REBOOT_FILE',
'SMTP_SERVER',
'D_SYSINFO_OSTYPE',
'D_SYSINFO_OSNAME',
'D_SYSINFO_HOSTNAME',
'ENABLE_DHCP',
'CFG_GATEWAY',
'CFG_NETMASK',
'CFG_IP_ADDRESS',
'ENABLE_NIC',
'VNC_CLIENT_PORT',
'VNC_SERVER_PORT',
);
	@propnames = @all unless scalar(@propnames);
	my $r = $self->_send_command('fwconfig', join("\n", @propnames));
    my @lines = split /\n/, $r;
    my %s;
	my @s;
    for my $line (@lines) {
        chomp $line;
        next unless scalar($line);
        my ($propname, $value) = split /=/, $line;
		$value ||= '';
        $s{$propname} = $value;
	    push(@s, sprintf("%-24s = %-24s\n", $propname, $value));
    };
    if (wantarray()) {
    	return @s;
    } else {
		return \%s;
    };
};

sub rfbstatus {
	my $self = shift;
	my $s = $self->_send_command('xml2cli', 'rfbstatus');
	return $s;
};

# serveractions 
sub power_on {
	my $self = shift;
	my $s = $self->_send_command('serveraction', 'powerup');
	return $s;
};

sub power_off {
	my $self = shift;
	my $s = $self->_send_command('serveraction', 'powerdown');
	return $s;
};

sub gracereboot {
	my $self = shift;
	if ($self->firmware_version() < '2.00') {
		warn("Warning: Not implemented on this firmware: gracereboot\n");
		return;
	} else {
		my $s = $self->_send_command('serveraction', 'gracereboot');
		return $s;
	};
};

sub graceshutdown {
	my $self = shift;
	if ($self->firmware_version() < '2.00') {
		warn("Warning: Not implemented on this firmware: graceshutdown\n");
		return;
	} else {
		my $s = $self->_send_command('serveraction', 'graceshutdown');
		return $s;
	};
};

sub power_cycle {
	my $self = shift;
	my $s = $self->_send_command('serveraction', 'powercycle');
	return $s;
};

sub hard_reset {
	my $self = shift;
	my $s = $self->_send_command('serveraction', 'hardreset');
	return $s;
};

sub rac_reset {
	my $self = shift;
	my $s = $self->_send_command('xml2cli2', 'dra3reset 1 1');
	return $s;
};

# tests
sub test_email {
	my ($self, $user) = @_;
	$user ||= 'root';
	my $s = $self->_send_command('xml2cli2', 'testalert -e -u' . $user);
	return $s;
};

sub test_page {
	my ($self, $user) = @_;
	$user ||= 'root';
	# -n for alphanumeric paging
	my $s = $self->_send_command('xml2cli2', 'testalert -a -u' . $user);
	return $s;
};

#
# Internal functions, anything below is subject to change ...
#
sub _has_map {
	my $self = shift;
	return (1) if (%{ $self->{name_to_sensorid} });
};

sub _send_command {
	my ($self, $function, $input, $handle, $xnum) = @_;
	my $xml = _gen_xml($function, $input, $handle, $xnum);
	my $response = $self->_send_xml_command($xml);
	my $ref = _checked_response($response);
	# decode XML returned by RAC, could be a sub
	my $r = $ref->{RESP}[0];
				#print Dumper($r) , "\n";
	die('Unexpected XML from RAC [' . $r . "]\n") unless defined($r);
	#die('Unexpected XML from RAC [' . Dumper($r). "]\n") unless defined($r);
	my $output = '';
	my @output;
	my $rc  = $r->{RC}[0];
	my $msg = $RAC_CODE{$rc} || $RAC_CODE{'x'};
	my $cmd = $r->{CMD};

	# Hard to get this right because of "\cM\cJ" "\cJ" conversions
	# Disabled for now ...
	if (0 && $r->{CMDOUTPUT}) {
		$output = $r->{CMDOUTPUT}[0];
		#my $buffer = $output;
		#my $lines  = ($buffer =~ tr/\n//);
		my $length = hex($r->{OUTPUTLEN}[0]);
		my $l = length($output); #+ $lines;
		warn "Warning: outputlen[$l] != [$length]\n" unless ($l == $length);
	};

	if ($cmd eq 'getconstatus') {
		die ($msg . " [rc=$rc]\n") if ($rc !~ /^0x300..$/);
	} else {
		die ($msg . " [rc=$rc]\n") if ($rc ne '0x0');
	};

	for ($cmd) {
		/sensorlist/ and do { 
				if (ref($r->{SENSORLIST}[0])) {
					my $slref = $r->{SENSORLIST}[0]{SENSOR};
					foreach my $sensor (@$slref) {
						push (@output, $$sensor{KEY});
					};
				} else {
					warn("No sensor(s). System powered off ?\n") if ($DEBUG);
				};
				$self->{handle} = $r->{HANDLE}[0];
				last};
		/sensorpropget/ and do {
				my %output = ();
				#print Dumper($r) , "\n";
				unless (ref($r->{SENSORLIST}[0])) {
					warn("Sensor(s) not found. System powered off ?\n")
						if ($DEBUG);
					$output = \%output;
					last;
				};
				my $slref = $r->{SENSORLIST}[0]{SENSOR};
				my ($plref, $sensor_id, $propname, $val);
				foreach my $sensor (@$slref) {
					$sensor_id =  $$sensor{KEY};
					$plref =  $$sensor{PROP};
					my %sprops = ();
					foreach my $prop (@$plref) {
						$propname =  $$prop{NAME};
						$val	  =  $$prop{VAL}[0];
						$sprops{$propname} = $val;
					};
					$output{$sensor_id} = \%sprops;
				};
				$output = \%output;
				last};

		/crsportget/   and do { $output = hex($r->{PORT}[0]); last};
		/xml2cli$/     and do { $output = $r->{CMDOUTPUT}[0]; last};
		/xml2cli2/     and do { $output = $r->{CMDOUTPUT}[0]; last};
		/getconstatus/ and do { $output = $msg; last};
		/serveraction/ and do { $output = $msg . "\n"; last};
		/getvirstatus/ and do { $output = $msg . "\n"; last};
		/serverstatus/ and do { $output = $r->{SYSPWR_STATUS}[0] . "\n"; last};
		/multiinfo/    and do { $output = $r; last};
		/selgetentry/  and do {
				die("No eventlist\n") unless ref($r->{EVENTLIST}[0]);
				my $elref = $r->{EVENTLIST}[0]{EVENT};
				foreach my $event (@$elref) {
					my ($key, $tr, $pc);
					$key = $$event{KEY};
					$tr = hex($$event{TR}[0]);
					$pc = hex($$event{PC}[0]);
					print "Discarding: $key tr[$tr] pc[$pc]\n" if ($DEBUG);
					my $href = {
						severity => $$event{SEV}[0],
						sensor_id => $$event{SENSOR}[0]{KEY},
						message => $$event{STR}[0],
						date => $$event{DATETIME}[0],
					};
					push (@output, $href);
				};
				last};
		/selgetinfo/   and do { $output = {
									ENTRIES => hex($r->{ENTRIES}[0]),
									HANDLE  => $r->{HANDLE}[0],
									SPACE   => hex($r->{SPACE}[0]),
									ADDTIME  => $r->{ADDTIME}[0],
									ERASETIME  => $r->{ERASETIME}[0],
									};
							    last };
		/keybsend/     and do { $output = $msg . "\n"; last};
		/fwconfig/     and do { $output = $r->{PROPTEXT}[0]; last}; # TODO
		die ('Unknown function: '.$cmd."\n".$r."\n");
		#die ('Unknown function: '.$cmd."\n".Dumper($r)."\n");
	};
	if (wantarray()) {
		return @output;
	} else {
		return $output;
	};
};

sub _gen_xml {
	my ($function, $input, $handle, $xnum) = @_;
	$handle ||= '0x0';
	$xnum ||= sprintf("0x%x", $EVENTS_PER_REQUEST);
	my $XML ='<?XML version="1.0"?><?RMCXML version="1.0"?><RMCSEQ><REQ CMD="';
	my $_XML = '</REQ></RMCSEQ>';
	my $_QA  = '">';
	my ($CMI, $_CMI) = ('<CMDINPUT>', '</CMDINPUT>');
	my ($KEY, $_KEY) = ('<KEYS>', '</KEYS>');
	my ($ACT, $_ACT) = ('<ACT>', '</ACT>');
	my ($GET, $SET)  = ('<ACTION>get</ACTION>', '<ACTION>set</ACTION>');
	my ($UNM, $_UNM) = ('<USERNAMES>', '</USERNAMES>');
	my $UNM2 = '<USERNAMES></USERNAMES>';
	my ($PRN, $_PRN) = ('<PROPNAMES>', '</PROPNAMES>');
	my ($HND, $_HND) = ('<HANDLE>', '</HANDLE>');
	my ($OFS, $_OFS) = ('<OFFSET>', '</OFFSET>');
	my ($ORD, $_ORD) = ('<ORDER>', '</ORDER>');
	my ($NUM, $_NUM) = ('<NUM>', '</NUM>');
	my ($SRL, $_SRL) = ('<SENSORLIST>', '</SENSORLIST>');
	my ($PRL, $_PRL) = ('<PROPLIST>', '</PROPLIST>');
	my $PNAMES = '';
	foreach my $PNAME (@PROPNAMES) {
		$PNAMES .= '<PROPNAME NAME="' . $PNAME . '"/>';
	}

	my $xml = $XML . $function . $_QA;
	for ($function) {
		/sensorpropget/ and do { $xml .= $HND . $handle . $_HND .
										 $SRL . $input . $_SRL .
										 $PRL . $PNAMES . $_PRL;
								last};
		/keybsend/	   and do { $xml .= $KEY . $input . $_KEY; last};
		/xml2cli/      and do { $xml .= $CMI . $input . $_CMI; last};
		/xml2cli2/     and do { $xml .= $CMI . $input . $_CMI; last};
		/serveraction/ and do { $xml .= $ACT . $input . $_ACT; last};
		/fwconfig/ and do { $xml .= $GET . $UNM2 . $PRN . $input . $_PRN; last};
		/crsportget/   and last;
		/getconstatus/ and last;
		/sensorlist/   and last;
		/getvirstatus/ and last;
		/serverstatus/ and last;
		/multiinfo/    and last;
		/selgetinfo/   and last;
		/selgetentry/  and do { $xml .= $HND . $handle . $_HND .
										$OFS . $input  . $_OFS .
										$ORD . '0x0' . $_ORD .
										$NUM . $xnum . $_NUM;
								last};
		die "Unknown function: $function\n";
	};
	$xml .= $_XML . "\n";
	return $xml;
};

sub _send_xml_command {
	my ($self,$xml) = @_;
	my $host = $self->{host};
	my $sid = $self->establish_session();
	print "host = [$host] sid = [$sid] xml = [$xml]\n" if ($DEBUG);
	my $cgibin = $self->_http() . "://$host/cgi/bin";
	my $request = HTTP::Request->new(POST => $cgibin);
	$request->header(Cookie => "sid=$sid");
	$request->content_type('application/x-www-form-urlencoded');
	$request->content($xml);
	my $response = $self->{'_ua'}->request($request);
	die("While trying to POST to $cgibin: " . $response->status_line . "\n")
		unless ($response->is_success);
	
	my $content = $response->content;
	print "_send_xml_command: content = $content\n" if ($DEBUG);
	return $content;
};

sub _checked_response {
	my $response = shift;
	my $ref;
	eval { $ref= $xs->XMLin($response); };
	die ('Invalid XML from RAC:'. $response . "\n") if ($@);
	my $rc = '0x0';
	if ($ref->{RC}) {	# challenge response
		$rc = $ref->{RC}[0];
	} else {			# normal response
		$rc = $ref->{RESP}[0]->{RC}[0];
	};
	my $msg = $RAC_CODE{$rc} || $RAC_CODE{'x'};
	if ($rc !~ /^0x300../ && $rc ne '0x0') {
		die ( $msg . " [rc=$rc]\n");
	};
	return $ref;
};

sub _http {
	my $self = shift;
	my $p = $self->{protocol} || $self->_protocol();
	return $p;
};

# returns string 'http' or 'https' depending on firmware version
sub _protocol {
	my $self = shift;
	my $host = $self->{host};
	my $url = "http://$host/";
	my $response = $self->{'_ua'}->get($url);
	die("While trying to get $url: " . $response->status_line . "\n")
		unless ($response->is_success);

	print "_protocol: content = ". $response->content . "\n" if ($DEBUG);
	my $p = "http";
	$p = "https" if ($response->content =~ /refresh/i);
	$self->{protocol} = $p; 
	return $p;
};

sub _logout {
	my $self = shift;
	my $host = $self->{host};
	my $url = $self->_http() . "://$host/cgi/logout";
	my $response = $self->{'_ua'}->get($url);
	die("While trying to get $url: " . $response->status_line . "\n")
		unless ($response->is_success);
	return;
};

sub _login {
	my $self = shift;
	my $host = $self->{host};
	my $url = $self->_http() . "://$host/cgi/challenge";
	my $response = $self->{'_ua'}->get($url);
	die("While trying to get $url: " . $response->status_line . "\n")
		unless ($response->is_success);

	my $content = $response->content;
	print "_login: content = $content\n" if ($DEBUG);
	my $ref = _checked_response($content);
	my $challenge = $ref->{CHALLENGE}[0];
	my $sid = $response->headers->header('Set-Cookie');
	die('Huh ? No SessionId header !' . "\n") unless defined($sid);
	chomp($sid);
	$sid =~ s/.*sid=(.*);.*/$1/;

	my $password = $self->{password};
	my $hash = _hash($password, $challenge);
	my $user =  $self->{user};
	$url = $self->_http() . "://$host/cgi/login?user=$user&hash=$hash";
	my $request = HTTP::Request->new(GET => $url);
	$request->header(Cookie => "sid=$sid");
	$response = $self->{'_ua'}->request($request);
	die("While trying to get $url: " . $response->status_line . "\n")	
		unless ($response->is_success);

	$content = $response->content;
	print "_login(2): content = $content\n" if ($DEBUG);
	$ref = _checked_response($content);

	$self->{session_id} = $sid;
	return $sid;
};

sub _verifysession {
	my $self = shift;
	my $host = $self->{host};
	my $sid = $self->{session_id};
	my $cgibin = $self->_http() . "://$host/cgi/bin";
	my $request = HTTP::Request->new(POST => $cgibin);
	$request->header(Cookie => "sid=$sid");
	$request->content_type('application/x-www-form-urlencoded');
	$request->content(_gen_xml('xml2cli', 'getsysinfo -A'));
	my $response = $self->{'_ua'}->request($request);
	my $verified = $response->is_success;
	return $verified;
};

sub _date {
	my $dt = shift;
	my ($year,$mon,$mday,$hour,$min,$sec) = unpack('a4a2a2a2a2a2A*',$dt);
	my $t = POSIX::mktime($sec, $min, $hour, $mday, $mon - 1, $year - 1900);
	die ("Invalid date: $!\n") if not defined($t);
	my $s = POSIX::ctime($t);
	chomp($s);
	return $s;
};

sub _interpret_codes {
	my $sref = shift;
	$sref->{SEVERITY} = $SEVERITY{$sref->{SEVERITY}};
	my $type = $sref->{SENSOR_TYPE};
	# Correct faulty logic
	if ($type =~ m/fan/i) {
		$type = 'fan control' if ($sref->{NAME} =~ m/fan control/i);
	};
	$type = lc($type);
	$type =~ s/^\s*//;
	$type =~ s/\s*$//;
	my $val;
	if (exists($CODES{$type})) {
		$val  = $sref->{VAL};
		if ($val =~ m/C0:/i) {
			$val =~ s/C0://i;
			$val =~ s/([0-9]*):.*/$1/i;
		};
		my $eref = $CODES{$type};
		my %vals = %$eref;
		# Work around firmware bug where VAL = "Device detected";
		if ($val =~ m/^[0-9a-f ]*$/i) {
			$val = hex($val);
		};
		$val = $vals{$val};
		if (defined($val)) {
			$sref->{VAL} = $val;
		};
	};
	return $sref;
};

sub _canonic {
	my $s = shift;
	$s =~ s/\s/_/g;
	$s = uc($s);
	return $s;
};

sub _checked_reverse {
	my $href = shift;
	my $b = scalar(keys %$href);
	my %r = reverse %$href;
	my $a = scalar(keys %r);
	die ("No 1-1 mapping. $b <> $a" ) if ($b ne $a);
	return \%r;
};

sub _hash {
	my ($password, $challenge) = @_;
	print "password = [$password] challenge = [$challenge]\n" if ($DEBUG);
	my @challenge_bytes = unpack 'c16', decode_base64($challenge);
	my @pwd_hash		= unpack 'c16', md5($password);
	my @xor_bytes;
	for my $i (0..15) {
		$xor_bytes[$i] = $challenge_bytes[$i] ^ $pwd_hash[$i];
	};
	my $hash = md5(pack 'c16', @xor_bytes);
	my $crc = _crc16($hash);
	$hash .= chr($crc & 0xff) . chr($crc >> 8 & 0xff);
	return encode_base64($hash, "");
}

sub _crc16 {
	my $str = shift;
	my $crc = 0;
	for my $k (0..length($str)-1) {
		$crc ^= ord(substr($str, $k, 1)) << 8;
		for (0..7) {
			$crc = (($crc & 0x8000) == 32768 ? ($crc<<1) ^ 0x1021 : $crc<<1);
		}
	}
	$crc = $crc & 0xFFFF;
	return $crc;
}

sub prompt {
	my ($message, $default) = @_;
	my $ISA_TTY = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT));
	my $dispdef = defined $default ? "[$default] " : " ";
	$default = defined $default ? $default : "";
	my $answer = '';
	local $|=1;
	print "$message $dispdef";
	if (!$ISA_TTY) {
		print "$default\n";
	} else {
		chomp($answer = <STDIN>);
	};
	return ($answer ne '') ? $answer : $default;
};

1;

__END__

=head1 NAME

PowerEdge::RAC - Remotely manage your PowerEdges with Perl

=head1 SYNOPSIS

  use PowerEdge::RAC;
  
  my $server = new PowerEdge::RAC(
                host => '192.168.0.120',
                user => 'root',
                password => 'calvin'
  );
  
  $server->test_email('root');
  $server->power_on();
  
  $| = 1;
  
  while(!$server->is_powered_on()) {
      print ".";
      sleep 1;
  };
  
  print "\n", $server->post_log();
  
  print $server->read_sensors_txt(), "\n";


=head1 DESCRIPTION

PowerEdge::RAC supplies some functions that you may find useful to
remotely manage PowerEdge servers.

PowerEdge servers can be remotely managed with the aid of special hardware
known as RAC cards (Remote Access Controller, DRAC II and III, ERA, ERA/O).
The RAC can be accessed through utilities that run atop the OS, but
also directly, through its own NIC. Giving you the ability to start a server
even from a hung or powered-down state.  For this last vital function Dell
provides only a slowish and somewhat flaky interface tying you down to 
running Java applets in an unfree browser on an unfree OS. This module 
tries to remedy that.


=head1 METHODS


=head2 new([host => $h,] [user => $u,] [password => $p,] [session_id => $s])  

Constructs a new PowerEdge::RAC object with specified parameters.
This does not yet establish a session with the specified RAC.
That is delayed until you use any of the methods below.
If you must you can also call establish_session() explicitely. 

Warning: currently all other methods return everything in one scalar string. 
In future this will likely change to lists or hashes for those methods 
that return multiple pieces of information (lines) like rac_log(), 
post_log(), sysinfo(), sessions(), arp() etc.

=head2 session_id() or session_id($sid)

Return the session_id or set it to the value $sid

Note. The RAC keeps a table of active sessions of the form

session_id user state IPaddress time

with only 16 slots. Each new login uses up another slot. Since
a session expires only after a few minutes this table could easily
fill up. That is why PowerEdge::RAC tries to reuse the session_id
on subsequent requests. If you want to preserve sessions across
instances of PowerEdge::RAC you'll have to store the session 
externally. E.g. in a file or in a cookie when you run
PowerEdge::RAC from a CGI environment.

=head2 sessions()

Returns the RAC's active sessions.

=head2 sysinfo()

Return information about the system as stored in the RAC.
Note that you cannot set the information this way. You'll have to 
use racadm or OMSA for that. Returns a list of info lines in list 
context, so you can say print $server->sysinfo(); 
In scalar context returns a hashref. Optionally takes one argument
and prints the value of relevant system info item only.
Example: print $server->sysinfo('Firmware version');  

=head2 multi_info()

Return information about the system as stored in the RAC.
This command is new in the 2.0 firmware and appears to be aimed at replacing
getsysinfo. It has the same information only in a more structured way.
Returns a hashref. Call Dumper($href) if you want to know what is there ..
Subject to change.

=head2 is_powered_on()

Returns 1 when the server is in powered-on state, 0 otherwise.

=head2 power_off()

Power off the server.
WARNING. This does NOT allow the OS to shutdown gracefully. In fact the 
RAC appears to be incapable of doing that.  Although it accepts commands
like `serveraction graceshutdown' that would suggest otherwise, none of 
appear to be implemented ...
After giving power_off() the RAC simply turns of the power to the system.
Only use this function when the OS is down and filesystems are unmounted. 
Then again, if your system hangs and you are 60 miles away from the console 
this might just save your day ...
UPDATE: The new 2.00 firmware (released 23 jan 2003) does allow this.
See the next command.

=head2 graceshutdown()

Shutdown the OS gracefully if possible.  For this to work the RAC must 
be able to communicate with the main system. In particular
 o the esm module must be loaded
 o racser must be running
 o racsrvc must be running
If this succeeds the command that will be invoked is shutdown -h now
You then still have to call power_off() to power off the server.
You'ld better sleep 60 seconds before that or risk killing the machine while 
it's shutting down.  This only works with RAC firmware >= 2.00.

=head2 power_on()

Power on the server. Has no effect when the server is already powered on.

=head2 power_cycle()

Power off the server. Wait. Then power it on again.

=head2 test_email('racuser')

Makes the RAC send a test e-mail to the adres configured for racuser.
The specified user must already have been configured in the RAC
(again using either racadm or the OMSA) or the test will fail.
Also a mail server must be configured and that server must be setup 
to relay mail from the RAC's IP address.
 
=head2 arp()

Show the RAC's arp cache.

=head2 ping($ip)

Make the RAC ping the specified IP address.

=head2 netstat()

Takes one argument, a number from '1' to '9'.
Show netstat output for the specified interface.
Will return a summary for all interfaces when invoked without arguments. 

=head2 post_log()

Returns the post messages.

=head2 event_log()

Takes one argument and returns the specified number of messages lines
from the RAC's System Event Log. As one string in scalar context 
or as a list of hash references in list context. Each line (hash)
has: severity, sensor_id, message, date, (key, tr, pc).

=head2 clear_event_log()

Clears the RAC's System Event Log.

=head2 rac_log()

Takes one argument and returns the specified number of messages 
from the RAC log. The format of the message lines varies between 
different hardware/firmware revisions.

=head2 clear_rac_log()

Clears the RAC log.

=head2 rac_reset()

Resets the RAC card (not the server!). After this it will take approx. 
45 seconds before the card is again ready to accepts commands.

=head2 get_gmt()

Get the date and time from the RAC. Note that before the time is set
the RAC uses a cyclic counter that only counts 24 hours. This seems to 
be indicated by the string DSU appearing in the result in those cases.
The time on the RAC can be set by either the following set_gmt()
command or e.g. with the racadm utility.

=head2 set_gmt()

Set the date and time on the RAC. This needs to be set after the card
has been reset, either by rac_reset() or e.g. after the card was 
disconnected from power. Takes two arguments, the desired time in seconds 
sinds the epoch, 00:00:00 UTC Jan 1th 1970, and an offset in seconds.
Without arguments uses the localtime of the systems this module runs on. 

=head2 read_sensors_txt()

Produces a formatted text version of the sensor readings. For all sensors or 
for the list of sensorids that can optionally be specified as an argument. 
If you want control over the formatting of the sensor output use one of 
the following functions and maybe using this function as a starting point.

=head2 read_sensors_by_id()

Takes a list of sensorid's as argument and returns a hash of hashreferences
that map sensorproperties to values, for the respective sensorid's. 
Without arguments this tries to determine a list of all sensors that
are available and returns those along with their values. 
When the server is powered off the sensors cannot reliably be detected. 
In this case read_sensors() will return an empty list (or scalar).
See the caveat under sensorlist() below.

=head2 read_sensors_by_name()

Same as the previous function only sensors can be specified by their
name. You can use the next function sensorid_to_name() to obtain
a list of sensorid's and names for your hardware. This function is provided 
mainly to improve the readability of your code. Beware of the overhead
your program may incur because of the need to obtain the mapping
from the RAC. See the next function.

=head2 sensorid_to_name()

This returns a hash mapping sensorid's to names. When passed a list
of sensorid's it returns the names of the sensors, again as a list.
Sensorsid's and names can vary between firmware and hardware versions
and system model. Therefore the mapping has to be obtained from the RAC
at least once. It costs about 8 seconds to query all sensors in a PE1650 
for their name. As long as hardware and firmware don't change this 
mapping won't either so it is cached by this module. This should be safe 
as long as you don't swap machines in between queries ;-)

If you are going to query a lot of machines regularly, the fastest way is
to create a list of sensorids for your hard/firmware once and hardcode 
that in your scripts. Easily obtaining that list is exactly what this
function is for.  See the caveat under sensorlist() below.

=head2 sensorlist()

Returns a list of sensorid's. Not very useful in itself but it
can be used as input for the read_sensors_by_id() function above. 
Mainly a faster way than read_sensors_by_id() to compare the available 
sensors between different hardware.
This list isn't very reliable though. The sensorids returned do not 
necessarily reflect actual hardware found in your system. When queried 
for their properties some return no values others cause long (up to 
200 seconds) timeouts.

=head2 getniccfg()

Returns the RAC's NIC configuration: IP address (which you already 
have to know to use this function ;-)), netmask and gateway.

=head2 setniccfg()

Set the RAC's NIC configuration: takes the following arguments:
IP address, netmask and gateway. The change will only take effect
after a reset. So you could change all your cards at once and call 
rac_reset() on each when ready. After a reset it takes about 
thirty seconds for the RAC to come up with its new IP.

=head2 fwupdate()

RAC firmware update.  This function takes two arguments:
The IP address of the TFTP server and the directory on the TFTP server 
where the firmware update resides. For example:
$rac->fwupdate('192.168.1.1', '/rac/firmware/22/');

Note that the name of the actual file that the RAC tries to transfer
depends on system model and should not be included as the firmware itself 
appends it. Therefore be sure to end the directory name with a slash.

The firmware isn't very clever at detecting various errors that may
cause the TFTP transfer to fail and simply times out after ninety
seconds. This module makes no attempt to improve this situation.

WARNING: this function may take several minutes to complete.
It involves flashing new firmware to the RAC so the author strongly advises
you to not unplug the machine from power during an update !
The author has never encountered any problems and the mechanism appears
to be quite resilient against errors but your mileage may vary. 
Use at your own risk.

See the next function too.

=head2 fwupdate_status()

The fwupdate update function will print messages informing the user about 
the progress of an update if stdout is a terminal.
This isn't possible when it is invoked in a web environment.
The fwupdate_status function can be used to poll the status of an update
and thus makes it possible to provide immediate feedback when the
user presses a button for example.

=head2 enable_dhcp()

Set the RAC's NIC configuration to use DHCP. This will only take
effect after a reset. So you could set all your cards to DHCP and
call rac_reset() when ready.


=head1 EXAMPLES

See the demo scripts included with the source package.

=head1 LICENSE

PowerEdge::RAC is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.  For more information see the 
"README" or "Artistic" files provided with the Perl distribution.

=head1 AUTHOR & COPYRIGHT

Copyright (c) 2003 Harold van Oostrom. All rights reserved.

=head1 SEE ALSO

L<MIME::Base64>, L<LWP::UserAgent>, L<XML::Simple>, L<Digest::MD5>, L<Crypt::SSLeay>

=cut