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