projects/linux·blob v6.2-rc1 · refs

1102 lines · 25.3 KiB

1#!/usr/bin/env perl
2# SPDX-License-Identifier: GPL-2.0
3
4BEGIN { $Pod::Usage::Formatter = 'Pod::Text::Termcap'; }
5
6use strict;
7use warnings;
8use utf8;
9use Pod::Usage qw(pod2usage);
10use Getopt::Long;
11use File::Find;
12use IO::Handle;
13use Fcntl ':mode';
14use Cwd 'abs_path';
15use Data::Dumper;
16
17my $help = 0;
18my $hint = 0;
19my $man = 0;
20my $debug = 0;
21my $enable_lineno = 0;
22my $show_warnings = 1;
23my $prefix="Documentation/ABI";
24my $sysfs_prefix="/sys";
25my $search_string;
26
27# Debug options
28my $dbg_what_parsing = 1;
29my $dbg_what_open = 2;
30my $dbg_dump_abi_structs = 4;
31my $dbg_undefined = 8;
32
33$Data::Dumper::Indent = 1;
34$Data::Dumper::Terse = 1;
35
36#
37# If true, assumes that the description is formatted with ReST
38#
39my $description_is_rst = 1;
40
41GetOptions(
42 "debug=i" => \$debug,
43 "enable-lineno" => \$enable_lineno,
44 "rst-source!" => \$description_is_rst,
45 "dir=s" => \$prefix,
46 'help|?' => \$help,
47 "show-hints" => \$hint,
48 "search-string=s" => \$search_string,
49 man => \$man
50) or pod2usage(2);
51
52pod2usage(1) if $help;
53pod2usage(-exitstatus => 0, -noperldoc, -verbose => 2) if $man;
54
55pod2usage(2) if (scalar @ARGV < 1 || @ARGV > 2);
56
57my ($cmd, $arg) = @ARGV;
58
59pod2usage(2) if ($cmd ne "search" && $cmd ne "rest" && $cmd ne "validate" && $cmd ne "undefined");
60pod2usage(2) if ($cmd eq "search" && !$arg);
61
62require Data::Dumper if ($debug & $dbg_dump_abi_structs);
63
64my %data;
65my %symbols;
66
67#
68# Displays an error message, printing file name and line
69#
70sub parse_error($$$$) {
71 my ($file, $ln, $msg, $data) = @_;
72
73 return if (!$show_warnings);
74
75 $data =~ s/\s+$/\n/;
76
77 print STDERR "Warning: file $file#$ln:\n\t$msg";
78
79 if ($data ne "") {
80 print STDERR ". Line\n\t\t$data";
81 } else {
82 print STDERR "\n";
83 }
84}
85
86#
87# Parse an ABI file, storing its contents at %data
88#
89sub parse_abi {
90 my $file = $File::Find::name;
91
92 my $mode = (stat($file))[2];
93 return if ($mode & S_IFDIR);
94 return if ($file =~ m,/README,);
95 return if ($file =~ m,/\.,);
96
97 my $name = $file;
98 $name =~ s,.*/,,;
99
100 my $fn = $file;
101 $fn =~ s,Documentation/ABI/,,;
102
103 my $nametag = "File $fn";
104 $data{$nametag}->{what} = "File $name";
105 $data{$nametag}->{type} = "File";
106 $data{$nametag}->{file} = $name;
107 $data{$nametag}->{filepath} = $file;
108 $data{$nametag}->{is_file} = 1;
109 $data{$nametag}->{line_no} = 1;
110
111 my $type = $file;
112 $type =~ s,.*/(.*)/.*,$1,;
113
114 my $what;
115 my $new_what;
116 my $tag = "";
117 my $ln;
118 my $xrefs;
119 my $space;
120 my @labels;
121 my $label = "";
122
123 print STDERR "Opening $file\n" if ($debug & $dbg_what_open);
124 open IN, $file;
125 while(<IN>) {
126 $ln++;
127 if (m/^(\S+)(:\s*)(.*)/i) {
128 my $new_tag = lc($1);
129 my $sep = $2;
130 my $content = $3;
131
132 if (!($new_tag =~ m/(what|where|date|kernelversion|contact|description|users)/)) {
133 if ($tag eq "description") {
134 # New "tag" is actually part of
135 # description. Don't consider it a tag
136 $new_tag = "";
137 } elsif ($tag ne "") {
138 parse_error($file, $ln, "tag '$tag' is invalid", $_);
139 }
140 }
141
142 # Invalid, but it is a common mistake
143 if ($new_tag eq "where") {
144 parse_error($file, $ln, "tag 'Where' is invalid. Should be 'What:' instead", "");
145 $new_tag = "what";
146 }
147
148 if ($new_tag =~ m/what/) {
149 $space = "";
150 $content =~ s/[,.;]$//;
151
152 push @{$symbols{$content}->{file}}, " $file:" . ($ln - 1);
153
154 if ($tag =~ m/what/) {
155 $what .= "\xac" . $content;
156 } else {
157 if ($what) {
158 parse_error($file, $ln, "What '$what' doesn't have a description", "") if (!$data{$what}->{description});
159
160 foreach my $w(split /\xac/, $what) {
161 $symbols{$w}->{xref} = $what;
162 };
163 }
164
165 $what = $content;
166 $label = $content;
167 $new_what = 1;
168 }
169 push @labels, [($content, $label)];
170 $tag = $new_tag;
171
172 push @{$data{$nametag}->{symbols}}, $content if ($data{$nametag}->{what});
173 next;
174 }
175
176 if ($tag ne "" && $new_tag) {
177 $tag = $new_tag;
178
179 if ($new_what) {
180 @{$data{$what}->{label_list}} = @labels if ($data{$nametag}->{what});
181 @labels = ();
182 $label = "";
183 $new_what = 0;
184
185 $data{$what}->{type} = $type;
186 if (!defined($data{$what}->{file})) {
187 $data{$what}->{file} = $name;
188 $data{$what}->{filepath} = $file;
189 } else {
190 $data{$what}->{description} .= "\n\n" if (defined($data{$what}->{description}));
191 if ($name ne $data{$what}->{file}) {
192 $data{$what}->{file} .= " " . $name;
193 $data{$what}->{filepath} .= " " . $file;
194 }
195 }
196 print STDERR "\twhat: $what\n" if ($debug & $dbg_what_parsing);
197 $data{$what}->{line_no} = $ln;
198 } else {
199 $data{$what}->{line_no} = $ln if (!defined($data{$what}->{line_no}));
200 }
201
202 if (!$what) {
203 parse_error($file, $ln, "'What:' should come first:", $_);
204 next;
205 }
206 if ($new_tag eq "description") {
207 $sep =~ s,:, ,;
208 $content = ' ' x length($new_tag) . $sep . $content;
209 while ($content =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
210 if ($content =~ m/^(\s*)(\S.*)$/) {
211 # Preserve initial spaces for the first line
212 $space = $1;
213 $content = "$2\n";
214 $data{$what}->{$tag} .= $content;
215 } else {
216 undef($space);
217 }
218
219 } else {
220 $data{$what}->{$tag} = $content;
221 }
222 next;
223 }
224 }
225
226 # Store any contents before tags at the database
227 if (!$tag && $data{$nametag}->{what}) {
228 $data{$nametag}->{description} .= $_;
229 next;
230 }
231
232 if ($tag eq "description") {
233 my $content = $_;
234 while ($content =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
235 if (m/^\s*\n/) {
236 $data{$what}->{$tag} .= "\n";
237 next;
238 }
239
240 if (!defined($space)) {
241 # Preserve initial spaces for the first line
242 if ($content =~ m/^(\s*)(\S.*)$/) {
243 $space = $1;
244 $content = "$2\n";
245 }
246 } else {
247 $space = "" if (!($content =~ s/^($space)//));
248 }
249 $data{$what}->{$tag} .= $content;
250
251 next;
252 }
253 if (m/^\s*(.*)/) {
254 $data{$what}->{$tag} .= "\n$1";
255 $data{$what}->{$tag} =~ s/\n+$//;
256 next;
257 }
258
259 # Everything else is error
260 parse_error($file, $ln, "Unexpected content", $_);
261 }
262 $data{$nametag}->{description} =~ s/^\n+// if ($data{$nametag}->{description});
263 if ($what) {
264 parse_error($file, $ln, "What '$what' doesn't have a description", "") if (!$data{$what}->{description});
265
266 foreach my $w(split /\xac/,$what) {
267 $symbols{$w}->{xref} = $what;
268 };
269 }
270 close IN;
271}
272
273sub create_labels {
274 my %labels;
275
276 foreach my $what (keys %data) {
277 next if ($data{$what}->{file} eq "File");
278
279 foreach my $p (@{$data{$what}->{label_list}}) {
280 my ($content, $label) = @{$p};
281 $label = "abi_" . $label . " ";
282 $label =~ tr/A-Z/a-z/;
283
284 # Convert special chars to "_"
285 $label =~s/([\x00-\x2f\x3a-\x40\x5b-\x60\x7b-\xff])/_/g;
286 $label =~ s,_+,_,g;
287 $label =~ s,_$,,;
288
289 # Avoid duplicated labels
290 while (defined($labels{$label})) {
291 my @chars = ("A".."Z", "a".."z");
292 $label .= $chars[rand @chars];
293 }
294 $labels{$label} = 1;
295
296 $data{$what}->{label} = $label;
297
298 # only one label is enough
299 last;
300 }
301 }
302}
303
304#
305# Outputs the book on ReST format
306#
307
308# \b doesn't work well with paths. So, we need to define something else:
309# Boundaries are punct characters, spaces and end-of-line
310my $start = qr {(^|\s|\() }x;
311my $bondary = qr { ([,.:;\)\s]|\z) }x;
312my $xref_match = qr { $start(\/(sys|config|proc|dev|kvd)\/[^,.:;\)\s]+)$bondary }x;
313my $symbols = qr { ([\x01-\x08\x0e-\x1f\x21-\x2f\x3a-\x40\x7b-\xff]) }x;
314
315sub output_rest {
316 create_labels();
317
318 my $part = "";
319
320 foreach my $what (sort {
321 ($data{$a}->{type} eq "File") cmp ($data{$b}->{type} eq "File") ||
322 $a cmp $b
323 } keys %data) {
324 my $type = $data{$what}->{type};
325
326 my @file = split / /, $data{$what}->{file};
327 my @filepath = split / /, $data{$what}->{filepath};
328
329 if ($enable_lineno) {
330 printf ".. LINENO %s%s#%s\n\n",
331 $prefix, $file[0],
332 $data{$what}->{line_no};
333 }
334
335 my $w = $what;
336
337 if ($type ne "File") {
338 my $cur_part = $what;
339 if ($what =~ '/') {
340 if ($what =~ m#^(\/?(?:[\w\-]+\/?){1,2})#) {
341 $cur_part = "Symbols under $1";
342 $cur_part =~ s,/$,,;
343 }
344 }
345
346 if ($cur_part ne "" && $part ne $cur_part) {
347 $part = $cur_part;
348 my $bar = $part;
349 $bar =~ s/./-/g;
350 print "$part\n$bar\n\n";
351 }
352
353 printf ".. _%s:\n\n", $data{$what}->{label};
354
355 my @names = split /\xac/,$w;
356 my $len = 0;
357
358 foreach my $name (@names) {
359 $name =~ s/$symbols/\\$1/g;
360 $name = "**$name**";
361 $len = length($name) if (length($name) > $len);
362 }
363
364 print "+-" . "-" x $len . "-+\n";
365 foreach my $name (@names) {
366 printf "| %s", $name . " " x ($len - length($name)) . " |\n";
367 print "+-" . "-" x $len . "-+\n";
368 }
369
370 print "\n";
371 }
372
373 for (my $i = 0; $i < scalar(@filepath); $i++) {
374 my $path = $filepath[$i];
375 my $f = $file[$i];
376
377 $path =~ s,.*/(.*/.*),$1,;;
378 $path =~ s,[/\-],_,g;;
379 my $fileref = "abi_file_".$path;
380
381 if ($type eq "File") {
382 print ".. _$fileref:\n\n";
383 } else {
384 print "Defined on file :ref:`$f <$fileref>`\n\n";
385 }
386 }
387
388 if ($type eq "File") {
389 my $bar = $w;
390 $bar =~ s/./-/g;
391 print "$w\n$bar\n\n";
392 }
393
394 my $desc = "";
395 $desc = $data{$what}->{description} if (defined($data{$what}->{description}));
396 $desc =~ s/\s+$/\n/;
397
398 if (!($desc =~ /^\s*$/)) {
399 if ($description_is_rst) {
400 # Remove title markups from the description
401 # Having titles inside ABI files will only work if extra
402 # care would be taken in order to strictly follow the same
403 # level order for each markup.
404 $desc =~ s/\n[\-\*\=\^\~]+\n/\n\n/g;
405
406 # Enrich text by creating cross-references
407
408 my $new_desc = "";
409 my $init_indent = -1;
410 my $literal_indent = -1;
411
412 open(my $fh, "+<", \$desc);
413 while (my $d = <$fh>) {
414 my $indent = $d =~ m/^(\s+)/;
415 my $spaces = length($indent);
416 $init_indent = $indent if ($init_indent < 0);
417 if ($literal_indent >= 0) {
418 if ($spaces > $literal_indent) {
419 $new_desc .= $d;
420 next;
421 } else {
422 $literal_indent = -1;
423 }
424 } else {
425 if ($d =~ /()::$/ && !($d =~ /^\s*\.\./)) {
426 $literal_indent = $spaces;
427 }
428 }
429
430 $d =~ s,Documentation/(?!devicetree)(\S+)\.rst,:doc:`/$1`,g;
431
432 my @matches = $d =~ m,Documentation/ABI/([\w\/\-]+),g;
433 foreach my $f (@matches) {
434 my $xref = $f;
435 my $path = $f;
436 $path =~ s,.*/(.*/.*),$1,;;
437 $path =~ s,[/\-],_,g;;
438 $xref .= " <abi_file_" . $path . ">";
439 $d =~ s,\bDocumentation/ABI/$f\b,:ref:`$xref`,g;
440 }
441
442 # Seek for cross reference symbols like /sys/...
443 @matches = $d =~ m/$xref_match/g;
444
445 foreach my $s (@matches) {
446 next if (!($s =~ m,/,));
447 if (defined($data{$s}) && defined($data{$s}->{label})) {
448 my $xref = $s;
449
450 $xref =~ s/$symbols/\\$1/g;
451 $xref = ":ref:`$xref <" . $data{$s}->{label} . ">`";
452
453 $d =~ s,$start$s$bondary,$1$xref$2,g;
454 }
455 }
456 $new_desc .= $d;
457 }
458 close $fh;
459
460
461 print "$new_desc\n\n";
462 } else {
463 $desc =~ s/^\s+//;
464
465 # Remove title markups from the description, as they won't work
466 $desc =~ s/\n[\-\*\=\^\~]+\n/\n\n/g;
467
468 if ($desc =~ m/\:\n/ || $desc =~ m/\n[\t ]+/ || $desc =~ m/[\x00-\x08\x0b-\x1f\x7b-\xff]/) {
469 # put everything inside a code block
470 $desc =~ s/\n/\n /g;
471
472 print "::\n\n";
473 print " $desc\n\n";
474 } else {
475 # Escape any special chars from description
476 $desc =~s/([\x00-\x08\x0b-\x1f\x21-\x2a\x2d\x2f\x3c-\x40\x5c\x5e-\x60\x7b-\xff])/\\$1/g;
477 print "$desc\n\n";
478 }
479 }
480 } else {
481 print "DESCRIPTION MISSING for $what\n\n" if (!$data{$what}->{is_file});
482 }
483
484 if ($data{$what}->{symbols}) {
485 printf "Has the following ABI:\n\n";
486
487 foreach my $content(@{$data{$what}->{symbols}}) {
488 my $label = $data{$symbols{$content}->{xref}}->{label};
489
490 # Escape special chars from content
491 $content =~s/([\x00-\x1f\x21-\x2f\x3a-\x40\x7b-\xff])/\\$1/g;
492
493 print "- :ref:`$content <$label>`\n\n";
494 }
495 }
496
497 if (defined($data{$what}->{users})) {
498 my $users = $data{$what}->{users};
499
500 $users =~ s/\n/\n\t/g;
501 printf "Users:\n\t%s\n\n", $users if ($users ne "");
502 }
503
504 }
505}
506
507#
508# Searches for ABI symbols
509#
510sub search_symbols {
511 foreach my $what (sort keys %data) {
512 next if (!($what =~ m/($arg)/));
513
514 my $type = $data{$what}->{type};
515 next if ($type eq "File");
516
517 my $file = $data{$what}->{filepath};
518
519 $what =~ s/\xac/, /g;
520 my $bar = $what;
521 $bar =~ s/./-/g;
522
523 print "\n$what\n$bar\n\n";
524
525 my $kernelversion = $data{$what}->{kernelversion} if (defined($data{$what}->{kernelversion}));
526 my $contact = $data{$what}->{contact} if (defined($data{$what}->{contact}));
527 my $users = $data{$what}->{users} if (defined($data{$what}->{users}));
528 my $date = $data{$what}->{date} if (defined($data{$what}->{date}));
529 my $desc = $data{$what}->{description} if (defined($data{$what}->{description}));
530
531 $kernelversion =~ s/^\s+// if ($kernelversion);
532 $contact =~ s/^\s+// if ($contact);
533 if ($users) {
534 $users =~ s/^\s+//;
535 $users =~ s/\n//g;
536 }
537 $date =~ s/^\s+// if ($date);
538 $desc =~ s/^\s+// if ($desc);
539
540 printf "Kernel version:\t\t%s\n", $kernelversion if ($kernelversion);
541 printf "Date:\t\t\t%s\n", $date if ($date);
542 printf "Contact:\t\t%s\n", $contact if ($contact);
543 printf "Users:\t\t\t%s\n", $users if ($users);
544 print "Defined on file(s):\t$file\n\n";
545 print "Description:\n\n$desc";
546 }
547}
548
549# Exclude /sys/kernel/debug and /sys/kernel/tracing from the search path
550sub dont_parse_special_attributes {
551 if (($File::Find::dir =~ m,^/sys/kernel,)) {
552 return grep {!/(debug|tracing)/ } @_;
553 }
554
555 if (($File::Find::dir =~ m,^/sys/fs,)) {
556 return grep {!/(pstore|bpf|fuse)/ } @_;
557 }
558
559 return @_
560}
561
562my %leaf;
563my %aliases;
564my @files;
565my %root;
566
567sub graph_add_file {
568 my $file = shift;
569 my $type = shift;
570
571 my $dir = $file;
572 $dir =~ s,^(.*/).*,$1,;
573 $file =~ s,.*/,,;
574
575 my $name;
576 my $file_ref = \%root;
577 foreach my $edge(split "/", $dir) {
578 $name .= "$edge/";
579 if (!defined ${$file_ref}{$edge}) {
580 ${$file_ref}{$edge} = { };
581 }
582 $file_ref = \%{$$file_ref{$edge}};
583 ${$file_ref}{"__name"} = [ $name ];
584 }
585 $name .= "$file";
586 ${$file_ref}{$file} = {
587 "__name" => [ $name ]
588 };
589
590 return \%{$$file_ref{$file}};
591}
592
593sub graph_add_link {
594 my $file = shift;
595 my $link = shift;
596
597 # Traverse graph to find the reference
598 my $file_ref = \%root;
599 foreach my $edge(split "/", $file) {
600 $file_ref = \%{$$file_ref{$edge}} || die "Missing node!";
601 }
602
603 # do a BFS
604
605 my @queue;
606 my %seen;
607 my $st;
608
609 push @queue, $file_ref;
610 $seen{$start}++;
611
612 while (@queue) {
613 my $v = shift @queue;
614 my @child = keys(%{$v});
615
616 foreach my $c(@child) {
617 next if $seen{$$v{$c}};
618 next if ($c eq "__name");
619
620 if (!defined($$v{$c}{"__name"})) {
621 printf STDERR "Error: Couldn't find a non-empty name on a children of $file/.*: ";
622 print STDERR Dumper(%{$v});
623 exit;
624 }
625
626 # Add new name
627 my $name = @{$$v{$c}{"__name"}}[0];
628 if ($name =~ s#^$file/#$link/#) {
629 push @{$$v{$c}{"__name"}}, $name;
630 }
631 # Add child to the queue and mark as seen
632 push @queue, $$v{$c};
633 $seen{$c}++;
634 }
635 }
636}
637
638my $escape_symbols = qr { ([\x01-\x08\x0e-\x1f\x21-\x29\x2b-\x2d\x3a-\x40\x7b-\xfe]) }x;
639sub parse_existing_sysfs {
640 my $file = $File::Find::name;
641
642 my $mode = (lstat($file))[2];
643 my $abs_file = abs_path($file);
644
645 my @tmp;
646 push @tmp, $file;
647 push @tmp, $abs_file if ($abs_file ne $file);
648
649 foreach my $f(@tmp) {
650 # Ignore cgroup, as this is big and has zero docs under ABI
651 return if ($f =~ m#^/sys/fs/cgroup/#);
652
653 # Ignore firmware as it is documented elsewhere
654 # Either ACPI or under Documentation/devicetree/bindings/
655 return if ($f =~ m#^/sys/firmware/#);
656
657 # Ignore some sysfs nodes that aren't actually part of ABI
658 return if ($f =~ m#/sections|notes/#);
659
660 # Would need to check at
661 # Documentation/admin-guide/kernel-parameters.txt, but this
662 # is not easily parseable.
663 return if ($f =~ m#/parameters/#);
664 }
665
666 if (S_ISLNK($mode)) {
667 $aliases{$file} = $abs_file;
668 return;
669 }
670
671 return if (S_ISDIR($mode));
672
673 # Trivial: file is defined exactly the same way at ABI What:
674 return if (defined($data{$file}));
675 return if (defined($data{$abs_file}));
676
677 push @files, graph_add_file($abs_file, "file");
678}
679
680sub get_leave($)
681{
682 my $what = shift;
683 my $leave;
684
685 my $l = $what;
686 my $stop = 1;
687
688 $leave = $l;
689 $leave =~ s,/$,,;
690 $leave =~ s,.*/,,;
691 $leave =~ s/[\(\)]//g;
692
693 # $leave is used to improve search performance at
694 # check_undefined_symbols, as the algorithm there can seek
695 # for a small number of "what". It also allows giving a
696 # hint about a leave with the same name somewhere else.
697 # However, there are a few occurences where the leave is
698 # either a wildcard or a number. Just group such cases
699 # altogether.
700 if ($leave =~ m/\.\*/ || $leave eq "" || $leave =~ /\\d/) {
701 $leave = "others";
702 }
703
704 return $leave;
705}
706
707my @not_found;
708
709sub check_file($$)
710{
711 my $file_ref = shift;
712 my $names_ref = shift;
713 my @names = @{$names_ref};
714 my $file = $names[0];
715
716 my $found_string;
717
718 my $leave = get_leave($file);
719 if (!defined($leaf{$leave})) {
720 $leave = "others";
721 }
722 my @expr = @{$leaf{$leave}->{expr}};
723 die ("\rmissing rules for $leave") if (!defined($leaf{$leave}));
724
725 my $path = $file;
726 $path =~ s,(.*/).*,$1,;
727
728 if ($search_string) {
729 return if (!($file =~ m#$search_string#));
730 $found_string = 1;
731 }
732
733 for (my $i = 0; $i < @names; $i++) {
734 if ($found_string && $hint) {
735 if (!$i) {
736 print STDERR "--> $names[$i]\n";
737 } else {
738 print STDERR " $names[$i]\n";
739 }
740 }
741 foreach my $re (@expr) {
742 print STDERR "$names[$i] =~ /^$re\$/\n" if ($debug && $dbg_undefined);
743 if ($names[$i] =~ $re) {
744 return;
745 }
746 }
747 }
748
749 if ($leave ne "others") {
750 my @expr = @{$leaf{"others"}->{expr}};
751 for (my $i = 0; $i < @names; $i++) {
752 foreach my $re (@expr) {
753 print STDERR "$names[$i] =~ /^$re\$/\n" if ($debug && $dbg_undefined);
754 if ($names[$i] =~ $re) {
755 return;
756 }
757 }
758 }
759 }
760
761 push @not_found, $file if (!$search_string || $found_string);
762
763 if ($hint && (!$search_string || $found_string)) {
764 my $what = $leaf{$leave}->{what};
765 $what =~ s/\xac/\n\t/g;
766 if ($leave ne "others") {
767 print STDERR "\r more likely regexes:\n\t$what\n";
768 } else {
769 print STDERR "\r tested regexes:\n\t$what\n";
770 }
771 }
772}
773
774sub check_undefined_symbols {
775 my $num_files = scalar @files;
776 my $next_i = 0;
777 my $start_time = times;
778
779 @files = sort @files;
780
781 my $last_time = $start_time;
782
783 # When either debug or hint is enabled, there's no sense showing
784 # progress, as the progress will be overriden.
785 if ($hint || ($debug && $dbg_undefined)) {
786 $next_i = $num_files;
787 }
788
789 my $is_console;
790 $is_console = 1 if (-t STDERR);
791
792 for (my $i = 0; $i < $num_files; $i++) {
793 my $file_ref = $files[$i];
794 my @names = @{$$file_ref{"__name"}};
795
796 check_file($file_ref, \@names);
797
798 my $cur_time = times;
799
800 if ($i == $next_i || $cur_time > $last_time + 1) {
801 my $percent = $i * 100 / $num_files;
802
803 my $tm = $cur_time - $start_time;
804 my $time = sprintf "%d:%02d", int($tm), 60 * ($tm - int($tm));
805
806 printf STDERR "\33[2K\r", if ($is_console);
807 printf STDERR "%s: processing sysfs files... %i%%: $names[0]", $time, $percent;
808 printf STDERR "\n", if (!$is_console);
809 STDERR->flush();
810
811 $next_i = int (($percent + 1) * $num_files / 100);
812 $last_time = $cur_time;
813 }
814 }
815
816 my $cur_time = times;
817 my $tm = $cur_time - $start_time;
818 my $time = sprintf "%d:%02d", int($tm), 60 * ($tm - int($tm));
819
820 printf STDERR "\33[2K\r", if ($is_console);
821 printf STDERR "%s: processing sysfs files... done\n", $time;
822
823 foreach my $file (@not_found) {
824 print "$file not found.\n";
825 }
826}
827
828sub undefined_symbols {
829 print STDERR "Reading $sysfs_prefix directory contents...";
830 find({
831 wanted =>\&parse_existing_sysfs,
832 preprocess =>\&dont_parse_special_attributes,
833 no_chdir => 1
834 }, $sysfs_prefix);
835 print STDERR "done.\n";
836
837 $leaf{"others"}->{what} = "";
838
839 print STDERR "Converting ABI What fields into regexes...";
840 foreach my $w (sort keys %data) {
841 foreach my $what (split /\xac/,$w) {
842 next if (!($what =~ m/^$sysfs_prefix/));
843
844 # Convert what into regular expressions
845
846 # Escape dot characters
847 $what =~ s/\./\xf6/g;
848
849 # Temporarily change [0-9]+ type of patterns
850 $what =~ s/\[0\-9\]\+/\xff/g;
851
852 # Temporarily change [\d+-\d+] type of patterns
853 $what =~ s/\[0\-\d+\]/\xff/g;
854 $what =~ s/\[(\d+)\]/\xf4$1\xf5/g;
855
856 # Temporarily change [0-9] type of patterns
857 $what =~ s/\[(\d)\-(\d)\]/\xf4$1-$2\xf5/g;
858
859 # Handle multiple option patterns
860 $what =~ s/[\{\<\[]([\w_]+)(?:[,|]+([\w_]+)){1,}[\}\>\]]/($1|$2)/g;
861
862 # Handle wildcards
863 $what =~ s,\*,.*,g;
864 $what =~ s,/\xf6..,/.*,g;
865 $what =~ s/\<[^\>]+\>/.*/g;
866 $what =~ s/\{[^\}]+\}/.*/g;
867 $what =~ s/\[[^\]]+\]/.*/g;
868
869 $what =~ s/[XYZ]/.*/g;
870
871 # Recover [0-9] type of patterns
872 $what =~ s/\xf4/[/g;
873 $what =~ s/\xf5/]/g;
874
875 # Remove duplicated spaces
876 $what =~ s/\s+/ /g;
877
878 # Special case: this ABI has a parenthesis on it
879 $what =~ s/sqrt\(x^2\+y^2\+z^2\)/sqrt\(x^2\+y^2\+z^2\)/;
880
881 # Special case: drop comparition as in:
882 # What: foo = <something>
883 # (this happens on a few IIO definitions)
884 $what =~ s,\s*\=.*$,,;
885
886 # Escape all other symbols
887 $what =~ s/$escape_symbols/\\$1/g;
888 $what =~ s/\\\\/\\/g;
889 $what =~ s/\\([\[\]\(\)\|])/$1/g;
890 $what =~ s/(\d+)\\(-\d+)/$1$2/g;
891
892 $what =~ s/\xff/\\d+/g;
893
894 # Special case: IIO ABI which a parenthesis.
895 $what =~ s/sqrt(.*)/sqrt\(.*\)/;
896
897 # Simplify regexes with multiple .*
898 $what =~ s#(?:\.\*){2,}##g;
899# $what =~ s#\.\*/\.\*#.*#g;
900
901 # Recover dot characters
902 $what =~ s/\xf6/\./g;
903
904 my $leave = get_leave($what);
905
906 my $added = 0;
907 foreach my $l (split /\|/, $leave) {
908 if (defined($leaf{$l})) {
909 next if ($leaf{$l}->{what} =~ m/\b$what\b/);
910 $leaf{$l}->{what} .= "\xac" . $what;
911 $added = 1;
912 } else {
913 $leaf{$l}->{what} = $what;
914 $added = 1;
915 }
916 }
917 if ($search_string && $added) {
918 print STDERR "What: $what\n" if ($what =~ m#$search_string#);
919 }
920
921 }
922 }
923 # Compile regexes
924 foreach my $l (sort keys %leaf) {
925 my @expr;
926 foreach my $w(sort split /\xac/, $leaf{$l}->{what}) {
927 push @expr, qr /^$w$/;
928 }
929 $leaf{$l}->{expr} = \@expr;
930 }
931
932 # Take links into account
933 foreach my $link (sort keys %aliases) {
934 my $abs_file = $aliases{$link};
935 graph_add_link($abs_file, $link);
936 }
937 print STDERR "done.\n";
938
939 check_undefined_symbols;
940}
941
942# Ensure that the prefix will always end with a slash
943# While this is not needed for find, it makes the patch nicer
944# with --enable-lineno
945$prefix =~ s,/?$,/,;
946
947if ($cmd eq "undefined" || $cmd eq "search") {
948 $show_warnings = 0;
949}
950#
951# Parses all ABI files located at $prefix dir
952#
953find({wanted =>\&parse_abi, no_chdir => 1}, $prefix);
954
955print STDERR Data::Dumper->Dump([\%data], [qw(*data)]) if ($debug & $dbg_dump_abi_structs);
956
957#
958# Handles the command
959#
960if ($cmd eq "undefined") {
961 undefined_symbols;
962} elsif ($cmd eq "search") {
963 search_symbols;
964} else {
965 if ($cmd eq "rest") {
966 output_rest;
967 }
968
969 # Warn about duplicated ABI entries
970 foreach my $what(sort keys %symbols) {
971 my @files = @{$symbols{$what}->{file}};
972
973 next if (scalar(@files) == 1);
974
975 printf STDERR "Warning: $what is defined %d times: @files\n",
976 scalar(@files);
977 }
978}
979
980__END__
981
982=head1 NAME
983
984get_abi.pl - parse the Linux ABI files and produce a ReST book.
985
986=head1 SYNOPSIS
987
988B<get_abi.pl> [--debug <level>] [--enable-lineno] [--man] [--help]
989 [--(no-)rst-source] [--dir=<dir>] [--show-hints]
990 [--search-string <regex>]
991 <COMMAND> [<ARGUMENT>]
992
993Where B<COMMAND> can be:
994
995=over 8
996
997B<search> I<SEARCH_REGEX> - search for I<SEARCH_REGEX> inside ABI
998
999B<rest> - output the ABI in ReST markup language
1000
1001B<validate> - validate the ABI contents
1002
1003B<undefined> - existing symbols at the system that aren't
1004 defined at Documentation/ABI
1005
1006=back
1007
1008=head1 OPTIONS
1009
1010=over 8
1011
1012=item B<--dir>
1013
1014Changes the location of the ABI search. By default, it uses
1015the Documentation/ABI directory.
1016
1017=item B<--rst-source> and B<--no-rst-source>
1018
1019The input file may be using ReST syntax or not. Those two options allow
1020selecting between a rst-compliant source ABI (B<--rst-source>), or a
1021plain text that may be violating ReST spec, so it requres some escaping
1022logic (B<--no-rst-source>).
1023
1024=item B<--enable-lineno>
1025
1026Enable output of .. LINENO lines.
1027
1028=item B<--debug> I<debug level>
1029
1030Print debug information according with the level, which is given by the
1031following bitmask:
1032
1033 - 1: Debug parsing What entries from ABI files;
1034 - 2: Shows what files are opened from ABI files;
1035 - 4: Dump the structs used to store the contents of the ABI files.
1036
1037=item B<--show-hints>
1038
1039Show hints about possible definitions for the missing ABI symbols.
1040Used only when B<undefined>.
1041
1042=item B<--search-string> I<regex string>
1043
1044Show only occurences that match a search string.
1045Used only when B<undefined>.
1046
1047=item B<--help>
1048
1049Prints a brief help message and exits.
1050
1051=item B<--man>
1052
1053Prints the manual page and exits.
1054
1055=back
1056
1057=head1 DESCRIPTION
1058
1059Parse the Linux ABI files from ABI DIR (usually located at Documentation/ABI),
1060allowing to search for ABI symbols or to produce a ReST book containing
1061the Linux ABI documentation.
1062
1063=head1 EXAMPLES
1064
1065Search for all stable symbols with the word "usb":
1066
1067=over 8
1068
1069$ scripts/get_abi.pl search usb --dir Documentation/ABI/stable
1070
1071=back
1072
1073Search for all symbols that match the regex expression "usb.*cap":
1074
1075=over 8
1076
1077$ scripts/get_abi.pl search usb.*cap
1078
1079=back
1080
1081Output all obsoleted symbols in ReST format
1082
1083=over 8
1084
1085$ scripts/get_abi.pl rest --dir Documentation/ABI/obsolete
1086
1087=back
1088
1089=head1 BUGS
1090
1091Report bugs to Mauro Carvalho Chehab <mchehab+huawei@kernel.org>
1092
1093=head1 COPYRIGHT
1094
1095Copyright (c) 2016-2021 by Mauro Carvalho Chehab <mchehab+huawei@kernel.org>.
1096
1097License GPLv2: GNU GPL version 2 <http://gnu.org/licenses/gpl.html>.
1098
1099This is free software: you are free to change and redistribute it.
1100There is NO WARRANTY, to the extent permitted by law.
1101
1102=cut