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