67a2ee365c2d563aa23f18c777d5839c47517991
[openssl.git] / util / find-doc-nits
1 #! /usr/bin/env perl
2 # Copyright 2002-2019 The OpenSSL Project Authors. All Rights Reserved.
3 #
4 # Licensed under the Apache License 2.0 (the "License").  You may not use
5 # this file except in compliance with the License.  You can obtain a copy
6 # in the file LICENSE in the source distribution or at
7 # https://www.openssl.org/source/license.html
8
9
10 require 5.10.0;
11 use warnings;
12 use strict;
13 use Pod::Checker;
14 use File::Find;
15 use File::Basename;
16 use File::Spec::Functions;
17 use Getopt::Std;
18 use lib catdir(dirname($0), "perl");
19 use OpenSSL::Util::Pod;
20
21 # Options.
22 our($opt_d);
23 our($opt_e);
24 our($opt_s);
25 our($opt_o);
26 our($opt_h);
27 our($opt_l);
28 our($opt_n);
29 our($opt_p);
30 our($opt_u);
31 our($opt_v);
32 our($opt_c);
33
34 sub help {
35     print <<EOF;
36 Find small errors (nits) in documentation.  Options:
37     -d Detailed list of undocumented (implies -u)
38     -e Detailed list of new undocumented (implies -v)
39     -s Same as -e except no output is generated if nothing is undocumented
40     -o Causes -e/-v to count symbols added since 1.1.1 as new (implies -v)
41     -l Print bogus links
42     -n Print nits in POD pages
43     -p Warn if non-public name documented (implies -n)
44     -u Count undocumented functions
45     -v Count new undocumented functions
46     -h Print this help message
47     -c List undocumented commands and options
48 EOF
49     exit;
50 }
51
52 my $temp = '/tmp/docnits.txt';
53 my $OUT;
54 my %public;
55 my $status = 0;
56
57 my %mandatory_sections =
58     ( '*'    => [ 'NAME', 'DESCRIPTION', 'COPYRIGHT' ],
59       1      => [ 'SYNOPSIS', 'OPTIONS' ],
60       3      => [ 'SYNOPSIS', 'RETURN VALUES' ],
61       5      => [ ],
62       7      => [ ] );
63
64 # Print error message, set $status.
65 sub err {
66     print join(" ", @_), "\n";
67     $status = 1
68 }
69
70 # Cross-check functions in the NAME and SYNOPSIS section.
71 sub name_synopsis {
72     my $id = shift;
73     my $filename = shift;
74     my $contents = shift;
75
76     # Get NAME section and all words in it.
77     return unless $contents =~ /=head1 NAME(.*)=head1 SYNOPSIS/ms;
78     my $tmp = $1;
79     $tmp =~ tr/\n/ /;
80     err($id, "trailing comma before - in NAME")
81         if $tmp =~ /, *-/;
82     $tmp =~ s/ -.*//g;
83     err($id, "POD markup among the names in NAME")
84         if $tmp =~ /[<>]/;
85     $tmp =~ s/  */ /g;
86     err($id, "missing comma in NAME")
87         if $tmp =~ /[^,] /;
88
89     my $dirname = dirname($filename);
90     my $simplename = basename(basename($filename, ".in"), ".pod");
91     my $foundfilename = 0;
92     my %foundfilenames = ();
93     my %names;
94     foreach my $n ( split ',', $tmp ) {
95         $n =~ s/^\s+//;
96         $n =~ s/\s+$//;
97         err($id, "the name '$n' contains white-space")
98             if $n =~ /\s/;
99         $names{$n} = 1;
100         $foundfilename++ if $n eq $simplename;
101         $foundfilenames{$n} = 1
102             if ((-f "$dirname/$n.pod.in" || -f "$dirname/$n.pod")
103                 && $n ne $simplename);
104     }
105     err($id, "the following exist as other .pod or .pod.in files:",
106          sort keys %foundfilenames)
107         if %foundfilenames;
108     err($id, "$simplename (filename) missing from NAME section")
109         unless $foundfilename;
110     foreach my $n ( keys %names ) {
111         err($id, "$n is not public")
112             if $opt_p and !defined $public{$n};
113     }
114
115     # Find all functions in SYNOPSIS
116     return unless $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms;
117     my $syn = $1;
118     foreach my $line ( split /\n+/, $syn ) {
119         next unless $line =~ /^\s/;
120         my $sym;
121         $line =~ s/STACK_OF\([^)]+\)/int/g;
122         $line =~ s/SPARSE_ARRAY_OF\([^)]+\)/int/g;
123         $line =~ s/__declspec\([^)]+\)//;
124         if ( $line =~ /env (\S*)=/ ) {
125             # environment variable env NAME=...
126             $sym = $1;
127         } elsif ( $line =~ /typedef.*\(\*(\S+)\)\(.*/ ) {
128             # a callback function pointer: typedef ... (*NAME)(...
129             $sym = $1;
130         } elsif ( $line =~ /typedef.* (\S+)\(.*/ ) {
131             # a callback function signature: typedef ... NAME(...
132             $sym = $1;
133         } elsif ( $line =~ /typedef.* (\S+);/ ) {
134             # a simple typedef: typedef ... NAME;
135             $sym = $1;
136         } elsif ( $line =~ /enum (\S*) \{/ ) {
137             # an enumeration: enum ... {
138             $sym = $1;
139         } elsif ( $line =~ /#(?:define|undef) ([A-Za-z0-9_]+)/ ) {
140             $sym = $1;
141         } elsif ( $line =~ /([A-Za-z0-9_]+)\(/ ) {
142             $sym = $1;
143         }
144         else {
145             next;
146         }
147         err($id, "$sym missing from NAME section")
148             unless defined $names{$sym};
149         $names{$sym} = 2;
150
151         # Do some sanity checks on the prototype.
152         err($id, "prototype missing spaces around commas: $line")
153             if ( $line =~ /[a-z0-9],[^ ]/ );
154     }
155
156     foreach my $n ( keys %names ) {
157         next if $names{$n} == 2;
158         err($id, "$n missing from SYNOPSIS")
159     }
160 }
161
162 # Check if SECTION ($3) is located before BEFORE ($4)
163 sub check_section_location {
164     my $id = shift;
165     my $contents = shift;
166     my $section = shift;
167     my $before = shift;
168
169     return unless $contents =~ /=head1 $section/
170         and $contents =~ /=head1 $before/;
171     err($id, "$section should appear before $before section")
172         if $contents =~ /=head1 $before.*=head1 $section/ms;
173 }
174
175 # Check if a =head1 is duplicated, or a =headX is duplicated within a
176 # =head1.  Treats =head2 =head3 as equivalent -- it doesn't reset the head3
177 # sets if it finds a =head2 -- but that is good enough for now. Also check
178 # for proper capitalization, trailing periods, etc.
179 sub check_head_style {
180     my $id = shift;
181     my $contents = shift;
182     my %head1;
183     my %subheads;
184
185     foreach my $line ( split /\n+/, $contents ) {
186         next unless $line =~ /^=head/;
187         if ( $line =~ /head1/ ) {
188             err($id, "duplicate section $line")
189                 if defined $head1{$line};
190             $head1{$line} = 1;
191             %subheads = ();
192         } else {
193             err($id, "duplicate subsection $line")
194                 if defined $subheads{$line};
195             $subheads{$line} = 1;
196         }
197         err($id, "period in =head")
198             if $line =~ /\.[^\w]/ or $line =~ /\.$/;
199         err($id, "not all uppercase in =head1")
200             if $line =~ /head1.*[a-z]/;
201         err($id, "all uppercase in subhead")
202             if $line =~ /head[234][ A-Z0-9]+$/;
203     }
204 }
205
206 sub check {
207     my $filename = shift;
208     my $dirname = basename(dirname($filename));
209
210     my $contents = '';
211     {
212         local $/ = undef;
213         open POD, $filename or die "Couldn't open $filename, $!";
214         $contents = <POD>;
215         close POD;
216     }
217
218     my $id = "${filename}:1:";
219     check_head_style($id, $contents);
220
221     # Check ordering of some sections in man3
222     if ( $filename =~ m|man3/| ) {
223         check_section_location($id, $contents, "RETURN VALUES", "EXAMPLES");
224         check_section_location($id, $contents, "SEE ALSO", "HISTORY");
225         check_section_location($id, $contents, "EXAMPLES", "SEE ALSO");
226     }
227
228     name_synopsis($id, $filename, $contents)
229         unless $contents =~ /=for comment generic/
230             or $filename =~ m@man[157]/@;
231
232     err($id, "doesn't start with =pod")
233         if $contents !~ /^=pod/;
234     err($id, "doesn't end with =cut")
235         if $contents !~ /=cut\n$/;
236     err($id, "more than one cut line.")
237         if $contents =~ /=cut.*=cut/ms;
238     err($id, "EXAMPLE not EXAMPLES section.")
239         if $contents =~ /=head1 EXAMPLE[^S]/;
240     err($id, "WARNING not WARNINGS section.")
241         if $contents =~ /=head1 WARNING[^S]/;
242     err($id, "missing copyright")
243         if $contents !~ /Copyright .* The OpenSSL Project Authors/;
244     err($id, "copyright not last")
245         if $contents =~ /head1 COPYRIGHT.*=head/ms;
246     err($id, "head2 in All uppercase")
247         if $contents =~ /head2\s+[A-Z ]+\n/;
248     err($id, "extra space after head")
249         if $contents =~ /=head\d\s\s+/;
250     err($id, "period in NAME section")
251         if $contents =~ /=head1 NAME.*\.\n.*=head1 SYNOPSIS/ms;
252     err($id, "Duplicate $1 in L<>")
253         if $contents =~ /L<([^>]*)\|([^>]*)>/ && $1 eq $2;
254     err($id, "Bad =over $1")
255         if $contents =~ /=over([^ ][^24])/;
256     err($id, "Possible version style issue")
257         if $contents =~ /OpenSSL version [019]/;
258     err($id, "Brackets on item line")
259         if $contents =~ /=item \[/;
260     if ( $contents !~ /=for comment generic/) {
261         # Some API pages have B<foo<I<TYPE>bar>.
262         err($id, "Bad flag formatting inside B<>")
263             if $contents =~ /B<-[A-Za-z_ ]+ /;
264         while ( $contents =~ /([BI])<([^>]*)>/g ) {
265             my $B = $1;
266             my $T = $2;
267             next if $T =~ /E</;  # Assume it's E<lt>
268             err($id, "Bad content inside $B<$T>")
269                 if $T =~ /[<|]/;
270         }
271     }
272
273     if ( $contents !~ /=for comment multiple includes/ ) {
274         # Look for multiple consecutive openssl #include lines
275         # (non-consecutive lines are okay; see man3/MD5.pod).
276         if ( $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms ) {
277             my $count = 0;
278             foreach my $line ( split /\n+/, $1 ) {
279                 if ( $line =~ m@include <openssl/@ ) {
280                     err($id, "has multiple includes")
281                         if ++$count == 2;
282                 } else {
283                     $count = 0;
284                 }
285             }
286         }
287     }
288
289     open my $OUT, '>', $temp
290         or die "Can't open $temp, $!";
291     podchecker($filename, $OUT);
292     close $OUT;
293     open $OUT, '<', $temp
294         or die "Can't read $temp, $!";
295     while ( <$OUT> ) {
296         next if /\(section\) in.*deprecated/;
297         print;
298     }
299     close $OUT;
300     unlink $temp || warn "Can't remove $temp, $!";
301
302     # Find what section this page is in; assume 3.
303     my $section = 3;
304     $section = $1 if $dirname =~ /man([1-9])/;
305
306     foreach ((@{$mandatory_sections{'*'}}, @{$mandatory_sections{$section}})) {
307         # Skip "return values" if not -s
308         err($id, "missing $_ head1 section")
309             if $contents !~ /^=head1\s+${_}\s*$/m;
310     }
311 }
312
313 my %dups;
314
315 sub parsenum {
316     my $file = shift;
317     my @apis;
318
319     open my $IN, '<', $file
320         or die "Can't open $file, $!, stopped";
321
322     while ( <$IN> ) {
323         next if /^#/;
324         next if /\bNOEXIST\b/;
325         my @fields = split();
326         die "Malformed line $_"
327             if scalar @fields != 2 && scalar @fields != 4;
328         push @apis, $fields[0];
329     }
330
331     close $IN;
332
333     print "# Found ", scalar(@apis), " in $file\n" unless $opt_p;
334     return sort @apis;
335 }
336
337 sub getdocced
338 {
339     my $dir = shift;
340     my %return;
341
342     foreach my $pod ( glob("$dir/*.pod"), glob("$dir/*.pod.in") ) {
343         my %podinfo = extract_pod_info($pod);
344         foreach my $n ( @{$podinfo{names}} ) {
345             $return{$n} = $pod;
346             print "# Duplicate $n in $pod and $dups{$n}\n"
347                 if defined $dups{$n} && $dups{$n} ne $pod;
348             $dups{$n} = $pod;
349         }
350     }
351
352     return %return;
353 }
354
355 my %docced;
356
357 sub loadmissing($)
358 {
359     my $missingfile = shift;
360     my @missing;
361
362     open FH, $missingfile
363         || die "Can't open $missingfile";
364     while ( <FH> ) {
365         chomp;
366         next if /^#/;
367         push @missing, $_;
368     }
369     close FH;
370
371     return @missing;
372 }
373
374 sub checkmacros {
375     my $count = 0;
376     my %seen;
377     my @missing;
378
379     if ($opt_o) {
380         @missing = loadmissing('util/missingmacro111.txt');
381     } elsif ($opt_v) {
382         @missing = loadmissing('util/missingmacro.txt');
383     }
384
385     print "# Checking macros (approximate)\n"
386         if !$opt_s;
387     foreach my $f ( glob('include/openssl/*.h') ) {
388         # Skip some internals we don't want to document yet.
389         next if $f eq 'include/openssl/asn1.h';
390         next if $f eq 'include/openssl/asn1t.h';
391         next if $f eq 'include/openssl/err.h';
392         open(IN, $f) || die "Can't open $f, $!";
393         while ( <IN> ) {
394             next unless /^#\s*define\s*(\S+)\(/;
395             my $macro = $1;
396             next if $docced{$macro} || defined $seen{$macro};
397             next if $macro =~ /i2d_/
398                 || $macro =~ /d2i_/
399                 || $macro =~ /DEPRECATEDIN/
400                 || $macro =~ /IMPLEMENT_/
401                 || $macro =~ /DECLARE_/;
402
403             # Skip macros known to be missing
404             next if $opt_v && grep( /^$macro$/, @missing);
405     
406             print "$f:$macro\n"
407                 if $opt_d || $opt_e;
408             $count++;
409             $seen{$macro} = 1;
410         }
411         close(IN);
412     }
413     print "# Found $count macros missing\n"
414         if !$opt_s || $count > 0;
415 }
416
417 sub printem {
418     my $libname = shift;
419     my $numfile = shift;
420     my $missingfile = shift;
421     my $count = 0;
422     my %seen;
423
424     my @missing = loadmissing($missingfile) if ($opt_v);
425
426     foreach my $func ( parsenum($numfile) ) {
427         next if $docced{$func} || defined $seen{$func};
428
429         # Skip ASN1 utilities
430         next if $func =~ /^ASN1_/;
431
432         # Skip functions known to be missing
433         next if $opt_v && grep( /^$func$/, @missing);
434
435         print "$libname:$func\n"
436             if $opt_d || $opt_e;
437         $count++;
438         $seen{$func} = 1;
439     }
440     print "# Found $count missing from $numfile\n\n"
441         if !$opt_s || $count > 0;
442 }
443
444
445 # Collection of links in each POD file.
446 # filename => [ "foo(1)", "bar(3)", ... ]
447 my %link_collection = ();
448 # Collection of names in each POD file.
449 # "name(s)" => filename
450 my %name_collection = ();
451
452 sub collectnames {
453     my $filename = shift;
454     $filename =~ m|man(\d)/|;
455     my $section = $1;
456     my $simplename = basename(basename($filename, ".in"), ".pod");
457     my $id = "${filename}:1:";
458
459     my $contents = '';
460     {
461         local $/ = undef;
462         open POD, $filename or die "Couldn't open $filename, $!";
463         $contents = <POD>;
464         close POD;
465     }
466
467     $contents =~ /=head1 NAME([^=]*)=head1 /ms;
468     my $tmp = $1;
469     unless (defined $tmp) {
470         err($id, "weird name section");
471         return;
472     }
473     $tmp =~ tr/\n/ /;
474     $tmp =~ s/ -.*//g;
475
476     my @names =
477         map { s|/|-|g; $_ }              # Treat slash as dash
478         map { s/^\s+//g; s/\s+$//g; $_ } # Trim prefix and suffix blanks
479         split(/,/, $tmp);
480     unless (grep { $simplename eq $_ } @names) {
481         err($id, "missing $simplename");
482         push @names, $simplename;
483     }
484     foreach my $name (@names) {
485         next if $name eq "";
486         if ($name =~ /\s/) {
487             err($id, "'$name' contains white space")
488         }
489         my $name_sec = "$name($section)";
490         if (! exists $name_collection{$name_sec}) {
491             $name_collection{$name_sec} = $filename;
492         } elsif ($filename eq $name_collection{$name_sec}) {
493             err($id, "$name_sec repeated in NAME section of",
494                  $name_collection{$name_sec});
495         } else {
496             err($id, "$name_sec also in NAME section of",
497                  $name_collection{$name_sec});
498         }
499     }
500
501     my @foreign_names =
502         map { map { s/\s+//g; $_ } split(/,/, $_) }
503         $contents =~ /=for\s+comment\s+foreign\s+manuals:\s*(.*)\n\n/;
504     foreach (@foreign_names) {
505         $name_collection{$_} = undef; # It still exists!
506     }
507
508     my @links = $contents =~ /L<
509                               # if the link is of the form L<something|name(s)>,
510                               # then remove 'something'.  Note that 'something'
511                               # may contain POD codes as well...
512                               (?:(?:[^\|]|<[^>]*>)*\|)?
513                               # we're only interested in references that have
514                               # a one digit section number
515                               ([^\/>\(]+\(\d\))
516                              /gx;
517     $link_collection{$filename} = [ @links ];
518 }
519
520 sub checklinks {
521     foreach my $filename (sort keys %link_collection) {
522         foreach my $link (@{$link_collection{$filename}}) {
523             err("${filename}:1:", "reference to non-existing $link")
524                 unless exists $name_collection{$link};
525         }
526     }
527 }
528
529 sub publicize {
530     foreach my $name ( parsenum('util/libcrypto.num') ) {
531         $public{$name} = 1;
532     }
533     foreach my $name ( parsenum('util/libssl.num') ) {
534         $public{$name} = 1;
535     }
536     foreach my $name ( parsenum('util/private.num') ) {
537         $public{$name} = 1;
538     }
539 }
540
541 # Cipher/digests to skip if not documented
542 my %skips = (
543     'aes128' => 1,
544     'aes192' => 1,
545     'aes256' => 1,
546     'aria128' => 1,
547     'aria192' => 1,
548     'aria256' => 1,
549     'camellia128' => 1,
550     'camellia192' => 1,
551     'camellia256' => 1,
552     'des' => 1,
553     'des3' => 1,
554     'idea' => 1,
555     'cipher' => 1,
556     'digest' => 1,
557 );
558
559 sub checkflags {
560     my $cmd = shift;
561     my $doc = shift;
562     my %cmdopts;
563     my %docopts;
564     my %localskips;
565
566     # Get the list of options in the command.
567     open CFH, "./apps/openssl list --options $cmd|"
568         || die "Can list options for $cmd, $!";
569     while ( <CFH> ) {
570         chop;
571         s/ .$//;
572         $cmdopts{$_} = 1;
573     }
574     close CFH;
575
576     # Get the list of flags from the synopsis
577     open CFH, "<$doc"
578         || die "Can't open $doc, $!";
579     while ( <CFH> ) {
580         chop;
581         last if /DESCRIPTION/;
582         if ( /=for comment ifdef (.*)/ ) {
583             foreach my $f ( split / /, $1 ) {
584                 $localskips{$f} = 1;
585             }
586             next;
587         }
588         next unless /\[B<-([^ >]+)/;
589         my $opt = $1;
590         $opt = $1 if $opt =~ /I<(.*)/;
591         $docopts{$1} = 1;
592     }
593     close CFH;
594
595     # See what's in the command not the manpage.
596     my @undocced = ();
597     foreach my $k ( keys %cmdopts ) {
598         push @undocced, $k unless $docopts{$k};
599     }
600     if ( scalar @undocced > 0 ) {
601         foreach ( @undocced ) {
602             err("$doc: undocumented option -$_");
603         }
604     }
605
606     # See what's in the command not the manpage.
607     my @unimpl = ();
608     foreach my $k ( keys %docopts ) {
609         push @unimpl, $k unless $cmdopts{$k};
610     }
611     if ( scalar @unimpl > 0 ) {
612         foreach ( @unimpl ) {
613             next if defined $skips{$_} || defined $localskips{$_};
614             err("$cmd documented but not implemented -$_");
615         }
616     }
617 }
618
619 getopts('cdesolnphuv');
620
621 help() if $opt_h;
622
623 $opt_n = 1 if $opt_p;
624 $opt_u = 1 if $opt_d;
625 $opt_e = 1 if $opt_s;
626 $opt_v = 1 if $opt_o || $opt_e;
627
628 die "Cannot use both -u and -v"
629     if $opt_u && $opt_v;
630 die "Cannot use both -d and -e"
631     if $opt_d && $opt_e;
632
633 # We only need to check c, l, n, u and v.
634 # Options d, e, s, o and p imply one of the above.
635 die "Need one of -[cdesolnpuv] flags.\n"
636     unless $opt_c or $opt_l or $opt_n or $opt_u or $opt_v;
637
638 if ( $opt_c ) {
639     my @commands = ();
640
641     # Get list of commands.
642     open FH, "./apps/openssl list -1 -commands|"
643         || die "Can't list commands, $!";
644     while ( <FH> ) {
645         chop;
646         push @commands, $_;
647     }
648     close FH;
649
650     # See if each has a manpage.
651     foreach my $cmd ( @commands ) {
652         next if $cmd eq 'help' || $cmd eq 'exit';
653         my $doc = "doc/man1/$cmd.pod";
654         $doc = "doc/man1/openssl-$cmd.pod" if -f "doc/man1/openssl-$cmd.pod";
655         if ( ! -f "$doc" ) {
656             err("$doc does not exist");
657         } else {
658             checkflags($cmd, $doc);
659         }
660     }
661
662     # See what help is missing.
663     open FH, "./apps/openssl list --missing-help |"
664         || die "Can't list missing help, $!";
665     while ( <FH> ) {
666         chop;
667         my ($cmd, $flag) = split;
668         err("$cmd has no help for -$flag");
669     }
670     close FH;
671
672     exit $status;
673 }
674
675 if ( $opt_l ) {
676     foreach (@ARGV ? @ARGV : (glob('doc/*/*.pod'), glob('doc/*/*.pod.in'),
677                               glob('doc/internal/*/*.pod'))) {
678         collectnames($_);
679     }
680     checklinks();
681 }
682
683 if ( $opt_n ) {
684     publicize() if $opt_p;
685     foreach (@ARGV ? @ARGV : (glob('doc/*/*.pod'), glob('doc/*/*.pod.in'))) {
686         check($_);
687     }
688     {
689         local $opt_p = undef;
690         foreach (@ARGV ? @ARGV : glob('doc/internal/*/*.pod')) {
691             check($_);
692         }
693     }
694
695     # If not given args, check that all man1 commands are named properly.
696     if ( scalar @ARGV == 0 ) {
697         foreach (glob('doc/man1/*.pod')) {
698             next if /CA.pl/ || /openssl.pod/;
699             err("$_ doesn't start with openssl-") unless /openssl-/;
700         }
701     }
702 }
703
704 if ( $opt_u || $opt_v) {
705     my %temp = getdocced('doc/man3');
706     foreach ( keys %temp ) {
707         $docced{$_} = $temp{$_};
708     }
709     if ($opt_o) {
710         printem('crypto', 'util/libcrypto.num', 'util/missingcrypto111.txt');
711         printem('ssl', 'util/libssl.num', 'util/missingssl111.txt');
712     } else {
713         printem('crypto', 'util/libcrypto.num', 'util/missingcrypto.txt');
714         printem('ssl', 'util/libssl.num', 'util/missingssl.txt');
715     }
716     checkmacros();
717 }
718
719 exit $status;