scripts/get_abi.pl

   1 #!/usr/bin/perl
   2 # SPDX-License-Identifier: GPL-2.0
   3
   4 use strict;
   5 use Pod::Usage;
   6 use Getopt::Long;
   7 use File::Find;
   8 use Fcntl ':mode';
   9
  10 my $help;
  11 my $man;
  12 my $debug;
  13 my $prefix="Documentation/ABI";
  14
  15 GetOptions(
  16         "debug|d+" => \$debug,
  17         "dir=s" => \$prefix,
  18         'help|?' => \$help,
  19         man => \$man
  20 ) or pod2usage(2);
  21
  22 pod2usage(1) if $help;
  23 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
  24
  25 pod2usage(2) if (scalar @ARGV < 1 || @ARGV > 2);
  26
  27 my ($cmd, $arg) = @ARGV;
  28
  29 pod2usage(2) if ($cmd ne "search" && $cmd ne "rest" && $cmd ne "validate");
  30 pod2usage(2) if ($cmd eq "search" && !$arg);
  31
  32 require Data::Dumper if ($debug);
  33
  34 my %data;
  35
  36 #
  37 # Displays an error message, printing file name and line
  38 #
  39 sub 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 #
  48 sub 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
 204 my %labels;
 205
 206 sub 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 #
 324 sub 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 #
 363 find({wanted =>\&parse_abi, no_chdir => 1}, $prefix);
 364
 365 print STDERR Data::Dumper->Dump([\%data], [qw(*data)]) if ($debug);
 366
 367 #
 368 # Handles the command
 369 #
 370 if ($cmd eq "rest") {
 371         output_rest;
 372 } elsif ($cmd eq "search") {
 373         search_symbols;
 374 }
 375
 376
 377 __END__
 378
 379 =head1 NAME
 380
 381 abi_book.pl - parse the Linux ABI files and produce a ReST book.
 382
 383 =head1 SYNOPSIS
 384
 385 B<abi_book.pl> [--debug] [--man] [--help] [--dir=<dir>] <COMAND> [<ARGUMENT>]
 386
 387 Where <COMMAND> can be:
 388
 389 =over 8
 390
 391 B<search> [SEARCH_REGEX] - search for [SEARCH_REGEX] inside ABI
 392
 393 B<rest>                  - output the ABI in ReST markup language
 394
 395 B<validate>              - validate the ABI contents
 396
 397 =back
 398
 399 =head1 OPTIONS
 400
 401 =over 8
 402
 403 =item B<--dir>
 404
 405 Changes the location of the ABI search. By default, it uses
 406 the Documentation/ABI directory.
 407
 408 =item B<--debug>
 409
 410 Put the script in verbose mode, useful for debugging. Can be called multiple
 411 times, to increase verbosity.
 412
 413 =item B<--help>
 414
 415 Prints a brief help message and exits.
 416
 417 =item B<--man>
 418
 419 Prints the manual page and exits.
 420
 421 =back
 422
 423 =head1 DESCRIPTION
 424
 425 Parse the Linux ABI files from ABI DIR (usually located at Documentation/ABI),
 426 allowing to search for ABI symbols or to produce a ReST book containing
 427 the Linux ABI documentation.
 428
 429 =head1 EXAMPLES
 430
 431 Search 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
 439 Search 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
 447 Output 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
 457 Report bugs to Mauro Carvalho Chehab <mchehab+samsung@kernel.org>
 458
 459 =head1 COPYRIGHT
 460
 461 Copyright (c) 2016-2019 by Mauro Carvalho Chehab <mchehab+samsung@kernel.org>.
 462
 463 License GPLv2: GNU GPL version 2 <http://gnu.org/licenses/gpl.html>.
 464
 465 This is free software: you are free to change and redistribute it.
 466 There is NO WARRANTY, to the extent permitted by law.
 467
 468 =cut