2010-01-30 23:20:11 +00:00
#!/usr/bin/perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
#egan@us.ibm.com
#modified by jbjohnso@us.ibm.com
#(C)IBM Corp
package xCAT_plugin::ipmi ;
BEGIN
{
$ ::XCATROOT = $ ENV { 'XCATROOT' } ? $ ENV { 'XCATROOT' } : '/opt/xcat' ;
}
use lib "$::XCATROOT/lib/perl" ;
use strict ;
use warnings "all" ;
use xCAT::GlobalDef ;
use xCAT_monitoring::monitorctrl ;
use xCAT::SPD qw/decode_spd/ ;
use xCAT::IPMI ;
use POSIX qw( ceil floor ) ;
use Storable qw( store_fd retrieve_fd thaw freeze ) ;
use xCAT::Utils ;
use xCAT::SvrUtils ;
use xCAT::Usage ;
use Thread qw( yield ) ;
use LWP 5.64 ;
use HTTP::Request::Common ;
my $ iem_support ;
2010-02-02 01:32:04 +00:00
my $ vpdhash ;
2010-03-03 21:28:52 +00:00
my % allerrornodes = ( ) ;
2010-01-30 23:20:11 +00:00
eval {
require IBM::EnergyManager ;
$ iem_support = 1 ;
} ;
require Exporter ;
our @ ISA = qw( Exporter ) ;
our @ EXPORT = qw(
ipmicmd
) ;
sub handled_commands {
return {
2010-02-01 18:01:35 +00:00
rpower = > 'nodehm:power,mgt' , #done
2010-01-30 23:20:11 +00:00
renergy = > 'nodehm:power,mgt' ,
2010-02-01 18:01:35 +00:00
getipmicons = > 'ipmi' , #done
2010-02-02 01:32:04 +00:00
rspconfig = > 'nodehm:mgt' , #done
2010-02-01 18:01:35 +00:00
rspreset = > 'nodehm:mgt' , #done
2010-02-03 12:52:42 +00:00
rvitals = > 'nodehm:mgt' , #done
2010-02-05 02:44:47 +00:00
rinv = > 'nodehm:mgt' , #done
2010-02-01 18:01:35 +00:00
rsetboot = > 'nodehm:mgt' , #done
2010-02-01 19:20:57 +00:00
rbeacon = > 'nodehm:mgt' , #done
2010-01-30 23:20:11 +00:00
reventlog = > 'nodehm:mgt' ,
2010-02-05 02:44:47 +00:00
# rfrurewrite => 'nodehm:mgt', #deferred, doesn't even work on several models, no one asks about it, keeping it commented for future requests
2010-02-02 01:32:04 +00:00
getrvidparms = > 'nodehm:mgt' #done
2010-01-30 23:20:11 +00:00
}
}
#use Data::Dumper;
use POSIX "WNOHANG" ;
use IO::Handle ;
use IO::Socket ;
use IO::Select ;
use Class::Struct ;
use Digest::MD5 qw( md5 ) ;
use Digest::SHA1 qw( sha1 ) ;
use POSIX qw( WNOHANG mkfifo strftime ) ;
use Fcntl qw( :flock ) ;
#local to module
2010-02-01 19:52:01 +00:00
my $ callback ;
2010-01-30 23:20:11 +00:00
my $ ipmi_bmcipaddr ;
my $ timeout ;
my $ port ;
my $ debug ;
my $ ndebug = 0 ;
my $ sock ;
my $ noclose ;
my % sessiondata ; #hold per session variables, in preparation for single-process strategy
my % pendingtransactions ; #list of peers with callbacks, callback arguments, and timer expiry data
my $ ipmiv2 = 0 ;
my $ authoffset = 0 ;
my $ enable_cache = "yes" ;
my $ cache_dir = "/var/cache/xcat" ;
#my $ibmledtab = $ENV{XCATROOT}."/lib/GUMI/ibmleds.tab";
use xCAT::data::ibmleds ;
use xCAT::data::ipmigenericevents ;
use xCAT::data::ipmisensorevents ;
my $ cache_version = 3 ;
my % sdr_caches ; #store sdr cachecs in memory indexed such that identical nodes do not hit the disk multiple times
2010-03-03 21:28:52 +00:00
#my $status_noop="XXXno-opXXX";
2010-01-30 23:20:11 +00:00
my % idpxthermprofiles = (
'0z' = > [ 0x37 , 0x41 , 0 , 0 , 0 , 0 , 5 , 0xa , 0x3c , 0xa , 0xa , 0x1e ] ,
'1a' = > [ 0x30 , 0x3c , 0 , 0 , 0 , 0 , 5 , 0xa , 0x3c , 0xa , 0xa , 0x1e ] ,
'2b' = > [ 0x30 , 0x3c , 0 , 0 , 0 , 0 , 5 , 0xa , 0x3c , 0xa , 0xa , 0x1e ] ,
'3c' = > [ 0x30 , 0x3c , 0 , 0 , 0 , 0 , 5 , 0xa , 0x3c , 0xa , 0xa , 0x1e ] ,
'4d' = > [ 0x37 , 0x44 , 0 , 0 , 0 , 0 , 5 , 0xa , 0x3c , 0xa , 0xa , 0x1e ] ,
'5e' = > [ 0x37 , 0x44 , 0 , 0 , 0 , 0 , 5 , 0xa , 0x3c , 0xa , 0xa , 0x1e ] ,
'6f' = > [ 0x35 , 0x44 , 0 , 0 , 0 , 0 , 5 , 0xa , 0x3c , 0xa , 0xa , 0x1e ] ,
) ;
my % codes = (
0x00 = > "Command Completed Normal" ,
0xC0 = > "Node busy, command could not be processed" ,
0xC1 = > "Invalid or unsupported command" ,
0xC2 = > "Command invalid for given LUN" ,
0xC3 = > "Timeout while processing command, response unavailable" ,
0xC4 = > "Out of space, could not execute command" ,
0xC5 = > "Reservation canceled or invalid reservation ID" ,
0xC6 = > "Request data truncated" ,
0xC7 = > "Request data length invalid" ,
0xC8 = > "Request data field length limit exceeded" ,
0xC9 = > "Parameter out of range" ,
0xCA = > "Cannot return number of requested data bytes" ,
0xCB = > "Requested Sensor, data, or record not present" ,
0xCB = > "Not present" ,
0xCC = > "Invalid data field in Request" ,
0xCD = > "Command illegal for specified sensor or record type" ,
0xCE = > "Command response could not be provided" ,
0xCF = > "Cannot execute duplicated request" ,
0xD0 = > "Command reqponse could not be provided. SDR Repository in update mode" ,
0xD1 = > "Command response could not be provided. Device in firmware update mode" ,
0xD2 = > "Command response could not be provided. BMC initialization or initialization agent in progress" ,
0xD3 = > "Destination unavailable" ,
0xD4 = > "Insufficient privilege level" ,
0xD5 = > "Command or request parameter(s) not supported in present state" ,
0xFF = > "Unspecified error" ,
) ;
#Payload types:
# 0 => IPMI (format 1 0)
# 1 => SOL 1 0
# 0x10 => rmcp+ open req 1 0
# 0x11 => rmcp+ response 1 0
# 0x12 => rakp1 (all 1 0)
# 0x13 => rakp2
# 0x14 => rakp3
# 0x15 => rakp4
my % units = (
0 = > "" , #"unspecified",
1 = > "C" ,
2 = > "F" ,
3 = > "K" ,
4 = > "Volts" ,
5 = > "Amps" ,
6 = > "Watts" ,
7 = > "Joules" ,
8 = > "Coulombs" ,
9 = > "VA" ,
10 = > "Nits" ,
11 = > "lumen" ,
12 = > "lux" ,
13 = > "Candela" ,
14 = > "kPa" ,
15 = > "PSI" ,
16 = > "Newton" ,
17 = > "CFM" ,
18 = > "RPM" ,
19 = > "Hz" ,
20 = > "microsecond" ,
21 = > "millisecond" ,
22 = > "second" ,
23 = > "minute" ,
24 = > "hour" ,
25 = > "day" ,
26 = > "week" ,
27 = > "mil" ,
28 = > "inches" ,
29 = > "feet" ,
30 = > "cu in" ,
31 = > "cu feet" ,
32 = > "mm" ,
33 = > "cm" ,
34 = > "m" ,
35 = > "cu cm" ,
36 = > "cu m" ,
37 = > "liters" ,
38 = > "fluid ounce" ,
39 = > "radians" ,
40 = > "steradians" ,
41 = > "revolutions" ,
42 = > "cycles" ,
43 = > "gravities" ,
44 = > "ounce" ,
45 = > "pound" ,
46 = > "ft-lb" ,
47 = > "oz-in" ,
48 = > "gauss" ,
49 = > "gilberts" ,
50 = > "henry" ,
51 = > "millihenry" ,
52 = > "farad" ,
53 = > "microfarad" ,
54 = > "ohms" ,
55 = > "siemens" ,
56 = > "mole" ,
57 = > "becquerel" ,
58 = > "PPM" ,
59 = > "reserved" ,
60 = > "Decibels" ,
61 = > "DbA" ,
62 = > "DbC" ,
63 = > "gray" ,
64 = > "sievert" ,
65 = > "color temp deg K" ,
66 = > "bit" ,
67 = > "kilobit" ,
68 = > "megabit" ,
69 = > "gigabit" ,
70 = > "byte" ,
71 = > "kilobyte" ,
72 = > "megabyte" ,
73 = > "gigabyte" ,
74 = > "word" ,
75 = > "dword" ,
76 = > "qword" ,
77 = > "line" ,
78 = > "hit" ,
79 = > "miss" ,
80 = > "retry" ,
81 = > "reset" ,
82 = > "overflow" ,
83 = > "underrun" ,
84 = > "collision" ,
85 = > "packets" ,
86 = > "messages" ,
87 = > "characters" ,
88 = > "error" ,
89 = > "correctable error" ,
90 = > "uncorrectable error" ,
) ;
my % chassis_types = (
0 = > "Unspecified" ,
1 = > "Other" ,
2 = > "Unknown" ,
3 = > "Desktop" ,
4 = > "Low Profile Desktop" ,
5 = > "Pizza Box" ,
6 = > "Mini Tower" ,
7 = > "Tower" ,
8 = > "Portable" ,
9 = > "LapTop" ,
10 = > "Notebook" ,
11 = > "Hand Held" ,
12 = > "Docking Station" ,
13 = > "All in One" ,
14 = > "Sub Notebook" ,
15 = > "Space-saving" ,
16 = > "Lunch Box" ,
17 = > "Main Server Chassis" ,
18 = > "Expansion Chassis" ,
19 = > "SubChassis" ,
20 = > "Bus Expansion Chassis" ,
21 = > "Peripheral Chassis" ,
22 = > "RAID Chassis" ,
23 = > "Rack Mount Chassis" ,
) ;
my % MFG_ID = (
2 = > "IBM" ,
343 = > "Intel" ,
) ;
my % PROD_ID = (
"2:34869" = > "e325" ,
"2:3" = > "x346" ,
"2:4" = > "x336" ,
"343:258" = > "Tiger 2" ,
"343:256" = > "Tiger 4" ,
) ;
my $ localtrys = 3 ;
my $ localdebug = 0 ;
struct SDR = > {
rec_type = > '$' ,
sensor_owner_id = > '$' ,
sensor_owner_lun = > '$' ,
sensor_number = > '$' ,
entity_id = > '$' ,
entity_instance = > '$' ,
sensor_init = > '$' ,
sensor_cap = > '$' ,
sensor_type = > '$' ,
event_type_code = > '$' ,
ass_event_mask = > '@' ,
deass_event_mask = > '@' ,
dis_read_mask = > '@' ,
sensor_units_1 = > '$' ,
sensor_units_2 = > '$' ,
sensor_units_3 = > '$' ,
linearization = > '$' ,
M = > '$' ,
tolerance = > '$' ,
B = > '$' ,
accuracy = > '$' ,
accuracy_exp = > '$' ,
R_exp = > '$' ,
B_exp = > '$' ,
analog_char_flag = > '$' ,
nominal_reading = > '$' ,
normal_max = > '$' ,
normal_min = > '$' ,
sensor_max_read = > '$' ,
sensor_min_read = > '$' ,
upper_nr_threshold = > '$' ,
upper_crit_thres = > '$' ,
upper_ncrit_thres = > '$' ,
lower_nr_threshold = > '$' ,
lower_crit_thres = > '$' ,
lower_ncrit_thres = > '$' ,
pos_threshold = > '$' ,
neg_threshold = > '$' ,
id_string_type = > '$' ,
id_string = > '$' ,
#LED id
led_id = > '$' ,
fru_type = > '$' ,
fru_subtype = > '$' ,
} ;
struct FRU = > {
rec_type = > '$' ,
desc = > '$' ,
value = > '$' ,
} ;
sub decode_fru_locator { #Handle fru locator records
my @ locator = @ _ ;
my $ sdr = SDR - > new ( ) ;
$ sdr - > rec_type ( 0x11 ) ;
$ sdr - > sensor_owner_id ( "FRU" ) ;
$ sdr - > sensor_owner_lun ( "FRU" ) ;
$ sdr - > sensor_number ( $ locator [ 7 ] ) ;
unless ( $ locator [ 8 ] & 0x80 and ( $ locator [ 8 ] & 0x1f ) == 0 and $ locator [ 9 ] == 0 ) {
#only logical devices at lun 0 supported for now
return undef ;
}
unless ( ( $ locator [ 16 ] & 0xc0 ) == 0xc0 ) { #Only unpacked ASCII for now, no unicode or BCD plus yet
return undef ;
}
my $ idlen = $ locator [ 16 ] & 0x3f ;
unless ( $ idlen > 1 ) { return undef ; }
$ sdr - > id_string ( pack ( "C*" , @ locator [ 17 .. 17 + $ idlen - 1 ] ) ) ;
$ sdr - > fru_type ( $ locator [ 11 ] ) ;
$ sdr - > fru_subtype ( $ locator [ 12 ] ) ;
return $ sdr ;
}
sub waitforack {
my $ sock = shift ;
my $ select = new IO:: Select ;
$ select - > add ( $ sock ) ;
my $ str ;
if ( $ select - > can_read ( 60 ) ) { # Continue after 60 seconds, even if not acked...
if ( $ str = <$sock> ) {
} else {
$ select - > remove ( $ sock ) ; #Block until parent acks data
}
}
}
sub translate_sensor {
my $ reading = shift ;
my $ sdr = shift ;
my $ unitdesc ;
my $ value ;
my $ lformat ;
my $ per ;
$ unitdesc = $ units { $ sdr - > sensor_units_2 } ;
if ( $ sdr - > rec_type == 1 ) {
$ value = ( ( $ sdr - > M * $ reading ) + ( $ sdr - > B * ( 10 ** $ sdr - > B_exp ) ) ) * ( 10 ** $ sdr - > R_exp ) ;
} else {
$ value = $ reading ;
}
if ( $ sdr - > rec_type != 1 or $ sdr - > linearization == 0 ) {
$ reading = $ value ;
if ( $ value == int ( $ value ) ) {
$ lformat = "%-30s%8d%-20s" ;
} else {
$ lformat = "%-30s%8.3f%-20s" ;
}
} elsif ( $ sdr - > linearization == 7 ) {
if ( $ value > 0 ) {
$ reading = 1 / $ value ;
} else {
$ reading = 0 ;
}
$ lformat = "%-30s%8d %-20s" ;
} else {
$ reading = "RAW($sdr->linearization) $reading" ;
}
if ( $ sdr - > sensor_units_1 & 1 ) {
$ per = "% " ;
} else {
$ per = " " ;
}
my $ numformat = ( $ sdr - > sensor_units_1 & 0b11000000 ) >> 6 ;
if ( $ numformat ) {
if ( $ numformat eq 0b11 ) {
#Not sure what to do.. leave it alone for now
} else {
if ( $ reading & 0b10000000 ) {
if ( $ numformat eq 0b01 ) {
$ reading = 0 - ( ( ~ ( $ reading & 0b01111111 ) ) & 0b1111111 ) ;
} elsif ( $ numformat eq 0b10 ) {
$ reading = 0 - ( ( ( ~ ( $ reading & 0b01111111 ) ) & 0b1111111 ) + 1 ) ;
}
}
}
}
if ( $ unitdesc eq "Watts" ) {
my $ f = ( $ reading * 3.413 ) ;
$ unitdesc = "Watts (" . int ( $ f + .5 ) . " BTUs/hr)" ;
#$f = ($reading * 0.00134);
#$unitdesc .= " $f horsepower)";
}
if ( $ unitdesc eq "C" ) {
my $ f = ( $ reading * 9 / 5 ) + 32 ;
$ unitdesc = "C (" . int ( $ f + .5 ) . " F)" ;
}
if ( $ unitdesc eq "F" ) {
my $ c = ( $ reading - 32 ) * 5 / 9 ;
$ unitdesc = "F (" . int ( $ c + .5 ) . " C)" ;
}
return "$reading $unitdesc" ;
}
sub ipmicmd {
my $ sessdata = shift ;
my $ rc = 0 ;
my $ text = "" ;
my $ error = "" ;
my @ output ;
my $ noclose = 0 ;
$ sessdata - > { ipmisession } - > login ( callback = > \ & on_bmc_connect , callback_args = > $ sessdata ) ;
}
sub on_bmc_connect {
my $ status = shift ;
my $ sessdata = shift ;
my $ command = $ sessdata - > { command } ;
if ( $ status =~ /ERROR:/ ) {
2010-02-01 19:52:01 +00:00
sendmsg ( [ 1 , $ status ] , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
return ;
}
#ok, detect some common prereqs here, notably:
#getdevid
if ( $ command eq "getrvidparms" ) {
unless ( defined $ sessdata - > { device_id } ) {
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 6 , command = > 1 , data = > [] , callback = > \ & gotdevid , callback_args = > $ sessdata ) ;
2010-01-31 18:38:46 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 19:20:57 +00:00
getrvidparms ( $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
#initsdr
if ( $ command eq "rinv" or $ command eq "reventlog" or $ command eq "rvitals" ) {
unless ( defined $ sessdata - > { device_id } ) {
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 6 , command = > 1 , data = > [] , callback = > \ & gotdevid , callback_args = > $ sessdata ) ;
2010-01-31 18:38:46 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
2010-01-31 18:38:46 +00:00
unless ( $ sessdata - > { sdr_hash } ) {
2010-01-30 23:20:11 +00:00
initsdr ( $ sessdata ) ;
2010-01-31 18:38:46 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
}
if ( $ command eq "ping" ) {
2010-02-01 16:35:57 +00:00
sendmsg ( "ping" , $ sessdata - > { node } ) ;
return ;
}
if ( $ command eq "rpower" ) {
return power ( $ sessdata ) ;
2010-02-01 17:22:05 +00:00
} elsif ( $ command eq "rspreset" ) {
return resetbmc ( $ sessdata ) ;
2010-02-02 01:32:04 +00:00
} elsif ( $ command eq "rbeacon" ) {
2010-02-01 17:35:57 +00:00
return beacon ( $ sessdata ) ;
2010-02-02 01:32:04 +00:00
} elsif ( $ command eq "rsetboot" ) {
2010-02-01 18:01:35 +00:00
return setboot ( $ sessdata ) ;
2010-02-02 01:32:04 +00:00
} elsif ( $ command eq "rspconfig" ) {
shift @ { $ sessdata - > { extraargs } } ;
if ( $ sessdata - > { subcommand } =~ /=/ ) {
setnetinfo ( $ sessdata ) ;
} else {
getnetinfo ( $ sessdata ) ;
}
} elsif ( $ command eq "rvitals" ) {
vitals ( $ sessdata ) ;
2010-02-04 17:05:21 +00:00
} elsif ( $ command eq "rinv" ) {
inv ( $ sessdata ) ;
2010-02-05 02:44:47 +00:00
} elsif ( $ command eq "reventlog" ) {
eventlog ( $ sessdata ) ;
2010-02-05 18:47:49 +00:00
} elsif ( $ command eq "renergy" ) {
renergy ( $ sessdata ) ;
2010-02-02 01:32:04 +00:00
}
2010-01-30 23:20:11 +00:00
return ;
2010-01-30 23:48:18 +00:00
my @ output ;
2010-01-30 23:20:11 +00:00
2010-01-30 23:48:18 +00:00
my $ rc ; #in for testing, evaluated as a TODO
2010-01-30 23:20:11 +00:00
my $ text ;
2010-01-30 23:48:18 +00:00
my $ error ;
my $ node ;
2010-02-01 16:35:57 +00:00
my $ subcommand = "" ;
2010-02-01 19:20:57 +00:00
if ( $ command eq "rvitals" ) {
2010-01-30 23:20:11 +00:00
( $ rc , @ output ) = vitals ( $ subcommand ) ;
}
elsif ( $ command eq "renergy" ) {
( $ rc , @ output ) = renergy ( $ subcommand ) ;
}
elsif ( $ command eq "rspreset" ) {
( $ rc , @ output ) = resetbmc ( ) ;
$ noclose = 1 ;
}
elsif ( $ command eq "reventlog" ) {
if ( $ subcommand eq "decodealert" ) {
( $ rc , $ text ) = decodealert ( @ _ ) ;
}
else {
( $ rc , @ output ) = eventlog ( $ subcommand ) ;
}
}
elsif ( $ command eq "rinv" ) {
( $ rc , @ output ) = inv ( $ subcommand ) ;
}
elsif ( $ command eq "fru" ) {
( $ rc , @ output ) = fru ( $ subcommand ) ;
}
elsif ( $ command eq "rgetnetinfo" ) {
my @ subcommands = ( $ subcommand ) ;
if ( $ subcommand eq "all" ) {
@ subcommands = (
"ip" ,
"netmask" ,
"gateway" ,
"backupgateway" ,
"snmpdest1" ,
"snmpdest2" ,
"snmpdest3" ,
"snmpdest4" ,
"community" ,
) ;
my @ coutput ;
foreach ( @ subcommands ) {
$ subcommand = $ _ ;
( $ rc , @ output ) = getnetinfo ( $ subcommand ) ;
push ( @ coutput , @ output ) ;
}
@ output = @ coutput ;
}
else {
( $ rc , @ output ) = getnetinfo ( $ subcommand ) ;
}
}
elsif ( $ command eq "generic" ) {
( $ rc , @ output ) = generic ( $ subcommand ) ;
}
elsif ( $ command eq "rfrurewrite" ) {
( $ rc , @ output ) = writefru ( $ subcommand , shift ) ;
}
elsif ( $ command eq "fru" ) {
( $ rc , @ output ) = fru ( $ subcommand ) ;
}
elsif ( $ command eq "rsetboot" ) {
( $ rc , @ output ) = setboot ( $ subcommand ) ;
}
else {
$ rc = 1 ;
$ text = "unsupported command $command $subcommand" ;
}
if ( $ debug ) {
print "$node: command completed\n" ;
}
if ( $ text ) {
push ( @ output , $ text ) ;
}
return ( $ rc , @ output ) ;
}
sub resetbmc {
2010-02-01 17:22:05 +00:00
my $ sessdata = shift ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 6 , command = > 2 , data = > [] , callback = > \ & resetedbmc , callback_args = > $ sessdata ) ;
}
sub resetedbmc {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) {
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
} else {
2010-02-01 17:22:05 +00:00
if ( $ rsp - > { code } ) {
if ( $ codes { $ rsp - > { code } } ) {
sendmsg ( [ 1 , $ codes { $ rsp - > { code } } ] , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
} else {
2010-02-01 17:22:05 +00:00
sendmsg ( [ 1 , sprintf ( "Unknown error %02xh" , $ rsp - > { code } ) ] , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 17:22:05 +00:00
return ;
}
sendmsg ( "BMC reset" , $ sessdata - > { node } ) ;
$ sessdata - > { ipmisession } = undef ; #throw away now unusable session
2010-01-30 23:20:11 +00:00
}
}
sub setnetinfo {
2010-02-02 01:32:04 +00:00
my $ sessdata = shift ;
my $ subcommand = $ sessdata - > { subcommand } ;
2010-01-30 23:20:11 +00:00
my $ argument ;
( $ subcommand , $ argument ) = split ( /=/ , $ subcommand ) ;
my @ input = @ _ ;
2010-05-19 15:42:55 +00:00
my $ netfun = 0x0c ;
2010-01-30 23:20:11 +00:00
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my $ code ;
my $ match ;
2010-02-02 01:32:04 +00:00
my $ channel_number = $ sessdata - > { ipmisession } - > { currentchannel } ;
2010-01-30 23:20:11 +00:00
if ( $ subcommand eq "snmpdest" ) {
$ subcommand = "snmpdest1" ;
}
unless ( defined ( $ argument ) ) {
return 0 ;
}
if ( $ subcommand eq "thermprofile" ) {
return idpxthermprofile ( $ argument ) ;
}
if ( $ subcommand eq "alert" and $ argument eq "on" or $ argument =~ /^en/ or $ argument =~ /^enable/ ) {
2010-05-19 15:42:55 +00:00
$ netfun = 0x4 ;
2010-01-30 23:20:11 +00:00
@ cmd = ( 0x12 , 0x9 , 0x1 , 0x18 , 0x11 , 0x00 ) ;
} elsif ( $ subcommand eq "alert" and $ argument eq "off" or $ argument =~ /^dis/ or $ argument =~ /^disable/ ) {
2010-05-19 15:42:55 +00:00
$ netfun = 0x4 ;
2010-01-30 23:20:11 +00:00
@ cmd = ( 0x12 , 0x9 , 0x1 , 0x10 , 0x11 , 0x00 ) ;
}
elsif ( $ subcommand eq "garp" ) {
my $ halfsec = $ argument * 2 ; #pop(@input) * 2;
if ( $ halfsec > 255 ) {
$ halfsec = 255 ;
}
if ( $ halfsec < 4 ) {
$ halfsec = 4 ;
}
@ cmd = ( 0x01 , $ channel_number , 0x0b , $ halfsec ) ;
}
elsif ( $ subcommand =~ m/community/ ) {
my $ cindex = 0 ;
my @ clist ;
foreach ( 0 .. 17 ) {
push @ clist , 0 ;
}
foreach ( split // , $ argument ) {
$ clist [ $ cindex + + ] = ord ( $ _ ) ;
}
@ cmd = ( 1 , $ channel_number , 0x10 , @ clist ) ;
}
elsif ( $ subcommand =~ m/snmpdest(\d+)/ ) {
my $ dstip = $ argument ; #pop(@input);
2010-02-02 01:32:04 +00:00
$ dstip = inet_ntoa ( inet_aton ( $ dstip ) ) ;
2010-01-30 23:20:11 +00:00
my @ dip = split /\./ , $ dstip ;
@ cmd = ( 0x01 , $ channel_number , 0x13 , $ 1 , 0x00 , 0x00 , $ dip [ 0 ] , $ dip [ 1 ] , $ dip [ 2 ] , $ dip [ 3 ] , 0 , 0 , 0 , 0 , 0 , 0 ) ;
}
#elsif($subcommand eq "alert" ) {
# my $action=pop(@input);
#print "action=$action\n";
# $netfun=0x28; #TODO: not right
# mapping alert action to number
# my $act_number=8;
# if ($action eq "on") {$act_number=8;}
# elsif ($action eq "off") { $act_number=0;}
# else { return(1,"unsupported alert action $action");}
# @cmd = (0x12, $channel_number,0x09, 0x01, $act_number+16, 0x11,0x00);
#}
else {
return ( 1 , "configuration of $subcommand is not implemented currently" ) ;
}
2010-02-02 01:32:04 +00:00
my $ command = shift @ cmd ;
2010-05-19 15:42:55 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > $ netfun , command = > $ command , data = > \ @ cmd , callback = > \ & netinfo_set , callback_args = > $ sessdata ) ;
2010-02-02 01:32:04 +00:00
}
sub netinfo_set {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) {
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
return ;
}
if ( $ rsp - > { code } ) {
if ( $ codes { $ rsp - > { code } } ) {
sendmsg ( [ 1 , $ codes { $ rsp - > { code } } ] , $ sessdata - > { node } ) ;
} else {
sendmsg ( [ 1 , sprintf ( "Unknown ipmi error %02xh" , $ rsp - > { code } ) ] , $ sessdata - > { node } ) ;
}
return ;
}
getnetinfo ( $ sessdata ) ;
return ;
2010-01-30 23:20:11 +00:00
}
sub getnetinfo {
2010-02-02 01:32:04 +00:00
my $ sessdata = shift ;
my $ subcommand = $ sessdata - > { subcommand } ;
my $ channel_number = $ sessdata - > { ipmisession } - > { currentchannel } ;
2010-01-30 23:20:11 +00:00
$ subcommand =~ s/=.*// ;
if ( $ subcommand eq "thermprofile" ) {
my $ code ;
my @ returnd ;
my $ thermdata ;
my $ netfun = 0x2e << 2 ; #currently combined netfun & lun, to be simplified later
my @ cmd = ( 0x41 , 0x4d , 0x4f , 0x00 , 0x6f , 0xff , 0x61 , 0x00 ) ;
my @ bytes ;
my $ error = docmd ( $ netfun , \ @ cmd , \ @ bytes ) ;
@ bytes = splice @ bytes , 16 ;
my $ validprofiles = "" ;
foreach ( keys % idpxthermprofiles ) {
if ( sprintf ( "%02x %02x %02x %02x %02x %02x %02x" , @ bytes ) eq sprintf ( "%02x %02x %02x %02x %02x %02x %02x" , @ { $ idpxthermprofiles { $ _ } } ) ) {
$ validprofiles . = "$_," ;
}
}
if ( $ validprofiles ) {
chop ( $ validprofiles ) ;
return ( 0 , "The following thermal profiles are in effect: " . $ validprofiles ) ;
}
return ( 1 , sprintf ( "Unable to identify current thermal profile: \"%02x %02x %02x %02x %02x %02x %02x\"" , @ bytes ) ) ;
}
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my $ code ;
if ( $ subcommand eq "snmpdest" ) {
$ subcommand = "snmpdest1" ;
}
2010-02-02 01:32:04 +00:00
my $ netfun = 0x0c ;
2010-01-30 23:20:11 +00:00
if ( $ subcommand eq "alert" ) {
2010-05-19 15:42:55 +00:00
$ netfun = 0x4 ;
2010-01-30 23:20:11 +00:00
@ cmd = ( 0x13 , 9 , 1 , 0 ) ;
}
elsif ( $ subcommand eq "garp" ) {
@ cmd = ( 0x02 , $ channel_number , 0x0b , 0x00 , 0x00 ) ;
}
elsif ( $ subcommand =~ m/^snmpdest(\d+)/ ) {
@ cmd = ( 0x02 , $ channel_number , 0x13 , $ 1 , 0x00 ) ;
}
elsif ( $ subcommand eq "ip" ) {
@ cmd = ( 0x02 , $ channel_number , 0x03 , 0x00 , 0x00 ) ;
}
elsif ( $ subcommand eq "netmask" ) {
@ cmd = ( 0x02 , $ channel_number , 0x06 , 0x00 , 0x00 ) ;
}
elsif ( $ subcommand eq "gateway" ) {
@ cmd = ( 0x02 , $ channel_number , 0x0C , 0x00 , 0x00 ) ;
}
elsif ( $ subcommand eq "backupgateway" ) {
@ cmd = ( 0x02 , $ channel_number , 0x0E , 0x00 , 0x00 ) ;
}
elsif ( $ subcommand eq "community" ) {
@ cmd = ( 0x02 , $ channel_number , 0x10 , 0x00 , 0x00 ) ;
}
else {
return ( 1 , "unsupported command getnetinfo $subcommand" ) ;
}
2010-02-02 01:32:04 +00:00
my $ command = shift @ cmd ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > $ netfun , command = > $ command , data = > \ @ cmd , callback = > \ & getnetinfo_response , callback_args = > $ sessdata ) ;
}
sub getnetinfo_response {
my $ rsp = shift ;
my $ sessdata = shift ;
my $ subcommand = $ sessdata - > { subcommand } ;
$ sessdata - > { subcommand } = shift @ { $ sessdata - > { extraargs } } ;
if ( $ rsp - > { error } ) {
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
return ;
}
if ( $ rsp - > { code } ) {
if ( $ codes { $ rsp - > { code } } ) {
sendmsg ( [ 1 , $ codes { $ rsp - > { code } } ] , $ sessdata - > { node } ) ;
} else {
sendmsg ( [ 1 , sprintf ( "Unknown ipmi error %02xh" , $ rsp - > { code } ) ] , $ sessdata - > { node } ) ;
}
return ;
}
if ( $ subcommand eq "snmpdest" ) {
$ subcommand = "snmpdest1" ;
}
my @ returnd = ( 0 , @ { $ rsp - > { data } } ) ;
my $ format = "%-25s" ;
if ( $ subcommand eq "garp" ) {
my $ code = $ returnd [ 2 ] / 2 ;
sendmsg ( sprintf ( "$format %d" , "Gratuitous ARP seconds:" , $ code ) , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-02 01:32:04 +00:00
elsif ( $ subcommand eq "alert" ) {
if ( $ returnd [ 3 ] & 0x8 ) {
sendmsg ( "SP Alerting: enabled" , $ sessdata - > { node } ) ;
} else {
sendmsg ( "SP Alerting: disabled" , $ sessdata - > { node } ) ;
}
}
elsif ( $ subcommand =~ m/^snmpdest(\d+)/ ) {
sendmsg ( sprintf ( "$format %d.%d.%d.%d" ,
2010-01-30 23:20:11 +00:00
"SP SNMP Destination $1:" ,
$ returnd [ 5 ] ,
$ returnd [ 6 ] ,
$ returnd [ 7 ] ,
2010-02-02 01:32:04 +00:00
$ returnd [ 8 ] ) , $ sessdata - > { node } ) ;
} elsif ( $ subcommand eq "ip" ) {
sendmsg ( sprintf ( "$format %d.%d.%d.%d" ,
2010-01-30 23:20:11 +00:00
"BMC IP:" ,
$ returnd [ 2 ] ,
$ returnd [ 3 ] ,
$ returnd [ 4 ] ,
2010-02-02 01:32:04 +00:00
$ returnd [ 5 ] ) , $ sessdata - > { node } ) ;
} elsif ( $ subcommand eq "netmask" ) {
sendmsg ( sprintf ( "$format %d.%d.%d.%d" ,
2010-01-30 23:20:11 +00:00
"BMC Netmask:" ,
$ returnd [ 2 ] ,
$ returnd [ 3 ] ,
$ returnd [ 4 ] ,
2010-02-02 01:32:04 +00:00
$ returnd [ 5 ] ) , $ sessdata - > { node } ) ;
} elsif ( $ subcommand eq "gateway" ) {
sendmsg ( sprintf ( "$format %d.%d.%d.%d" ,
2010-01-30 23:20:11 +00:00
"BMC Gateway:" ,
$ returnd [ 2 ] ,
$ returnd [ 3 ] ,
$ returnd [ 4 ] ,
2010-02-02 01:32:04 +00:00
$ returnd [ 5 ] ) , $ sessdata - > { node } ) ;
} elsif ( $ subcommand eq "backupgateway" ) {
sendmsg ( sprintf ( "$format %d.%d.%d.%d" ,
2010-01-30 23:20:11 +00:00
"BMC Backup Gateway:" ,
$ returnd [ 2 ] ,
$ returnd [ 3 ] ,
$ returnd [ 4 ] ,
2010-02-02 01:32:04 +00:00
$ returnd [ 5 ] ) , $ sessdata - > { node } ) ;
} elsif ( $ subcommand eq "community" ) {
my $ text = sprintf ( "$format " , "SP SNMP Community:" ) ;
2010-01-30 23:20:11 +00:00
my $ l = 2 ;
while ( $ returnd [ $ l ] ne 0 ) {
$ l = $ l + 1 ;
}
my $ i = 2 ;
while ( $ i < $ l ) {
$ text = $ text . sprintf ( "%c" , $ returnd [ $ i ] ) ;
$ i = $ i + 1 ;
}
2010-02-02 01:32:04 +00:00
sendmsg ( $ text , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-02 01:32:04 +00:00
if ( $ sessdata - > { subcommand } ) {
if ( $ sessdata - > { subcommand } =~ /=/ ) {
setnetinfo ( $ sessdata ) ;
} else {
getnetinfo ( $ sessdata ) ;
}
}
return ;
2010-01-30 23:20:11 +00:00
}
sub setboot {
2010-02-01 18:01:35 +00:00
my $ sessdata = shift ;
#This disables the 60 second timer
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 8 , data = > [ 3 , 8 ] , callback = > \ & setboot_timerdisabled , callback_args = > $ sessdata ) ;
}
sub setboot_timerdisabled {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) {
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
return ;
}
if ( $ rsp - > { code } ) {
if ( $ codes { $ rsp - > { code } } ) {
sendmsg ( [ 1 , $ codes { $ rsp - > { code } } ] , $ sessdata - > { node } ) ;
} else {
sendmsg ( [ 1 , sprintf ( "Unknown ipmi error %02xh" , $ rsp - > { code } ) ] , $ sessdata - > { node } ) ;
}
return ;
}
2010-01-30 23:20:11 +00:00
my $ error ;
2010-06-11 18:24:29 +00:00
@ ARGV = @ { $ sessdata - > { extraargs } } ;
my $ persistent = 0 ;
my $ uefi = 0 ;
use Getopt::Long ;
unless ( GetOptions (
'o' = > \ $ persistent ,
'u' = > \ $ uefi ,
) ) {
sendmsg ( [ 1 , "Error parsing arguments" ] , $ sessdata - > { node } ) ;
return ;
}
my $ subcommand = shift @ ARGV ;
2010-01-30 23:20:11 +00:00
2010-02-01 18:01:35 +00:00
my @ cmd ;
2010-06-11 18:24:29 +00:00
my $ overbootflags = 0x80 | $ persistent << 6 | $ uefi << 5 ;
2010-01-30 23:20:11 +00:00
if ( $ subcommand eq "net" ) {
2010-06-11 18:24:29 +00:00
@ cmd = ( 0x5 , $ overbootflags , 0x4 , 0x0 , 0x0 , 0x0 ) ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ subcommand eq "hd" ) {
2010-06-11 18:24:29 +00:00
@ cmd = ( 0x5 , $ overbootflags , 0x8 , 0x0 , 0x0 , 0x0 ) ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ subcommand eq "cd" ) {
2010-06-11 18:24:29 +00:00
@ cmd = ( 0x5 , $ overbootflags , 0x14 , 0x0 , 0x0 , 0x0 ) ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ subcommand eq "floppy" ) {
2010-06-11 18:24:29 +00:00
@ cmd = ( 0x5 , $ overbootflags , 0x3c , 0x0 , 0x0 , 0x0 ) ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ subcommand =~ m/^def/ ) {
2010-02-01 18:01:35 +00:00
@ cmd = ( 0x5 , 0x0 , 0x0 , 0x0 , 0x0 , 0x0 ) ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ subcommand eq "setup" ) { #Not supported by BMCs I've checked so far..
2010-06-11 18:24:29 +00:00
@ cmd = ( 0x5 , $ overbootflags , 0x18 , 0x0 , 0x0 , 0x0 ) ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ subcommand =~ m/^stat/ ) {
2010-02-01 18:01:35 +00:00
setboot_stat ( "NOQUERY" , $ sessdata ) ;
return ;
2010-01-30 23:20:11 +00:00
}
else {
2010-02-01 18:01:35 +00:00
sendmsg ( [ 1 , "unsupported command setboot $subcommand" ] , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 18:01:35 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 8 , data = > \ @ cmd , callback = > \ & setboot_stat , callback_args = > $ sessdata ) ;
}
sub setboot_stat {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( ref $ rsp ) {
if ( $ rsp - > { error } ) { sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ; }
elsif ( $ rsp - > { code } ) {
if ( $ codes { $ rsp - > { code } } ) {
sendmsg ( [ 1 , $ codes { $ rsp - > { code } } ] , $ sessdata - > { node } ) ;
} else {
sendmsg ( [ 1 , sprintf ( "Unknown ipmi error %02xh" , $ rsp - > { code } ) ] , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 18:01:35 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 18:01:35 +00:00
}
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 9 , data = > [ 5 , 0 , 0 ] , callback = > \ & setboot_gotstat , callback_args = > $ sessdata ) ;
}
sub setboot_gotstat {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) { sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ; }
elsif ( $ rsp - > { code } ) {
if ( $ codes { $ rsp - > { code } } ) {
sendmsg ( [ 1 , $ codes { $ rsp - > { code } } ] , $ sessdata - > { node } ) ;
} else {
sendmsg ( [ 1 , sprintf ( "Unknown ipmi error %02xh" , $ rsp - > { code } ) ] , $ sessdata - > { node } ) ;
}
return ;
}
my % bootchoices = (
0 = > 'BIOS default' ,
1 = > 'Network' ,
2 = > 'Hard Drive' ,
5 = > 'CD/DVD' ,
6 = > 'BIOS Setup' ,
15 = > 'Floppy'
) ;
my @ returnd = ( $ rsp - > { code } , @ { $ rsp - > { data } } ) ;
2010-01-30 23:20:11 +00:00
unless ( $ returnd [ 3 ] & 0x80 ) {
2010-02-01 18:01:35 +00:00
sendmsg ( "boot override inactive" , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
my $ boot = ( $ returnd [ 4 ] & 0x3C ) >> 2 ;
2010-02-01 18:01:35 +00:00
sendmsg ( $ bootchoices { $ boot } , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
sub idpxthermprofile {
#iDataplex thermal profiles as of 6/10/2008
my $ subcommand = lc ( shift ) ;
my @ returnd ;
my $ netfun = 0xb8 ;
my @ cmd = ( 0x41 , 0x4d , 0x4f , 0x00 , 0x6f , 0xfe , 0x60 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0xff ) ;
if ( $ idpxthermprofiles { $ subcommand } ) {
push @ cmd , @ { $ idpxthermprofiles { $ subcommand } } ;
} else {
return ( 1 , "Not an understood thermal profile, expected a 2 hex digit value corresponding to chassis label on iDataplex server" ) ;
}
docmd (
$ netfun ,
\ @ cmd ,
\ @ returnd
) ;
return ( 0 , "OK" ) ;
}
sub getrvidparms {
2010-01-30 23:48:18 +00:00
my $ sessdata = shift ;
unless ( $ sessdata ) { die "not fixed yet" }
2010-01-30 23:20:11 +00:00
#check devide id
2010-01-30 23:48:18 +00:00
unless ( $ sessdata - > { mfg_id } == 2 ) { #Only implemented for IBM servers
2010-02-01 19:20:57 +00:00
sendmsg ( [ 1 , "Remote video is not supported on this system" ] , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
#TODO: use get bmc capabilities to see if rvid is actually supported before bothering the client java app
2010-02-01 19:20:57 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0x50 , data = > [] , callback = > \ & getrvidparms_with_buildid , callback_args = > $ sessdata ) ;
}
2010-02-02 01:32:04 +00:00
sub check_rsp_errors { #TODO: pass in command-specfic error code translation table
2010-02-01 19:20:57 +00:00
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) { #non ipmi error
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
2010-02-02 01:32:04 +00:00
return 1 ;
2010-02-01 19:20:57 +00:00
}
if ( $ rsp - > { code } ) { #ipmi error
if ( $ codes { $ rsp - > { code } } ) {
sendmsg ( [ 1 , $ codes { $ rsp - > { code } } ] ) ;
} else {
sendmsg ( [ 1 , sprintf ( "Unknown error code %02xh" , $ rsp - > { code } ) ] , $ sessdata - > { node } ) ;
}
2010-02-02 01:32:04 +00:00
return 1 ;
}
return 0 ;
}
sub getrvidparms_with_buildid {
if ( check_rsp_errors ( @ _ ) ) {
2010-02-01 19:20:57 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-02 01:32:04 +00:00
my $ rsp = shift ;
my $ sessdata = shift ;
2010-02-01 19:20:57 +00:00
my @ build_id = ( 0 , @ { $ rsp - > { data } } ) ;
2010-01-30 23:20:11 +00:00
unless ( $ build_id [ 1 ] == 0x59 and $ build_id [ 2 ] == 0x55 and $ build_id [ 3 ] == 0x4f and $ build_id [ 4 ] == 0x4f ) { #Only know how to cope with yuoo builds
2010-02-01 19:20:57 +00:00
sendmsg ( [ 1 , "Remote video is not supported on this system" ] , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
#wvid should be a possiblity, time to do the http...
my $ browser = LWP::UserAgent - > new ( ) ;
2010-02-01 19:20:57 +00:00
my $ message = $ sessdata - > { ipmisession } - > { userid } . "," . $ sessdata - > { ipmisession } - > { password } ;
2010-01-30 23:20:11 +00:00
$ browser - > cookie_jar ( { } ) ;
2010-02-01 19:20:57 +00:00
my $ baseurl = "http://" . $ sessdata - > { ipmisession } - > { bmc } . "/" ;
2010-01-30 23:20:11 +00:00
my $ response = $ browser - > request ( POST $ baseurl . "/session/create" , 'Content-Type' = > "text/xml" , Content = > $ message ) ;
unless ( $ response - > content eq "ok" ) {
2010-02-01 19:20:57 +00:00
sendmsg ( [ 1 , "Server returned unexpected data" ] , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-03-12 15:05:51 +00:00
$ response = $ browser - > request ( GET $ baseurl . "/page/session.html" ) ; #we don't care, but some firmware is confused if we don't
2010-01-30 23:20:11 +00:00
$ response = $ browser - > request ( GET $ baseurl . "/kvm/kvm/jnlp" ) ;
my $ jnlp = $ response - > content ;
if ( $ jnlp =~ /This advanced option requires the purchase and installation/ ) {
2010-02-01 19:20:57 +00:00
sendmsg ( [ 1 , "Node does not have feature key for remote video" ] , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 19:52:01 +00:00
my $ currnode = $ sessdata - > { node } ;
2010-01-30 23:20:11 +00:00
$ jnlp =~ s!argument>title=.*Video Viewer</argument>!argument>title=$currnode wvid</argument>! ;
2010-02-01 19:20:57 +00:00
sendmsg ( "method:imm" , $ sessdata - > { node } ) ;
sendmsg ( "jnlp:$jnlp" , $ sessdata - > { node } ) ;
my @ cmdargv = @ { $ sessdata - > { extraargs } } ;
2010-01-30 23:20:11 +00:00
if ( grep /-m/ , @ cmdargv ) {
$ response = $ browser - > request ( GET $ baseurl . "/kvm/vm/jnlp" ) ;
2010-02-01 19:20:57 +00:00
sendmsg ( "mediajnlp:" . $ response - > content , $ sessdata - > { node } ) ; ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 19:20:57 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
sub power {
2010-02-01 16:35:57 +00:00
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
my $ netfun = 0x00 ;
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my $ code ;
2010-02-01 16:35:57 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 1 , data = > [] , callback = > \ & power_with_context , callback_args = > $ sessdata ) ;
}
sub power_with_context {
my $ rsp = shift ;
my $ sessdata = shift ;
my $ text = "" ;
if ( $ rsp - > { error } ) {
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 16:35:57 +00:00
if ( $ rsp - > { code } != 0 ) {
$ text = $ codes { $ rsp - > { code } } ;
unless ( $ text ) { $ text = sprintf ( "Unknown error code %02xh" , $ rsp - > { code } ) ; }
sendmsg ( [ 1 , $ text ] , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 16:35:57 +00:00
$ sessdata - > { powerstatus } = ( $ rsp - > { data } - > [ 0 ] & 1 ? "on" : "off" ) ;
if ( $ sessdata - > { subcommand } eq "stat" or $ sessdata - > { subcommand } eq "state" or $ sessdata - > { subcommand } eq "status" ) {
2010-02-03 12:52:42 +00:00
if ( $ sessdata - > { powerstatprefix } ) {
sendmsg ( $ sessdata - > { powerstatprefix } . $ sessdata - > { powerstatus } , $ sessdata - > { node } ) ;
} else {
sendmsg ( $ sessdata - > { powerstatus } , $ sessdata - > { node } ) ;
}
2010-02-04 17:05:21 +00:00
if ( $ sessdata - > { sensorstoread } and scalar @ { $ sessdata - > { sensorstoread } } ) { #if we are in an rvitals path, hook back into good graces
2010-02-03 12:52:42 +00:00
$ sessdata - > { currsdr } = shift @ { $ sessdata - > { sensorstoread } } ;
readsensor ( $ sessdata ) ; #next
}
2010-02-01 16:35:57 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 16:35:57 +00:00
my $ subcommand = $ sessdata - > { subcommand } ;
if ( $ sessdata - > { subcommand } eq "boot" ) {
$ text = $ sessdata - > { powerstatus } . " " ;
$ subcommand = ( $ sessdata - > { powerstatus } eq "on" ? "reset" : "on" ) ;
$ sessdata - > { subcommand } = $ subcommand ; #lazy typing..
}
my % argmap = ( #english to ipmi dictionary
"on" = > 1 ,
2010-02-11 21:28:53 +00:00
"off" = > 0 ,
2010-02-01 16:35:57 +00:00
"softoff" = > 5 ,
"reset" = > 3 ,
"nmi" = > 4
) ;
if ( $ subcommand eq "on" ) {
if ( $ sessdata - > { powerstatus } eq "on" ) {
2010-03-03 21:28:52 +00:00
sendmsg ( "on" , $ sessdata - > { node } ) ;
$ allerrornodes { $ sessdata - > { node } } = 1 ;
2010-02-01 16:35:57 +00:00
return ; # don't bother sending command
2010-01-30 23:20:11 +00:00
}
2010-02-01 16:35:57 +00:00
} elsif ( $ subcommand eq "softoff" or $ subcommand eq "off" or $ subcommand eq "reset" ) {
if ( $ sessdata - > { powerstatus } eq "off" ) {
2010-03-03 21:28:52 +00:00
sendmsg ( "off" , $ sessdata - > { node } ) ;
$ allerrornodes { $ sessdata - > { node } } = 1 ;
2010-02-01 16:35:57 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 16:35:57 +00:00
} elsif ( not $ argmap { $ subcommand } ) {
sendmsg ( [ 1 , "unsupported command power $subcommand" ] ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 16:35:57 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 2 , data = > [ $ argmap { $ subcommand } ] , callback = > \ & power_response , callback_args = > $ sessdata ) ;
}
sub power_response {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) {
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
return ;
}
2010-05-17 15:16:47 +00:00
my @ returnd = ( $ rsp - > { code } , @ { $ rsp - > { data } } ) ;
2010-02-01 16:35:57 +00:00
if ( $ rsp - > { code } ) {
my $ text = $ codes { $ rsp - > { code } } ;
unless ( $ text ) { $ text = sprintf ( "Unknown response %02xh" , $ rsp - > { code } ) ; }
sendmsg ( [ 1 , $ text ] , $ sessdata - > { node } ) ;
}
sendmsg ( $ sessdata - > { subcommand } , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
sub generic {
my $ subcommand = shift ;
my $ netfun ;
my @ args ;
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my $ code ;
( $ netfun , @ args ) = split ( /-/ , $ subcommand ) ;
$ netfun = oct ( $ netfun ) ;
printf ( "netfun: 0x%02x\n" , $ netfun ) ;
print "command: " ;
foreach ( @ args ) {
push ( @ cmd , oct ( $ _ ) ) ;
printf ( "0x%02x " , oct ( $ _ ) ) ;
}
print "\n\n" ;
$ error = docmd (
$ netfun ,
\ @ cmd ,
\ @ returnd
) ;
if ( $ error ) {
$ rc = 1 ;
$ text = $ error ;
}
$ code = $ returnd [ 0 ] ;
if ( $ code == 0x00 ) {
}
else {
$ rc = 1 ;
$ text = $ codes { $ code } ;
}
printf ( "return code: 0x%02x\n\n" , $ code ) ;
print "return data:\n" ;
my @ rdata = @ returnd [ 1 .. @ returnd - 2 ] ;
hexadump ( \ @ rdata ) ;
print "\n" ;
print "full output:\n" ;
hexadump ( \ @ returnd ) ;
print "\n" ;
# if(!$text) {
# $rc = 1;
# $text = sprintf("unknown response %02x",$code);
# }
return ( $ rc , $ text ) ;
}
sub beacon {
2010-02-01 17:35:57 +00:00
my $ sessdata = shift ;
my $ subcommand = $ sessdata - > { subcommand } ;
my $ ipmiv2 = 0 ;
if ( $ sessdata - > { ipmisession } - > { ipmiversion } eq '2.0' ) {
$ ipmiv2 = 1 ;
}
if ( $ subcommand ne "on" and $ subcommand ne "off" ) {
sendmsg ( [ 1 , "please specify on or off for ipmi nodes (stat impossible)" ] , $ sessdata - > { node } ) ;
}
2010-01-30 23:20:11 +00:00
2010-02-01 17:35:57 +00:00
#if stuck with 1.5, say light for 255 seconds. In 2.0, specify to turn it on forever
2010-01-30 23:20:11 +00:00
if ( $ subcommand eq "on" ) {
if ( $ ipmiv2 ) {
2010-02-01 17:35:57 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 4 , data = > [ 0 , 1 ] , callback = > \ & beacon_answer , callback_args = > $ sessdata ) ;
2010-01-30 23:20:11 +00:00
} else {
2010-02-01 17:35:57 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 4 , data = > [ 0xff ] , callback = > \ & beacon_answer , callback_args = > $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 17:35:57 +00:00
}
2010-01-30 23:20:11 +00:00
elsif ( $ subcommand eq "off" ) {
if ( $ ipmiv2 ) {
2010-02-01 17:35:57 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 4 , data = > [ 0 , 0 ] , callback = > \ & beacon_answer , callback_args = > $ sessdata ) ;
2010-01-30 23:20:11 +00:00
} else {
2010-02-01 17:35:57 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0 , command = > 4 , data = > [ 0x0 ] , callback = > \ & beacon_answer , callback_args = > $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
}
else {
2010-02-01 17:35:57 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 17:35:57 +00:00
}
sub beacon_answer {
my $ rsp = shift ;
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
2010-02-01 17:35:57 +00:00
if ( $ rsp - > { error } ) { #non ipmi error
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 17:35:57 +00:00
if ( $ rsp - > { code } ) { #ipmi error
if ( $ codes { $ rsp - > { code } } ) {
sendmsg ( [ 1 , $ codes { $ rsp - > { code } } ] ) ;
} else {
sendmsg ( [ 1 , sprintf ( "Unknown error code %02xh" , $ rsp - > { code } ) ] , $ sessdata - > { node } ) ;
}
return ;
}
sendmsg ( $ sessdata - > { subcommand } , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
sub inv {
2010-02-04 17:05:21 +00:00
my $ sessdata = shift ;
my $ subcommand = $ sessdata - > { subcommand } ;
2010-01-30 23:20:11 +00:00
my $ rc = 0 ;
my $ text ;
my @ output ;
my @ types ;
unless ( $ subcommand ) {
$ subcommand = "all" ;
}
if ( $ subcommand eq "all" ) {
2010-02-04 18:43:13 +00:00
@ types = qw( model serial deviceid mprom guid misc hw asset firmware ) ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ subcommand eq "asset" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipotherfru } = 1 ;
2010-01-30 23:20:11 +00:00
@ types = qw( asset ) ;
}
elsif ( $ subcommand eq "model" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipotherfru } = 1 ;
2010-01-30 23:20:11 +00:00
@ types = qw( model ) ;
}
elsif ( $ subcommand eq "serial" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipotherfru } = 1 ;
2010-01-30 23:20:11 +00:00
@ types = qw( serial ) ;
}
elsif ( $ subcommand eq "vpd" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipotherfru } = 1 ;
2010-01-30 23:20:11 +00:00
@ types = qw( model serial deviceid mprom ) ;
}
elsif ( $ subcommand eq "mprom" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipfru } = 1 ; #full fru read is expensive, skip it
2010-01-30 23:20:11 +00:00
@ types = qw( mprom ) ;
}
elsif ( $ subcommand eq "misc" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipotherfru } = 1 ;
2010-01-30 23:20:11 +00:00
@ types = qw( misc ) ;
}
elsif ( $ subcommand eq "deviceid" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipfru } = 1 ; #full fru read is expensive, skip it
2010-01-30 23:20:11 +00:00
@ types = qw( deviceid ) ;
}
elsif ( $ subcommand eq "guid" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipfru } = 1 ; #full fru read is expensive, skip it
2010-01-30 23:20:11 +00:00
@ types = qw( guid ) ;
}
elsif ( $ subcommand eq "uuid" ) {
2010-02-04 17:05:21 +00:00
$ sessdata - > { skipfru } = 1 ; #full fru read is expensive, skip it
2010-01-30 23:20:11 +00:00
@ types = qw( guid ) ;
}
else {
@ types = ( $ subcommand ) ;
#return(1,"unsupported BMC inv argument $subcommand");
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { invtypes } = \ @ types ;
initfru ( $ sessdata ) ;
}
sub fru_initted {
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
my $ key ;
2010-02-04 17:05:21 +00:00
my @ types = @ { $ sessdata - > { invtypes } } ;
my $ format = "%-20s %s" ;
2010-01-30 23:20:11 +00:00
2010-02-04 17:05:21 +00:00
foreach $ key ( sort keys % { $ sessdata - > { fru_hash } } ) {
my $ fru = $ sessdata - > { fru_hash } - > { $ key } ;
2010-01-30 23:20:11 +00:00
my $ type ;
foreach $ type ( split /,/ , $ fru - > rec_type ) {
if ( grep { $ _ eq $ type } @ types ) {
2010-02-04 17:05:21 +00:00
sendmsg ( sprintf ( $ format , $ sessdata - > { fru_hash } - > { $ key } - > desc . ":" , $ sessdata - > { fru_hash } - > { $ key } - > value ) , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
last ;
}
}
}
}
sub add_textual_fru {
my $ parsedfru = shift ;
my $ description = shift ;
my $ category = shift ;
my $ subcategory = shift ;
my $ types = shift ;
2010-02-04 17:05:21 +00:00
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
if ( $ parsedfru - > { $ category } and $ parsedfru - > { $ category } - > { $ subcategory } ) {
my $ fru ;
my @ subfrus ;
if ( ref $ parsedfru - > { $ category } - > { $ subcategory } eq 'ARRAY' ) {
@ subfrus = @ { $ parsedfru - > { $ category } - > { $ subcategory } } ;
} else {
@ subfrus = ( $ parsedfru - > { $ category } - > { $ subcategory } )
}
foreach ( @ subfrus ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( $ types ) ;
$ fru - > desc ( $ description ) ;
if ( not ref $ _ ) {
$ fru - > value ( $ _ ) ;
} else {
if ( $ _ - > { encoding } == 3 ) {
$ fru - > value ( $ _ - > { value } ) ;
} else {
$ fru - > value ( phex ( $ _ - > { value } ) ) ;
}
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ sessdata - > { frudex } } = $ fru ;
$ sessdata - > { frudex } += 1 ;
2010-01-30 23:20:11 +00:00
}
}
}
sub add_textual_frus {
my $ parsedfru = shift ;
my $ desc = shift ;
my $ categorydesc = shift ;
my $ category = shift ;
my $ type = shift ;
2010-02-04 17:05:21 +00:00
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
unless ( $ type ) { $ type = 'hw' ; }
2010-02-09 22:25:08 +00:00
add_textual_fru ( $ parsedfru , $ desc . " " . $ categorydesc . "Part Number" , $ category , "partnumber" , $ type , $ sessdata ) ;
add_textual_fru ( $ parsedfru , $ desc . " " . $ categorydesc . "Manufacturer" , $ category , "manufacturer" , $ type , $ sessdata ) ;
add_textual_fru ( $ parsedfru , $ desc . " " . $ categorydesc . "Serial Number" , $ category , "serialnumber" , $ type , $ sessdata ) ;
add_textual_fru ( $ parsedfru , $ desc . " " . $ categorydesc . "" , $ category , "name" , $ type , $ sessdata ) ;
2010-01-30 23:20:11 +00:00
if ( $ parsedfru - > { $ category } - > { builddate } ) {
2010-02-09 22:25:08 +00:00
add_textual_fru ( $ parsedfru , $ desc . " " . $ categorydesc . "Manufacture Date" , $ category , "builddate" , $ type , $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
if ( $ parsedfru - > { $ category } - > { buildlocation } ) {
2010-02-09 22:25:08 +00:00
add_textual_fru ( $ parsedfru , $ desc . " " . $ categorydesc . "Manufacture Location" , $ category , "buildlocation" , $ type , $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
if ( $ parsedfru - > { $ category } - > { model } ) {
2010-02-09 22:25:08 +00:00
add_textual_fru ( $ parsedfru , $ desc . " " . $ categorydesc . "Model" , $ category , "model" , $ type , $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-09 22:25:08 +00:00
add_textual_fru ( $ parsedfru , $ desc . " " . $ categorydesc . "Additional Info" , $ category , "extra" , $ type , $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
sub initfru {
my $ netfun = 0x28 ;
2010-01-30 23:48:18 +00:00
my $ sessdata = shift ;
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } = { } ;
2010-01-30 23:20:11 +00:00
2010-02-04 17:05:21 +00:00
my $ mfg_id = $ sessdata - > { mfg_id } ;
my $ prod_id = $ sessdata - > { prod_id } ;
my $ device_id = $ sessdata - > { device_id } ;
2010-01-30 23:20:11 +00:00
2010-02-04 17:05:21 +00:00
my $ fru = FRU - > new ( ) ;
2010-01-30 23:20:11 +00:00
$ fru - > rec_type ( "deviceid" ) ;
$ fru - > desc ( "Manufacturer ID" ) ;
my $ value = $ mfg_id ;
if ( $ MFG_ID { $ mfg_id } ) {
$ value = "$MFG_ID{$mfg_id} ($mfg_id)" ;
}
$ fru - > value ( $ value ) ;
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { mfg_id } = $ fru ;
2010-01-30 23:20:11 +00:00
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "deviceid" ) ;
$ fru - > desc ( "Product ID" ) ;
$ value = $ prod_id ;
my $ tmp = "$mfg_id:$prod_id" ;
if ( $ PROD_ID { $ tmp } ) {
$ value = "$PROD_ID{$tmp} ($prod_id)" ;
}
$ fru - > value ( $ value ) ;
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { prod_id } = $ fru ;
2010-01-30 23:20:11 +00:00
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "deviceid" ) ;
$ fru - > desc ( "Device ID" ) ;
$ fru - > value ( $ device_id ) ;
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { device_id } = $ fru ;
2010-01-30 23:20:11 +00:00
2010-02-04 17:05:21 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x6 , command = > 0x37 , data = > [] , callback = > \ & gotguid , callback_args = > $ sessdata ) ;
}
sub got_bmc_fw_info {
my $ rsp = shift ;
my $ sessdata = shift ;
my $ fw_rev1 = $ sessdata - > { firmware_rev1 } ;
my $ fw_rev2 = $ sessdata - > { firmware_rev2 } ;
my $ mprom ;
my $ isanimm = 0 ;
if ( ref $ rsp and not $ rsp - > { error } and not $ rsp - > { code } ) { #I am a callback and the command worked
my @ returnd = ( @ { $ rsp - > { data } } ) ;
my @ a = ( $ fw_rev2 ) ;
my $ prefix = pack ( "C*" , @ returnd [ 0 .. 3 ] ) ;
if ( $ prefix =~ /yuoo/i ) { #we have an imm
$ isanimm = 1 ;
}
$ mprom = sprintf ( "%d.%s (%s)" , $ fw_rev1 , decodebcd ( \ @ a ) , getascii ( @ returnd ) ) ;
} else { #either not a callback or IBM call failed
my @ a = ( $ fw_rev2 ) ;
$ mprom = sprintf ( "%d.%s" , $ fw_rev1 , decodebcd ( \ @ a ) ) ;
}
my $ fru = FRU - > new ( ) ;
2010-02-04 18:43:13 +00:00
$ fru - > rec_type ( "mprom,firmware,bmc,imm" ) ;
2010-02-04 17:05:21 +00:00
$ fru - > desc ( "BMC Firmware" ) ;
$ fru - > value ( $ mprom ) ;
$ sessdata - > { fru_hash } - > { mprom } = $ fru ;
if ( $ isanimm ) {
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0 , 0 , 0 , 0 ] , callback = > \ & get_uefi_version_with_fmapi , callback_args = > $ sessdata ) ;
} else {
initfru_with_mprom ( $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-04 17:05:21 +00:00
}
sub get_uefi_version_with_fmapi {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ data = @ { $ rsp - > { data } } ;
unless ( $ data [ 2 ] == 0 and $ data [ 3 ] = 3 and $ data [ 4 ] == 0x12 and $ data [ 5 ] == 2 ) { #we support this major version only
initfru_with_mprom ( $ sessdata ) ;
return ;
}
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 1 , 0 , 0 , 5 , 0x84 , 0x62 , 0x69 , 0x6f , 0x73 ] , callback = > \ & get_uefi_version_with_xid , callback_args = > $ sessdata ) ;
}
2010-01-30 23:20:11 +00:00
2010-02-04 17:05:21 +00:00
sub get_uefi_version_with_xid {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ data = @ { $ rsp - > { data } } ;
if ( $ data [ 2 ] != 0 or $ data [ 3 ] != 5 or $ data [ 4 ] != 0x44 ) {
sendmsg ( [ 1 , "Error1 retrieving UEFI build version" ] , $ sessdata - > { node } ) ;
return ;
}
splice @ data , 0 , 5 ;
$ sessdata - > { fmapixid } = \ @ data ;
2010-02-04 18:43:13 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 3 , 0 , 0 , 0xa , 0x44 , @ { $ sessdata - > { fmapixid } } , 0x84 , 0x62 , 0x69 , 0x6f , 0x73 ] , callback = > \ & waitfor_openxid , callback_args = > $ sessdata ) ;
2010-02-04 17:05:21 +00:00
}
2010-02-04 18:43:13 +00:00
sub waitfor_openxid {
2010-02-04 17:05:21 +00:00
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ data = @ { $ rsp - > { data } } ;
if ( $ data [ 2 ] != 0 ) {
sendmsg ( [ 1 , "Error2 retrieving UEFI build version" ] , $ sessdata - > { node } ) ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0x4 , 0 , 0 , 0x05 , 0x44 , @ { $ sessdata - > { fmapixid } } ] , callback = > \ & fmapi_xid_closed , callback_args = > $ sessdata ) ;
return ;
}
2010-02-04 18:43:13 +00:00
if ( ( scalar @ data ) > 4 and $ data [ 5 ] == 0x40 ) { #ready to proceed
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0xa , 0 , 0 , 0xf , 0x44 , @ { $ sessdata - > { fmapixid } } , 0x87 , 0x62 , 0x75 , 0x69 , 0x6C , 0x64 , 0x69 , 0x64 , 0x11 , 0x52 ] , callback = > \ & got_uefi_buildid , callback_args = > $ sessdata ) ;
} else {
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0x9 , 0 , 0 , 0x5 , 0x44 , @ { $ sessdata - > { fmapixid } } ] , callback = > \ & waitfor_openxid , callback_args = > $ sessdata ) ;
}
2010-02-04 17:05:21 +00:00
}
sub got_uefi_buildid {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ data = @ { $ rsp - > { data } } ;
if ( $ data [ 2 ] != 0 ) {
sendmsg ( [ 1 , "Error3 retrieving UEFI build version" ] , $ sessdata - > { node } ) ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0x4 , 0 , 0 , 0x05 , 0x44 , @ { $ sessdata - > { fmapixid } } ] , callback = > \ & fmapi_xid_closed , callback_args = > $ sessdata ) ;
return ;
}
my $ buildsize = $ data [ 4 ] & 0x7f ;
my @ buildid = splice @ data , 5 , $ buildsize ;
$ sessdata - > { biosbuildid } = pack ( "C*" , @ buildid ) ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0xa , 0 , 0 , 0x14 , 0x44 , @ { $ sessdata - > { fmapixid } } , 0x8c , 0x62 , 0x75 , 0x69 , 0x6C , 0x64 , 0x76 , 0x65 , 0x72 , 0x73 , 0x69 , 0x6F , 0x6E , 0x11 , 0x52 ] , callback = > \ & got_uefi_buildversion , callback_args = > $ sessdata ) ;
}
sub got_uefi_buildversion {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ data = @ { $ rsp - > { data } } ;
if ( $ data [ 2 ] != 0 ) {
sendmsg ( [ 1 , "Error4 retrieving UEFI build version" ] , $ sessdata - > { node } ) ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0x4 , 0 , 0 , 0x05 , 0x44 , @ { $ sessdata - > { fmapixid } } ] , callback = > \ & fmapi_xid_closed , callback_args = > $ sessdata ) ;
return ;
}
my $ buildsize = $ data [ 4 ] & 0x7f ;
my @ buildid = splice @ data , 5 , $ buildsize ;
$ sessdata - > { biosbuildversion } = pack ( "C*" , @ buildid ) ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0xa , 0 , 0 , 0x11 , 0x44 , @ { $ sessdata - > { fmapixid } } , 0x89 , 0x62 , 0x75 , 0x69 , 0x6C , 0x64 , 0x64 , 0x61 , 0x74 , 0x65 , 0x11 , 0x52 ] , callback = > \ & got_uefi_builddate , callback_args = > $ sessdata ) ;
}
sub got_uefi_builddate {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ data = @ { $ rsp - > { data } } ;
if ( $ data [ 2 ] != 0 ) {
sendmsg ( [ 1 , "Error5 retrieving UEFI build version" ] , $ sessdata - > { node } ) ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0x4 , 0 , 0 , 0x05 , 0x44 , @ { $ sessdata - > { fmapixid } } ] , callback = > \ & fmapi_xid_closed , callback_args = > $ sessdata ) ;
return ;
}
my $ buildsize = $ data [ 4 ] & 0x7f ;
my @ buildid = splice @ data , 5 , $ buildsize ;
$ sessdata - > { biosbuilddate } = pack ( "C*" , @ buildid ) ;
my $ bver = $ sessdata - > { biosbuildversion } . " (" . $ sessdata - > { biosbuildid } . " " . $ sessdata - > { biosbuilddate } . ")" ;
my $ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "bios,uefi,firmware" ) ;
$ fru - > desc ( "UEFI Version" ) ;
$ fru - > value ( $ bver ) ;
$ sessdata - > { fru_hash } - > { uefi } = $ fru ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0x4 , 0 , 0 , 0x05 , 0x44 , @ { $ sessdata - > { fmapixid } } ] , callback = > \ & fmapi_xid_closed , callback_args = > $ sessdata ) ;
}
sub fmapi_xid_closed {
my $ rsp = shift ;
my $ sessdata = shift ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xf0 , data = > [ 0x2 , 0 , 0 , 0x05 , 0x44 , @ { $ sessdata - > { fmapixid } } ] , callback = > \ & fmapi_xid_destroyed , callback_args = > $ sessdata ) ;
}
sub fmapi_xid_destroyed {
my $ rsp = shift ;
my $ sessdata = shift ;
initfru_with_mprom ( $ sessdata ) ;
}
sub initfru_withguid {
my $ sessdata = shift ;
my $ mfg_id = $ sessdata - > { mfg_id } ;
my $ prod_id = $ sessdata - > { prod_id } ;
my $ mprom ;
if ( $ mfg_id == 2 && $ prod_id != 34869 ) {
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0x50 , data = > [] , callback = > \ & got_bmc_fw_info , callback_args = > $ sessdata ) ;
} else {
got_bmc_fw_info ( 0 , $ sessdata ) ;
}
}
sub initfru_with_mprom {
my $ sessdata = shift ;
if ( $ sessdata - > { skipfru } ) {
fru_initted ( $ sessdata ) ;
return ;
}
$ sessdata - > { currfruid } = 0 ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x10 , data = > [ 0 ] , callback = > \ & process_currfruid , callback_args = > $ sessdata ) ;
}
sub process_currfruid {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { code } == 0xcb ) {
$ sessdata - > { currfrudata } = "Not Present" ;
$ sessdata - > { currfrudone } = 1 ;
add_fruhash ( $ sessdata ) ;
return ;
}
if ( check_rsp_errors ( $ rsp , $ sessdata ) ) {
return ;
}
my @ bytes = @ { $ rsp - > { data } } ;
$ sessdata - > { currfrusize } = ( $ bytes [ 1 ] << 8 ) + $ bytes [ 0 ] ;
readcurrfrudevice ( 0 , $ sessdata ) ;
}
sub initfru_zero {
my $ sessdata = shift ;
my $ fruhash = shift ;
my $ frudex = 0 ;
my $ fru ;
2010-01-30 23:20:11 +00:00
if ( defined $ fruhash - > { product } - > { manufacturer } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "System Manufacturer" ) ;
if ( $ fruhash - > { product } - > { product } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { product } - > { manufacturer } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { product } - > { manufacturer } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( defined $ fruhash - > { product } - > { product } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "model" ) ;
$ fru - > desc ( "System Description" ) ;
if ( $ fruhash - > { product } - > { product } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { product } - > { product } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { product } - > { product } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( defined $ fruhash - > { product } - > { model } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "model" ) ;
$ fru - > desc ( "System Model/MTM" ) ;
if ( $ fruhash - > { product } - > { model } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { product } - > { model } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { product } - > { model } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( defined $ fruhash - > { product } - > { version } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "System Revision" ) ;
if ( $ fruhash - > { product } - > { version } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { product } - > { version } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { product } - > { version } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( defined $ fruhash - > { product } - > { serialnumber } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "serial" ) ;
$ fru - > desc ( "System Serial Number" ) ;
if ( $ fruhash - > { product } - > { serialnumber } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { product } - > { serialnumber } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { product } - > { serialnumber } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( defined $ fruhash - > { product } - > { asset } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "asset" ) ;
$ fru - > desc ( "System Asset Number" ) ;
if ( $ fruhash - > { product } - > { asset } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { product } - > { asset } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { product } - > { asset } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
foreach ( @ { $ fruhash - > { product } - > { extra } } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "Product Extra data" ) ;
if ( $ _ - > { encoding } == 3 ) {
$ fru - > value ( $ _ - > { value } ) ;
} else {
#print Dumper($_);
#print $_->{encoding};
next ;
$ fru - > value ( phex ( $ _ - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( $ fruhash - > { chassis } - > { serialnumber } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "serial" ) ;
$ fru - > desc ( "Chassis Serial Number" ) ;
if ( $ fruhash - > { chassis } - > { serialnumber } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { chassis } - > { serialnumber } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { chassis } - > { serialnumber } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( $ fruhash - > { chassis } - > { partnumber } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "model" ) ;
$ fru - > desc ( "Chassis Part Number" ) ;
if ( $ fruhash - > { chassis } - > { partnumber } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { chassis } - > { partnumber } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { chassis } - > { partnumber } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
foreach ( @ { $ fruhash - > { chassis } - > { extra } } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "Chassis Extra data" ) ;
if ( $ _ - > { encoding } == 3 ) {
$ fru - > value ( $ _ - > { value } ) ;
} else {
next ;
#print Dumper($_);
#print $_->{encoding};
$ fru - > value ( phex ( $ _ - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( $ fruhash - > { board } - > { builddate } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "Board manufacture date" ) ;
$ fru - > value ( $ fruhash - > { board } - > { builddate } ) ;
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( $ fruhash - > { board } - > { manufacturer } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "Board manufacturer" ) ;
if ( $ fruhash - > { board } - > { manufacturer } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { board } - > { manufacturer } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { board } - > { manufacturer } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( $ fruhash - > { board } - > { name } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "Board Description" ) ;
if ( $ fruhash - > { board } - > { name } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { board } - > { name } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { board } - > { name } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( $ fruhash - > { board } - > { serialnumber } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "Board Serial Number" ) ;
if ( $ fruhash - > { board } - > { serialnumber } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { board } - > { serialnumber } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { board } - > { serialnumber } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
if ( $ fruhash - > { board } - > { partnumber } - > { value } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "Board Model Number" ) ;
if ( $ fruhash - > { board } - > { partnumber } - > { encoding } == 3 ) {
$ fru - > value ( $ fruhash - > { board } - > { partnumber } - > { value } ) ;
} else {
$ fru - > value ( phex ( $ fruhash - > { board } - > { partnumber } - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
foreach ( @ { $ fruhash - > { board } - > { extra } } ) {
$ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "misc" ) ;
$ fru - > desc ( "Board Extra data" ) ;
if ( $ _ - > { encoding } == 3 ) {
$ fru - > value ( $ _ - > { value } ) ;
} else {
next ;
#print Dumper($_);
#print $_->{encoding};
$ fru - > value ( phex ( $ _ - > { value } ) ) ;
}
2010-02-04 17:05:21 +00:00
$ sessdata - > { fru_hash } - > { $ frudex + + } = $ fru ;
2010-01-30 23:20:11 +00:00
}
#Ok, done with fru 0, on to the other fru devices from SDR
2010-02-04 17:05:21 +00:00
$ sessdata - > { frudex } = $ frudex ;
if ( $ sessdata - > { skipotherfru } ) { #skip non-primary fru devices
fru_initted ( $ sessdata ) ;
return ;
}
2010-01-30 23:20:11 +00:00
my $ key ;
my $ subrc ;
2010-01-30 23:48:18 +00:00
my % sdr_hash = % { $ sessdata - > { sdr_hash } } ;
2010-02-04 17:05:21 +00:00
$ sessdata - > { dimmfru } = [] ;
$ sessdata - > { genhwfru } = [] ;
2010-01-30 23:20:11 +00:00
foreach $ key ( sort { $ sdr_hash { $ a } - > id_string cmp $ sdr_hash { $ b } - > id_string } keys % sdr_hash ) {
my $ sdr = $ sdr_hash { $ key } ;
unless ( $ sdr - > rec_type == 0x11 and $ sdr - > fru_type == 0x10 ) { #skip non fru sdr stuff and frus I don't understand
next ;
}
if ( $ sdr - > fru_type == 0x10 ) { #supported
if ( $ sdr - > fru_subtype == 0x1 ) { #DIMM
2010-02-04 17:05:21 +00:00
push @ { $ sessdata - > { dimmfru } } , $ sdr ;
2010-01-30 23:20:11 +00:00
} elsif ( $ sdr - > fru_subtype == 0 or $ sdr - > fru_subtype == 2 ) {
2010-02-04 17:05:21 +00:00
push @ { $ sessdata - > { genhwfru } } , $ sdr ;
2010-01-30 23:20:11 +00:00
}
}
}
2010-02-04 17:05:21 +00:00
if ( scalar @ { $ sessdata - > { dimmfru } } ) {
$ sessdata - > { currfrusdr } = shift @ { $ sessdata - > { dimmfru } } ;
$ sessdata - > { currfruid } = $ sessdata - > { currfrusdr } - > sensor_number ;
$ sessdata - > { currfrutype } = "dimm" ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x10 , data = > [ $ sessdata - > { currfruid } ] , callback = > \ & process_currfruid , callback_args = > $ sessdata ) ;
} elsif ( scalar @ { $ sessdata - > { genhwfru } } ) {
$ sessdata - > { currfrusdr } = shift @ { $ sessdata - > { genhwfru } } ;
$ sessdata - > { currfruid } = $ sessdata - > { currfrusdr } - > sensor_number ;
$ sessdata - > { currfrutype } = "genhw" ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x10 , data = > [ $ sessdata - > { currfruid } ] , callback = > \ & process_currfruid , callback_args = > $ sessdata ) ;
} else {
fru_initted ( $ sessdata ) ;
}
2010-01-30 23:20:11 +00:00
}
sub get_frusize {
my $ fruid = shift ;
my $ netfun = 0x28 ; # Storage (0x0A << 2)
my @ cmd = ( 0x10 , $ fruid ) ;
my @ bytes ;
my $ error = docmd ( $ netfun , \ @ cmd , \ @ bytes ) ;
pop @ bytes ;
unless ( defined $ bytes [ 0 ] and $ bytes [ 0 ] == 0 ) {
if ( $ codes { $ bytes [ 0 ] } ) {
return ( 0 , $ codes { $ bytes [ 0 ] } ) ;
}
return ( 0 , "FRU device $fruid inaccessible" ) ;
}
return ( $ bytes [ 2 ] << 8 ) + $ bytes [ 1 ] ;
}
sub formfru {
my $ fruhash = shift ;
my $ frusize = shift ;
$ frusize -= 8 ; #consume 8 bytes for mandatory header
my $ availindex = 1 ;
my @ bytes = ( 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ) ; #
if ( $ fruhash - > { internal } ) { #Allocate the space at header time
$ bytes [ 1 ] = $ availindex ;
$ availindex += ceil ( ( scalar @ { $ fruhash - > { internal } } ) / 8 ) ;
$ frusize -= ( scalar @ { $ fruhash - > { internal } } ) ; #consume internal bytes
push @ bytes , @ { $ fruhash - > { internal } } ;
}
if ( $ fruhash - > { chassis } ) {
$ bytes [ 2 ] = $ availindex ;
push @ bytes , @ { $ fruhash - > { chassis } - > { raw } } ;
$ availindex += ceil ( ( scalar @ { $ fruhash - > { chassis } - > { raw } } ) / 8 ) ;
$ frusize -= ceil ( ( scalar @ { $ fruhash - > { chassis } - > { raw } } ) / 8 ) * 8 ;
}
if ( $ fruhash - > { board } ) {
$ bytes [ 3 ] = $ availindex ;
push @ bytes , @ { $ fruhash - > { board } - > { raw } } ;
$ availindex += ceil ( ( scalar @ { $ fruhash - > { board } - > { raw } } ) / 8 ) ;
$ frusize -= ceil ( ( scalar @ { $ fruhash - > { board } - > { raw } } ) / 8 ) * 8 ;
}
#xCAT will always have a product FRU in this process
$ bytes [ 4 ] = $ availindex ;
unless ( defined $ fruhash - > { product } ) { #Make sure there is a data structure
#to latch onto..
$ fruhash - > { product } = { } ;
}
my @ prodbytes = buildprodfru ( $ fruhash - > { product } ) ;
push @ bytes , @ prodbytes ;
$ availindex += ceil ( ( scalar @ prodbytes ) / 8 ) ;
$ frusize -= ceil ( ( scalar @ prodbytes ) / 8 ) * 8 ; ;
#End of product fru setup
if ( $ fruhash - > { extra } ) {
$ bytes [ 5 ] = $ availindex ;
push @ bytes , @ { $ fruhash - > { extra } } ;
$ frusize -= ceil ( ( scalar @ { $ fruhash - > { extra } } ) / 8 ) * 8 ;
#Don't need to track availindex anymore
}
$ bytes [ 7 ] = dochksum ( [ @ bytes [ 0 .. 6 ] ] ) ;
if ( $ frusize < 0 ) {
return undef ;
} else {
return \ @ bytes ;
}
}
sub transfieldtobytes {
my $ hashref = shift ;
unless ( defined $ hashref ) {
return ( 0xC0 ) ;
}
my @ data ;
my $ size ;
if ( $ hashref - > { encoding } == 3 ) {
@ data = unpack ( "C*" , $ hashref - > { value } ) ;
} else {
@ data = @ { $ hashref - > { value } } ;
}
$ size = scalar ( @ data ) ;
if ( $ size > 64 ) {
die "Field too large for IPMI FRU specification" ;
}
unshift ( @ data , $ size | ( $ hashref - > { encoding } << 6 ) ) ;
return @ data ;
}
sub mergefru {
2010-02-01 19:52:01 +00:00
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
my $ phash = shift ; #Product hash
2010-02-01 19:52:01 +00:00
unless ( $ phash ) { die "here" }
my $ currnode = $ sessdata - > { node } ;
2010-01-30 23:20:11 +00:00
if ( $ vpdhash - > { $ currnode } - > [ 0 ] - > { mtm } ) {
$ phash - > { model } - > { encoding } = 3 ;
$ phash - > { model } - > { value } = $ vpdhash - > { $ currnode } - > [ 0 ] - > { mtm } ;
}
if ( $ vpdhash - > { $ currnode } - > [ 0 ] - > { serial } ) {
$ phash - > { serialnumber } - > { encoding } = 3 ;
$ phash - > { serialnumber } - > { value } = $ vpdhash - > { $ currnode } - > [ 0 ] - > { serial } ;
}
if ( $ vpdhash - > { $ currnode } - > [ 0 ] - > { asset } ) {
$ phash - > { asset } - > { encoding } = 3 ;
$ phash - > { asset } - > { value } = $ vpdhash - > { $ currnode } - > [ 0 ] - > { asset } ;
}
}
sub buildprodfru {
2010-02-01 19:52:01 +00:00
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
my $ prod = shift ;
2010-02-01 19:52:01 +00:00
mergefru ( $ sessdata , $ prod ) ;
my $ currnode = $ sessdata - > { node } ;
2010-01-30 23:20:11 +00:00
my @ bytes = ( 1 , 0 , 0 ) ;
my @ data ;
my $ padsize ;
push @ bytes , transfieldtobytes ( $ prod - > { manufacturer } ) ;
push @ bytes , transfieldtobytes ( $ prod - > { product } ) ;
push @ bytes , transfieldtobytes ( $ prod - > { model } ) ;
push @ bytes , transfieldtobytes ( $ prod - > { version } ) ;
push @ bytes , transfieldtobytes ( $ prod - > { serialnumber } ) ;
push @ bytes , transfieldtobytes ( $ prod - > { asset } ) ;
push @ bytes , transfieldtobytes ( $ prod - > { fruid } ) ;
push @ bytes , transfieldtobytes ( $ prod - > { fruid } ) ;
foreach ( @ { $ prod - > { extra } } ) {
my $ sig = getascii ( transfieldtobytes ( $ _ ) ) ;
unless ( $ sig and $ sig =~ /FRU by xCAT/ ) {
push @ bytes , transfieldtobytes ( $ _ ) ;
}
}
push @ bytes , transfieldtobytes ( { encoding = > 3 , value = > "$currnode FRU by xCAT " . xCAT::Utils:: Version ( 'short' ) } ) ;
push @ bytes , ( 0xc1 ) ;
$ bytes [ 1 ] = ceil ( ( scalar ( @ bytes ) + 1 ) / 8 ) ;
$ padsize = ( ceil ( ( scalar ( @ bytes ) + 1 ) / 8 ) * 8 ) - scalar ( @ bytes ) - 1 ;
while ( $ padsize - - ) {
push @ bytes , ( 0x00 ) ;
}
$ padsize = dochksum ( \ @ bytes ) ; #reuse padsize for a second to store checksum
push @ bytes , $ padsize ;
return @ bytes ;
}
sub fru {
my $ subcommand = shift ;
my $ netfun = 0x28 ;
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my @ output ;
my $ code ;
@ cmd = ( 0x10 , 0x00 ) ;
$ error = docmd (
$ netfun ,
\ @ cmd ,
\ @ returnd
) ;
if ( $ error ) {
$ rc = 1 ;
$ text = $ error ;
return ( $ rc , $ text ) ;
}
$ code = $ returnd [ 0 ] ;
if ( $ code == 0x00 ) {
}
else {
$ rc = 1 ;
$ text = $ codes { $ code } ;
}
if ( $ rc != 0 ) {
if ( ! $ text ) {
$ text = sprintf ( "unknown response %02x" , $ code ) ;
}
return ( $ rc , $ text ) ;
}
my $ fru_size_ls = $ returnd [ 1 ] ;
my $ fru_size_ms = $ returnd [ 2 ] ;
my $ fru_size = $ fru_size_ms * 256 + $ fru_size_ls ;
if ( $ subcommand eq "dump" ) {
print "FRU Size: $fru_size\n" ;
my ( $ rc , @ output ) = frudump ( 0 , $ fru_size , 8 ) ;
if ( $ rc ) {
return ( $ rc , @ output ) ;
}
hexadump ( \ @ output ) ;
return ( 0 , "" ) ;
}
if ( $ subcommand eq "wipe" ) {
my @ bytes = ( ) ;
for ( my $ i = 0 ; $ i < $ fru_size ; $ i + + ) {
push ( @ bytes , 0xff ) ;
}
my ( $ rc , $ text ) = fruwrite ( 0 , \ @ bytes , 8 ) ;
if ( $ rc ) {
return ( $ rc , $ text ) ;
}
return ( 0 , "FRU $fru_size bytes wiped" ) ;
}
return ( 0 , "" ) ;
}
2010-02-04 17:05:21 +00:00
sub add_fruhash {
my $ sessdata = shift ;
my $ fruhash ;
if ( $ sessdata - > { currfruid } != 0 and not ref $ sessdata - > { currfrudata } ) {
my $ fru = FRU - > new ( ) ;
if ( $ sessdata - > { currfrutype } and $ sessdata - > { currfrutype } eq 'dimm' ) {
$ fru - > rec_type ( "dimm,hw" ) ;
} else {
$ fru - > rec_type ( "hw" ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-04 17:05:21 +00:00
$ fru - > value ( $ sessdata - > { currfrudata } ) ;
$ fru - > desc ( $ sessdata - > { currfrusdr } - > id_string ) ;
$ sessdata - > { fru_hash } - > { $ sessdata - > { frudex } } = $ fru ;
$ sessdata - > { frudex } += 1 ;
} elsif ( $ sessdata - > { currfrutype } and $ sessdata - > { currfrutype } eq 'dimm' ) {
$ fruhash = decode_spd ( @ { $ sessdata - > { currfrudata } } ) ;
} else {
my $ err ;
( $ err , $ fruhash ) = parsefru ( $ sessdata - > { currfrudata } ) ;
if ( $ err ) {
sendmsg ( [ 1 , "Error reading fru area $err" . $ sessdata - > { currfruid } ] ) ;
return ;
}
}
if ( $ sessdata - > { currfruid } == 0 ) {
initfru_zero ( $ sessdata , $ fruhash ) ;
return ;
} elsif ( ref $ sessdata - > { currfrudata } ) {
if ( $ sessdata - > { currfrutype } and $ sessdata - > { currfrutype } eq 'dimm' ) {
add_textual_frus ( $ fruhash , $ sessdata - > { currfrusdr } - > id_string , "" , "product" , "dimm,hw" , $ sessdata ) ;
} else {
add_textual_frus ( $ fruhash , $ sessdata - > { currfrusdr } - > id_string , "Board" , "board" , undef , $ sessdata ) ;
add_textual_frus ( $ fruhash , $ sessdata - > { currfrusdr } - > id_string , "Product" , "product" , undef , $ sessdata ) ;
add_textual_frus ( $ fruhash , $ sessdata - > { currfrusdr } - > id_string , "Chassis" , "chassis" , undef , $ sessdata ) ;
}
}
if ( scalar @ { $ sessdata - > { dimmfru } } ) {
$ sessdata - > { currfrusdr } = shift @ { $ sessdata - > { dimmfru } } ;
$ sessdata - > { currfruid } = $ sessdata - > { currfrusdr } - > sensor_number ;
$ sessdata - > { currfrutype } = "dimm" ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x10 , data = > [ $ sessdata - > { currfruid } ] , callback = > \ & process_currfruid , callback_args = > $ sessdata ) ;
} elsif ( scalar @ { $ sessdata - > { genhwfru } } ) {
$ sessdata - > { currfrusdr } = shift @ { $ sessdata - > { genhwfru } } ;
$ sessdata - > { currfruid } = $ sessdata - > { currfrusdr } - > sensor_number ;
$ sessdata - > { currfrutype } = "genhw" ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x10 , data = > [ $ sessdata - > { currfruid } ] , callback = > \ & process_currfruid , callback_args = > $ sessdata ) ;
} else {
fru_initted ( $ sessdata ) ;
}
}
2010-01-30 23:20:11 +00:00
2010-02-04 17:05:21 +00:00
sub readcurrfrudevice {
my $ rsp = shift ;
my $ sessdata = shift ;
my $ chunk = 16 ; #we have no idea how much will be supported to grab at a time, stick to 16 as a magic number for the moment
if ( not ref $ rsp ) {
$ sessdata - > { currfruoffset } = 0 ;
$ sessdata - > { currfrudata } = [] ;
$ sessdata - > { currfrudone } = 0 ;
$ sessdata - > { currfruchunk } = 16 ;
} else {
if ( $ rsp - > { code } != 0xcb and check_rsp_errors ( $ rsp , $ sessdata ) ) {
return ;
} elsif ( $ rsp - > { code } == 0xcb ) {
$ sessdata - > { currfrudata } = "Not Present" ;
$ sessdata - > { currfrudone } = 1 ;
add_fruhash ( $ sessdata ) ;
return ;
}
my @ data = @ { $ rsp - > { data } } ;
if ( $ data [ 0 ] != $ sessdata - > { currfruchunk } ) {
sendmsg ( [ 1 , "Received incorrect data from BMC" ] , $ sessdata - > { node } ) ;
return ;
}
shift @ data ;
push @ { $ sessdata - > { currfrudata } } , @ data ;
if ( $ sessdata - > { currfrudone } ) {
add_fruhash ( $ sessdata ) ;
return ;
}
}
2010-01-30 23:20:11 +00:00
2010-02-04 17:05:21 +00:00
my $ ms = $ sessdata - > { currfruoffset } >> 8 ;
my $ ls = $ sessdata - > { currfruoffset } & 0xff ;
if ( $ sessdata - > { currfruoffset } + 16 >= $ sessdata - > { currfrusize } ) {
$ chunk = $ sessdata - > { currfrusize } - $ sessdata - > { currfruoffset } ; # shrink chunk to only get the remainder data
$ sessdata - > { currfrudone } = 1 ;
} else {
$ sessdata - > { currfruoffset } += $ chunk ;
}
$ sessdata - > { currfruchunk } = $ chunk ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x11 , data = > [ $ sessdata - > { currfruid } , $ ls , $ ms , $ chunk ] , callback = > \ & readcurrfrudevice , callback_args = > $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
sub parsefru {
my $ bytes = shift ;
my $ fruhash ;
my $ curridx ; #store indexes as needed for convenience
my $ currsize ; #store current size
my $ subidx ;
my @ currarea ;
unless ( $ bytes - > [ 0 ] == 1 ) {
if ( $ bytes - > [ 0 ] == 0 or $ bytes - > [ 0 ] == 0xff ) { #not in spec, but probably unitialized, xCAT probably will rewrite fresh
return "clear" , undef ;
} else { #some meaning suggested, but not parsable, xCAT shouldn't meddle
return "unknown" , undef ;
}
}
if ( $ bytes - > [ 1 ] ) { #The FRU spec, unfortunately, gave no easy way to tell the size of internal area
#consequently, will find the next defined field and preserve the addressing and size of current FRU
#area until then
my $ internal_size ;
if ( $ bytes - > [ 2 ] ) {
$ internal_size = $ bytes - > [ 2 ] * 8 - ( $ bytes - > [ 1 ] * 8 ) ;
} elsif ( $ bytes - > [ 3 ] ) {
$ internal_size = $ bytes - > [ 3 ] * 8 - ( $ bytes - > [ 1 ] * 8 ) ;
} elsif ( $ bytes - > [ 4 ] ) {
$ internal_size = $ bytes - > [ 4 ] * 8 - ( $ bytes - > [ 1 ] * 8 ) ;
} elsif ( $ bytes - > [ 5 ] ) {
$ internal_size = $ bytes - > [ 5 ] * 8 - ( $ bytes - > [ 1 ] * 8 ) ;
} else { #The FRU area is intact enough to signify xCAT can't safely manipulate contents
return "unknown-winternal" , undef ;
}
#capture slice of bytes
$ fruhash - > { internal } = [ @ { $ bytes } [ ( $ bytes - > [ 1 ] * 8 ) .. ( $ bytes - > [ 1 ] * 8 + $ internal_size - 1 ) ] ] ; #,$bytes->[1]*8,$internal_size];
}
if ( $ bytes - > [ 2 ] ) { #Chassis info area, xCAT will preserve fields, not manipulate them
$ curridx = $ bytes - > [ 2 ] * 8 ;
unless ( $ bytes - > [ $ curridx ] == 1 ) { #definitely unparsable, but the section is preservable
return "unknown-COULDGUESS" , undef ; #be lazy for now, TODO revisit this and add guessing if it ever matters
}
$ currsize = ( $ bytes - > [ $ curridx + 1 ] ) * 8 ;
@ currarea = @ { $ bytes } [ $ curridx .. ( $ curridx + $ currsize - 1 ) ] ; #splice @$bytes,$curridx,$currsize;
$ fruhash - > { chassis } = parsechassis ( @ currarea ) ;
}
if ( $ bytes - > [ 3 ] ) { #Board info area, to be preserved
$ curridx = $ bytes - > [ 3 ] * 8 ;
unless ( $ bytes - > [ $ curridx ] == 1 ) {
return "unknown-COULDGUESS" , undef ;
}
$ currsize = ( $ bytes - > [ $ curridx + 1 ] ) * 8 ;
@ currarea = @ { $ bytes } [ $ curridx .. ( $ curridx + $ currsize - 1 ) ] ;
$ fruhash - > { board } = parseboard ( @ currarea ) ;
}
if ( $ bytes - > [ 4 ] ) { #Product info area present, will probably be thoroughly modified
$ curridx = $ bytes - > [ 4 ] * 8 ;
unless ( $ bytes - > [ $ curridx ] == 1 ) {
return "unknown-COULDGUESS" , undef ;
}
$ currsize = ( $ bytes - > [ $ curridx + 1 ] ) * 8 ;
@ currarea = @ { $ bytes } [ $ curridx .. ( $ curridx + $ currsize - 1 ) ] ;
$ fruhash - > { product } = parseprod ( @ currarea ) ;
}
if ( $ bytes - > [ 5 ] ) { #Generic multirecord present..
$ fruhash - > { extra } = [] ;
my $ last = 0 ;
$ curridx = $ bytes - > [ 5 ] * 8 ;
my $ currsize ;
while ( not $ last ) {
if ( $ bytes - > [ $ curridx + 1 ] & 128 ) {
$ last = 1 ;
}
$ currsize = $ bytes - > [ $ curridx + 2 ] ;
push @ { $ fruhash - > { extra } } , $ bytes - > [ $ curridx .. $ curridx + 4 + $ currsize - 1 ] ;
}
}
return 0 , $ fruhash ;
}
sub parseprod {
my @ area = @ _ ;
my % info ;
my $ language = $ area [ 2 ] ;
my $ idx = 3 ;
my $ currsize ;
my $ currdata ;
my $ encode ;
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % info ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ info { manufacturer } - > { encoding } = $ encode ;
$ info { manufacturer } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % info ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ info { product } - > { encoding } = $ encode ;
$ info { product } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % info ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ info { model } - > { encoding } = $ encode ;
$ info { model } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % info ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ info { version } - > { encoding } = $ encode ;
$ info { version } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % info ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ info { serialnumber } - > { encoding } = $ encode ;
$ info { serialnumber } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % info ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ info { asset } - > { encoding } = $ encode ;
$ info { asset } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % info ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ info { fruid } - > { encoding } = $ encode ;
$ info { fruid } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
if ( $ currsize ) {
$ info { extra } = [] ;
}
while ( $ currsize > 0 ) {
if ( $ currsize > 1 ) {
push @ { $ info { extra } } , { value = > $ currdata , encoding = > $ encode } ;
}
$ idx += $ currsize ;
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
}
return \ % info ;
}
sub parseboard {
my @ area = @ _ ;
my % boardinf ;
my $ idx = 6 ;
my $ language = $ area [ 2 ] ;
my $ tstamp = ( $ area [ 3 ] + ( $ area [ 4 ] << 8 ) + ( $ area [ 5 ] << 16 ) ) * 60 + 820472400 ; #820472400 is meant to be 1/1/1996
$ boardinf { raw } = [ @ area ] ; #store for verbatim replacement
unless ( $ tstamp == 820472400 ) {
$ boardinf { builddate } = scalar localtime ( $ tstamp ) ;
}
my $ encode ;
my $ currsize ;
my $ currdata ;
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % boardinf ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ boardinf { manufacturer } - > { encoding } = $ encode ;
$ boardinf { manufacturer } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % boardinf ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ boardinf { name } - > { encoding } = $ encode ;
$ boardinf { name } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % boardinf ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ boardinf { serialnumber } - > { encoding } = $ encode ;
$ boardinf { serialnumber } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % boardinf ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ boardinf { partnumber } - > { encoding } = $ encode ;
$ boardinf { partnumber } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
unless ( $ currsize ) {
return \ % boardinf ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ boardinf { fruid } - > { encoding } = $ encode ;
$ boardinf { fruid } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
if ( $ currsize ) {
$ boardinf { extra } = [] ;
}
while ( $ currsize > 0 ) {
if ( $ currsize > 1 ) {
push @ { $ boardinf { extra } } , { value = > $ currdata , encoding = > $ encode } ;
}
$ idx += $ currsize ;
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ area , $ idx ) ;
}
return \ % boardinf ;
}
sub parsechassis {
my @ chassarea = @ _ ;
my % chassisinf ;
my $ currsize ;
my $ currdata ;
my $ idx = 3 ;
my $ encode ;
$ chassisinf { raw } = [ @ chassarea ] ; #store for verbatim replacement
$ chassisinf { type } = "unknown" ;
if ( $ chassis_types { $ chassarea [ 2 ] } ) {
$ chassisinf { type } = $ chassis_types { $ chassarea [ 2 ] } ;
}
if ( $ chassarea [ $ idx ] == 0xc1 ) {
return \ % chassisinf ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ chassarea , $ idx ) ;
unless ( $ currsize ) {
return \ % chassisinf ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ chassisinf { partnumber } - > { encoding } = $ encode ;
$ chassisinf { partnumber } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ chassarea , $ idx ) ;
unless ( $ currsize ) {
return \ % chassisinf ;
}
$ idx += $ currsize ;
if ( $ currsize > 1 ) {
$ chassisinf { serialnumber } - > { encoding } = $ encode ;
$ chassisinf { serialnumber } - > { value } = $ currdata ;
}
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ chassarea , $ idx ) ;
if ( $ currsize ) {
$ chassisinf { extra } = [] ;
}
while ( $ currsize > 0 ) {
if ( $ currsize > 1 ) {
push @ { $ chassisinf { extra } } , { value = > $ currdata , encoding = > $ encode } ;
}
$ idx += $ currsize ;
( $ currsize , $ currdata , $ encode ) = extractfield ( \ @ chassarea , $ idx ) ;
}
return \ % chassisinf ;
}
sub extractfield { #idx is location of the type/length byte, returns something appropriate
my $ area = shift ;
my $ idx = shift ;
my $ language = shift ;
my $ data ;
2010-02-12 19:24:25 +00:00
if ( $ idx >= scalar @$ area ) {
sendmsg ( [ 1 , "Error parsing FRU data from BMC" ] ) ;
return 1 , undef , undef ;
}
2010-01-30 23:20:11 +00:00
my $ size = $ area - > [ $ idx ] & 0b00111111 ;
my $ encoding = ( $ area - > [ $ idx ] & 0b11000000 ) >> 6 ;
unless ( $ size ) {
return 1 , undef , undef ;
}
if ( $ size == 1 && $ encoding == 3 ) {
return 0 , '' , '' ;
}
if ( $ encoding == 3 ) {
$ data = getascii ( @$ area [ $ idx + 1 .. $ size + $ idx ] ) ;
} else {
$ data = [ @$ area [ $ idx + 1 .. $ size + $ idx ] ] ;
}
return $ size + 1 , $ data , $ encoding ;
}
sub writefru {
my $ netfun = 0x28 ; # Storage (0x0A << 2)
my @ cmd = ( 0x10 , 0 ) ;
my @ bytes ;
my $ error = docmd ( $ netfun , \ @ cmd , \ @ bytes ) ;
pop @ bytes ;
unless ( defined $ bytes [ 0 ] and $ bytes [ 0 ] == 0 ) {
return ( 1 , "FRU device 0 inaccessible" ) ;
}
my $ frusize = ( $ bytes [ 2 ] << 8 ) + $ bytes [ 1 ] ;
( $ error , @ bytes ) = frudump ( 0 , $ frusize , 16 ) ;
if ( $ error ) {
return ( 1 , "Error retrieving FRU: " . $ error ) ;
}
my $ fruhash ;
( $ error , $ fruhash ) = parsefru ( \ @ bytes ) ;
my $ newfru = formfru ( $ fruhash , $ frusize ) ;
unless ( $ newfru ) {
return ( 1 , "FRU data will not fit in BMC FRU space, fields too long" ) ;
}
my $ rc = 1 ;
my $ writeattempts = 0 ;
my $ text ;
while ( $ rc and $ writeattempts < 15 ) {
if ( $ writeattempts ) {
sleep 1 ;
}
( $ rc , $ text ) = fruwrite ( 0 , $ newfru , 8 ) ;
if ( $ text =~ /rotected/ ) {
last ;
}
$ writeattempts + + ;
}
if ( $ rc ) {
return ( $ rc , $ text ) ;
}
return ( 0 , "FRU Updated" ) ;
}
sub fruwrite {
my $ offset = shift ;
my $ bytes = shift ;
my $ chunk = shift ;
my $ length = @$ bytes ;
my $ netfun = 0x28 ;
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my @ output ;
my $ code ;
my @ fru_data = ( ) ;
for ( my $ c = $ offset ; $ c < $ length + $ offset ; $ c += $ chunk ) {
my $ ms = int ( $ c / 0x100 ) ;
my $ ls = $ c - $ ms * 0x100 ;
@ cmd = ( 0x12 , 0x00 , $ ls , $ ms , @$ bytes [ $ c - $ offset .. $ c - $ offset + $ chunk - 1 ] ) ;
$ error = docmd (
$ netfun ,
\ @ cmd ,
\ @ returnd
) ;
if ( $ error ) {
$ rc = 1 ;
$ text = $ error ;
return ( $ rc , $ text ) ;
}
$ code = $ returnd [ 0 ] ;
if ( $ code == 0x00 ) {
}
else {
$ rc = 1 ;
$ text = $ codes { $ code } ;
}
if ( $ rc != 0 ) {
if ( $ code == 0x80 ) {
$ text = "Write protected FRU" ;
}
if ( ! $ text ) {
$ text = sprintf ( "unknown response %02x" , $ code ) ;
}
return ( $ rc , $ text ) ;
}
my $ count = $ returnd [ 1 ] ;
if ( $ count != $ chunk ) {
$ rc = 1 ;
$ text = "FRU write error (bytes requested: $chunk, wrote: $count)" ;
return ( $ rc , $ text ) ;
}
}
return ( 0 ) ;
}
sub decodealert {
2010-01-30 23:48:18 +00:00
my $ sessdata = shift ;
2010-02-13 14:49:26 +00:00
my $ skip_sdrinit = 0 ;
unless ( ref $ sessdata ) { #called from xcat traphandler
$ sessdata = { sdr_hash = > { } } ;
$ skip_sdrinit = 1 ; #TODO sdr_init, cache only to avoid high trap handling overhead
2010-01-30 23:48:18 +00:00
}
2010-01-30 23:20:11 +00:00
my $ trap = shift ;
if ( $ trap =~ /xCAT_plugin::ipmi/ ) {
$ trap = shift ;
$ skip_sdrinit = 1 ;
}
my $ node = shift ;
my @ pet = @ _ ;
my $ rc ;
my $ text ;
my $ type ;
my $ desc ;
#my $ipmisensoreventtab = "$ENV{XCATROOT}/lib/GUMI/ipmisensorevent.tab";
#my $ipmigenericeventtab = "$ENV{XCATROOT}/lib/GUMI/ipmigenericevent.tab";
my $ offsetmask = 0b00000000000000000000000000001111 ;
my $ offsetrmask = 0b00000000000000000000000001110000 ;
my $ assertionmask = 0b00000000000000000000000010000000 ;
my $ eventtypemask = 0b00000000000000001111111100000000 ;
my $ sensortypemask = 0b00000000111111110000000000000000 ;
my $ reservedmask = 0b11111111000000000000000000000000 ;
my $ offset = $ trap & $ offsetmask ;
my $ offsetr = $ trap & $ offsetrmask ;
my $ event_dir = $ trap & $ assertionmask ;
my $ event_type = ( $ trap & $ eventtypemask ) >> 8 ;
my $ sensor_type = ( $ trap & $ sensortypemask ) >> 16 ;
my $ reserved = ( $ trap & $ reservedmask ) >> 24 ;
if ( $ debug >= 2 ) {
printf ( "offset: %02xh\n" , $ offset ) ;
printf ( "offsetr: %02xh\n" , $ offsetr ) ;
printf ( "assertion: %02xh\n" , $ event_dir ) ;
printf ( "eventtype: %02xh\n" , $ event_type ) ;
printf ( "sensortype: %02xh\n" , $ sensor_type ) ;
printf ( "reserved: %02xh\n" , $ reserved ) ;
}
my @ hex = ( 0 , @ pet ) ;
my $ pad = $ hex [ 0 ] ;
my @ uuid = @ hex [ 1 .. 16 ] ;
my @ seqnum = @ hex [ 17 , 18 ] ;
my @ timestamp = @ hex [ 19 , 20 , 21 , 22 ] ;
my @ utcoffset = @ hex [ 23 , 24 ] ;
my $ trap_source_type = $ hex [ 25 ] ;
my $ event_source_type = $ hex [ 26 ] ;
my $ sev = $ hex [ 27 ] ;
my $ sensor_device = $ hex [ 28 ] ;
my $ sensor_num = $ hex [ 29 ] ;
my $ entity_id = $ hex [ 30 ] ;
my $ entity_instance = $ hex [ 31 ] ;
my $ event_data_1 = $ hex [ 32 ] ;
my $ event_data_2 = $ hex [ 33 ] ;
my $ event_data_3 = $ hex [ 34 ] ;
my @ event_data = @ hex [ 35 .. 39 ] ;
my $ langcode = $ hex [ 40 ] ;
my $ mfg_id = $ hex [ 41 ] + $ hex [ 42 ] * 0x100 + $ hex [ 43 ] * 0x10000 + $ hex [ 44 ] * 0x1000000 ;
my $ prod_id = $ hex [ 45 ] + $ hex [ 46 ] * 0x100 ;
my @ oem = $ hex [ 47 .. @ hex - 1 ] ;
if ( $ sev == 0x00 ) {
$ sev = "LOG" ;
}
elsif ( $ sev == 0x01 ) {
$ sev = "MONITOR" ;
}
elsif ( $ sev == 0x02 ) {
$ sev = "INFORMATION" ;
}
elsif ( $ sev == 0x04 ) {
$ sev = "OK" ;
}
elsif ( $ sev == 0x08 ) {
$ sev = "WARNING" ;
}
elsif ( $ sev == 0x10 ) {
$ sev = "CRITICAL" ;
}
elsif ( $ sev == 0x20 ) {
$ sev = "NON-RECOVERABLE" ;
}
else {
$ sev = "UNKNOWN-SEVERITY:$sev" ;
}
$ text = "$sev:" ;
( $ rc , $ type , $ desc ) = getsensorevent ( $ sensor_type , $ offset , "ipmisensorevents" ) ;
if ( $ rc == 1 ) {
$ type = "Unknown Type $sensor_type" ;
$ desc = "Unknown Event $offset" ;
$ rc = 0 ;
}
if ( $ event_type <= 0x0c ) {
my $ gtype ;
my $ gdesc ;
( $ rc , $ gtype , $ gdesc ) = getsensorevent ( $ event_type , $ offset , "ipmigenericevents" ) ;
if ( $ rc == 1 ) {
$ gtype = "Unknown Type $gtype" ;
$ gdesc = "Unknown Event $offset" ;
$ rc = 0 ;
}
$ desc = $ gdesc ;
}
if ( $ type eq "" || $ type eq "-" ) {
$ type = "OEM Sensor Type $sensor_type"
}
if ( $ desc eq "" || $ desc eq "-" ) {
$ desc = "OEM Sensor Event $offset"
}
if ( $ type eq $ desc ) {
$ desc = "" ;
}
my $ extra_info = getaddsensorevent ( $ sensor_type , $ offset , $ event_data_1 , $ event_data_2 , $ event_data_3 ) ;
if ( $ extra_info ) {
if ( $ desc ) {
$ desc = "$desc $extra_info" ;
}
else {
$ desc = "$extra_info" ;
}
}
$ text = "$text $type," ;
$ text = "$text $desc" ;
my $ key ;
my $ sensor_desc = sprintf ( "Sensor 0x%02x" , $ sensor_num ) ;
2010-01-30 23:48:18 +00:00
my % sdr_hash = % { $ sessdata - > { sdr_hash } } ;
2010-01-30 23:20:11 +00:00
foreach $ key ( keys % sdr_hash ) {
my $ sdr = $ sdr_hash { $ key } ;
if ( $ sdr - > sensor_number == $ sensor_num ) {
$ sensor_desc = $ sdr_hash { $ key } - > id_string ;
if ( $ sdr - > rec_type == 0x01 ) {
last ;
}
}
}
$ text = "$text ($sensor_desc)" ;
if ( $ event_dir ) {
$ text = "$text - Recovered" ;
}
return ( 0 , $ text ) ;
}
sub readauxentry {
my $ netfn = 0x2e << 2 ;
my $ entrynum = shift ;
my $ entryls = ( $ entrynum & 0xff ) ;
my $ entryms = ( $ entrynum >> 8 ) ;
my @ cmd = ( 0x93 , 0x4d , 0x4f , 0x00 , $ entryls , $ entryms , 0 , 0 , 0xff , 0x5 ) ; #Get log size andup to 1275 bytes of data, keeping it under 1500 to accomodate mixed-mtu circumstances
my @ data ;
my $ error = docmd (
$ netfn ,
\ @ cmd ,
\ @ data
) ;
if ( $ error ) { return $ error ; }
if ( $ data [ 0 ] ) { return $ data [ 0 ] ; }
my $ text ;
unless ( $ data [ 1 ] == 0x4d and $ data [ 2 ] == 0x4f and $ data [ 3 ] == 0 ) { return "Unrecognized response format" }
$ entrynum = $ data [ 6 ] + ( $ data [ 7 ] << 8 ) ;
if ( ( $ data [ 10 ] & 1 ) == 1 ) {
$ text = "POSSIBLY INCOMPLETE DATA FOLLOWS:\n" ;
}
my $ addtext = "" ;
if ( $ data [ 5 ] > 5 ) {
$ addtext = "\nTODO:SUPPORT MORE DATA THAT WAS SEEN HERE" ;
}
@ data = splice @ data , 11 ;
pop @ data ;
while ( scalar ( @ data ) ) {
my @ subdata = splice @ data , 0 , 30 ;
my $ numbytes = scalar ( @ subdata ) ;
my $ formatstring = "%02x" x $ numbytes ;
$ formatstring =~ s/%02x%02x/%02x%02x /g ;
$ text . = sprintf ( $ formatstring . "\n" , @ subdata ) ;
}
$ text . = $ addtext ;
return ( 0 , $ entrynum , $ text ) ;
}
sub eventlog {
2010-01-30 23:48:18 +00:00
my $ sessdata = shift ;
2010-02-05 02:44:47 +00:00
my $ subcommand = $ sessdata - > { subcommand } ;
2010-01-30 23:48:18 +00:00
unless ( $ sessdata ) { die "not fixed yet" }
2010-01-30 23:20:11 +00:00
2010-02-05 02:44:47 +00:00
my $ netfun = 0x0a ;
2010-01-30 23:20:11 +00:00
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my $ code ;
my @ output ;
my $ entry ;
2010-02-05 02:44:47 +00:00
$ sessdata - > { fullsel } = 0 ;
2010-01-30 23:20:11 +00:00
my @ sel ;
my $ mfg_id ;
my $ prod_id ;
my $ device_id ;
#device id needed here
$ rc = 0 ;
unless ( defined ( $ subcommand ) ) {
$ subcommand = 'all' ;
}
if ( $ subcommand eq "all" ) {
2010-02-05 02:44:47 +00:00
$ sessdata - > { fullsel } = 1 ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ subcommand eq "clear" ) {
}
elsif ( $ subcommand =~ /^\d+$/ ) {
2010-02-05 02:44:47 +00:00
$ sessdata - > { numevents } = $ subcommand ;
2010-01-30 23:20:11 +00:00
}
else {
return ( 1 , "unsupported command eventlog $subcommand" ) ;
}
2010-02-05 02:44:47 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x48 , data = > [] , callback = > \ & eventlog_with_time , callback_args = > $ sessdata ) ;
}
sub eventlog_with_time {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ returnd = ( 0 , @ { $ rsp - > { data } } ) ;
2010-01-30 23:20:11 +00:00
#Here we set tfactor based on the delta between the BMC reported time and our
#time. The IPMI spec says the BMC should return seconds since 1970 in local
#time, but the reality is the firmware pushing to the BMC has no context
#to know, so here we guess and adjust all timestamps based on delta between
#our now and the BMC's now
2010-02-05 02:44:47 +00:00
$ sessdata - > { tfactor } = $ returnd [ 4 ] << 24 | $ returnd [ 3 ] << 16 | $ returnd [ 2 ] << 8 | $ returnd [ 1 ] ;
if ( $ sessdata - > { tfactor } > 0x20000000 ) {
$ sessdata - > { tfactor } -= time ( ) ;
2010-01-30 23:20:11 +00:00
} else {
2010-02-05 02:44:47 +00:00
$ sessdata - > { tfactor } = 0 ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 02:44:47 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x0a , command = > 0x40 , data = > [] , callback = > \ & eventlog_with_selinfo , callback_args = > $ sessdata ) ;
}
sub eventlog_with_selinfo {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my $ code = $ rsp - > { code } ;
my @ returnd = ( 0 , @ { $ rsp - > { data } } ) ;
2010-01-30 23:20:11 +00:00
2010-02-05 02:44:47 +00:00
#sif($code == 0x81) {
# $rc = 1;
# $text = "cannot execute command, SEL erase in progress";
#}
2010-01-30 23:20:11 +00:00
my $ sel_version = $ returnd [ 1 ] ;
if ( $ sel_version != 0x51 ) {
2010-02-05 02:44:47 +00:00
sendmsg ( sprintf ( "SEL version 51h support only, version reported: %x" , $ sel_version ) , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 02:44:47 +00:00
hexdump ( \ @ returnd ) ;
my $ num_entries = ( $ returnd [ 3 ] << 8 ) + $ returnd [ 2 ] ;
2010-01-30 23:20:11 +00:00
if ( $ num_entries <= 0 ) {
2010-02-05 02:44:47 +00:00
sendmsg ( "no SEL entries" , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
my $ canres = $ returnd [ 14 ] & 0b00000010 ;
if ( ! $ canres ) {
2010-02-05 02:44:47 +00:00
sendmsg ( [ 1 , "SEL reservation not supported" ] , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 02:44:47 +00:00
my $ subcommand = $ sessdata - > { subcommand } ;
2010-01-30 23:20:11 +00:00
if ( $ subcommand =~ /clear/ ) { #Don't bother with a reservation unless a clear is involved
#atomic SEL retrieval need not require it, so an event during retrieval will not kill reventlog effort off
2010-02-05 02:44:47 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x42 , data = > [] , callback = > \ & clear_sel_with_reservation , callback_args = > $ sessdata ) ;
return ;
} elsif ( $ sessdata - > { mfg_id } == 2 ) {
#read_ibm_auxlog($sessdata); #TODO JBJ fix this back in
#return;
2010-01-30 23:20:11 +00:00
#For requests other than clear, we check for IBM extended auxillary log data
}
2010-02-05 02:44:47 +00:00
$ sessdata - > { selentries } = [] ;
$ sessdata - > { selentry } = 0 ;
2010-02-05 02:55:37 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x43 , data = > [ 0 , 0 , 0x00 , 0x00 , 0x00 , 0xFF ] , callback = > \ & got_sel , callback_args = > $ sessdata ) ;
2010-02-05 02:44:47 +00:00
}
sub got_sel {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ returnd = ( 0 , @ { $ rsp - > { data } } ) ;
#elsif($code == 0x81) {
# $rc = 1;
# $text = "cannot execute command, SEL erase in progress";
#}
2010-01-30 23:20:11 +00:00
2010-02-05 02:44:47 +00:00
my $ next_rec_ls = $ returnd [ 1 ] ;
my $ next_rec_ms = $ returnd [ 2 ] ;
my @ sel_data = @ returnd [ 3 .. 19 ] ;
2010-01-30 23:20:11 +00:00
2010-02-05 02:44:47 +00:00
$ sessdata - > { selentry } += 1 ;
2010-01-30 23:20:11 +00:00
if ( $ debug ) {
2010-02-05 02:44:47 +00:00
print $ sessdata - > { selentry } . ": " ;
2010-01-30 23:20:11 +00:00
hexdump ( \ @ sel_data ) ;
}
my $ record_id = $ sel_data [ 0 ] + $ sel_data [ 1 ] * 256 ;
my $ record_type = $ sel_data [ 2 ] ;
if ( $ record_type == 0x02 ) {
}
else {
2010-02-05 02:44:47 +00:00
my $ text = getoemevent ( $ record_type , $ sessdata - > { mfg_id } , \ @ sel_data ) ;
my $ entry = $ sessdata - > { selentry } ;
if ( $ sessdata - > { auxloginfo } and $ sessdata - > { auxloginfo } - > { $ entry } ) {
$ text . = " With additional data:\n" . $ sessdata - > { auxloginfo } - > { $ entry } ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 02:44:47 +00:00
if ( $ sessdata - > { fullsel } ) {
sendmsg ( $ text , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
} else {
2010-02-05 02:44:47 +00:00
push ( @ { $ sessdata - > { selentries } } , $ text ) ;
2010-01-30 23:20:11 +00:00
}
if ( $ next_rec_ms == 0xFF && $ next_rec_ls == 0xFF ) {
2010-02-05 02:44:47 +00:00
sendsel ( $ sessdata ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 02:55:37 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x43 , data = > [ 0 , 0 , $ next_rec_ls , $ next_rec_ms , 0x00 , 0xFF ] , callback = > \ & got_sel , callback_args = > $ sessdata ) ;
2010-02-05 02:44:47 +00:00
return ;
2010-01-30 23:20:11 +00:00
}
my $ timestamp = ( $ sel_data [ 3 ] | $ sel_data [ 4 ] << 8 | $ sel_data [ 5 ] << 16 | $ sel_data [ 6 ] << 24 ) ;
unless ( $ timestamp < 0x20000000 ) { #IPMI Spec says below this is effectively BMC uptime, not correctable
2010-02-05 02:44:47 +00:00
$ timestamp -= $ sessdata - > { tfactor } ; #apply correction factor based on how off the current BMC clock is from management server
2010-01-30 23:20:11 +00:00
}
my ( $ seldate , $ seltime ) = timestamp2datetime ( $ timestamp ) ;
# $text = "$entry: $seldate $seltime";
2010-02-05 02:44:47 +00:00
my $ text = ":$seldate $seltime" ;
2010-01-30 23:20:11 +00:00
# my $gen_id_slave_addr = ($sel_data[7] & 0b11111110) >> 1;
# my $gen_id_slave_addr_hs = ($sel_data[7] & 0b00000001);
# my $gen_id_ch_num = ($sel_data[8] & 0b11110000) >> 4;
# my $gen_id_ipmb = ($sel_data[8] & 0b00000011);
my $ sensor_owner_id = $ sel_data [ 7 ] ;
my $ sensor_owner_lun = $ sel_data [ 8 ] ;
my $ sensor_type = $ sel_data [ 10 ] ;
my $ sensor_num = $ sel_data [ 11 ] ;
my $ event_dir = $ sel_data [ 12 ] & 0b10000000 ;
my $ event_type = $ sel_data [ 12 ] & 0b01111111 ;
my $ offset = $ sel_data [ 13 ] & 0b00001111 ;
my $ event_data_1 = $ sel_data [ 13 ] ;
my $ event_data_2 = $ sel_data [ 14 ] ;
my $ event_data_3 = $ sel_data [ 15 ] ;
my $ sev = 0 ;
$ sev = ( $ sel_data [ 14 ] & 0b11110000 ) >> 4 ;
# if($event_type != 1) {
# $sev = ($sel_data[14] & 0b11110000) >> 4;
# }
# $text = "$text $sev:";
my $ type ;
my $ desc ;
2010-02-05 02:44:47 +00:00
my $ rc ;
2010-01-30 23:20:11 +00:00
( $ rc , $ type , $ desc ) = getsensorevent ( $ sensor_type , $ offset , "ipmisensorevents" ) ;
if ( $ rc == 1 ) {
$ type = "Unknown Type $sensor_type" ;
$ desc = "Unknown Event $offset" ;
$ rc = 0 ;
}
if ( $ event_type <= 0x0c ) {
my $ gtype ;
my $ gdesc ;
( $ rc , $ gtype , $ gdesc ) = getsensorevent ( $ event_type , $ offset , "ipmigenericevents" ) ;
if ( $ rc == 1 ) {
$ gtype = "Unknown Type $gtype" ;
$ gdesc = "Unknown Event $offset" ;
$ rc = 0 ;
}
$ desc = $ gdesc ;
}
if ( $ type eq "" || $ type eq "-" ) {
$ type = "OEM Sensor Type $sensor_type"
}
if ( $ desc eq "" || $ desc eq "-" ) {
$ desc = "OEM Sensor Event $offset"
}
if ( $ type eq $ desc ) {
$ desc = "" ;
}
my $ extra_info = getaddsensorevent ( $ sensor_type , $ offset , $ event_data_1 , $ event_data_2 , $ event_data_3 ) ;
if ( $ extra_info ) {
if ( $ desc ) {
$ desc = "$desc $extra_info" ;
}
else {
$ desc = "$extra_info" ;
}
}
$ text = "$text $type," ;
$ text = "$text $desc" ;
# my $key;
my $ key = $ sensor_owner_id . "." . $ sensor_owner_lun . "." . $ sensor_num ;
my $ sensor_desc = sprintf ( "Sensor 0x%02x" , $ sensor_num ) ;
# foreach $key (keys %sdr_hash) {
# my $sdr = $sdr_hash{$key};
# if($sdr->sensor_number == $sensor_num) {
# $sensor_desc = $sdr_hash{$key}->id_string;
# last;
# }
# }
2010-01-30 23:48:18 +00:00
my % sdr_hash = % { $ sessdata - > { sdr_hash } } ;
2010-01-30 23:20:11 +00:00
if ( defined $ sdr_hash { $ key } ) {
$ sensor_desc = $ sdr_hash { $ key } - > id_string ;
if ( $ sdr_hash { $ key } - > event_type_code == 1 ) {
if ( ( $ event_data_1 & 0b11000000 ) == 0b01000000 ) {
$ sensor_desc . = " reading " . translate_sensor ( $ event_data_2 , $ sdr_hash { $ key } ) ;
if ( ( $ event_data_1 & 0b00110000 ) == 0b00010000 ) {
$ sensor_desc . = " with threshold " . translate_sensor ( $ event_data_3 , $ sdr_hash { $ key } ) ;
}
}
}
}
$ text = "$text ($sensor_desc)" ;
if ( $ event_dir ) {
$ text = "$text - Recovered" ;
}
2010-02-05 02:44:47 +00:00
my $ entry = $ sessdata - > { selentry } ;
2010-01-30 23:20:11 +00:00
2010-02-05 02:44:47 +00:00
if ( $ sessdata - > { auxloginfo } and $ sessdata - > { auxloginfo } - > { $ entry } ) {
2010-01-30 23:20:11 +00:00
$ text . = " with additional data:" ;
2010-02-05 02:44:47 +00:00
if ( $ sessdata - > { fullsel } ) {
sendmsg ( $ text , $ sessdata - > { node } ) ;
foreach ( split /\n/ , $ sessdata - > { auxloginfo } - > { $ entry } ) {
sendmsg ( 0 , $ _ , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
} else {
2010-02-05 02:44:47 +00:00
push ( @ { $ sessdata - > { selentries } } , $ text ) ;
push @ { $ sessdata - > { selentries } } , split /\n/ , $ sessdata - > { auxloginfo } - > { $ entry } ;
2010-01-30 23:20:11 +00:00
}
} else {
2010-02-05 02:44:47 +00:00
if ( $ sessdata - > { fullsel } ) {
2010-02-05 12:49:18 +00:00
sendmsg ( $ text , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
} else {
2010-02-05 02:44:47 +00:00
push ( @ { $ sessdata - > { selentries } } , $ text ) ;
2010-01-30 23:20:11 +00:00
}
}
if ( $ next_rec_ms == 0xFF && $ next_rec_ls == 0xFF ) {
2010-02-05 02:44:47 +00:00
sendsel ( $ sessdata ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 02:55:37 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x43 , data = > [ 0 , 0 , $ next_rec_ls , $ next_rec_ms , 0x00 , 0xFF ] , callback = > \ & got_sel , callback_args = > $ sessdata ) ;
2010-02-05 02:44:47 +00:00
}
2010-01-30 23:20:11 +00:00
2010-02-05 02:44:47 +00:00
sub sendsel {
my $ sessdata = shift ;
####my @routput = reverse(@output);
####my @noutput;
####my $c;
####foreach(@routput) {
#### $c++;
#### if($c > $num) {
#### last;
#### }
#### push(@noutput,$_);
####}
####@output = reverse(@noutput);
2010-01-30 23:20:11 +00:00
2010-02-05 02:44:47 +00:00
####return($rc,@output);
}
sub clear_sel_with_reservation {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ returnd = ( 0 , @ { $ rsp - > { data } } ) ;
#elsif($code == 0x81) {
# $rc = 1;
# $text = "cannot execute command, SEL erase in progress";
#}
$ sessdata - > { res_id_ls } = $ returnd [ 1 ] ;
$ sessdata - > { res_id_ms } = $ returnd [ 2 ] ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x47 , data = > [ $ sessdata - > { res_id_ls } , $ sessdata - > { res_id_ms } , 0x43 , 0x4c , 0x52 , 0xaa ] , callback = > \ & wait_for_selerase , callback_args = > $ sessdata ) ;
}
sub wait_for_selerase {
my $ rsp = shift ;
my $ sessdata = shift ;
my @ returnd = ( 0 , @ { $ rsp - > { data } } ) ;
my $ erase_status = $ returnd [ 1 ] & 0b00000001 ;
sendmsg ( "SEL cleared" , $ sessdata - > { node } ) ;
}
#commenting out usless 'while 0' loop.
#skip test for now, need to get new res id for some machines
# while($erase_status == 0 && 0) {
# sleep(1);
# @cmd=(0x47,$res_id_ls,$res_id_ms,0x43,0x4c,0x52,0x00);
# $error = docmd(
# $netfun,
# \@cmd,
# \@returnd
# );
# if($error) {
# $rc = 1;
# $text = $error;
# return($rc,$text);
# }
# $code = $returnd[0];
# if($code == 0x00) {
# }
# else {
# $rc = 1;
# $text = $codes{$code};
# }
# if($rc != 0) {
# if(!$text) {
# $text = sprintf("unknown response %02x",$code);
# }
# return($rc,$text);
# }
# $erase_status = $returnd[1] & 0b00000001;
# }
sub read_ibm_auxlog {
my $ sessdata = shift ;
my $ entry = $ sessdata - > { selentry } ;
my @ auxdata ;
my $ netfn = 0xa << 2 ;
my @ auxlogcmd = ( 0x5a , 1 ) ;
my $ error = docmd (
$ netfn ,
\ @ auxlogcmd ,
\ @ auxdata ) ;
#print Dumper(\@auxdata);
unless ( $ error or $ auxdata [ 0 ] or $ auxdata [ 5 ] != 0x4d or $ auxdata [ 6 ] != 0x4f or $ auxdata [ 7 ] != 0x0 ) { #Don't bother if support cannot be confirmed by service processor
$ netfn = 0x2e << 2 ; #switch netfunctions to read
my $ numauxlogs = $ auxdata [ 8 ] + ( $ auxdata [ 9 ] << 8 ) ;
my $ auxidx = 1 ;
my $ rc ;
my $ entry ;
my $ extdata ;
while ( $ auxidx <= $ numauxlogs ) {
( $ rc , $ entry , $ extdata ) = readauxentry ( $ auxidx + + ) ;
unless ( $ rc ) {
if ( $ sessdata - > { auxloginfo } - > { $ entry } ) {
$ sessdata - > { auxloginfo } - > { $ entry } . = "!" . $ extdata ;
} else {
$ sessdata - > { auxloginfo } - > { $ entry } = $ extdata ;
}
}
}
if ( $ sessdata - > { auxloginfo } - > { 0 } ) {
if ( $ sessdata - > { fullsel } ) {
foreach ( split /!/ , $ sessdata - > { auxloginfo } - > { 0 } ) {
sendoutput ( 0 , ":Unassociated auxillary data detected:" ) ;
foreach ( split /\n/ , $ _ ) {
sendoutput ( 0 , $ _ ) ;
}
}
}
}
#print Dumper(\%auxloginfo);
}
2010-01-30 23:20:11 +00:00
}
2010-02-05 02:44:47 +00:00
2010-01-30 23:20:11 +00:00
sub getoemevent {
my $ record_type = shift ;
my $ mfg_id = shift ;
my $ sel_data = shift ;
2010-02-05 02:44:47 +00:00
my $ sessdata ;
2010-01-30 23:20:11 +00:00
my $ text = ":" ;
if ( $ record_type < 0xE0 && $ record_type > 0x2F ) { #Should be timestampped, whatever it is
my $ timestamp = ( @$ sel_data [ 3 ] | @$ sel_data [ 4 ] << 8 | @$ sel_data [ 5 ] << 16 | @$ sel_data [ 6 ] << 24 ) ;
unless ( $ timestamp < 0x20000000 ) {
2010-02-05 02:44:47 +00:00
$ timestamp -= $ sessdata - > { tfactor } ;
2010-01-30 23:20:11 +00:00
}
my ( $ seldate , $ seltime ) = timestamp2datetime ( $ timestamp ) ;
my @ rest = @$ sel_data [ 7 .. 15 ] ;
if ( $ mfg_id == 2 ) {
$ text . = "$seldate $seltime IBM OEM Event-" ;
if ( $ rest [ 3 ] == 0 && $ rest [ 4 ] == 0 && $ rest [ 7 ] == 0 ) {
$ text = $ text . "PCI Event/Error, details in next event"
} elsif ( $ rest [ 3 ] == 1 && $ rest [ 4 ] == 0 && $ rest [ 7 ] == 0 ) {
$ text = $ text . "Processor Event/Error occurred, details in next event"
} elsif ( $ rest [ 3 ] == 2 && $ rest [ 4 ] == 0 && $ rest [ 7 ] == 0 ) {
$ text = $ text . "Memory Event/Error occurred, details in next event"
} elsif ( $ rest [ 3 ] == 3 && $ rest [ 4 ] == 0 && $ rest [ 7 ] == 0 ) {
$ text = $ text . "Scalability Event/Error occurred, details in next event"
} elsif ( $ rest [ 3 ] == 4 && $ rest [ 4 ] == 0 && $ rest [ 7 ] == 0 ) {
$ text = $ text . "PCI bus Event/Error occurred, details in next event"
} elsif ( $ rest [ 3 ] == 5 && $ rest [ 4 ] == 0 && $ rest [ 7 ] == 0 ) {
$ text = $ text . "Chipset Event/Error occurred, details in next event"
} elsif ( $ rest [ 3 ] == 6 && $ rest [ 4 ] == 1 && $ rest [ 7 ] == 0 ) {
$ text = $ text . "BIOS/BMC Power Executive mismatch (BIOS $rest[5], BMC $rest[6])"
} elsif ( $ rest [ 3 ] == 6 && $ rest [ 4 ] == 2 && $ rest [ 7 ] == 0 ) {
$ text = $ text . "Boot denied due to power limitations"
} else {
$ text = $ text . "Unknown event " . phex ( \ @ rest ) ;
}
} else {
$ text . = "$seldate $seltime " . sprintf ( "Unknown OEM SEL Type %02x:" , $ record_type ) . phex ( \ @ rest ) ;
}
} else { #Non-timestamped
my % memerrors = (
0x00 = > "DIMM enabled" ,
0x01 = > "DIMM disabled, failed ECC test" ,
0x02 = > "POST/BIOS memory test failed, DIMM disabled" ,
0x03 = > "DIMM disabled, non-supported memory device" ,
0x04 = > "DIMM disabled, non-matching or missing DIMM(s)" ,
) ;
my % pcierrors = (
0x00 = > "Device OK" ,
0x01 = > "Required ROM space not available" ,
0x02 = > "Required I/O Space not available" ,
0x03 = > "Required memory not available" ,
0x04 = > "Required memory below 1MB not available" ,
0x05 = > "ROM checksum failed" ,
0x06 = > "BIST failed" ,
0x07 = > "Planar device missing or disabled by user" ,
0x08 = > "PCI device has an invalid PCI configuration space header" ,
0x09 = > "FRU information for added PCI device" ,
0x0a = > "FRU information for removed PCI device" ,
0x0b = > "A PCI device was added, PCI FRU information is stored in next log entry" ,
0x0c = > "A PCI device was removed, PCI FRU information is stored in next log entry" ,
0x0d = > "Requested resources not available" ,
0x0e = > "Required I/O Space Not Available" ,
0x0f = > "Required I/O Space Not Available" ,
0x10 = > "Required I/O Space Not Available" ,
0x11 = > "Required I/O Space Not Available" ,
0x12 = > "Required I/O Space Not Available" ,
0x13 = > "Planar video disabled due to add in video card" ,
0x14 = > "FRU information for PCI device partially disabled " ,
0x15 = > "A PCI device was partially disabled, PCI FRU information is stored in next log entry" ,
0x16 = > "A 33Mhz device is installed on a 66Mhz bus, PCI device information is stored in next log entry" ,
0x17 = > "FRU information, 33Mhz device installed on 66Mhz bus" ,
0x18 = > "Merge cable missing" ,
0x19 = > "Node 1 to Node 2 cable missing" ,
0x1a = > "Node 1 to Node 3 cable missing" ,
0x1b = > "Node 2 to Node 3 cable missing" ,
0x1c = > "Nodes could not merge" ,
0x1d = > "No 8 way SMP cable" ,
0x1e = > "Primary North Bridge to PCI Host Bridge IB Link has failed" ,
0x1f = > "Redundant PCI Host Bridge IB Link has failed" ,
) ;
my % procerrors = (
0x00 = > "Processor has failed BIST" ,
0x01 = > "Unable to apply processor microcode update" ,
0x02 = > "POST does not support current stepping level of processor" ,
0x03 = > "CPU mismatch detected" ,
) ;
my @ rest = @$ sel_data [ 3 .. 15 ] ;
if ( $ record_type == 0xE0 && $ rest [ 0 ] == 2 && $ mfg_id == 2 && $ rest [ 1 ] == 0 && $ rest [ 12 ] == 1 ) { #Rev 1 POST memory event
$ text = "IBM Memory POST Event-" ;
my $ msuffix = sprintf ( ", chassis %d, card %d, dimm %d" , $ rest [ 3 ] , $ rest [ 4 ] , $ rest [ 5 ] ) ;
#the next bit is a basic lookup table, should implement as a table ala ibmleds.tab, or a hash... yeah, a hash...
$ text = $ text . $ memerrors { $ rest [ 2 ] } . $ msuffix ;
} elsif ( $ record_type == 0xE0 && $ rest [ 0 ] == 1 && $ mfg_id == 2 && $ rest [ 12 ] == 0 ) { #A processor error or event, rev 0 only known in the spec I looked at
$ text = $ text . $ procerrors { $ rest [ 1 ] } ;
} elsif ( $ record_type == 0xE0 && $ rest [ 0 ] == 0 && $ mfg_id == 2 ) { #A PCI error or event, rev 1 or 2, the revs differe in endianness
my $ msuffix ;
if ( $ rest [ 12 ] == 0 ) {
$ msuffix = sprintf ( "chassis %d, slot %d, bus %s, device %02x%02x:%02x%02x" , $ rest [ 2 ] , $ rest [ 3 ] , $ rest [ 4 ] , $ rest [ 5 ] , $ rest [ 6 ] , $ rest [ 7 ] , $ rest [ 8 ] ) ;
} elsif ( $ rest [ 12 ] == 1 ) {
$ msuffix = sprintf ( "chassis %d, slot %d, bus %s, device %02x%02x:%02x%02x" , $ rest [ 2 ] , $ rest [ 3 ] , $ rest [ 4 ] , $ rest [ 5 ] , $ rest [ 6 ] , $ rest [ 7 ] , $ rest [ 8 ] ) ;
} else {
return ( "Unknown IBM PCI event/error format" ) ;
}
$ text = $ text . $ pcierrors { $ rest [ 1 ] } . $ msuffix ;
} else {
#Some event we can't define that is OEM or some otherwise unknown event
$ text = sprintf ( "SEL Type %02x:" , $ record_type ) . phex ( \ @ rest ) ;
}
} #End timestampped intepretation
return ( $ text ) ;
}
sub getsensorevent
{
my $ sensortype = sprintf ( "%02Xh" , shift ) ;
my $ sensoroffset = sprintf ( "%02Xh" , shift ) ;
my $ file = shift ;
my @ line ;
my $ type ;
my $ code ;
my $ desc ;
my $ offset ;
my $ rc = 1 ;
if ( $ file eq "ipmigenericevents" ) {
if ( $ xCAT:: data:: ipmigenericevents:: ipmigenericevents { "$sensortype,$sensoroffset" } ) {
( $ type , $ desc ) = split ( /,/ , $ xCAT:: data:: ipmigenericevents:: ipmigenericevents { "$sensortype,$sensoroffset" } , 2 ) ;
return ( 0 , $ type , $ desc ) ;
}
if ( $ xCAT:: data:: ipmigenericevents:: ipmigenericevents { "$sensortype,-" } ) {
( $ type , $ desc ) = split ( /,/ , $ xCAT:: data:: ipmigenericevents:: ipmigenericevents { "$sensortype,-" } , 2 ) ;
return ( 0 , $ type , $ desc ) ;
}
}
if ( $ file eq "ipmisensorevents" ) {
if ( $ xCAT:: data:: ipmisensorevents:: ipmisensorevents { "$sensortype,$sensoroffset" } ) {
( $ type , $ desc ) = split ( /,/ , $ xCAT:: data:: ipmisensorevents:: ipmisensorevents { "$sensortype,$sensoroffset" } , 2 ) ;
return ( 0 , $ type , $ desc ) ;
}
if ( $ xCAT:: data:: ipmisensorevents:: ipmisensorevents { "$sensortype,-" } ) {
( $ type , $ desc ) = split ( /,/ , $ xCAT:: data:: ipmisensorevents:: ipmisensorevents { "$sensortype,-" } , 2 ) ;
return ( 0 , $ type , $ desc ) ;
}
}
return ( 0 , "No Mappings found ($sensortype)" , "No Mappings found ($sensoroffset)" ) ;
}
sub getaddsensorevent {
my $ sensor_type = shift ;
my $ offset = shift ;
my $ event_data_1 = shift ;
my $ event_data_2 = shift ;
my $ event_data_3 = shift ;
my $ text = "" ;
if ( $ sensor_type == 0x08 && $ offset == 6 ) {
my % extra = (
0x0 = > "Vendor mismatch" ,
0x1 = > "Revision mismatch" ,
0x2 = > "Processor missing" ,
) ;
if ( $ extra { $ event_data_3 } ) {
$ text = $ extra { $ event_data_3 } ;
}
}
if ( $ sensor_type == 0x0C ) {
$ text = sprintf ( "Memory module %d" , $ event_data_3 ) ;
}
if ( $ sensor_type == 0x0f ) {
if ( $ offset == 0x00 ) {
my % extra = (
0x00 = > "Unspecified" ,
0x01 = > "No system memory installed" ,
0x02 = > "No usable system memory" ,
0x03 = > "Unrecoverable hard disk failure" ,
0x04 = > "Unrecoverable system board failure" ,
0x05 = > "Unrecoverable diskette failure" ,
0x06 = > "Unrecoverable hard disk controller failure" ,
0x07 = > "Unrecoverable keyboard failure" ,
0x08 = > "Removable boot media not found" ,
0x09 = > "Unrecoverable video controller failure" ,
0x0a = > "No video device detected" ,
0x0b = > "Firmware (BIOS) ROM corruption detected" ,
0x0c = > "CPU voltage mismatch" ,
0x0d = > "CPU speed matching failure" ,
) ;
$ text = $ extra { $ event_data_2 } ;
}
if ( $ offset == 0x02 ) {
my % extra = (
0x00 = > "Unspecified" ,
0x01 = > "Memory initialization" ,
0x02 = > "Hard-disk initialization" ,
0x03 = > "Secondary processor(s) initialization" ,
0x04 = > "User authentication" ,
0x05 = > "User-initiated system setup" ,
0x06 = > "USB resource configuration" ,
0x07 = > "PCI resource configuration" ,
0x08 = > "Option ROM initialization" ,
0x09 = > "Video initialization" ,
0x0a = > "Cache initialization" ,
0x0b = > "SM Bus initialization" ,
0x0c = > "Keyboard controller initialization" ,
0x0d = > "Embedded controller/management controller initialization" ,
0x0e = > "Docking station attachement" ,
0x0f = > "Enabling docking station" ,
0x10 = > "Docking staion ejection" ,
0x11 = > "Disable docking station" ,
0x12 = > "Calling operation system wake-up vector" ,
0x13 = > "Starting operation system boot process, call init 19h" ,
0x14 = > "Baseboard or motherboard initialization" ,
0x16 = > "Floppy initialization" ,
0x17 = > "Keyboard test" ,
0x18 = > "Pointing device test" ,
0x19 = > "Primary processor initialization" ,
) ;
$ text = $ extra { $ event_data_2 } ;
}
}
if ( $ sensor_type == 0x10 ) {
if ( $ offset == 0x0 ) {
$ text = sprintf ( "Memory module %d" , $ event_data_2 ) ;
} elsif ( $ offset == 0x01 ) {
$ text = "Disabled for " ;
unless ( $ event_data_3 & 0x20 ) {
if ( $ event_data_3 & 0x10 ) {
$ text . = "assertions of" ;
} else {
$ text . = "deassertions of" ;
}
}
$ text . = sprintf ( "type %02xh/offset %02xh" , $ event_data_2 , $ event_data_3 & 0x0F ) ;
} elsif ( $ offset == 0x05 ) {
$ text = "$event_data_3% full" ;
}
}
if ( $ sensor_type == 0x12 ) {
if ( $ offset == 0x03 ) {
}
if ( $ offset == 0x04 ) {
if ( $ event_data_2 & 0b00100000 ) {
$ text = "$text, NMI" ;
}
if ( $ event_data_2 & 0b00010000 ) {
$ text = "$text, OEM action" ;
}
if ( $ event_data_2 & 0b00001000 ) {
$ text = "$text, power cycle" ;
}
if ( $ event_data_2 & 0b00000100 ) {
$ text = "$text, reset" ;
}
if ( $ event_data_2 & 0b00000010 ) {
$ text = "$text, power off" ;
}
if ( $ event_data_2 & 0b00000001 ) {
$ text = "$text, Alert" ;
}
$ text =~ s/^, // ;
}
}
if ( $ sensor_type == 0x1d && $ offset == 0x07 ) {
my % causes = (
0 = > "Unknown" ,
1 = > "Chassis reset via User command to BMC" ,
2 = > "Reset button" ,
3 = > "Power button" ,
4 = > "Watchdog action" ,
5 = > "OEM" ,
6 = > "AC Power apply force on" ,
7 = > "Restore previous power state on AC" ,
8 = > "PEF initiated reset" ,
9 = > "PEF initiated power cycle" ,
10 = > "Soft reboot" ,
11 = > "RTC Wake" ,
) ;
if ( $ causes { $ event_data_2 & 0xf } ) {
$ text = $ causes { $ event_data_2 } ;
} else {
$ text = "Unrecognized cause " . $ event_data_2 & 0xf ;
}
$ text . = "via channel $event_data_3" ;
}
if ( $ sensor_type == 0x21 ) {
my % extra = (
0 = > "PCI slot" ,
1 = > "Drive array" ,
2 = > "External connector" ,
3 = > "Docking port" ,
4 = > "Other slot" ,
5 = > "Sensor ID" ,
6 = > "AdvncedTCA" ,
7 = > "Memory slot" ,
8 = > "FAN" ,
9 = > "PCIe" ,
10 = > "SCSI" ,
11 = > "SATA/SAS" ,
) ;
$ text = $ extra { $ event_data_2 & 127 } ;
unless ( $ text ) {
$ text = "Unknown slot/conn type " . $ event_data_2 & 127 ;
}
$ text . = " $event_data_3" ;
}
if ( $ sensor_type == 0x23 ) {
my % extra = (
0x10 = > "SMI" ,
0x20 = > "NMI" ,
0x30 = > "Messaging Interrupt" ,
0xF0 = > "Unspecified" ,
0x01 = > "BIOS FRB2" ,
0x02 = > "BIOS/POST" ,
0x03 = > "OS Load" ,
0x04 = > "SMS/OS" ,
0x05 = > "OEM" ,
0x0F = > "Unspecified"
) ;
if ( $ extra { $ event_data_2 & 0xF0 } ) {
$ text = $ extra { $ event_data_2 & 0xF0 } ;
}
if ( $ extra { $ event_data_2 & 0x0F } ) {
$ text . = ", " . $ extra { $ event_data_2 & 0x0F } ;
}
$ text =~ s/^, // ;
}
if ( $ sensor_type == 0x28 ) {
if ( $ offset == 0x4 ) {
$ text = "Sensor $event_data_2" ;
} elsif ( $ offset == 0x5 ) {
$ text = "" ;
my $ logicalfru = 0 ;
if ( $ event_data_2 & 128 ) {
$ logicalfru = 1 ;
}
my $ intelligent = 1 ;
if ( $ event_data_2 & 24 ) {
$ text . = "LUN " . ( $ event_data_2 & 24 ) >> 3 ;
} else {
$ intelligent = 0 ;
}
if ( $ event_data_2 & 7 ) {
$ text . = "Bus ID " . ( $ event_data_2 & 7 ) ;
}
if ( $ logicalfru ) {
$ text . = "FRU ID " . $ event_data_3 ;
} elsif ( not $ intelligent ) {
$ text . = "I2C addr " . $ event_data_3 >> 1 ;
}
}
}
if ( $ sensor_type == 0x2a ) {
$ text = sprintf ( "Channel %d, User %d" , $ event_data_3 & 0x0f , $ event_data_2 & 0x3f ) ;
if ( $ offset == 1 ) {
if ( ( $ event_data_3 & 207 ) == 1 ) {
$ text . = " at user request" ;
} elsif ( ( $ event_data_3 & 207 ) == 2 ) {
$ text . = " timed out" ;
} elsif ( ( $ event_data_3 & 207 ) == 3 ) {
$ text . = " configuration change" ;
}
}
}
if ( $ sensor_type == 0x2b ) {
my % extra = (
0x0 = > "Unspecified" ,
0x1 = > "BMC device ID" ,
0x2 = > "BMC Firmware" ,
0x3 = > "BMC Hardware" ,
0x4 = > "BMC manufacturer" ,
0x5 = > "IPMI Version" ,
0x6 = > "BMC aux firmware ID" ,
0x7 = > "BMC boot block" ,
0x8 = > "Other BMC Firmware" ,
0x09 = > "BIOS/EFI change" ,
0x0a = > "SMBIOS change" ,
0x0b = > "OS change" ,
0x0c = > "OS Loader change" ,
0x0d = > "Diagnostics change" ,
0x0e = > "Management agent change" ,
0x0f = > "Management software change" ,
0x10 = > "Management middleware change" ,
0x11 = > "FPGA/CPLD/PSoC change" ,
0x12 = > "FRU change" ,
0x13 = > "device addition/removal" ,
0x14 = > "Equivalent replacement" ,
0x15 = > "Newer replacement" ,
0x16 = > "Older replacement" ,
0x17 = > "DIP/Jumper change" ,
) ;
if ( $ extra { $ event_data_2 } ) {
$ text = $ extra { $ event_data_2 } ;
} else {
$ text = "Unknown version change type $event_data_2" ;
}
}
if ( $ sensor_type == 0x2c ) {
my % extra = (
0 = > "" ,
1 = > "Software dictated" ,
2 = > "Latch operated" ,
3 = > "Hotswap buton pressed" ,
4 = > "automatic operation" ,
5 = > "Communication lost" ,
6 = > "Communication lost locally" ,
7 = > "Unexpected removal" ,
8 = > "Operator intervention" ,
9 = > "Unknwon IPMB address" ,
10 = > "Unexpected deactivation" ,
0xf = > "unknown" ,
) ;
if ( $ extra { $ event_data_2 >> 4 } ) {
$ text = $ extra { $ event_data_2 >> 4 } ;
} else {
$ text = "Unrecognized cause " . $ event_data_2 >> 4 ;
}
my $ prev_state = $ event_data_2 & 0xf ;
unless ( $ prev_state == $ offset ) {
my % oldstates = (
0 = > "Not Installed" ,
1 = > "Inactive" ,
2 = > "Activation requested" ,
3 = > "Activating" ,
4 = > "Active" ,
5 = > "Deactivation requested" ,
6 = > "Deactivating" ,
7 = > "Communication lost" ,
) ;
if ( $ oldstates { $ prev_state } ) {
$ text . = "(was " . $ oldstates { $ prev_state } . ")" ;
} else {
$ text . = "(was in unrecognized state $prev_state)" ;
}
}
}
return ( $ text ) ;
}
sub initiem {
2010-02-03 12:52:42 +00:00
my $ sessdata = shift ;
$ sessdata - > { iem } = IBM::EnergyManager - > new ( ) ;
my @ payload = $ sessdata - > { iem } - > get_next_payload ( ) ;
2010-01-30 23:20:11 +00:00
my $ netfun = shift @ payload ;
2010-02-03 12:52:42 +00:00
my $ command = shift @ payload ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > $ netfun , command = > $ command , data = > \ @ payload , callback = > \ & ieminitted , callback_args = > $ sessdata ) ;
}
sub ieminitted {
my $ rsp = shift ;
my $ sessdata = shift ;
my @ returnd = ( $ rsp - > { code } , @ { $ rsp - > { data } } ) ;
$ sessdata - > { iem } - > handle_next_payload ( @ returnd ) ;
$ sessdata - > { iemcallback } - > ( $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
sub readenergy {
2010-02-03 12:52:42 +00:00
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
unless ( $ iem_support ) {
2010-02-03 12:52:42 +00:00
sendmsg ( [ 1 , "IBM::EnergyManager package required for this value" ] , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
my @ entries ;
2010-02-03 12:52:42 +00:00
$ sessdata - > { iemcallback } = \ & readenergy_withiem ;
initiem ( $ sessdata ) ;
}
sub readenergy_withiem {
my $ sessdata = shift ;
$ sessdata - > { iem } - > prep_get_ac_energy ( ) ;
$ sessdata - > { iemcallback } = \ & got_ac_energy ;
process_data_from_iem ( $ sessdata ) ;
}
sub got_ac_energy {
my $ sessdata = shift ;
$ sessdata - > { iem } - > prep_get_precision ( ) ;
$ sessdata - > { iemcallback } = \ & got_ac_energy_with_precision ;
execute_iem_commands ( $ sessdata ) ; #this gets all precision data initialized
}
sub got_ac_energy_with_precision {
my $ sessdata = shift ;
$ sessdata - > { iemtextdata } . = sprintf ( " +/-%.1f%%" , $ sessdata - > { iem } - > energy_ac_precision ( ) * 0.1 ) ; #note while \x{B1} would be cool, it's non-trivial to support
sendmsg ( $ sessdata - > { iemtextdata } , $ sessdata - > { node } ) ;
$ sessdata - > { iem } - > prep_get_dc_energy ( ) ;
$ sessdata - > { iemcallback } = \ & got_dc_energy ;
process_data_from_iem ( $ sessdata ) ;
}
sub got_dc_energy {
my $ sessdata = shift ;
$ sessdata - > { iemtextdata } . = sprintf ( " +/-%.1f%%" , $ sessdata - > { iem } - > energy_dc_precision ( ) * 0.1 ) ;
sendmsg ( $ sessdata - > { iemtextdata } , $ sessdata - > { node } ) ;
if ( scalar @ { $ sessdata - > { sensorstoread } } ) {
$ sessdata - > { currsdr } = shift @ { $ sessdata - > { sensorstoread } } ;
readsensor ( $ sessdata ) ; #next sensor
}
2010-01-30 23:20:11 +00:00
}
sub execute_iem_commands {
2010-02-03 12:52:42 +00:00
my $ sessdata = shift ;
my @ payload = $ sessdata - > { iem } - > get_next_payload ( ) ;
if ( scalar @ payload ) {
2010-01-30 23:20:11 +00:00
my $ netfun = shift @ payload ;
2010-02-03 12:52:42 +00:00
my $ command = shift @ payload ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > $ netfun , command = > $ command , data = > \ @ payload , callback = > \ & executed_iem_command , callback_args = > $ sessdata ) ;
} else { #complete, return to callback
$ sessdata - > { iemcallback } - > ( $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-03 12:52:42 +00:00
}
sub executed_iem_command {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
my @ returnd = ( $ rsp - > { code } , @ { $ rsp - > { data } } ) ;
$ sessdata - > { iem } - > handle_next_payload ( @ returnd ) ;
execute_iem_commands ( $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
sub process_data_from_iem {
2010-02-03 12:52:42 +00:00
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
my @ returnd ;
2010-02-03 12:52:42 +00:00
$ sessdata - > { iemdatacallback } = $ sessdata - > { iemcallback } ;
$ sessdata - > { iemcallback } = \ & got_data_to_process_from_iem ;
execute_iem_commands ( $ sessdata ) ;
}
sub got_data_to_process_from_iem {
my $ sessdata = shift ;
my @ iemdata = $ sessdata - > { iem } - > extract_data ;
2010-01-30 23:20:11 +00:00
my $ label = shift @ iemdata ;
my $ units = shift @ iemdata ;
my $ value = 0 ;
my $ shift = 0 ;
while ( scalar @ iemdata ) { #stuff the 64-bits of data into an int, would break in 32 bit
$ value += pop ( @ iemdata ) << $ shift ;
#$value.=sprintf("%02x ",shift @iemdata);
$ shift += 8 ;
}
if ( $ units eq "mJ" ) {
$ units = "kWh" ;
$ value = $ value / 3600000000 ;
2010-02-03 12:52:42 +00:00
$ sessdata - > { iemtextdata } = sprintf ( "$label: %.4f $units" , $ value ) ;
2010-01-30 23:20:11 +00:00
} elsif ( $ units eq "mW" ) {
$ units = "W" ;
$ value = $ value / 1000.0 ;
2010-02-03 12:52:42 +00:00
$ sessdata - > { iemtextdata } = sprintf ( "$label: %.1f $units" , $ value ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-03 12:52:42 +00:00
$ sessdata - > { iemdatacallback } - > ( $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
sub checkleds {
2010-01-30 23:48:18 +00:00
my $ sessdata = shift ;
2010-01-30 23:20:11 +00:00
my $ netfun = 0xe8 ; #really 0x3a
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ led_id_ms ;
my $ led_id_ls ;
my $ rc = 0 ;
my @ output = ( ) ;
my $ text = "" ;
my $ key ;
2010-02-02 02:30:12 +00:00
my $ mfg_id = $ sessdata - > { mfg_id } ;
2010-01-30 23:20:11 +00:00
#TODO device id
if ( $ mfg_id != 2 ) {
2010-02-02 02:30:12 +00:00
sendmsg ( "LED status not supported on this system" , $ sessdata - > { node } ) ;
return ;
2010-01-30 23:20:11 +00:00
}
2010-01-30 23:48:18 +00:00
my % sdr_hash = % { $ sessdata - > { sdr_hash } } ;
2010-02-02 02:30:12 +00:00
$ sessdata - > { doleds } = [] ;
2010-01-30 23:20:11 +00:00
foreach $ key ( sort { $ sdr_hash { $ a } - > id_string cmp $ sdr_hash { $ b } - > id_string } keys % sdr_hash ) {
my $ sdr = $ sdr_hash { $ key } ;
if ( $ sdr - > rec_type == 0xC0 && $ sdr - > sensor_type == 0xED ) {
#this stuff is to help me build the file from spec paste
#my $tehstr=sprintf("grep 0x%04X /opt/xcat/lib/x3755led.tab",$sdr->led_id);
#my $tehstr=`$tehstr`;
#$tehstr =~ s/^0x....//;
#printf("%X.%X.0x%04x",$mfg_id,$prod_id,$sdr->led_id);
#print $tehstr;
#We are inconsistant in our spec, first try a best guess
#at endianness, assume the smaller value is MSB
if ( ( $ sdr - > led_id & 0xff ) > ( $ sdr - > led_id >> 8 ) ) {
$ led_id_ls = $ sdr - > led_id & 0xff ;
$ led_id_ms = $ sdr - > led_id >> 8 ;
} else {
$ led_id_ls = $ sdr - > led_id >> 8 ;
$ led_id_ms = $ sdr - > led_id & 0xff ;
}
2010-02-02 02:30:12 +00:00
push @ { $ sessdata - > { doleds } } , [ $ led_id_ms , $ led_id_ls , $ sdr ] ;
}
}
$ sessdata - > { doled } = shift @ { $ sessdata - > { doleds } } ;
if ( $ sessdata - > { doled } ) {
$ sessdata - > { current_led_sdr } = pop @ { $ sessdata - > { doled } } ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xc0 , data = > $ sessdata - > { doled } , callback = > \ & did_led , callback_args = > $ sessdata ) ;
} else {
sendmsg ( "No supported LEDs found in system" , $ sessdata - > { node } ) ;
}
# if ($#output==-1) {
# push(@output,"No active error LEDs detected");
# }
}
sub did_led {
my $ rsp = $ _ [ 0 ] ;
my $ sessdata = $ _ [ 1 ] ;
my $ mfg_id = $ sessdata - > { mfg_id } ;
my $ prod_id = $ sessdata - > { prod_id } ;
my $ sdr = $ sessdata - > { current_led_sdr } ;
if ( not $ sessdata - > { ledswappedendian } and $ _ [ 0 ] - > { code } == 0xc9 ) { #missed an endian guess probably
$ sessdata - > { ledswappedendian } = 1 ;
my @ doled ;
$ doled [ 0 ] = $ sessdata - > { doled } - > [ 1 ] ;
$ doled [ 1 ] = $ sessdata - > { doled } - > [ 0 ] ;
$ sessdata - > { doled } = \ @ doled ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xc0 , data = > $ sessdata - > { doled } , callback = > \ & did_led , callback_args = > $ sessdata ) ;
return ;
} elsif ( $ _ [ 0 ] - > { code } == 0xc9 ) {
$ _ [ 0 ] - > { code } = 0 ; #TODO: some system actually gives an led locator record that doesn't exist....
print "DEBUG: unfindable LED record\n" ;
}
$ sessdata - > { ledswappedendian } = 0 ; #reset ledswappedendian flag to allow future swaps
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ led_id_ls = $ sessdata - > { doled } - > [ 1 ] ;
my $ led_id_ms = $ sessdata - > { doled } - > [ 0 ] ;
my @ returnd = ( 0 , @ { $ rsp - > { data } } ) ;
if ( $ returnd [ 2 ] ) { # != 0) {
#It's on...
if ( $ returnd [ 6 ] == 4 ) {
sendmsg ( sprintf ( "BIOS or admininstrator has %s lit" , getsensorname ( $ mfg_id , $ prod_id , $ sdr - > led_id , "ibmleds" ) ) , $ sessdata - > { node } ) ;
$ sessdata - > { activeleds } = 1 ;
2010-01-30 23:20:11 +00:00
}
2010-02-02 02:30:12 +00:00
elsif ( $ returnd [ 6 ] == 3 ) {
sendmsg ( sprintf ( "A user has manually requested LED 0x%04x (%s) be active" , $ sdr - > led_id , getsensorname ( $ mfg_id , $ prod_id , $ sdr - > led_id , "ibmleds" ) ) , $ sessdata - > { node } ) ;
$ sessdata - > { activeleds } = 1 ;
2010-01-30 23:20:11 +00:00
}
2010-02-02 02:30:12 +00:00
elsif ( $ returnd [ 6 ] == 1 && $ sdr - > led_id != 0 ) {
sendmsg ( sprintf ( "LED 0x%02x%02x (%s) active to indicate LED 0x%02x%02x (%s) is active" , $ led_id_ms , $ led_id_ls , getsensorname ( $ mfg_id , $ prod_id , $ sdr - > led_id , "ibmleds" ) , $ returnd [ 4 ] , $ returnd [ 5 ] , getsensorname ( $ mfg_id , $ prod_id , ( $ returnd [ 4 ] <<8)+$returnd[5],"ibmleds")),$sessdata-> { node } ) ;
$ sessdata - > { activeleds } = 1 ;
}
elsif ( $ sdr - > led_id == 0 ) {
sendmsg ( sprintf ( "LED 0x0000 (%s) active to indicate system error condition." , getsensorname ( $ mfg_id , $ prod_id , $ sdr - > led_id , "ibmleds" ) ) , $ sessdata - > { node } ) ;
$ sessdata - > { activeleds } = 1 ;
}
elsif ( $ returnd [ 6 ] == 2 ) {
my $ sensor_desc ;
#Ok, LED is tied to a sensor..
my $ sensor_num = $ returnd [ 5 ] ;
my % sdr_hash = % { $ sessdata - > { sdr_hash } } ;
foreach my $ key ( keys % sdr_hash ) {
my $ osdr = $ sdr_hash { $ key } ;
if ( $ osdr - > sensor_number == $ sensor_num ) {
$ sensor_desc = $ sdr_hash { $ key } - > id_string ;
if ( $ osdr - > rec_type == 0x01 ) {
last ;
}
}
}
#push(@output,sprintf("Sensor 0x%02x (%s) has activated LED 0x%04x",$sensor_num,$sensor_desc,$sdr->led_id));
sendmsg ( sprintf ( "LED 0x%02x%02x active to indicate Sensor 0x%02x (%s) error." , $ led_id_ms , $ led_id_ls , $ sensor_num , $ sensor_desc ) , $ sessdata - > { node } ) ;
$ sessdata - > { activeleds } = 1 ;
} else { #an LED is on for some other reason
print "DEBUG: unknown LED reason code " . $ returnd [ 6 ] . "\n" ;
#TODO: discern meaning of more 'reason' codes, 5 and ff have come up
}
}
$ sessdata - > { doled } = shift @ { $ sessdata - > { doleds } } ;
if ( $ sessdata - > { doled } ) {
$ sessdata - > { current_led_sdr } = pop @ { $ sessdata - > { doled } } ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x3a , command = > 0xc0 , data = > $ sessdata - > { doled } , callback = > \ & did_led , callback_args = > $ sessdata ) ;
} elsif ( not $ sessdata - > { activeleds } ) {
sendmsg ( "No active error LEDs detected" , $ sessdata - > { node } ) ;
}
if ( scalar @ { $ sessdata - > { sensorstoread } } ) {
$ sessdata - > { currsdr } = shift @ { $ sessdata - > { sensorstoread } } ;
readsensor ( $ sessdata ) ; #next sensor
}
2010-01-30 23:20:11 +00:00
}
sub renergy {
2010-02-05 18:47:49 +00:00
my $ sessdata = shift ;
my @ subcommands = @ { $ sessdata - > { extraargs } } ;
2010-01-30 23:20:11 +00:00
unless ( $ iem_support ) {
return ( 1 , "Command unsupported without IBM::EnergyManager installed" ) ;
}
my @ directives = ( ) ;
foreach ( @ subcommands ) {
2010-02-05 18:47:49 +00:00
if ( $ _ eq 'cappingmaxmin' ) {
push @ directives , 'cappingmax' , 'cappingmin' ;
}
2010-01-30 23:20:11 +00:00
push @ directives , split /,/ , $ _ ;
}
2010-02-05 18:47:49 +00:00
$ sessdata - > { directives } = \ @ directives ;
$ sessdata - > { iemcallback } = \ & renergy_withiem ;
initiem ( $ sessdata ) ;
}
sub renergy_withiem {
my $ sessdata = shift ;
my @ settable_keys = qw/savingstatus cappingstatus cappingwatt cappingvalue/ ;
my $ directive = shift ( @ { $ sessdata - > { directives } } ) ;
if ( $ sessdata - > { iemtextdata } ) {
sendmsg ( $ sessdata - > { iemtextdata } , $ sessdata - > { node } ) ;
$ sessdata - > { iemtextdata } = "" ;
}
if ( $ sessdata - > { gotcapstatus } ) {
$ sessdata - > { gotcapstatus } = 0 ;
my $ capenabled = $ sessdata - > { iem } - > capping_enabled ( ) ;
sendmsg ( "cappingstatus: " . ( $ capenabled ? "on" : "off" ) , $ sessdata - > { node } ) ;
}
if ( $ sessdata - > { gothistogram } ) {
$ sessdata - > { gothistogram } = 0 ;
my @ histdata = $ sessdata - > { iem } - > extract_relative_histogram ;
foreach ( sort { $ a <=> $ b } keys % { $ histdata [ 0 ] } ) {
sendmsg ( "$_: " . $ histdata [ 0 ] - > { $ _ } , $ sessdata - > { node } ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 18:47:49 +00:00
}
unless ( $ directive ) {
return ;
}
my $ value = undef ;
my $ key = undef ;
$ sessdata - > { iemcallback } = \ & renergy_withiem ;
if ( $ directive =~ /(.*)=(.*)\z/ ) {
$ key = $ 1 ;
$ value = $ 2 ;
unless ( grep /$key/ , @ settable_keys and $ value ) {
return ( 1 , "Malformed argument $directive" ) ;
}
if ( $ key eq "cappingwatt" or $ key eq "cappingvalue" ) {
$ value = $ value * 1000 ; #convert to milliwatts
$ sessdata - > { iem } - > prep_set_cap ( $ value ) ;
execute_iem_commands ( $ sessdata ) ; #this gets all precision data initialized
}
if ( $ key eq "cappingstatus" ) {
if ( grep /$value/ , qw/enable on 1/ ) {
$ value = 1 ;
} else {
$ value = 0 ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 18:47:49 +00:00
$ sessdata - > { iem } - > prep_set_capenable ( $ value ) ;
execute_iem_commands ( $ sessdata ) ; #this gets all precision data initialized
2010-01-30 23:20:11 +00:00
}
2010-02-05 18:47:49 +00:00
}
if ( $ directive =~ /cappingmin/ ) {
$ sessdata - > { iem } - > prep_get_mincap ( ) ;
process_data_from_iem ( $ sessdata ) ;
2010-02-24 18:19:27 +00:00
} elsif ( $ directive =~ /cappingmax$/ ) {
2010-02-05 18:47:49 +00:00
$ sessdata - > { iem } - > prep_get_maxcap ( ) ;
process_data_from_iem ( $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-05 18:47:49 +00:00
if ( $ directive =~ /cappingvalue/ ) {
$ sessdata - > { iem } - > prep_get_cap ( ) ;
process_data_from_iem ( $ sessdata ) ;
}
if ( $ directive =~ /cappingstatus/ ) {
$ sessdata - > { iem } - > prep_get_powerstatus ( ) ;
$ sessdata - > { gotcapstatus } = 1 ;
execute_iem_commands ( $ sessdata ) ;
}
if ( $ directive =~ /relhistogram/ ) {
$ sessdata - > { gothistogram } = 1 ;
$ sessdata - > { iem } - > prep_retrieve_histogram ( ) ;
execute_iem_commands ( $ sessdata ) ;
}
return ;
2010-01-30 23:20:11 +00:00
}
sub vitals {
2010-01-30 23:48:18 +00:00
my $ sessdata = shift ;
my % sdr_hash = % { $ sessdata - > { sdr_hash } } ;
2010-02-02 01:32:04 +00:00
my @ textfilters ;
foreach ( @ { $ sessdata - > { extraargs } } ) {
push @ textfilters , ( split /,/ , $ _ ) ;
}
2010-01-30 23:20:11 +00:00
unless ( scalar @ textfilters ) { @ textfilters = ( "all" ) ; }
my $ rc = 0 ;
my $ text ;
my $ key ;
my % sensor_filters = ( ) ;
my @ output ;
my $ reading ;
my $ unitdesc ;
my $ value ;
my $ extext ;
my $ format = "%-30s%8s %-20s" ;
2010-02-02 01:32:04 +00:00
my $ doall ;
$ doall = 0 ;
2010-01-30 23:20:11 +00:00
$ rc = 0 ;
#filters: defined in sensor type codes and data table
# 1 == temp, 2 == voltage 3== current (we lump in wattage here for lack of a better spot), 4 == fan
if ( grep { $ _ eq "all" } @ textfilters ) {
$ sensor_filters { 1 } = 1 ; #,0x02,0x03,0x04); rather than filtering, unfiltered results
$ sensor_filters { energy } = 1 ;
$ doall = 1 ;
}
if ( grep /temp/ , @ textfilters ) {
$ sensor_filters { 0x01 } = 1 ;
}
if ( grep /volt/ , @ textfilters ) {
$ sensor_filters { 0x02 } = 1 ;
}
if ( grep /watt/ , @ textfilters ) {
$ sensor_filters { 0x03 } = 1 ;
}
if ( grep /fan/ , @ textfilters ) {
$ sensor_filters { 0x04 } = 1 ;
}
if ( grep /power/ , @ textfilters ) { #power does not really include energy, but most people use 'power' to mean both
$ sensor_filters { 0x03 } = 1 ;
$ sensor_filters { powerstate } = 1 ;
$ sensor_filters { energy } = 1 ;
}
if ( grep /energy/ , @ textfilters ) {
$ sensor_filters { energy } = 1 ;
}
if ( grep /led/ , @ textfilters ) {
$ sensor_filters { leds } = 1 ;
}
unless ( keys % sensor_filters ) {
2010-02-02 01:32:04 +00:00
sendmsg ( [ 1 , "Unrecognized rvitals arguments " . join ( " " , @ { $ sessdata - > { extraargs } } ) ] , $ sessdata - > { node } ) ; ;
2010-01-30 23:20:11 +00:00
}
2010-02-02 01:32:04 +00:00
$ sessdata - > { sensorstoread } = [] ;
2010-01-30 23:20:11 +00:00
foreach ( keys % sensor_filters ) {
my $ filter = $ _ ;
if ( $ filter eq "energy" or $ filter eq "leds" ) { next ; }
foreach $ key ( sort { $ sdr_hash { $ a } - > id_string cmp $ sdr_hash { $ b } - > id_string } keys % sdr_hash ) {
my $ sdr = $ sdr_hash { $ key } ;
if ( ( $ doall and not $ sdr - > rec_type == 0x11 and not $ sdr - > sensor_type == 0xed ) or ( $ sdr - > rec_type == 0x01 and $ sdr - > sensor_type == $ filter ) ) {
my $ lformat = $ format ;
2010-02-02 01:32:04 +00:00
push @ { $ sessdata - > { sensorstoread } } , $ sdr ;
}
2010-01-30 23:20:11 +00:00
}
}
if ( $ sensor_filters { leds } ) {
2010-02-02 01:32:04 +00:00
push @ { $ sessdata - > { sensorstoread } } , "leds" ;
#my @cleds;
#($rc,@cleds) = checkleds();
#push @output,@cleds;
2010-01-30 23:20:11 +00:00
}
if ( $ sensor_filters { powerstate } ) {
2010-02-02 01:32:04 +00:00
push @ { $ sessdata - > { sensorstoread } } , "powerstat" ;
#($rc,$text) = power("stat");
#$text = sprintf($format,"Power Status:",$text,"");
#push(@output,$text);
2010-01-30 23:20:11 +00:00
}
if ( $ sensor_filters { energy } ) {
2010-02-03 12:52:42 +00:00
if ( $ iem_support ) {
push @ { $ sessdata - > { sensorstoread } } , "energy" ;
} elsif ( not $ doall ) {
sendmsg ( [ 1 , "Energy data requires additional IBM::EnergyManager plugin in conjunction with IMM managed IBM equipment" ] , $ sessdata - > { node } ) ;
}
2010-02-02 01:32:04 +00:00
#my @energies;
#($rc,@energies)=readenergy();
#push @output,@energies;
2010-01-30 23:20:11 +00:00
}
2010-02-02 01:32:04 +00:00
if ( scalar @ { $ sessdata - > { sensorstoread } } ) {
$ sessdata - > { currsdr } = shift @ { $ sessdata - > { sensorstoread } } ;
readsensor ( $ sessdata ) ; #and we are off
}
2010-01-30 23:20:11 +00:00
}
2010-02-02 01:32:04 +00:00
sub sensorformat {
my $ sessdata = shift ;
my $ sdr = $ sessdata - > { currsdr } ;
my $ rc = shift ;
my $ reading = shift ;
my $ extext = shift ;
my $ unitdesc = "" ;
my $ value ;
my $ lformat = "%-30s %-20s" ;
my $ per = " " ;
my $ data ;
if ( $ rc == 0 ) {
$ data = translate_sensor ( $ reading , $ sdr ) ;
} else {
$ data = "N/A" ;
}
#$unitdesc.= sprintf(" %x",$sdr->sensor_type);
use Data::Dumper ;
print Dumper ( $ lformat , $ sdr - > id_string , $ data ) ;
my $ text = sprintf ( $ lformat , $ sdr - > id_string . ":" , $ data ) ;
if ( $ extext ) {
$ text = "$text ($extext)" ;
2010-01-30 23:20:11 +00:00
}
2010-02-02 01:32:04 +00:00
sendmsg ( $ text , $ sessdata - > { node } ) ;
if ( scalar @ { $ sessdata - > { sensorstoread } } ) {
$ sessdata - > { currsdr } = shift @ { $ sessdata - > { sensorstoread } } ;
readsensor ( $ sessdata ) ; #next
}
}
2010-01-30 23:20:11 +00:00
2010-02-02 01:32:04 +00:00
sub readsensor {
my $ sessdata = shift ;
if ( not ref $ sessdata - > { currsdr } ) {
2010-02-02 02:30:12 +00:00
if ( $ sessdata - > { currsdr } eq "leds" ) {
checkleds ( $ sessdata ) ;
2010-02-03 12:52:42 +00:00
return ;
} elsif ( $ sessdata - > { currsdr } eq "powerstat" ) {
$ sessdata - > { powerstatprefix } = "Power Status: " ;
$ sessdata - > { subcommand } = "stat" ;
power ( $ sessdata ) ;
return ;
} elsif ( $ sessdata - > { currsdr } eq "energy" ) {
readenergy ( $ sessdata ) ;
return ;
2010-02-02 02:30:12 +00:00
} else {
2010-02-03 12:52:42 +00:00
sendmsg ( [ 1 , "TODO: make " . $ sessdata - > { currsdr } . " work again" ] , $ sessdata - > { node } ) ;
2010-02-02 02:30:12 +00:00
}
2010-02-02 01:32:04 +00:00
return ;
}
my $ sensor = $ sessdata - > { currsdr } - > sensor_number ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x4 , command = > 0x2d , data = > [ $ sensor ] , callback = > \ & sensor_was_read , callback_args = > $ sessdata ) ;
}
2010-01-30 23:20:11 +00:00
2010-02-02 01:32:04 +00:00
sub sensor_was_read {
my $ rsp = shift ;
my $ sessdata = shift ;
2010-02-02 02:30:12 +00:00
if ( $ rsp - > { error } ) {
sendmsg ( [ 1 , $ rsp - > { error } ] , $ sessdata - > { node } ) ;
}
if ( $ rsp - > { code } ) {
my $ text = $ codes { $ rsp - > { code } } ;
unless ( $ text ) { $ text = sprintf ( "Unknown error %02xh" , $ rsp - > { code } ) } ;
return sensorformat ( $ sessdata , 1 , $ text ) ;
}
2010-02-02 01:32:04 +00:00
my @ returnd = ( 0 , @ { $ rsp - > { data } } ) ;
2010-01-30 23:20:11 +00:00
if ( $ returnd [ 2 ] & 0x20 ) {
2010-02-02 01:32:04 +00:00
return sensorformat ( $ sessdata , 1 , "N/A" ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-02 01:32:04 +00:00
my $ text = $ returnd [ 1 ] ;
2010-01-30 23:20:11 +00:00
my $ exdata1 = $ returnd [ 3 ] ;
my $ exdata2 = $ returnd [ 3 ] ;
my $ extext ;
my @ exparts ;
2010-02-02 01:32:04 +00:00
my $ sdr = $ sessdata - > { currsdr } ;
2010-01-30 23:20:11 +00:00
if ( $ sdr - > event_type_code == 0x1 ) {
if ( $ exdata1 & 1 << 5 ) {
$ extext = "At or above upper non-recoverable threshold" ;
} elsif ( $ exdata1 & 1 << 4 ) {
$ extext = "At or above upper critical threshold" ;
} elsif ( $ exdata1 & 1 << 3 ) {
$ extext = "At or above upper non-critical threshold" ;
}
if ( $ exdata1 & 1 << 2 ) {
$ extext = "At or below lower non-critical threshold" ;
} elsif ( $ exdata1 & 1 << 1 ) {
$ extext = "At or below lower critical threshold" ;
} elsif ( $ exdata1 & 1 ) {
$ extext = "At or below lower non-recoverable threshold" ;
}
} elsif ( $ sdr - > event_type_code == 0x6f ) {
if ( $ sdr - > sensor_type == 0x10 ) {
@ exparts = ( ) ;
if ( $ exdata1 & 1 << 4 ) {
push @ exparts , "SEL full" ;
} elsif ( $ exdata1 & 1 << 5 ) {
push @ exparts , "SEL almost full" ;
}
if ( $ exdata1 & 1 ) {
push @ exparts , "Correctable Memory Error Logging Disabled" ;
}
if ( $ exdata1 & 1 << 3 ) {
push @ exparts , "All logging disabled" ;
} elsif ( $ exdata1 & 1 << 1 ) {
push @ exparts , "Some logging disabled" ;
}
if ( @ exparts ) {
$ extext = join ( "," , @ exparts ) ;
}
} elsif ( $ sdr - > sensor_type == 0x7 ) {
@ exparts = ( ) ;
if ( $ exdata1 & 1 ) {
push @ exparts , "IERR" ;
}
if ( $ exdata1 & 1 << 1 ) {
push @ exparts , "Thermal trip" ;
}
if ( $ exdata1 & 1 << 2 ) {
push @ exparts , "FRB1/BIST failure" ;
}
if ( $ exdata1 & 1 << 3 ) {
push @ exparts , "FRB2/Hang in POST due to processor" ;
}
if ( $ exdata1 & 1 << 4 ) {
push @ exparts , "FRB3/Processor Initialization failure" ;
}
if ( $ exdata1 & 1 << 5 ) {
push @ exparts , "Configuration error" ;
}
if ( $ exdata1 & 1 << 6 ) {
push @ exparts , "Uncorrectable CPU-complex error" ;
}
if ( $ exdata1 & 1 << 7 ) {
push @ exparts , "Present" ;
}
if ( $ exdata1 & 1 << 8 ) {
push @ exparts , "Processor disabled" ;
}
if ( $ exdata1 & 1 << 9 ) {
push @ exparts , "Terminator present" ;
}
if ( $ exdata1 & 1 << 10 ) {
push @ exparts , "Hardware throttled" ;
}
} elsif ( $ sdr - > sensor_type == 0x8 ) {
@ exparts = ( ) ;
if ( $ exdata1 & 1 ) {
push @ exparts , "Present" ;
}
if ( $ exdata1 & 1 << 1 ) {
push @ exparts , "Failed" ;
}
if ( $ exdata1 & 1 << 2 ) {
push @ exparts , "Failure predicted" ;
}
if ( $ exdata1 & 1 << 3 ) {
push @ exparts , "AC Lost" ;
}
if ( $ exdata1 & 1 << 4 ) {
push @ exparts , "AC input lost or out of range" ;
}
if ( $ exdata1 & 1 << 5 ) {
push @ exparts , "AC input out of range" ;
}
if ( $ exdata1 & 1 << 6 ) {
push @ exparts , "Configuration error" ;
}
if ( @ exparts ) {
$ extext = join ( "," , @ exparts ) ;
}
} elsif ( $ sdr - > sensor_type == 0x13 ) {
@ exparts = ( ) ;
if ( $ exdata1 & 1 ) {
push @ exparts , "Front panel NMI/Diagnostic" ;
}
if ( $ exdata1 & 1 << 1 ) {
push @ exparts , "Bus timeout" ;
}
if ( $ exdata1 & 1 << 2 ) {
push @ exparts , "I/O channel check NMI" ;
}
if ( $ exdata1 & 1 << 3 ) {
push @ exparts , "Software NMI" ;
}
if ( $ exdata1 & 1 << 4 ) {
push @ exparts , "PCI PERR" ;
}
if ( $ exdata1 & 1 << 5 ) {
push @ exparts , "PCI SERR" ;
}
if ( $ exdata1 & 1 << 6 ) {
push @ exparts , "EISA failsafe timeout" ;
}
if ( $ exdata1 & 1 << 7 ) {
push @ exparts , "Bus correctable .rror" ;
}
if ( $ exdata1 & 1 << 8 ) {
push @ exparts , "Bus uncorrectable error" ;
}
if ( $ exdata1 & 1 << 9 ) {
push @ exparts , "Fatal NMI" ;
}
if ( $ exdata1 & 1 << 10 ) {
push @ exparts , "Bus fatal error" ;
}
if ( @ exparts ) {
$ extext = join ( "," , @ exparts ) ;
}
} elsif ( $ sdr - > sensor_type == 0xc ) {
@ exparts = ( ) ;
if ( $ exdata1 & 1 ) {
push @ exparts , "Correctable error(s)" ;
}
if ( $ exdata1 & 1 << 1 ) {
push @ exparts , "Uncorrectable error(s)" ;
}
if ( $ exdata1 & 1 << 2 ) {
push @ exparts , "Parity" ;
}
if ( $ exdata1 & 1 << 3 ) {
push @ exparts , "Memory scrub failure" ;
}
if ( $ exdata1 & 1 << 4 ) {
push @ exparts , "DIMM disabled" ;
}
if ( $ exdata1 & 1 << 5 ) {
push @ exparts , "Correctable error limit reached" ;
}
if ( $ exdata1 & 1 << 6 ) {
push @ exparts , "Present" ;
}
if ( $ exdata1 & 1 << 7 ) {
push @ exparts , "Configuration error" ;
}
if ( $ exdata1 & 1 << 8 ) {
push @ exparts , "Spare" ;
}
if ( @ exparts ) {
$ extext = join ( "," , @ exparts ) ;
}
} elsif ( $ sdr - > sensor_type == 0x21 ) {
@ exparts = ( ) ;
if ( $ exdata1 & 1 ) {
push @ exparts , "Fault" ;
}
if ( $ exdata1 & 1 << 1 ) {
push @ exparts , "Identify" ;
}
if ( $ exdata1 & 1 << 2 ) {
push @ exparts , "Installed/attached" ;
}
if ( $ exdata1 & 1 << 3 ) {
push @ exparts , "Ready for install" ;
}
if ( $ exdata1 & 1 << 4 ) {
push @ exparts , "Ready for removal" ;
}
if ( $ exdata1 & 1 << 5 ) {
push @ exparts , "Powered off" ;
}
if ( $ exdata1 & 1 << 6 ) {
push @ exparts , "Removal requested" ;
}
if ( $ exdata1 & 1 << 7 ) {
push @ exparts , "Interlocked" ;
}
if ( $ exdata1 & 1 << 8 ) {
push @ exparts , "Disabled" ;
}
if ( $ exdata1 & 1 << 9 ) {
push @ exparts , "Spare" ;
}
} elsif ( $ sdr - > sensor_type == 0xf ) {
@ exparts = ( ) ;
if ( $ exdata1 & 1 ) {
push @ exparts , "POST error" ;
}
if ( $ exdata1 & 1 << 1 ) {
push @ exparts , "Firmware hang" ;
}
if ( $ exdata1 & 1 << 2 ) {
push @ exparts , "Firmware progress" ;
}
if ( @ exparts ) {
$ extext = join ( "," , @ exparts ) ;
}
} elsif ( $ sdr - > sensor_type == 0x9 ) {
@ exparts = ( ) ;
if ( $ exdata1 & 1 ) {
push @ exparts , "Power off" ;
}
if ( $ exdata1 & 1 << 1 ) {
push @ exparts , "Power off" ;
}
if ( $ exdata1 & 1 << 2 ) {
push @ exparts , "240VA Power Down" ;
}
if ( $ exdata1 & 1 << 3 ) {
push @ exparts , "Interlock Power Down" ;
}
if ( $ exdata1 & 1 << 4 ) {
push @ exparts , "AC lost" ;
}
if ( $ exdata1 & 1 << 5 ) {
push @ exparts , "Soft power control failure" ;
}
if ( $ exdata1 & 1 << 6 ) {
push @ exparts , "Power unit failure" ;
}
if ( $ exdata1 & 1 << 7 ) {
push @ exparts , "Power unit failure predicted" ;
}
if ( @ exparts ) {
$ extext = join ( "," , @ exparts ) ;
}
} else {
$ extext = "xCAT needs to add support for " . $ sdr - > sensor_type ;
}
}
2010-02-02 01:32:04 +00:00
return sensorformat ( $ sessdata , 0 , $ text , $ extext ) ;
2010-01-30 23:20:11 +00:00
}
sub initsdr {
my $ sessdata = shift ;
my $ netfun ;
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my $ code ;
my $ resv_id_ls ;
my $ resv_id_ms ;
my $ sdr_type ;
my $ sdr_offset ;
my $ sdr_len ;
my @ sdr_data = ( ) ;
my $ offset ;
my $ len ;
my $ i ;
# my $numbytes = 27;
my $ ipmisensortab = "$ENV{XCATROOT}/lib/GUMI/ipmisensor.tab" ;
my $ byte_format ;
my $ cache_file ;
#device id data TODO
2010-01-30 23:48:18 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x0a , command = > 0x20 , data = > [] , callback = > \ & got_sdr_rep_info , callback_args = > $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
sub initsdr_withrepinfo {
my $ sessdata = shift ;
my $ mfg_id = $ sessdata - > { mfg_id } ;
my $ prod_id = $ sessdata - > { prod_id } ;
my $ device_id = $ sessdata - > { device_id } ;
2010-01-31 18:38:46 +00:00
my $ dev_rev = $ sessdata - > { device_rev } ;
my $ fw_rev1 = $ sessdata - > { firmware_rev1 } ;
my $ fw_rev2 = $ sessdata - > { firmware_rev2 } ;
2010-01-30 23:20:11 +00:00
#TODO: beware of dynamic SDR contents
2010-01-30 23:48:18 +00:00
my $ cache_file = "$cache_dir/sdr_$mfg_id.$prod_id.$device_id.$dev_rev.$fw_rev1.$fw_rev2.$cache_version" ;
$ sessdata - > { sdrcache_file } = $ cache_file ;
2010-01-30 23:20:11 +00:00
if ( $ enable_cache eq "yes" ) {
if ( $ sdr_caches { "$mfg_id.$prod_id.$device_id.$dev_rev.$fw_rev1.$fw_rev2.$cache_version" } ) {
2010-01-31 18:38:46 +00:00
$ sessdata - > { sdr_hash } = $ sdr_caches { "$mfg_id.$prod_id.$device_id.$dev_rev.$fw_rev1.$fw_rev2.$cache_version" } ;
2010-02-02 01:32:04 +00:00
on_bmc_connect ( "SUCCESS" , $ sessdata ) ; #retry bmc_connect since sdr_cache is validated
return ; #don't proceed to slow load
2010-01-30 23:20:11 +00:00
} else {
2010-01-30 23:48:18 +00:00
my $ rc = loadsdrcache ( $ sessdata , $ cache_file ) ;
2010-01-30 23:20:11 +00:00
if ( $ rc == 0 ) {
2010-01-31 18:38:46 +00:00
$ sdr_caches { "$mfg_id.$prod_id.$device_id.$dev_rev.$fw_rev1.$fw_rev2.$cache_version" } = $ sessdata - > { sdr_hash } ;
2010-01-30 23:20:11 +00:00
on_bmc_connect ( "SUCCESS" , $ sessdata ) ; #retry bmc_connect since sdr_cache is validated
2010-02-01 14:00:49 +00:00
return ; #don't proceed to slow load
2010-01-30 23:20:11 +00:00
}
}
}
if ( $ sessdata - > { sdr_info } - > { version } != 0x51 ) {
2010-01-31 18:38:46 +00:00
sendoutput ( 1 , "SDR version unsupported." ) ;
2010-01-30 23:20:11 +00:00
return ( 1 ) ; #bail, do not try to continue
}
if ( $ sessdata - > { sdr_info } - > { resv_sdr } != 1 ) {
2010-01-31 18:38:46 +00:00
sendoutput ( 1 , "SDR reservation unsupported." ) ;
2010-01-30 23:20:11 +00:00
return 1 ;
}
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x0a , command = > 0x22 , data = > [] , callback = > \ & reserved_sdr_repo , callback_args = > $ sessdata ) ;
}
sub initsdr_withreservation {
my $ sessdata = shift ;
my $ rid_ls = 0 ;
my $ rid_ms = 0 ;
if ( $ sessdata - > { sdr_nrid_ls } ) { $ rid_ls = $ sessdata - > { sdr_nrid_ls } ; }
if ( $ sessdata - > { sdr_nrid_ms } ) { $ rid_ms = $ sessdata - > { sdr_nrid_ms } ; }
####if($debug) {
#### print "mfg,prod,dev: $mfg_id, $prod_id, $device_id\n";
#### printf("SDR info: %02x %d %d\n",$sdr_rep_info->version,$sdr_rep_info->rec_count,$sdr_rep_info->resv_sdr);
#### print "resv_id: $resv_id_ls $resv_id_ms\n";
####}
my $ resv_id_ls = $ sessdata - > { resv_id_ls } ;
my $ resv_id_ms = $ sessdata - > { resv_id_ms } ;
if ( $ rid_ls == 0xff and $ rid_ms == 0xff ) {
if ( $ enable_cache eq "yes" ) { #cache SDR repository for future use
2010-01-31 18:38:46 +00:00
storsdrcache ( $ sessdata - > { sdrcache_file } , $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
on_bmc_connect ( "SUCCESS" , $ sessdata ) ; #go back armed with a capable reserviction
return ; #Have reached the end
}
$ sessdata - > { sdr_fetch_args } = [ $ resv_id_ls , $ resv_id_ms , $ rid_ls , $ rid_ms , 0 , 5 ] ;
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0xa , command = > 0x23 , data = > $ sessdata - > { sdr_fetch_args } , callback = > \ & start_sdr_record , callback_args = > $ sessdata ) ;
return ;
}
sub start_sdr_record {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) {
2010-01-31 18:38:46 +00:00
sendoutput ( 1 , $ rsp - > { error } ) ;
2010-01-30 23:20:11 +00:00
return ;
}
my $ resv_id_ls = shift @ { $ sessdata - > { sdr_fetch_args } } ;
my $ resv_id_ms = shift @ { $ sessdata - > { sdr_fetch_args } } ;
my $ rid_ls = shift @ { $ sessdata - > { sdr_fetch_args } } ;
my $ rid_ms = shift @ { $ sessdata - > { sdr_fetch_args } } ;
my @ returnd = ( $ rsp - > { code } , @ { $ rsp - > { data } } ) ;
my $ code = $ returnd [ 0 ] ;
if ( $ code != 0x00 ) {
2010-01-30 23:48:18 +00:00
my $ text = $ codes { $ code } ;
2010-01-30 23:20:11 +00:00
if ( ! $ text ) {
$ text = sprintf ( "unknown response %02x" , $ code ) ;
}
2010-01-31 18:38:46 +00:00
sendoutput ( 1 , $ text ) ;
2010-01-30 23:20:11 +00:00
return ;
}
$ sessdata - > { sdr_nrid_ls } = $ returnd [ 1 ] ;
$ sessdata - > { sdr_nrid_ms } = $ returnd [ 2 ] ;
my $ sdr_ver = $ returnd [ 5 ] ;
my $ sdr_type = $ returnd [ 6 ] ;
2010-01-31 18:38:46 +00:00
$ sessdata - > { curr_sdr_type } = $ sdr_type ;
2010-01-30 23:20:11 +00:00
$ sessdata - > { curr_sdr_len } = $ returnd [ 7 ] + 5 ;
if ( $ sdr_type == 0x01 ) {
2010-02-02 01:32:04 +00:00
$ sessdata - > { total_sdr_offset } = 0 ;
2010-01-30 23:20:11 +00:00
}
elsif ( $ sdr_type == 0x02 ) {
2010-02-02 01:32:04 +00:00
$ sessdata - > { total_sdr_offset } = 16 ; #TODO: understand this..
2010-01-30 23:20:11 +00:00
}
elsif ( $ sdr_type == 0xC0 ) {
#LED descriptor, maybe
}
elsif ( $ sdr_type == 0x11 ) { #FRU locator
}
elsif ( $ sdr_type == 0x12 ) {
initsdr_withreservation ( $ sessdata ) ; #next, skip this unsupported record type
return ;
}
else {
initsdr_withreservation ( $ sessdata ) ; #next
return ;
}
$ sessdata - > { sdr_data } = [ 0 , 0 , 0 , $ sdr_ver , $ sdr_type , $ sessdata - > { curr_sdr_len } ] ;
$ sessdata - > { sdr_offset } = 5 ;
my $ offset = 5 ; #why duplicate? to make for shorter typing
my $ numbytes = 22 ;
if ( 5 <$sessdata-> { curr_sdr_len } ) { #can't imagine this not bing the case,but keep logic in case
if ( $ offset + $ numbytes > $ sessdata - > { curr_sdr_len } ) { #scale back request for remainder
$ numbytes = $ sessdata - > { curr_sdr_len } - $ offset ;
}
$ sessdata - > { sdr_fetch_args } = [ $ resv_id_ls , $ resv_id_ms , $ rid_ls , $ rid_ms , $ offset , $ numbytes ] ;
2010-01-31 18:38:46 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x0a , command = > 0x23 , data = > $ sessdata - > { sdr_fetch_args } , callback = > \ & add_sdr_data , callback_args = > $ sessdata ) ;
2010-01-30 23:20:11 +00:00
return ;
} else {
initsdr_withreservation ( $ sessdata ) ; #next
return ;
}
}
sub add_sdr_data {
my $ rsp = shift ;
my $ sessdata = shift ;
my $ numbytes = $ sessdata - > { sdr_fetch_args } - > [ 5 ] ;
my $ offset = $ sessdata - > { sdr_offset } ; #shorten typing a little
if ( $ rsp - > { error } ) {
sendoutput ( [ 1 , $ rsp - > { error } ] ) ;
return ; #give up
}
my @ returnd = ( $ rsp - > { code } , @ { $ rsp - > { data } } ) ;
2010-01-30 23:48:18 +00:00
my $ code = $ returnd [ 0 ] ;
2010-01-30 23:20:11 +00:00
if ( $ code != 0x00 ) {
2010-01-30 23:48:18 +00:00
my $ text = $ codes { $ code } ;
2010-01-30 23:20:11 +00:00
if ( ! $ text ) {
$ text = sprintf ( "unknown response %02x" , $ code ) ;
}
sendoutput ( [ 1 , $ text ] ) ;
return ; #abort the whole mess
}
2010-02-01 13:48:10 +00:00
push @ { $ sessdata - > { sdr_data } } , @ returnd [ 3 .. @ returnd - 1 ] ;
2010-01-30 23:20:11 +00:00
$ sessdata - > { sdr_offset } += $ numbytes ;
if ( $ sessdata - > { sdr_offset } + $ numbytes > $ sessdata - > { curr_sdr_len } ) { #scale back request for remainder
$ numbytes = $ sessdata - > { curr_sdr_len } - $ sessdata - > { sdr_offset } ;
}
$ sessdata - > { sdr_fetch_args } - > [ 4 ] = $ sessdata - > { sdr_offset } ;
$ sessdata - > { sdr_fetch_args } - > [ 5 ] = $ numbytes ;
if ( $ sessdata - > { sdr_offset } <$sessdata-> { curr_sdr_len } ) {
2010-01-31 18:38:46 +00:00
$ sessdata - > { ipmisession } - > subcmd ( netfn = > 0x0a , command = > 0x23 , data = > $ sessdata - > { sdr_fetch_args } , callback = > \ & add_sdr_data , callback_args = > $ sessdata ) ;
2010-01-30 23:20:11 +00:00
return ;
} else { #in this case, time to parse the accumulated data
parse_sdr ( $ sessdata ) ;
}
}
sub parse_sdr { #parse sdr data, then cann initsdr_withreserveation to advance to next record
my $ sessdata = shift ;
my @ sdr_data = @ { $ sessdata - > { sdr_data } } ;
#not bothering trying to keep a packet pending concurrent with operation, harder to code that
my $ mfg_id = $ sessdata - > { mfg_id } ;
my $ prod_id = $ sessdata - > { prod_id } ;
my $ device_id = $ sessdata - > { device_id } ;
2010-01-31 18:38:46 +00:00
my $ dev_rev = $ sessdata - > { device_rev } ;
my $ fw_rev1 = $ sessdata - > { firmware_rev1 } ;
my $ fw_rev2 = $ sessdata - > { firmware_rev2 } ;
2010-01-30 23:20:11 +00:00
my $ sdr_type = $ sessdata - > { curr_sdr_type } ;
if ( $ sdr_type == 0x11 ) { #FRU locator
my $ sdr = decode_fru_locator ( @ sdr_data ) ;
if ( $ sdr ) {
$ sessdata - > { sdr_hash } - > { $ sdr - > sensor_owner_id . "." . $ sdr - > sensor_owner_lun . "." . $ sdr - > sensor_number } = $ sdr ;
}
initsdr_withreservation ( $ sessdata ) ; #advance to next record
return ;
}
####if($debug) {
#### hexadump(\@sdr_data);
####}
if ( $ sdr_type == 0x12 ) { #if required, TODO support type 0x12
hexadump ( \ @ sdr_data ) ;
initsdr_withreservation ( $ sessdata ) ; #next record
return ;
}
my $ sdr = SDR - > new ( ) ;
if ( $ mfg_id == 2 && $ sdr_type == 0xC0 && $ sdr_data [ 9 ] == 0xED ) {
#printf("%02x%02x\n",$sdr_data[13],$sdr_data[12]);
$ sdr - > rec_type ( $ sdr_type ) ;
$ sdr - > sensor_type ( $ sdr_data [ 9 ] ) ;
#Using an impossible sensor number to not conflict with decodealert
$ sdr - > sensor_owner_id ( 260 ) ;
$ sdr - > sensor_owner_lun ( 260 ) ;
$ sdr - > id_string ( "LED" ) ;
if ( $ sdr_data [ 12 ] > $ sdr_data [ 13 ] ) {
$ sdr - > led_id ( ( $ sdr_data [ 13 ] << 8 ) + $ sdr_data [ 12 ] ) ;
} else {
$ sdr - > led_id ( ( $ sdr_data [ 12 ] << 8 ) + $ sdr_data [ 13 ] ) ;
}
#$sdr->led_id_ms($sdr_data[13]);
#$sdr->led_id_ls($sdr_data[12]);
$ sdr - > sensor_number ( sprintf ( "%04x" , $ sdr - > led_id ) ) ;
#printf("%02x,%02x,%04x\n",$mfg_id,$prod_id,$sdr->led_id);
#Was going to have a human readable name, but specs
#seem to not to match reality...
#$override_string = getsensorname($mfg_id,$prod_id,$sdr->sensor_number,$ipmiledtab);
#I'm hacking in owner and lun of 260 for LEDs....
2010-01-30 23:48:18 +00:00
$ sessdata - > { sdr_hash } - > { "260.260." . $ sdr - > led_id } = $ sdr ;
2010-01-30 23:20:11 +00:00
initsdr_withreservation ( $ sessdata ) ; #next record
return ;
}
$ sdr - > rec_type ( $ sdr_type ) ;
$ sdr - > sensor_owner_id ( $ sdr_data [ 6 ] ) ;
$ sdr - > sensor_owner_lun ( $ sdr_data [ 7 ] ) ;
$ sdr - > sensor_number ( $ sdr_data [ 8 ] ) ;
$ sdr - > entity_id ( $ sdr_data [ 9 ] ) ;
$ sdr - > entity_instance ( $ sdr_data [ 10 ] ) ;
$ sdr - > sensor_type ( $ sdr_data [ 13 ] ) ;
$ sdr - > event_type_code ( $ sdr_data [ 14 ] ) ;
$ sdr - > sensor_units_2 ( $ sdr_data [ 22 ] ) ;
$ sdr - > sensor_units_3 ( $ sdr_data [ 23 ] ) ;
if ( $ sdr_type == 0x01 ) {
$ sdr - > sensor_units_1 ( $ sdr_data [ 21 ] ) ;
$ sdr - > linearization ( $ sdr_data [ 24 ] & 0b01111111 ) ;
$ sdr - > M ( comp2int ( 10 , ( ( $ sdr_data [ 26 ] & 0b11000000 ) << 2 ) + $ sdr_data [ 25 ] ) ) ;
$ sdr - > B ( comp2int ( 10 , ( ( $ sdr_data [ 28 ] & 0b11000000 ) << 2 ) + $ sdr_data [ 27 ] ) ) ;
$ sdr - > R_exp ( comp2int ( 4 , ( $ sdr_data [ 30 ] & 0b11110000 ) >> 4 ) ) ;
$ sdr - > B_exp ( comp2int ( 4 , $ sdr_data [ 30 ] & 0b00001111 ) ) ;
} elsif ( $ sdr_type == 0x02 ) {
$ sdr - > sensor_units_1 ( $ sdr_data [ 21 ] ) ;
}
2010-02-02 01:32:04 +00:00
$ sdr - > id_string_type ( $ sdr_data [ 48 - $ sessdata - > { total_sdr_offset } ] ) ;
2010-01-30 23:20:11 +00:00
2010-01-30 23:48:18 +00:00
my $ override_string = getsensorname ( $ mfg_id , $ prod_id , $ sdr - > sensor_number ) ;
2010-01-30 23:20:11 +00:00
if ( $ override_string ne "" ) {
$ sdr - > id_string ( $ override_string ) ;
}
else {
unless ( defined $ sdr - > id_string_type ) { initsdr_withreservation ( $ sessdata ) ; return ; }
2010-01-30 23:48:18 +00:00
my $ byte_format = ( $ sdr - > id_string_type & 0b11000000 ) >> 6 ;
2010-01-30 23:20:11 +00:00
if ( $ byte_format == 0b11 ) {
my $ len = ( $ sdr - > id_string_type & 0b00011111 ) - 1 ;
if ( $ len > 1 ) {
2010-02-02 01:32:04 +00:00
$ sdr - > id_string ( pack ( "C*" , @ sdr_data [ 49 - $ sessdata - > { total_sdr_offset } .. 49 - $ sessdata - > { total_sdr_offset } + $ len ] ) ) ;
2010-01-30 23:20:11 +00:00
}
else {
$ sdr - > id_string ( "no description" ) ;
}
}
elsif ( $ byte_format == 0b10 ) {
$ sdr - > id_string ( "ASCII packed unsupported" ) ;
}
elsif ( $ byte_format == 0b01 ) {
$ sdr - > id_string ( "BCD unsupported" ) ;
}
elsif ( $ byte_format == 0b00 ) {
my $ len = ( $ sdr - > id_string_type & 0b00011111 ) - 1 ;
if ( $ len > 1 ) { #It should be something, but need sample to code
$ sdr - > id_string ( "unicode unsupported" ) ;
} else {
initsdr_withreservation ( $ sessdata ) ; return ;
}
}
}
2010-01-30 23:48:18 +00:00
$ sessdata - > { sdr_hash } - > { $ sdr - > sensor_owner_id . "." . $ sdr - > sensor_owner_lun . "." . $ sdr - > sensor_number } = $ sdr ;
2010-01-30 23:20:11 +00:00
initsdr_withreservation ( $ sessdata ) ; return ;
}
sub getsensorname
{
my $ mfgid = shift ;
my $ prodid = shift ;
my $ sensor = shift ;
my $ file = shift ;
my $ mfg ;
my $ prod ;
my $ type ;
my $ desc ;
my $ name = "" ;
2010-01-31 18:38:46 +00:00
if ( $ file and $ file eq "ibmleds" ) {
2010-01-30 23:20:11 +00:00
if ( $ xCAT:: data:: ibmleds:: leds { "$mfgid,$prodid" } - > { $ sensor } ) {
return $ xCAT:: data:: ibmleds:: leds { "$mfgid,$prodid" } - > { $ sensor } . " LED" ;
} elsif ( $ ndebug ) {
return "Unknown $sensor/$mfgid/$prodid" ;
} else {
return sprintf ( "LED 0x%x" , $ sensor ) ;
}
} else {
return "" ;
}
}
sub getchassiscap {
my $ netfun = 0x00 ;
my @ cmd ;
my @ returnd = ( ) ;
my $ error ;
my $ rc = 0 ;
my $ text ;
my $ code ;
@ cmd = ( 0x00 ) ;
$ error = docmd (
$ netfun ,
\ @ cmd ,
\ @ returnd
) ;
if ( $ error ) {
$ rc = 1 ;
$ text = $ error ;
return ( $ rc , $ text ) ;
}
$ code = $ returnd [ 0 ] ;
if ( $ code == 0x00 ) {
$ text = "" ;
}
else {
$ rc = 1 ;
$ text = $ codes { $ code } ;
if ( ! $ text ) {
$ rc = 1 ;
$ text = sprintf ( "unknown response %02x" , $ code ) ;
}
return ( $ rc , $ text ) ;
}
return ( $ rc , @ returnd [ 1 .. @ returnd - 2 ] ) ;
}
sub gotdevid {
#($rc,$text,$mfg_id,$prod_id,$device_id,$dev_rev,$fw_rev1,$fw_rev2) = getdevid();
my $ rsp = shift ;
my $ sessdata = shift ;
my $ text ;
2010-01-30 23:48:18 +00:00
if ( $ rsp - > { error } ) {
2010-01-30 23:20:11 +00:00
sendoutput ( [ 1 , $ rsp - > { error } ] ) ;
return ;
}
else {
2010-01-30 23:48:18 +00:00
my $ code = $ rsp - > { code } ;
2010-01-30 23:20:11 +00:00
2010-01-30 23:48:18 +00:00
if ( $ code != 0x00 ) {
my $ text = $ codes { $ code } ;
2010-01-30 23:20:11 +00:00
if ( ! $ text ) {
$ text = sprintf ( "unknown response %02x" , $ code ) ;
}
sendoutput ( [ 1 , $ text ] ) ;
return ;
}
}
2010-01-30 23:48:18 +00:00
my @ returnd = ( $ rsp - > { code } , @ { $ rsp - > { data } } ) ;
2010-01-30 23:20:11 +00:00
$ sessdata - > { device_id } = $ returnd [ 1 ] ;
$ sessdata - > { device_rev } = $ returnd [ 2 ] & 0b00001111 ;
$ sessdata - > { firmware_rev1 } = $ returnd [ 3 ] & 0b01111111 ;
$ sessdata - > { firmware_rev2 } = $ returnd [ 4 ] ;
$ sessdata - > { ipmi_ver } = $ returnd [ 5 ] ;
$ sessdata - > { dev_support } = $ returnd [ 6 ] ;
####my $sensor_device = 0;
####my $SDR = 0;
####my $SEL = 0;
####my $FRU = 0;
####my $IPMB_ER = 0;
####my $IPMB_EG = 0;
####my $BD = 0;
####my $CD = 0;
####if($dev_support & 0b00000001) {
#### $sensor_device = 1;
####}
####if($dev_support & 0b00000010) {
#### $SDR = 1;
####}
####if($dev_support & 0b00000100) {
#### $SEL = 1;
####}
####if($dev_support & 0b00001000) {
#### $FRU = 1;
####}
####if($dev_support & 0b00010000) {
#### $IPMB_ER = 1;
####}
####if($dev_support & 0b00100000) {
#### $IPMB_EG = 1;
####}
####if($dev_support & 0b01000000) {
#### $BD = 1;
####}
####if($dev_support & 0b10000000) {
#### $CD = 1;
####}
$ sessdata - > { mfg_id } = $ returnd [ 7 ] + $ returnd [ 8 ] * 0x100 + $ returnd [ 9 ] * 0x10000 ;
$ sessdata - > { prod_id } = $ returnd [ 10 ] + $ returnd [ 11 ] * 0x100 ;
on_bmc_connect ( "SUCCESS" , $ sessdata ) ;
# my @data = @returnd[12..@returnd-2];
# return($rc,$text,$mfg_id,$prod_id,$device_id,$device_rev,$firmware_rev1,$firmware_rev2);
}
2010-02-04 17:05:21 +00:00
sub gotguid {
if ( check_rsp_errors ( @ _ ) ) {
return ;
}
my $ rsp = shift ;
my $ sessdata = shift ;
#my @guidcmd = (0x18,0x37);
#if($mfg_id == 2 && $prod_id == 34869) { TODO: if GUID is inaccurate on the products mentioned, this code may be uncommented
# @guidcmd = (0x18,0x08);
#}
#if($mfg_id == 2 && $prod_id == 4) {
# @guidcmd = (0x18,0x08);
#}
#if($mfg_id == 2 && $prod_id == 3) {
# @guidcmd = (0x18,0x08);
#}
my $ fru = FRU - > new ( ) ;
$ fru - > rec_type ( "guid" ) ;
2010-05-16 23:22:52 +00:00
$ fru - > desc ( "UUID/GUID" ) ;
2010-02-04 17:05:21 +00:00
$ fru - > value ( sprintf ( "%02X%02X%02X%02X-%02X%02X-%02X%02X-%02X%02X-%02X%02X%02X%02X%02X%02X" , @ { $ rsp - > { data } } ) ) ;
$ sessdata - > { fru_hash } - > { guid } = $ fru ;
initfru_withguid ( $ sessdata ) ;
2010-01-30 23:20:11 +00:00
}
sub got_sdr_rep_info {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) {
sendoutput ( [ 1 , $ rsp - > { error } ] ) ;
return ;
}
else {
2010-01-30 23:48:18 +00:00
my $ code = $ rsp - > { code } ;
2010-01-30 23:20:11 +00:00
2010-01-30 23:48:18 +00:00
if ( $ code != 0x00 ) {
my $ text = $ codes { $ code } ;
2010-01-30 23:20:11 +00:00
if ( ! $ text ) {
$ text = sprintf ( "unknown response %02x" , $ code ) ;
}
2010-01-31 18:38:46 +00:00
sendoutput ( 1 , $ text ) ;
2010-01-30 23:20:11 +00:00
return ;
}
}
my @ returnd = @ { $ rsp - > { data } } ;
$ sessdata - > { sdr_info } - > { version } = $ returnd [ 0 ] ;
$ sessdata - > { sdr_info } - > { rec_count } = $ returnd [ 1 ] + $ returnd [ 2 ] << 8 ;
2010-01-31 18:38:46 +00:00
$ sessdata - > { sdr_info } - > { resv_sdr } = ( $ returnd [ 13 ] & 0b00000010 ) >> 1 ;
2010-01-30 23:20:11 +00:00
initsdr_withrepinfo ( $ sessdata ) ;
}
sub reserved_sdr_repo {
my $ rsp = shift ;
my $ sessdata = shift ;
if ( $ rsp - > { error } ) {
sendoutput ( [ 1 , $ rsp - > { error } ] ) ; ;
return ;
}
else {
my $ code = $ rsp - > { code } ;
if ( $ code != 0x00 ) {
my $ text = $ codes { $ code } ;
if ( ! $ text ) {
$ text = sprintf ( "unknown response %02x" , $ code ) ;
}
sendoutput ( [ 1 , $ text ] ) ;
}
}
my @ returnd = @ { $ rsp - > { data } } ;
$ sessdata - > { resv_id_ls } = $ returnd [ 0 ] ;
$ sessdata - > { resv_id_ms } = $ returnd [ 1 ] ;
initsdr_withreservation ( $ sessdata ) ;
}
sub dochksum ()
{
my $ data = shift ;
my $ sum = 0 ;
foreach ( @$ data ) {
$ sum += $ _ ;
}
$ sum = ~ $ sum + 1 ;
return ( $ sum & 0xFF ) ;
}
sub hexdump {
my $ data = shift ;
foreach ( @$ data ) {
printf ( "%02x " , $ _ ) ;
}
print "\n" ;
}
sub getascii {
my @ alpha ;
my $ text = "" ;
my $ c = 0 ;
foreach ( @ _ ) {
if ( defined $ _ and $ _ < 128 and $ _ > 0x20 ) {
$ alpha [ $ c ] = sprintf ( "%c" , $ _ ) ;
} else {
$ alpha [ $ c ] = " " ;
}
if ( $ alpha [ $ c ] !~ /[\/\w\-:\[\.\]]/ ) {
if ( $ alpha [ ( $ c - 1 ) ] !~ /\s/ ) {
$ alpha [ $ c ] = " " ;
} else {
$ c - - ;
}
}
$ c + + ;
}
foreach ( @ alpha ) {
$ text = $ text . $ _ ;
}
$ text =~ s/^\s+|\s+$// ;
return $ text ;
}
sub phex {
my $ data = shift ;
my @ alpha ;
my $ text = "" ;
my $ c = 0 ;
foreach ( @$ data ) {
$ text = $ text . sprintf ( "%02x " , $ _ ) ;
$ alpha [ $ c ] = sprintf ( "%c" , $ _ ) ;
if ( $ alpha [ $ c ] !~ /\w/ ) {
$ alpha [ $ c ] = " " ;
}
$ c + + ;
}
$ text = $ text . "(" ;
foreach ( @ alpha ) {
$ text = $ text . $ _ ;
}
$ text = $ text . ")" ;
return $ text ;
}
sub hexadump {
my $ data = shift ;
my @ alpha ;
my $ c = 0 ;
foreach ( @$ data ) {
printf ( "%02x " , $ _ ) ;
$ alpha [ $ c ] = sprintf ( "%c" , $ _ ) ;
if ( $ alpha [ $ c ] !~ /\w/ ) {
$ alpha [ $ c ] = "." ;
}
$ c + + ;
if ( $ c == 16 ) {
print " " ;
foreach ( @ alpha ) {
print $ _ ;
}
print "\n" ;
@ alpha = ( ) ;
$ c = 0 ;
}
}
foreach ( $ c .. 16 ) {
print " " ;
}
foreach ( @ alpha ) {
print $ _ ;
}
print "\n" ;
}
sub comp2int {
my $ length = shift ;
my $ bits = shift ;
my $ neg = 0 ;
if ( $ bits & 2 ** ( $ length - 1 ) ) {
$ neg = 1 ;
}
$ bits & = ( 2 ** ( $ length - 1 ) - 1 ) ;
if ( $ neg ) {
$ bits -= 2 ** ( $ length - 1 ) ;
}
return ( $ bits ) ;
}
sub timestamp2datetime {
my $ ts = shift ;
if ( $ ts < 0x20000000 ) {
return "BMC Uptime" , sprintf ( "%6d s" , $ ts ) ;
}
my @ t = localtime ( $ ts ) ;
my $ time = strftime ( "%H:%M:%S" , @ t ) ;
my $ date = strftime ( "%m/%d/%Y" , @ t ) ;
return ( $ date , $ time ) ;
}
sub decodebcd {
my $ numbers = shift ;
my @ bcd ;
my $ text ;
my $ ms ;
my $ ls ;
foreach ( @$ numbers ) {
$ ms = ( $ _ & 0b11110000 ) >> 4 ;
$ ls = ( $ _ & 0b00001111 ) ;
push ( @ bcd , $ ms ) ;
push ( @ bcd , $ ls ) ;
}
foreach ( @ bcd ) {
if ( $ _ < 0x0a ) {
$ text . = $ _ ;
}
elsif ( $ _ == 0x0a ) {
$ text . = " " ;
}
elsif ( $ _ == 0x0b ) {
$ text . = "-" ;
}
elsif ( $ _ == 0x0c ) {
$ text . = "." ;
}
}
return ( $ text ) ;
}
sub storsdrcache {
my $ file = shift ;
2010-01-30 23:48:18 +00:00
my $ sessdata = shift ;
unless ( $ sessdata ) { die "need to fix this one too" }
2010-01-30 23:20:11 +00:00
my $ key ;
my $ fh ;
system ( "mkdir -p $cache_dir" ) ;
if ( ! open ( $ fh , ">$file" ) ) {
return ( 1 ) ;
}
flock ( $ fh , LOCK_EX ) || return ( 1 ) ;
2010-01-30 23:48:18 +00:00
foreach $ key ( keys % { $ sessdata - > { sdr_hash } } ) {
my $ r = $ sessdata - > { sdr_hash } - > { $ key } ;
2010-01-30 23:20:11 +00:00
store_fd ( $ r , $ fh ) ;
}
close ( $ fh ) ;
return ( 0 ) ;
}
sub loadsdrcache {
my $ sessdata = shift ;
my $ file = shift ;
my $ r ;
my $ c = 0 ;
my $ fh ;
if ( ! open ( $ fh , "<$file" ) ) {
return ( 1 ) ;
}
flock ( $ fh , LOCK_SH ) || return ( 1 ) ;
while ( ) {
eval {
$ r = retrieve_fd ( $ fh ) ;
} || last ;
2010-01-31 18:38:46 +00:00
$ sessdata - > { sdr_hash } - > { $ r - > sensor_owner_id . "." . $ r - > sensor_owner_lun . "." . $ r - > sensor_number } = $ r ;
2010-01-30 23:20:11 +00:00
}
close ( $ fh ) ;
return ( 0 ) ;
}
sub preprocess_request {
my $ request = shift ;
2010-01-31 18:38:46 +00:00
if ( defined $ request - > { _xcatpreprocessed } - > [ 0 ] and $ request - > { _xcatpreprocessed } - > [ 0 ] == 1 ) { return [ $ request ] ; }
2010-01-30 23:20:11 +00:00
#exit if preprocessed
my $ callback = shift ;
my @ requests ;
my $ noderange = $ request - > { node } ; #Should be arrayref
my $ command = $ request - > { command } - > [ 0 ] ;
my $ extrargs = $ request - > { arg } ;
my @ exargs = ( $ request - > { arg } ) ;
if ( ref ( $ extrargs ) ) {
@ exargs = @$ extrargs ;
}
my $ usage_string = xCAT::Usage - > parseCommand ( $ command , @ exargs ) ;
if ( $ usage_string ) {
$ callback - > ( { data = > $ usage_string } ) ;
$ request = { } ;
return ;
}
if ( $ command eq "rpower" ) {
my $ subcmd = $ exargs [ 0 ] ;
if ( $ subcmd eq '' ) {
$ callback - > ( { data = > [ "Please enter an action (eg: boot,off,on, etc)" , $ usage_string ] } ) ;
$ request = { } ;
return 0 ;
}
if ( ( $ subcmd ne 'stat' ) && ( $ subcmd ne 'state' ) && ( $ subcmd ne 'status' ) && ( $ subcmd ne 'on' ) && ( $ subcmd ne 'off' ) && ( $ subcmd ne 'softoff' ) && ( $ subcmd ne 'nmi' ) && ( $ subcmd ne 'cycle' ) && ( $ subcmd ne 'reset' ) && ( $ subcmd ne 'boot' ) ) {
$ callback - > ( { data = > [ "Unsupported command: $command $subcmd" , $ usage_string ] } ) ;
$ request = { } ;
return ;
}
}
if ( ! $ noderange ) {
$ usage_string = xCAT::Usage - > getUsage ( $ command ) ;
$ callback - > ( { data = > $ usage_string } ) ;
$ request = { } ;
return ;
}
#print "noderange=@$noderange\n";
# find service nodes for requested nodes
# build an individual request for each service node
my $ service = "xcat" ;
my $ sn = xCAT::Utils - > get_ServiceNode ( $ noderange , $ service , "MN" ) ;
# build each request for each service node
foreach my $ snkey ( keys %$ sn )
{
#print "snkey=$snkey\n";
my $ reqcopy = { %$ request } ;
$ reqcopy - > { node } = $ sn - > { $ snkey } ;
$ reqcopy - > { '_xcatdest' } = $ snkey ;
$ reqcopy - > { _xcatpreprocessed } - > [ 0 ] = 1 ;
push @ requests , $ reqcopy ;
}
return \ @ requests ;
}
sub getipmicons {
my $ argr = shift ;
#$argr is [$node,$nodeip,$nodeuser,$nodepass];
my $ cb = shift ;
my $ ipmicons = { node = > [ { name = > [ $ argr - > [ 0 ] ] } ] } ;
$ ipmicons - > { node } - > [ 0 ] - > { bmcaddr } - > [ 0 ] = $ argr - > [ 1 ] ;
$ ipmicons - > { node } - > [ 0 ] - > { bmcuser } - > [ 0 ] = $ argr - > [ 2 ] ;
$ ipmicons - > { node } - > [ 0 ] - > { bmcpass } - > [ 0 ] = $ argr - > [ 3 ] ;
$ cb - > ( $ ipmicons ) ;
}
sub process_request {
my $ request = shift ;
2010-02-01 19:52:01 +00:00
$ callback = shift ;
2010-01-30 23:20:11 +00:00
my $ noderange = $ request - > { node } ; #Should be arrayref
my $ command = $ request - > { command } - > [ 0 ] ;
my $ extrargs = $ request - > { arg } ;
my @ exargs = ( $ request - > { arg } ) ;
if ( ref ( $ extrargs ) ) {
@ exargs = @$ extrargs ;
}
my $ ipmiuser = 'USERID' ;
my $ ipmipass = 'PASSW0RD' ;
my $ ipmitrys = 3 ;
my $ ipmitimeout = 2 ;
my $ ipmimaxp = 64 ;
my $ sitetab = xCAT::Table - > new ( 'site' ) ;
my $ ipmitab = xCAT::Table - > new ( 'ipmi' ) ;
my $ tmp ;
if ( $ sitetab ) {
( $ tmp ) = $ sitetab - > getAttribs ( { 'key' = > 'ipmimaxp' } , 'value' ) ;
if ( defined ( $ tmp ) ) { $ ipmimaxp = $ tmp - > { value } ; }
( $ tmp ) = $ sitetab - > getAttribs ( { 'key' = > 'ipmitimeout' } , 'value' ) ;
if ( defined ( $ tmp ) ) { $ ipmitimeout = $ tmp - > { value } ; }
( $ tmp ) = $ sitetab - > getAttribs ( { 'key' = > 'ipmiretries' } , 'value' ) ;
if ( defined ( $ tmp ) ) { $ ipmitrys = $ tmp - > { value } ; }
( $ tmp ) = $ sitetab - > getAttribs ( { 'key' = > 'ipmisdrcache' } , 'value' ) ;
if ( defined ( $ tmp ) ) { $ enable_cache = $ tmp - > { value } ; }
}
my $ passtab = xCAT::Table - > new ( 'passwd' ) ;
if ( $ passtab ) {
( $ tmp ) = $ passtab - > getAttribs ( { 'key' = > 'ipmi' } , 'username' , 'password' ) ;
if ( defined ( $ tmp ) ) {
$ ipmiuser = $ tmp - > { username } ;
$ ipmipass = $ tmp - > { password } ;
}
}
#my @threads;
my @ donargs = ( ) ;
if ( $ request - > { command } - > [ 0 ] =~ /fru/ ) {
my $ vpdtab = xCAT::Table - > new ( 'vpd' ) ;
$ vpdhash = $ vpdtab - > getNodesAttribs ( $ noderange , [ qw( serial mtm asset ) ] ) ;
}
my $ ipmihash = $ ipmitab - > getNodesAttribs ( $ noderange , [ 'bmc' , 'username' , 'password' ] ) ;
foreach ( @$ noderange ) {
my $ node = $ _ ;
my $ nodeuser = $ ipmiuser ;
my $ nodepass = $ ipmipass ;
my $ nodeip = $ node ;
my $ ent ;
if ( defined ( $ ipmitab ) ) {
$ ent = $ ipmihash - > { $ node } - > [ 0 ] ;
if ( ref ( $ ent ) and defined $ ent - > { bmc } ) { $ nodeip = $ ent - > { bmc } ; }
if ( ref ( $ ent ) and defined $ ent - > { username } ) { $ nodeuser = $ ent - > { username } ; }
if ( ref ( $ ent ) and defined $ ent - > { password } ) { $ nodepass = $ ent - > { password } ; }
}
push @ donargs , [ $ node , $ nodeip , $ nodeuser , $ nodepass ] ;
}
if ( $ request - > { command } - > [ 0 ] eq "getipmicons" ) {
foreach ( @ donargs ) {
getipmicons ( $ _ , $ callback ) ;
}
return ;
}
#get new node status
my % oldnodestatus = ( ) ; #saves the old node status
my $ check = 0 ;
my $ global_check = 1 ;
if ( $ sitetab ) {
( my $ ref ) = $ sitetab - > getAttribs ( { key = > 'nodestatus' } , 'value' ) ;
if ( $ ref ) {
if ( $ ref - > { value } =~ /0|n|N/ ) { $ global_check = 0 ; }
}
}
if ( $ command eq 'rpower' ) {
if ( ( $ global_check ) && ( $ extrargs - > [ 0 ] ne 'stat' ) && ( $ extrargs - > [ 0 ] ne 'status' ) && ( $ extrargs - > [ 0 ] ne 'state' ) ) {
$ check = 1 ;
my @ allnodes = ( ) ;
foreach ( @ donargs ) { push ( @ allnodes , $ _ - > [ 0 ] ) ; }
#save the old status
my $ nodelisttab = xCAT::Table - > new ( 'nodelist' ) ;
if ( $ nodelisttab ) {
my $ tabdata = $ nodelisttab - > getNodesAttribs ( \ @ allnodes , [ 'node' , 'status' ] ) ;
foreach my $ node ( @ allnodes )
{
my $ tmp1 = $ tabdata - > { $ node } - > [ 0 ] ;
if ( $ tmp1 ) {
if ( $ tmp1 - > { status } ) { $ oldnodestatus { $ node } = $ tmp1 - > { status } ; }
else { $ oldnodestatus { $ node } = "" ; }
}
}
}
#print "oldstatus:" . Dumper(\%oldnodestatus);
#set the new status to the nodelist.status
my % newnodestatus = ( ) ;
my $ newstat ;
if ( ( $ extrargs - > [ 0 ] eq 'off' ) || ( $ extrargs - > [ 0 ] eq 'softoff' ) ) {
my $ newstat = $ ::STATUS_POWERING_OFF ;
$ newnodestatus { $ newstat } = \ @ allnodes ;
} else {
#get the current nodeset stat
if ( @ allnodes > 0 ) {
my $ nsh = { } ;
my ( $ ret , $ msg ) = xCAT::SvrUtils - > getNodesetStates ( \ @ allnodes , $ nsh ) ;
if ( ! $ ret ) {
foreach ( keys %$ nsh ) {
my $ newstat = xCAT_monitoring::monitorctrl - > getNodeStatusFromNodesetState ( $ _ , "rpower" ) ;
$ newnodestatus { $ newstat } = $ nsh - > { $ _ } ;
}
} else {
$ callback - > ( { data = > $ msg } ) ;
}
}
}
#print "newstatus" . Dumper(\%newnodestatus);
xCAT_monitoring::monitorctrl:: setNodeStatusAttributes ( \ % newnodestatus , 1 ) ;
}
}
my $ children = 0 ;
my $ sub_fds = new IO:: Select ;
foreach ( @ donargs ) {
2010-02-01 19:52:01 +00:00
donode ( $ _ - > [ 0 ] , $ _ - > [ 1 ] , $ _ - > [ 2 ] , $ _ - > [ 3 ] , $ ipmitimeout , $ ipmitrys , $ command , - args = > \ @ exargs ) ;
2010-01-30 23:20:11 +00:00
}
2010-02-01 19:52:01 +00:00
while ( xCAT::IPMI - > waitforrsp ( ) ) { yield } ;
my $ node ;
foreach $ node ( keys % sessiondata ) {
if ( $ sessiondata { $ node } - > { ipmisession } ) {
$ sessiondata { $ node } - > { ipmisession } - > logout ( ) ;
}
}
while ( xCAT::IPMI - > waitforrsp ( ) ) { yield } ;
2010-03-03 21:28:52 +00:00
####return;
####while ($sub_fds->count > 0 and $children > 0) {
#### my $handlednodes={};
#### forward_data($callback,$sub_fds,$handlednodes);
#### #update the node status to the nodelist.status table
#### if ($check) {
#### updateNodeStatus($handlednodes, \@allerrornodes);
#### }
####}
####
#####Make sure they get drained, this probably is overkill but shouldn't hurt
####my $rc=1;
####while ( $rc>0 ) {
#### my $handlednodes={};
#### $rc=forward_data($callback,$sub_fds,$handlednodes);
#### #update the node status to the nodelist.status table
#### if ($check) {
#### updateNodeStatus($handlednodes, \@allerrornodes);
#### }
####}
2010-01-30 23:20:11 +00:00
if ( $ check ) {
#print "allerrornodes=@allerrornodes\n";
#revert the status back for there is no-op for the nodes
my % old = ( ) ;
2010-03-03 21:28:52 +00:00
foreach my $ node ( keys % allerrornodes ) {
my $ stat = $ oldnodestatus { $ node } ;
if ( exists ( $ old { $ stat } ) ) {
my $ pa = $ old { $ stat } ;
push ( @$ pa , $ node ) ;
} else {
$ old { $ stat } = [ $ node ] ;
}
2010-01-30 23:20:11 +00:00
}
xCAT_monitoring::monitorctrl:: setNodeStatusAttributes ( \ % old , 1 ) ;
}
}
2010-03-03 21:28:52 +00:00
#sub updateNodeStatus {
# my $handlednodes=shift;
# my $allerrornodes=shift;
# foreach my $node (keys(%$handlednodes)) {
# if ($handlednodes->{$node} == -1) { push(@$allerrornodes, $node); }
# }
#}
#sub forward_data { #unserialize data from pipe, chunk at a time, use magic to determine end of data structure
# my $callback = shift;
# my $fds = shift;
# my $errornodes=shift;
# my @ready_fds = $fds->can_read(1);
# my $rfh;
# my $rc = @ready_fds;
# foreach $rfh (@ready_fds) {
# my $data;
# if ($data = <$rfh>) {
# while ($data !~ /ENDOFFREEZE6sK4ci/) {
# $data .= <$rfh>;
# }
# eval { print $rfh "ACK\n"; }; # Ignore ack loss to child that has given up and exited
# my $responses=thaw($data);
# foreach (@$responses) {
# #save the nodes that has errors and the ones that has no-op for use by the node status monitoring
# my $no_op=0;
# if (exists($_->{node}->[0]->{errorcode})) { $no_op=1; }
# else {
# my $text=$_->{node}->[0]->{data}->[0]->{contents}->[0];
# #print "data:$text\n";
# if (($text) && ($text =~ /$status_noop/)) {
# $no_op=1;
# #remove the symbols that meant for use by node status
# $_->{node}->[0]->{data}->[0]->{contents}->[0] =~ s/ $status_noop//;
# }
# }
# #print "data:". $_->{node}->[0]->{data}->[0]->{contents}->[0] . "\n";
# if ($no_op) {
# if ($errornodes) { $errornodes->{$_->{node}->[0]->{name}->[0]}=-1; }
# } else {
# if ($errornodes) { $errornodes->{$_->{node}->[0]->{name}->[0]}=1; }
# }
# $callback->($_);
# }
# } else {
# $fds->remove($rfh);
# close($rfh);
# }
# }
# yield; #Avoid useless loop iterations by giving children a chance to fill pipes
# return $rc;
#}
2010-01-30 23:20:11 +00:00
sub donode {
my $ node = shift ;
my $ bmcip = shift ;
my $ user = shift ;
my $ pass = shift ;
my $ timeout = shift ;
my $ retries = shift ;
my $ command = shift ;
2010-01-30 23:48:18 +00:00
my % namedargs = @ _ ;
my $ extra = $ namedargs { - args } ;
my @ exargs = @$ extra ;
2010-01-30 23:20:11 +00:00
$ sessiondata { $ node } = {
node = > $ node , #this seems redundant, but some code will not be privy to what the key was
ipmisession = > xCAT::IPMI - > new ( bmc = > $ bmcip , userid = > $ user , password = > $ pass ) ,
command = > $ command ,
extraargs = > \ @ exargs ,
2010-02-01 16:35:57 +00:00
subcommand = > $ exargs [ 0 ] ,
2010-01-30 23:20:11 +00:00
} ;
2010-02-10 20:05:00 +00:00
if ( $ sessiondata { $ node } - > { ipmisession } - > { error } ) {
sendmsg ( [ 1 , $ sessiondata { $ node } - > { ipmisession } - > { error } ] , $ node ) ;
} else {
my ( $ rc , @ output ) = ipmicmd ( $ sessiondata { $ node } ) ;
sendoutput ( $ rc , @ output ) ;
yield ;
return $ rc ;
}
2010-01-30 23:20:11 +00:00
#my $msgtoparent=freeze(\@outhashes);
# print $outfd $msgtoparent;
}
2010-02-01 16:35:57 +00:00
sub sendmsg {
# my $callback = $output_handler;
my $ text = shift ;
my $ node = shift ;
my $ descr ;
my $ rc ;
if ( ref $ text eq 'HASH' ) {
die "not right now" ;
} elsif ( ref $ text eq 'ARRAY' ) {
$ rc = $ text - > [ 0 ] ;
$ text = $ text - > [ 1 ] ;
}
if ( $ text =~ /:/ ) {
( $ descr , $ text ) = split /:/ , $ text , 2 ;
}
$ text =~ s/^ *// ;
$ text =~ s/ *$// ;
my $ msg ;
my $ curptr ;
if ( $ node ) {
$ msg - > { node } = [ { name = > [ $ node ] } ] ;
$ curptr = $ msg - > { node } - > [ 0 ] ;
} else {
$ msg = { } ;
$ curptr = $ msg ;
}
if ( $ rc ) {
$ curptr - > { errorcode } = [ $ rc ] ;
$ curptr - > { error } = [ $ text ] ;
$ curptr = $ curptr - > { error } - > [ 0 ] ;
2010-03-03 21:28:52 +00:00
if ( defined $ node ) {
$ allerrornodes { $ node } = 1 ;
}
2010-02-01 16:35:57 +00:00
} else {
$ curptr - > { data } = [ { contents = > [ $ text ] } ] ;
$ curptr = $ curptr - > { data } - > [ 0 ] ;
if ( $ descr ) { $ curptr - > { desc } = [ $ descr ] ; }
}
2010-02-01 19:52:01 +00:00
# print $outfd freeze([$msg]);
# print $outfd "\nENDOFFREEZE6sK4ci\n";
# yield;
# waitforack($outfd);
$ callback - > ( $ msg ) ;
2010-02-01 16:35:57 +00:00
}
2010-01-30 23:20:11 +00:00
sub sendoutput {
my $ rc = shift ;
foreach ( @ _ ) {
my % output ;
( my $ desc , my $ text ) = split ( /:/ , $ _ , 2 ) ;
unless ( $ text ) {
$ text = $ desc ;
} else {
$ desc =~ s/^\s+// ;
$ desc =~ s/\s+$// ;
if ( $ desc ) {
$ output { node } - > [ 0 ] - > { data } - > [ 0 ] - > { desc } - > [ 0 ] = $ desc ;
}
}
$ text =~ s/^\s+// ;
$ text =~ s/\s+$// ;
2010-02-01 19:52:01 +00:00
$ output { node } - > [ 0 ] - > { name } - > [ 0 ] = "BADCODE" ;
2010-01-30 23:20:11 +00:00
if ( $ rc ) {
$ output { node } - > [ 0 ] - > { errorcode } = [ $ rc ] ;
$ output { node } - > [ 0 ] - > { error } - > [ 0 ] = $ text ;
} else {
$ output { node } - > [ 0 ] - > { data } - > [ 0 ] - > { contents } - > [ 0 ] = $ text ;
}
2010-02-01 19:52:01 +00:00
$ callback - > ( \ % output ) ;
2010-01-30 23:20:11 +00:00
#push @outhashes,\%output; #Save everything for the end, don't know how to be slicker with Storable and a pipe
2010-02-01 19:52:01 +00:00
# print $outfd freeze([\%output]);
# print $outfd "\nENDOFFREEZE6sK4ci\n";
# yield;
# waitforack($outfd);
2010-01-30 23:20:11 +00:00
}
}
1 ;