1#!/usr/bin/env perl 2 3#Creates the OpenBMC inventory from ServerWiz output XML. 4#Basically, the inventory includes anything with a FRU name, 5#plus some other specific things we always look for since we 6#need more than just FRUs. 7 8 9use strict; 10use XML::Simple; 11use mrw::Targets; 12use Getopt::Long; 13use JSON; 14 15my $serverwizFile; 16my $outputFile, my $target; 17my $fruName, my $type; 18my @items, my %item, my %inventory; 19 20#Ensure we never pick these up 21my %skipFRUTypes = (OCC => 1); 22 23#We always want the targets with these Types 24my %includedTypes = ("CORE" => 1); 25 26#We always want the targets with these MRW Types 27my %includedTargetTypes = ("chip-sp-bmc" => 1, 28 "chip-apss-psoc" => 1); 29 30#These are never considered FRUs 31my %notFRUTypes = ("CORE" => 1); 32 33GetOptions("x=s" => \$serverwizFile, 34 "o=s" => \$outputFile) 35or printUsage(); 36 37if ((not defined $serverwizFile) || (not defined $outputFile)) { 38 printUsage(); 39} 40 41my $targetObj = Targets->new; 42$targetObj->loadXML($serverwizFile); 43 44foreach $target (sort keys %{ $targetObj->getAllTargets() }) 45{ 46 $type = $targetObj->getType($target); 47 if (exists $skipFRUTypes{$type}) { 48 next; 49 } 50 51 $fruName = ""; 52 53 if (!$targetObj->isBadAttribute($target, "FRU_NAME")) { 54 $fruName = $targetObj->getAttribute($target,"FRU_NAME"); 55 } 56 57 my $targetType = $targetObj->getTargetType($target); 58 59 #We're looking for FRUs, and a few other required parts 60 if (($fruName ne "") || (exists $includedTargetTypes{$targetType}) || 61 (exists $includedTypes{$type})) 62 { 63 $item{name} = $target; 64 $item{orig_name} = $target; 65 $item{fru_type} = $type; 66 $item{target_type} = $targetType; 67 68 if (($fruName ne "") && (not exists $notFRUTypes{$type})) { 69 $item{is_fru} = 1; 70 } else { 71 $item{is_fru} = 0; 72 } 73 push @items, { %item }; 74 } 75 76} 77 78transform(\@items, \%inventory); 79 80#Encode in JSON and write it out 81my $json = JSON->new; 82$json->indent(1); 83$json->canonical(1); 84my $text = $json->encode(\%inventory); 85 86open(FILE, ">$outputFile") or die "Unable to create $outputFile\n"; 87print FILE $text; 88close FILE; 89 90print "Created $outputFile\n"; 91 92 93#Apply OpenBMC naming conventions to the Serverwiz names 94sub transform 95{ 96 my $items = shift @_; 97 my $inventory = shift @_; 98 99 removeConnectors($items); 100 101 removeProcModule($items); 102 103 renameSegmentWithType("PROC", "cpu", $items); 104 105 renameSegmentWithType("SYS", "system", $items); 106 renameType("SYS", "SYSTEM", $items); 107 108 renameSegmentWithType("NODE", "chassis", $items); 109 renameType("NODE", "SYSTEM", $items); 110 111 renameSegmentWithTargetType("card-motherboard", "motherboard", $items); 112 renameTypeWithTargetType("card-motherboard", "MOTHERBOARD", $items); 113 114 renameType("FSP", "BMC", $items); 115 116 removeCoreParentChiplet($items); 117 118 removeInstNumIfOneInstPresent($items); 119 120 removeHyphensFromInstanceNum($items); 121 122 for my $i (@$items) { 123 my $name = "<inventory_root>".$i->{name}; 124 delete $i->{name}; 125 delete $i->{orig_name}; 126 delete $i->{target_type}; 127 $inventory{$name} = { %$i }; 128 } 129} 130 131 132#Renames a segment in all target names based on its type 133# 134#For example: 135# renameSegmentWithType("PROC", "foo", $items) 136# would change 137# /sys-0/node-0/motherboard-0/module-0/cpu/core0 138# to 139# /sys-0/node-0/motherboard-0/module-0/foo/core0 140# assuming /sys-0/.../cpu had type PROC. 141sub renameSegmentWithType 142{ 143 my $type = shift @_; 144 my $newSegment = shift @_; 145 my $items = shift @_; 146 my %segmentsToRename; 147 148 for my $item (@$items) { 149 my @segments = split('/', $item->{orig_name}); 150 my $target = ""; 151 for my $s (@segments) { 152 if (length($s) > 0) { 153 $target .= "/$s"; 154 my $curType = ""; 155 if (!$targetObj->isBadAttribute($target, "TYPE")) { 156 $curType = $targetObj->getType($target); 157 } 158 if ($curType eq $type) { 159 if (not defined $segmentsToRename{$target}) { 160 my ($oldSegment) = $target =~ /\b(\w+)(-\d+)?$/; 161 $segmentsToRename{$target}{old} = $oldSegment; 162 $segmentsToRename{$target}{new} = $newSegment; 163 } 164 } 165 } 166 } 167 } 168 169 for my $s (keys %segmentsToRename) { 170 for my $item (@$items) { 171 $item->{name} =~ 172 s/$segmentsToRename{$s}{old}/$segmentsToRename{$s}{new}/; 173 } 174 } 175} 176 177 178#Renames a segment in all target names based on its target type 179# 180#For example: 181# renameSegmentWithType("PROC", "foo", $items) 182# would change 183# /sys-0/node-0/motherboard-0/module-0/cpu/core0 184# to 185# /sys-0/node-0/motherboard-0/module-0/foo/core0 186# assuming /sys-0/.../cpu had target type PROC. 187sub renameSegmentWithTargetType 188{ 189 my $type = shift @_; 190 my $newSegment = shift @_; 191 my $items = shift @_; 192 my %segmentsToRename; 193 194 for my $item (@$items) { 195 my @segments = split('/', $item->{orig_name}); 196 my $target = ""; 197 for my $s (@segments) { 198 if (length($s) > 0) { 199 $target .= "/$s"; 200 my $curType = $targetObj->getTargetType($target); 201 if ($curType eq $type) { 202 if (not defined $segmentsToRename{$target}) { 203 my ($oldSegment) = $target =~ /\b(\w+)(-\d+)?$/; 204 $segmentsToRename{$target}{old} = $oldSegment; 205 $segmentsToRename{$target}{new} = $newSegment; 206 } 207 } 208 } 209 } 210 } 211 212 for my $s (keys %segmentsToRename) { 213 for my $item (@$items) { 214 $item->{name} =~ 215 s/$segmentsToRename{$s}{old}/$segmentsToRename{$s}{new}/; 216 } 217 } 218} 219 220 221#Remove the core's parent chiplet, after moving 222#the chiplet's instance number to the core. 223#Note: Serverwiz always puts the core on a chiplet 224sub removeCoreParentChiplet 225{ 226 my $items = shift @_; 227 228 for my $item (@$items) { 229 if ($item->{fru_type} eq "CORE") { 230 $item->{name} =~ s/\w+-(\d+)\/(\w+)-\d+$/$2-$1/; 231 } 232 } 233} 234 235 236#Remove path segments that are connectors 237sub removeConnectors 238{ 239 my $items = shift @_; 240 my %connectors; 241 my $item; 242 243 for $item (@$items) { 244 my @segments = split('/', $item->{name}); 245 my $target = ""; 246 for my $s (@segments) { 247 if (length($s) > 0) { 248 $target .= "/$s"; 249 my $class = $targetObj->getAttribute($target, "CLASS"); 250 if ($class eq "CONNECTOR") { 251 if (not exists $connectors{$target}) { 252 $connectors{$target} = 1; 253 } 254 } 255 } 256 } 257 } 258 259 #remove the connector segments out of the path 260 #Reverse sort so we start with connectors further out 261 for my $connector (sort {$b cmp $a} keys %connectors) { 262 for $item (@$items) { 263 if ($item->{name} =~ /$connector\b/) { 264 my ($inst) = $connector =~ /-(\d+)$/; 265 my ($card) = $item->{name}; 266 $card =~ s/^$connector\///; 267 268 #add the connector instance to the child card 269 $card =~ s/^(\w+)-\d+/$1-$inst/; 270 271 #remove the connector segment from the path 272 my $base = $connector; 273 $base =~ s/\w+-\d+$//; 274 $item->{name} = $base . $card; 275 } 276 } 277 } 278} 279 280 281#Remove the processor module card from the path name. 282#Note: Serverwiz always outputs proc_socket-X/module-Y/proc. 283# where proc_socket, module, and proc can be any name 284# We already transormed it to module-X/proc. 285# Our use requires proc-X. 286# Note: No multichip modules in plan for OpenPower systems. 287sub removeProcModule 288{ 289 my $items = shift @_; 290 my $procName = ""; 291 292 #Find the name of the processor used in this model 293 for my $item (@$items) { 294 if ($item->{fru_type} eq "PROC") { 295 ($procName) = $item->{name} =~ /\b(\w+)$/; 296 last; 297 } 298 } 299 300 #Now remove it from every instance that it's a part of 301 if ($procName eq "") { 302 print "Could not find the name of the processor in this system\n"; 303 } else { 304 for my $item (@$items) { 305 $item->{name} =~ s/\w+-(\d+)\/$procName/$procName-$1/; 306 } 307 } 308} 309 310 311sub renameType 312{ 313 my $old = shift @_; 314 my $new = shift @_; 315 my $items = shift @_; 316 317 for my $item (@$items) { 318 $item->{fru_type} =~ s/$old/$new/; 319 } 320} 321 322 323sub renameTypeWithTargetType 324{ 325 my $targetType = shift@_; 326 my $newType = shift @_; 327 my $items = shift @_; 328 329 for my $item (@$items) { 330 if ($item->{target_type} eq $targetType) { 331 $item->{fru_type} = $newType; 332 } 333 } 334} 335 336 337sub removeHyphensFromInstanceNum 338{ 339 my $items = shift @_; 340 341 for my $item (@$items) { 342 $item->{name} =~ s/-(\d+)\b/$1/g; 343 } 344} 345 346 347sub renameSegment 348{ 349 my $old = shift @_; 350 my $new = shift @_; 351 my $items = shift @_; 352 353 for my $item (@$items) { 354 $item->{name} =~ s/\b$old\b/$new/; 355 } 356} 357 358 359sub removeInstNumIfOneInstPresent 360{ 361 my $items = shift @_; 362 my %instanceHash; 363 my $segment, my $item; 364 365 for $item (@$items) { 366 my @segments = split('/', $item->{name}); 367 368 for $segment (@segments) { 369 my ($s, $inst) = $segment =~ /(\w+)-(\d+)/; 370 if (defined $s) { 371 if (not exists $instanceHash{$s}) { 372 $instanceHash{$s}{inst} = $inst; 373 } 374 else { 375 if ($instanceHash{$s}{inst} ne $inst) { 376 $instanceHash{$s}{keep} = 1; 377 } 378 } 379 } 380 } 381 } 382 383 for my $segment (keys %instanceHash) { 384 385 if (not exists $instanceHash{$segment}{keep}) { 386 for $item (@$items) { 387 $item->{name} =~ s/$segment-\d+/$segment/; 388 } 389 } 390 } 391} 392 393 394sub printUsage 395{ 396 print "inventory.pl -x [XML filename] -o [output filename]\n"; 397 exit(1); 398} 399