xref: /openbmc/phosphor-mrw-tools/inventory.pl (revision 7a68567af7bf121143ef135152a39723518b6e06)
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