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