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