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
78#Hardcode the entries that will never be in the MRW
79#TODO: openbmc/openbmc#596 Remove when BIOS version is stored elsewhere.
80$inventory{'<inventory_root>/system/bios'} =
81    {is_fru => 1, fru_type => 'SYSTEM'};
82
83#TODO: openbmc/openbmc#597 Remove when misc FRU data is stored elsewhere.
84$inventory{'<inventory_root>/system/misc'} =
85    {is_fru => 0, fru_type => 'SYSTEM'};
86
87transform(\@items, \%inventory);
88
89#Encode in JSON and write it out
90my $json = JSON->new;
91$json->indent(1);
92$json->canonical(1);
93my $text = $json->encode(\%inventory);
94
95open(FILE, ">$outputFile") or die "Unable to create $outputFile\n";
96print FILE $text;
97close FILE;
98
99print "Created $outputFile\n";
100
101
102#Apply OpenBMC naming conventions to the Serverwiz names
103sub transform
104{
105    my $items = shift @_;
106    my $inventory = shift @_;
107
108    removeConnectors($items);
109
110    removeProcModule($items);
111
112    renameSegmentWithType("PROC", "cpu", $items);
113
114    renameSegmentWithType("SYS", "system", $items);
115    renameType("SYS", "SYSTEM", $items);
116
117    renameSegmentWithType("NODE", "chassis", $items);
118    renameType("NODE", "SYSTEM", $items);
119
120    renameSegmentWithTargetType("card-motherboard", "motherboard", $items);
121    renameTypeWithTargetType("card-motherboard", "MAIN_PLANAR", $items);
122
123    renameType("MEMBUF", "MEMORY_BUFFER", $items);
124
125    renameType("FSP", "BMC", $items);
126
127    removeCoreParentChiplet($items);
128
129    removeInstNumIfOneInstPresent($items);
130
131    removeHyphensFromInstanceNum($items);
132
133    for my $i (@$items) {
134        my $name = "<inventory_root>".$i->{name};
135        delete $i->{name};
136        delete $i->{orig_name};
137        delete $i->{target_type};
138        $inventory{$name} = { %$i };
139    }
140}
141
142
143#Renames a segment in all target names based on its type
144#
145#For example:
146#    renameSegmentWithType("PROC", "foo", $items)
147#  would change
148#    /sys-0/node-0/motherboard-0/module-0/cpu/core0
149#  to
150#    /sys-0/node-0/motherboard-0/module-0/foo/core0
151#  assuming /sys-0/.../cpu had type PROC.
152sub renameSegmentWithType
153{
154    my $type = shift @_;
155    my $newSegment = shift @_;
156    my $items = shift @_;
157    my %segmentsToRename;
158
159    for my $item (@$items) {
160        my @segments = split('/', $item->{orig_name});
161        my $target = "";
162        for my $s (@segments) {
163            if (length($s) > 0) {
164                $target .= "/$s";
165                my $curType = "";
166                if (!$targetObj->isBadAttribute($target, "TYPE")) {
167                    $curType = $targetObj->getType($target);
168                }
169                if ($curType eq $type) {
170                    if (not defined $segmentsToRename{$target}) {
171                        my ($oldSegment) = $target =~ /\b(\w+)(-\d+)?$/;
172                        $segmentsToRename{$target}{old} = $oldSegment;
173                        $segmentsToRename{$target}{new} = $newSegment;
174                    }
175                }
176             }
177        }
178    }
179
180    for my $s (keys %segmentsToRename) {
181        for my $item (@$items) {
182            $item->{name} =~
183                s/$segmentsToRename{$s}{old}/$segmentsToRename{$s}{new}/;
184        }
185    }
186}
187
188
189#Renames a segment in all target names based on its target type
190#
191#For example:
192#    renameSegmentWithType("PROC", "foo", $items)
193#  would change
194#    /sys-0/node-0/motherboard-0/module-0/cpu/core0
195#  to
196#    /sys-0/node-0/motherboard-0/module-0/foo/core0
197#  assuming /sys-0/.../cpu had target type PROC.
198sub renameSegmentWithTargetType
199{
200    my $type = shift @_;
201    my $newSegment = shift @_;
202    my $items = shift @_;
203    my %segmentsToRename;
204
205    for my $item (@$items) {
206        my @segments = split('/', $item->{orig_name});
207        my $target = "";
208        for my $s (@segments) {
209            if (length($s) > 0) {
210                $target .= "/$s";
211                my $curType = $targetObj->getTargetType($target);
212                if ($curType eq $type) {
213                    if (not defined $segmentsToRename{$target}) {
214                        my ($oldSegment) = $target =~ /\b(\w+)(-\d+)?$/;
215                        $segmentsToRename{$target}{old} = $oldSegment;
216                        $segmentsToRename{$target}{new} = $newSegment;
217                    }
218                }
219             }
220        }
221    }
222
223    for my $s (keys %segmentsToRename) {
224        for my $item (@$items) {
225            $item->{name} =~
226                s/$segmentsToRename{$s}{old}/$segmentsToRename{$s}{new}/;
227        }
228    }
229}
230
231
232#Remove the core's parent chiplet, after moving
233#the chiplet's instance number to the core.
234#Note: Serverwiz always puts the core on a chiplet
235sub removeCoreParentChiplet
236{
237    my $items = shift @_;
238
239    for my $item (@$items) {
240        if ($item->{fru_type} eq "CORE") {
241            $item->{name} =~ s/\w+-(\d+)\/(\w+)-\d+$/$2-$1/;
242        }
243    }
244}
245
246
247#Remove path segments that are connectors
248sub removeConnectors
249{
250    my $items = shift @_;
251    my %connectors;
252    my $item;
253
254    for $item (@$items) {
255        my @segments = split('/', $item->{name});
256        my $target = "";
257        for my $s (@segments) {
258            if (length($s) > 0) {
259                $target .= "/$s";
260                my $class = $targetObj->getAttribute($target, "CLASS");
261                if ($class eq "CONNECTOR") {
262                    if (not exists $connectors{$target}) {
263                        $connectors{$target} = 1;
264                    }
265                }
266            }
267        }
268    }
269
270    #remove the connector segments out of the path
271    #Reverse sort so we start with connectors further out
272    for my $connector (sort {$b cmp $a} keys %connectors) {
273        for $item (@$items) {
274            if ($item->{name} =~ /$connector\b/) {
275                my ($inst) = $connector =~ /-(\d+)$/;
276                my ($card) = $item->{name};
277                $card =~ s/^$connector\///;
278
279                #add the connector instance to the child card
280                $card =~ s/^(\w+)-\d+/$1-$inst/;
281
282                #remove the connector segment from the path
283                my $base = $connector;
284                $base =~ s/\w+-\d+$//;
285                $item->{name} = $base . $card;
286            }
287        }
288    }
289}
290
291
292#Remove the processor module card from the path name.
293#Note: Serverwiz always outputs proc_socket-X/module-Y/proc.
294#      where proc_socket, module, and proc can be any name
295#      We already transormed it to module-X/proc.
296#      Our use requires proc-X.
297#      Note: No multichip modules in plan for OpenPower systems.
298sub removeProcModule
299{
300    my $items = shift @_;
301    my $procName = "";
302
303    #Find the name of the processor used in this model
304    for my $item (@$items) {
305        if ($item->{fru_type} eq "PROC") {
306            ($procName) = $item->{name} =~ /\b(\w+)$/;
307            last;
308        }
309    }
310
311    #Now remove it from every instance that it's a part of
312    if ($procName eq "") {
313        print "Could not find the name of the processor in this system\n";
314    } else {
315        for my $item (@$items) {
316            $item->{name} =~ s/\w+-(\d+)\/$procName/$procName-$1/;
317        }
318    }
319}
320
321
322sub renameType
323{
324    my $old = shift @_;
325    my $new = shift @_;
326    my $items = shift @_;
327
328    for my $item (@$items) {
329        $item->{fru_type} =~ s/$old/$new/;
330    }
331}
332
333
334sub renameTypeWithTargetType
335{
336    my $targetType = shift@_;
337    my $newType = shift @_;
338    my $items = shift @_;
339
340    for my $item (@$items) {
341        if ($item->{target_type} eq $targetType) {
342            $item->{fru_type} = $newType;
343        }
344    }
345}
346
347
348sub removeHyphensFromInstanceNum
349{
350    my $items = shift @_;
351
352    for my $item (@$items) {
353        $item->{name} =~ s/-(\d+)\b/$1/g;
354    }
355}
356
357
358sub renameSegment
359{
360    my $old = shift @_;
361    my $new = shift @_;
362    my $items = shift @_;
363
364    for my $item (@$items) {
365      $item->{name} =~ s/\b$old\b/$new/;
366    }
367}
368
369
370sub removeInstNumIfOneInstPresent
371{
372    my $items = shift @_;
373    my %instanceHash;
374    my $segment, my $item;
375
376    for $item (@$items) {
377        my @segments = split('/', $item->{name});
378
379        for $segment (@segments) {
380            my ($s, $inst) = $segment =~ /(\w+)-(\d+)/;
381            if (defined $s) {
382                if (not exists $instanceHash{$s}) {
383                    $instanceHash{$s}{inst} = $inst;
384                }
385                else {
386                    if ($instanceHash{$s}{inst} ne $inst) {
387                        $instanceHash{$s}{keep} = 1;
388                    }
389                }
390            }
391        }
392    }
393
394    for my $segment (keys %instanceHash) {
395
396        if (not exists $instanceHash{$segment}{keep}) {
397            for $item (@$items) {
398               $item->{name} =~ s/$segment-\d+/$segment/;
399            }
400        }
401    }
402}
403
404
405sub printUsage
406{
407    print "inventory.pl -x [XML filename] -o [output filename]\n";
408    exit(1);
409}
410