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