1#!/usr/bin/perl
2# SPDX-License-Identifier: GPL-2.0
3
4use strict;
5use Pod::Usage;
6use Getopt::Long;
7use File::Find;
8use Fcntl ':mode';
9
10my $help;
11my $man;
12my $debug;
13my $prefix="Documentation/ABI";
14
15GetOptions(
16	"debug|d+" => \$debug,
17	"dir=s" => \$prefix,
18	'help|?' => \$help,
19	man => \$man
20) or pod2usage(2);
21
22pod2usage(1) if $help;
23pod2usage(-exitstatus => 0, -verbose => 2) if $man;
24
25pod2usage(2) if (scalar @ARGV < 1 || @ARGV > 2);
26
27my ($cmd, $arg) = @ARGV;
28
29pod2usage(2) if ($cmd ne "search" && $cmd ne "rest" && $cmd ne "validate");
30pod2usage(2) if ($cmd eq "search" && !$arg);
31
32require Data::Dumper if ($debug);
33
34my %data;
35
36#
37# Displays an error message, printing file name and line
38#
39sub parse_error($$$$) {
40	my ($file, $ln, $msg, $data) = @_;
41
42	print STDERR "file $file#$ln: $msg at\n\t$data";
43}
44
45#
46# Parse an ABI file, storing its contents at %data
47#
48sub parse_abi {
49	my $file = $File::Find::name;
50
51	my $mode = (stat($file))[2];
52	return if ($mode & S_IFDIR);
53	return if ($file =~ m,/README,);
54
55	my $name = $file;
56	$name =~ s,.*/,,;
57
58	my $nametag = "File $name";
59	$data{$nametag}->{what} = "File $name";
60	$data{$nametag}->{type} = "File";
61	$data{$nametag}->{file} = $name;
62	$data{$nametag}->{filepath} = $file;
63	$data{$nametag}->{is_file} = 1;
64
65	my $type = $file;
66	$type =~ s,.*/(.*)/.*,$1,;
67
68	my $what;
69	my $new_what;
70	my $tag;
71	my $ln;
72	my $xrefs;
73	my $space;
74	my @labels;
75	my $label;
76
77	print STDERR "Opening $file\n" if ($debug > 1);
78	open IN, $file;
79	while(<IN>) {
80		$ln++;
81		if (m/^(\S+)(:\s*)(.*)/i) {
82			my $new_tag = lc($1);
83			my $sep = $2;
84			my $content = $3;
85
86			if (!($new_tag =~ m/(what|where|date|kernelversion|contact|description|users)/)) {
87				if ($tag eq "description") {
88					# New "tag" is actually part of
89					# description. Don't consider it a tag
90					$new_tag = "";
91				} elsif ($tag ne "") {
92					parse_error($file, $ln, "tag '$tag' is invalid", $_);
93				}
94			}
95
96			# Invalid, but it is a common mistake
97			if ($new_tag eq "where") {
98				parse_error($file, $ln, "tag 'Where' is invalid. Should be 'What:' instead", $_);
99				$new_tag = "what";
100			}
101
102			if ($new_tag =~ m/what/) {
103				$space = "";
104				if ($tag =~ m/what/) {
105					$what .= ", " . $content;
106				} else {
107					parse_error($file, $ln, "What '$what' doesn't have a description", "") if ($what && !$data{$what}->{description});
108
109					$what = $content;
110					$label = $content;
111					$new_what = 1;
112				}
113				push @labels, [($content, $label)];
114				$tag = $new_tag;
115
116				push @{$data{$nametag}->{xrefs}}, [($content, $label)] if ($data{$nametag}->{what});
117				next;
118			}
119
120			if ($tag ne "" && $new_tag) {
121				$tag = $new_tag;
122
123				if ($new_what) {
124					@{$data{$what}->{label}} = @labels if ($data{$nametag}->{what});
125					@labels = ();
126					$label = "";
127					$new_what = 0;
128
129					$data{$what}->{type} = $type;
130					$data{$what}->{file} = $name;
131					$data{$what}->{filepath} = $file;
132					print STDERR "\twhat: $what\n" if ($debug > 1);
133				}
134
135				if (!$what) {
136					parse_error($file, $ln, "'What:' should come first:", $_);
137					next;
138				}
139				if ($tag eq "description") {
140					next if ($content =~ m/^\s*$/);
141					if ($content =~ m/^(\s*)(.*)/) {
142						my $new_content = $2;
143						$space = $new_tag . $sep . $1;
144						while ($space =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
145						$space =~ s/./ /g;
146						$data{$what}->{$tag} .= "$new_content\n";
147					}
148				} else {
149					$data{$what}->{$tag} = $content;
150				}
151				next;
152			}
153		}
154
155		# Store any contents before tags at the database
156		if (!$tag && $data{$nametag}->{what}) {
157			$data{$nametag}->{description} .= $_;
158			next;
159		}
160
161		if ($tag eq "description") {
162			if (!$data{$what}->{description}) {
163				next if (m/^\s*\n/);
164				if (m/^(\s*)(.*)/) {
165					$space = $1;
166					while ($space =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
167					$data{$what}->{$tag} .= "$2\n";
168				}
169			} else {
170				my $content = $_;
171				if (m/^\s*\n/) {
172					$data{$what}->{$tag} .= $content;
173					next;
174				}
175
176				while ($content =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e) {}
177				$space = "" if (!($content =~ s/^($space)//));
178
179				# Compress spaces with tabs
180				$content =~ s<^ {8}> <\t>;
181				$content =~ s<^ {1,7}\t> <\t>;
182				$content =~ s< {1,7}\t> <\t>;
183				$data{$what}->{$tag} .= $content;
184			}
185			next;
186		}
187		if (m/^\s*(.*)/) {
188			$data{$what}->{$tag} .= "\n$1";
189			$data{$what}->{$tag} =~ s/\n+$//;
190			next;
191		}
192
193		# Everything else is error
194		parse_error($file, $ln, "Unexpected line:", $_);
195	}
196	$data{$nametag}->{description} =~ s/^\n+//;
197	close IN;
198}
199
200#
201# Outputs the book on ReST format
202#
203
204my %labels;
205
206sub output_rest {
207	foreach my $what (sort {
208				($data{$a}->{type} eq "File") cmp ($data{$b}->{type} eq "File") ||
209				$a cmp $b
210			       } keys %data) {
211		my $type = $data{$what}->{type};
212		my $file = $data{$what}->{file};
213		my $filepath = $data{$what}->{filepath};
214
215		my $w = $what;
216		$w =~ s/([\(\)\_\-\*\=\^\~\\])/\\$1/g;
217
218
219		foreach my $p (@{$data{$what}->{label}}) {
220			my ($content, $label) = @{$p};
221			$label = "abi_" . $label . " ";
222			$label =~ tr/A-Z/a-z/;
223
224			# Convert special chars to "_"
225			$label =~s/([\x00-\x2f\x3a-\x40\x5b-\x60\x7b-\xff])/_/g;
226			$label =~ s,_+,_,g;
227			$label =~ s,_$,,;
228
229			# Avoid duplicated labels
230			while (defined($labels{$label})) {
231			    my @chars = ("A".."Z", "a".."z");
232			    $label .= $chars[rand @chars];
233			}
234			$labels{$label} = 1;
235
236			$data{$what}->{label} .= $label;
237
238			printf ".. _%s:\n\n", $label;
239
240			# only one label is enough
241			last;
242		}
243
244
245		$filepath =~ s,.*/(.*/.*),\1,;;
246		$filepath =~ s,[/\-],_,g;;
247		my $fileref = "abi_file_".$filepath;
248
249		if ($type eq "File") {
250			my $bar = $w;
251			$bar =~ s/./-/g;
252
253			print ".. _$fileref:\n\n";
254			print "$w\n$bar\n\n";
255		} else {
256			my @names = split /\s*,\s*/,$w;
257
258			my $len = 0;
259
260			foreach my $name (@names) {
261				$len = length($name) if (length($name) > $len);
262			}
263
264			print "What:\n\n";
265
266			print "+-" . "-" x $len . "-+\n";
267			foreach my $name (@names) {
268				printf "| %s", $name . " " x ($len - length($name)) . " |\n";
269				print "+-" . "-" x $len . "-+\n";
270			}
271			print "\n";
272		}
273
274		print "Defined on file :ref:`$file <$fileref>`\n\n" if ($type ne "File");
275
276		my $desc = $data{$what}->{description};
277		$desc =~ s/^\s+//;
278
279		# Remove title markups from the description, as they won't work
280		$desc =~ s/\n[\-\*\=\^\~]+\n/\n/g;
281
282		if (!($desc =~ /^\s*$/)) {
283			if ($desc =~ m/\:\n/ || $desc =~ m/\n[\t ]+/  || $desc =~ m/[\x00-\x08\x0b-\x1f\x7b-\xff]/) {
284				# put everything inside a code block
285				$desc =~ s/\n/\n /g;
286
287				print "::\n\n";
288				print " $desc\n\n";
289			} else {
290				# Escape any special chars from description
291				$desc =~s/([\x00-\x08\x0b-\x1f\x21-\x2a\x2d\x2f\x3c-\x40\x5c\x5e-\x60\x7b-\xff])/\\$1/g;
292
293				print "$desc\n\n";
294			}
295		} else {
296			print "DESCRIPTION MISSING for $what\n\n" if (!$data{$what}->{is_file});
297		}
298
299		if ($data{$what}->{xrefs}) {
300			printf "Has the following ABI:\n\n";
301
302			foreach my $p(@{$data{$what}->{xrefs}}) {
303				my ($content, $label) = @{$p};
304				$label = "abi_" . $label . " ";
305				$label =~ tr/A-Z/a-z/;
306
307				# Convert special chars to "_"
308				$label =~s/([\x00-\x2f\x3a-\x40\x5b-\x60\x7b-\xff])/_/g;
309				$label =~ s,_+,_,g;
310				$label =~ s,_$,,;
311
312				# Escape special chars from content
313				$content =~s/([\x00-\x1f\x21-\x2f\x3a-\x40\x7b-\xff])/\\$1/g;
314
315				print "- :ref:`$content <$label>`\n\n";
316			}
317		}
318	}
319}
320
321#
322# Searches for ABI symbols
323#
324sub search_symbols {
325	foreach my $what (sort keys %data) {
326		next if (!($what =~ m/($arg)/));
327
328		my $type = $data{$what}->{type};
329		next if ($type eq "File");
330
331		my $file = $data{$what}->{filepath};
332
333		my $bar = $what;
334		$bar =~ s/./-/g;
335
336		print "\n$what\n$bar\n\n";
337
338		my $kernelversion = $data{$what}->{kernelversion};
339		my $contact = $data{$what}->{contact};
340		my $users = $data{$what}->{users};
341		my $date = $data{$what}->{date};
342		my $desc = $data{$what}->{description};
343		$kernelversion =~ s/^\s+//;
344		$contact =~ s/^\s+//;
345		$users =~ s/^\s+//;
346		$users =~ s/\n//g;
347		$date =~ s/^\s+//;
348		$desc =~ s/^\s+//;
349
350		printf "Kernel version:\t\t%s\n", $kernelversion if ($kernelversion);
351		printf "Date:\t\t\t%s\n", $date if ($date);
352		printf "Contact:\t\t%s\n", $contact if ($contact);
353		printf "Users:\t\t\t%s\n", $users if ($users);
354		print "Defined on file:\t$file\n\n";
355		print "Description:\n\n$desc";
356	}
357}
358
359
360#
361# Parses all ABI files located at $prefix dir
362#
363find({wanted =>\&parse_abi, no_chdir => 1}, $prefix);
364
365print STDERR Data::Dumper->Dump([\%data], [qw(*data)]) if ($debug);
366
367#
368# Handles the command
369#
370if ($cmd eq "rest") {
371	output_rest;
372} elsif ($cmd eq "search") {
373	search_symbols;
374}
375
376
377__END__
378
379=head1 NAME
380
381abi_book.pl - parse the Linux ABI files and produce a ReST book.
382
383=head1 SYNOPSIS
384
385B<abi_book.pl> [--debug] [--man] [--help] [--dir=<dir>] <COMAND> [<ARGUMENT>]
386
387Where <COMMAND> can be:
388
389=over 8
390
391B<search> [SEARCH_REGEX] - search for [SEARCH_REGEX] inside ABI
392
393B<rest>                  - output the ABI in ReST markup language
394
395B<validate>              - validate the ABI contents
396
397=back
398
399=head1 OPTIONS
400
401=over 8
402
403=item B<--dir>
404
405Changes the location of the ABI search. By default, it uses
406the Documentation/ABI directory.
407
408=item B<--debug>
409
410Put the script in verbose mode, useful for debugging. Can be called multiple
411times, to increase verbosity.
412
413=item B<--help>
414
415Prints a brief help message and exits.
416
417=item B<--man>
418
419Prints the manual page and exits.
420
421=back
422
423=head1 DESCRIPTION
424
425Parse the Linux ABI files from ABI DIR (usually located at Documentation/ABI),
426allowing to search for ABI symbols or to produce a ReST book containing
427the Linux ABI documentation.
428
429=head1 EXAMPLES
430
431Search for all stable symbols with the word "usb":
432
433=over 8
434
435$ scripts/get_abi.pl search usb --dir Documentation/ABI/stable
436
437=back
438
439Search for all symbols that match the regex expression "usb.*cap":
440
441=over 8
442
443$ scripts/get_abi.pl search usb.*cap
444
445=back
446
447Output all obsoleted symbols in ReST format
448
449=over 8
450
451$ scripts/get_abi.pl rest --dir Documentation/ABI/obsolete
452
453=back
454
455=head1 BUGS
456
457Report bugs to Mauro Carvalho Chehab <mchehab+samsung@kernel.org>
458
459=head1 COPYRIGHT
460
461Copyright (c) 2016-2019 by Mauro Carvalho Chehab <mchehab+samsung@kernel.org>.
462
463License GPLv2: GNU GPL version 2 <http://gnu.org/licenses/gpl.html>.
464
465This is free software: you are free to change and redistribute it.
466There is NO WARRANTY, to the extent permitted by law.
467
468=cut
469