Initial revision
[opensuse:hwinfo.git] / src / ids / mk_ids
1 #! /usr/bin/perl
2
3 sub dump_entries;
4 sub add_entry;
5 sub add_subentry;
6 sub add_subsubentry;
7
8 # entry: <initial letter>, <hexdigits>, <hexdigits for subentry>, <subsubentry, part1>, <..., part2>
9 %spec = (
10   'bus'   => [ 'B', 2, 0, 0, 0 ],
11   'class' => [ 'C', 3, 2, 0, 0 ],
12   'eisa'  => [ '',  0, 4, 0, 4 ],
13   'pci'   => [ '',  4, 4, 4, 4 ],
14 );
15
16
17 if($ARGV[0] eq '-r') {
18   $reduced = 1;
19   $mini = 1;
20   shift
21 }
22
23
24 for $f (@ARGV) {
25   if(open F, $f) {
26     while(<F>) {
27       chomp;
28       s/\s*$//;
29       next if /^\s*#/;
30       next if /^$/;
31
32
33       # SaX Identity file
34       if(/^NAME=(.+?)§DEVICE=(.+?)§VID=0x([0-9a-fA-F]+?)§DID=0x([0-9a-fA-F]+?)§SERVER=([^§]+)$/) {
35         @i = ($1, $2, $3, $4, $5);
36         $type = 'pci';
37         $subkey = undef;
38         $$type = add_entry $type, $i[2], $i[0], $f, $.;
39         $subkey = add_subentry $type, $$type, $i[3], $i[1], undef, "x|$i[4]", $f, $.;
40         next;
41       }
42
43
44       if(/^B\s+([0-9a-fA-F]+)\s*(.*?)$/) {
45         $type = 'bus';
46         $subkey = undef;
47         $$type = add_entry $type, $1, $2, $f, $.;
48       }
49
50       elsif(/^C\s+([0-9a-fA-F]+)\s*(.*?)$/) {
51         $type = 'class';
52         $subkey = undef;
53         $$type = add_entry $type, $1, $2, $f, $.;
54       }
55
56       elsif(/^([0-9a-fA-F]{4})\s*(.*?)$/) {
57         $type = 'pci';
58         $subkey = undef;
59         $$type = add_entry $type, $1, $2, $f, $.;
60       }
61
62       elsif(/^([a-zA-Z_@]{3})\s*(.*?)$/) {
63         $type = 'eisa';
64         $subkey = undef;
65         $$type = add_entry $type, $1, $2, $f, $.;
66       }
67
68       elsif($type eq 'class' && /^\t\t/) {
69          # not yet
70 #        if(/\t\t([0-9a-fA-F]+)(\.([0-9a-fA-F]+))?\s*(\[(.*?)\])?\s*(.*?)$/) {
71 #          add_subsubentry $type, $$type, $subkey, $1, $2, $7, $4, $6, $f, $.;
72 #        }
73 #        else {
74 #          print STDERR "invalid line at $f($.)\n";
75 #          exit 2;
76 #        }
77       }
78
79       elsif($type eq 'pci' && /^\t\t/) {
80         # note: the order is <dev_id:vend_id> here; contrary to eisa
81         if(/\t\t([0-9a-fA-F]{4})([0-9a-fA-F]{4})(\.([0-9a-fA-F]+))?\s*(\[(.*?)\])?\s*(.*?)$/) {
82           add_subsubentry $type, $$type, $subkey, $1, $2, $7, $4, $6, $f, $.;
83         }
84         elsif(/\t\t([0-9a-fA-F]{4})\s+([0-9a-fA-F]{4})(\.([0-9a-fA-F]+))?\s*(\[(.*?)\])?\s*(.*?)$/) {
85           add_subsubentry $type, $$type, $subkey, $2, $1, $7, $4, $6, $f, $.;
86         }
87         else {
88           print STDERR "invalid line at $f($.)\n";
89           exit 2;
90         }
91       }
92
93       elsif($type eq 'eisa' && /^\t\t/) {
94         if(/\t\t([a-zA-Z_@]{3})([0-9a-fA-F]{4})(\.([0-9a-fA-F]+))?\s*(\[(.*?)\])?\s*(.*?)$/) {
95           add_subsubentry $type, $$type, $subkey, $1, $2, $7, $4, $6, $f, $.;
96         }
97         else {
98           print STDERR "invalid line at $f($.)\n";
99           exit 3;
100         }
101       }
102
103       elsif(/^\t/) {
104         if(/\t([0-9a-fA-F]+)(\.([0-9a-fA-F]+))?\s*(\[(.*?)\])?\s*(.*?)$/) {
105           $subkey = add_subentry $type, $$type, $1, $6, $3, $5, $f, $.;
106         }
107         else {
108           print STDERR "invalid line at $f($.)\n";
109           exit 4;
110         }
111       }
112
113       else {
114         print STDERR "invalid line at $f($.)\n";
115         exit 1;
116       }
117     }
118     close F
119   }
120   else {
121     print STDERR "failed to open $f\n"
122   }
123 }
124
125
126 for (sort keys %spec) {
127   dump_entries $_;
128 }
129
130 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
131 sub dump_entries
132 {
133   my ($et, @a, @b, @c, $s, $t, $i, $j, $k, $z);
134   local $_;
135
136   $et = shift;
137
138   for (sort keys %$et) {
139     @a = @{$$et{$_}};
140     $i = ${$spec{$et}}[0];
141     $i .= " " if $i;
142     $k = $a[1];
143     $k = substr($k, 0, 1) if $reduced && !${$spec{$et}}[0];
144     if(!$i && !$k) { $k = $_ }
145     @z = keys %{$a[0]};
146     if(!$mini || @z || $a[3] || ${$spec{$et}}[0]) {
147       print "$i$_\t$k\n";
148     }
149     for $s (sort keys %{$a[0]}) {
150       @b = @{$a[0]{$s}};
151       $i = $b[2];
152       $i = ".$i" if $i;
153       $j = $b[3];
154       $j = "[$j] " if $j;
155       $k = $b[1];
156       $k = substr($k, 0, 1) if $reduced;
157       @z = keys %{$b[0]};
158       if(!$mini || @z || $b[3]) {
159         print "\t$s$i\t$j$k\n";
160         for $t (sort keys %{$b[0]}) {
161           @c = @{$b[0]{$t}};
162           $i = $c[2];
163           $i = ".$i" if $i;
164           $j = $c[3];
165           $j = "[$j] " if $j;
166           $k = $c[1];
167           $k = substr($k, 0, 1) if $reduced;
168           print "\t\t$t$i\t$j$k\n"
169         }
170       }
171     }
172   }
173 }
174 # [ { }, $val, $class, $drv, $file, $line ];
175
176 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
177 sub add_entry
178 {
179   my ($type, $key, $val, $file, $line);
180   my ($h, @a);
181
182   ($type, $key, $val, $file, $line) = @_;
183
184   return undef unless exists $spec{$type};
185
186 #  print "$type, $key, $val, $file, $line\n";
187
188   if(${$spec{$type}}[1]) {
189     $key = hex $key;
190     $h = sprintf("%x", $key);
191     if(length($h) > ${$spec{$type}}[1]) {
192       print STDERR "invalid $type entry: $file($line): $h \"$val\"\n";
193       return undef
194     }
195     $key = sprintf "%0${$spec{$type}}[1]x", $key
196   }
197   else {
198     $key = "\U$key"
199   }
200
201   if(exists $$type{$key}) {
202     @a = @{$$type{$key}};
203     if($val && $a[1] && $val ne $a[1]) {
204       print STDERR "$type($key) entry: $file,$line: \"$val\" contradicts $a[4],$a[5]: \"$a[1]\"\n";
205       return $key
206     }
207     if($val) { ${$$type{$key}}[1] = $val; }
208   }
209   else {
210     $$type{$key} = [ { }, $val, undef, undef, $file, $line ];
211   }
212
213   return $key;
214 }
215
216
217 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
218 sub add_subentry
219 {
220   my ($type, $entry, $key, $val, $class, $drv, $file, $line);
221   my ($a, @a, $h, $i);
222
223   ($type, $entry, $key, $val, $class, $drv, $file, $line) = @_;
224
225   return undef unless exists $spec{$type};
226
227 #  print "$type, $entry, $key, $val, $class, $drv, $file, $line\n";
228
229   if(${$spec{$type}}[2]) {
230     $key = hex $key;
231     $h = sprintf("%x", $key);
232     if(length($h) > ${$spec{$type}}[2]) {
233       print STDERR "invalid sub$type entry: $file($line): $h \"$val\"\n";
234       return undef
235     }
236     $key = sprintf "%0${$spec{$type}}[2]x", $key
237   }
238
239   if($class) {
240     $class = hex $class;
241     $h = sprintf("%x", $class);
242     $i = ${$spec{'class'}}[1] + ${$spec{'class'}}[2];
243     if(length($h) > $i) {
244       print STDERR "invalid class spec: $file($line): \"$h\"\n";
245       return undef
246     }
247     $class = sprintf "%0${i}x", $class
248   }
249
250   $a = ${$$type{$entry}}[0];
251
252   if(exists ${$a}{$key}) {
253     @a = @{${$a}{$key}};
254
255     if(
256       ($val && $a[1] && $val ne $a[1]) ||
257       ($class && $a[2] && $class ne $a[2]) ||
258       ($drv && $a[3] && $drv ne $a[3])
259     ) {
260       print STDERR "sub$type($key) entry: $file,$line: \"$val\" contradicts $a[4],$a[5]: \"$a[1]\"\n";
261     }
262
263     if($val && !$a[1]) { ${${$a}{$key}}[1] = $val; }
264
265     if($class && !$a[2]) { ${${$a}{$key}}[2] = $class; }
266
267     if($drv && !$a[3]) { ${${$a}{$key}}[3] = $drv; }
268
269   }
270   else {
271     ${$a}{$key} = [ { }, $val, $class, $drv, $file, $line ];
272   }
273
274   return $key;
275 }
276
277
278 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
279 sub add_subsubentry
280 {
281   my ($type, $entry, $subentry, $key, $key2, $val, $class, $drv, $file, $line);
282   my ($a, @a, $h, $i);
283
284   ($type, $entry, $subentry, $key, $key2, $val, $class, $drv, $file, $line) = @_;
285
286   return undef unless exists $spec{$type};
287
288 #  print "$type, $entry, $subentry, $key, $key2, $val, $class, $drv, $file, $line\n";
289
290   if(${$spec{$type}}[3]) {
291     $key = hex $key;
292     $h = sprintf("%x", $key);
293     if(length($h) > ${$spec{$type}}[3]) {
294       print STDERR "invalid subsub$type entry1: $file($line): $h \"$val\"\n";
295       return undef
296     }
297     $key = sprintf "%0${$spec{$type}}[3]x", $key
298   }
299   else {
300     $key = "\U$key"
301   }
302
303   if(${$spec{$type}}[4]) {
304     $key2 = hex $key2;
305     $h = sprintf("%x", $key2);
306     if(length($h) > ${$spec{$type}}[4]) {
307       print STDERR "invalid subsub$type entry2: $file($line): $h \"$val\"\n";
308       return undef
309     }
310     $key2 = sprintf "%0${$spec{$type}}[4]x", $key2
311   }
312   else {
313     $key2 = "\U$key2"
314   }
315
316   $key .= $key2;
317
318   if($class) {
319     $class = hex $class;
320     $h = sprintf("%x", $class);
321     $i = ${$spec{'class'}}[1] + ${$spec{'class'}}[2];
322     if(length($h) > $i) {
323       print STDERR "invalid class spec: $file($line): \"$h\"\n";
324       return undef
325     }
326     $class = sprintf "%0${i}x", $class
327   }
328
329   $a = ${${$$type{$entry}}[0]}{$subentry}[0];
330
331   if(exists ${$a}{$key}) {
332     @a = @{${$a}{$key}};
333
334     if(
335       ($val && $a[1] && $val ne $a[1]) ||
336       ($class && $a[2] && $class ne $a[2]) ||
337       ($drv && $a[3] && $drv ne $a[3])
338     ) {
339       print STDERR "subsub$type($key) entry: $file,$line: \"$val\" contradicts $a[4],$a[5]: \"$a[1]\"\n";
340     }
341
342     if($val && !$a[1]) { ${${$a}{$key}}[1] = $val; }
343
344     if($class && !$a[2]) { ${${$a}{$key}}[2] = $class; }
345
346     if($drv && !$a[3]) { ${${$a}{$key}}[3] = $drv; }
347
348   }
349   else {
350     ${$a}{$key} = [ { }, $val, $class, $drv, $file, $line ];
351   }
352
353   return $key;
354 }
355