293f603b795a244ee774ce1711e7471ed577f6f8
[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
14 use Pod::Checker;
15 use File::Find;
16 use File::Basename;
17 use File::Spec::Functions;
18 use Getopt::Std;
19 use lib catdir(dirname($0), "perl");
20 use OpenSSL::Util::Pod;
21
22 # Set to 1 for debug output
23 my $debug = 0;
24
25 # Options.
26 our($opt_d);
27 our($opt_e);
28 our($opt_s);
29 our($opt_o);
30 our($opt_h);
31 our($opt_l);
32 our($opt_n);
33 our($opt_p);
34 our($opt_u);
35 our($opt_v);
36 our($opt_c);
37
38 # Print usage message and exit.
39 sub help {
40     print <<EOF;
41 Find small errors (nits) in documentation.  Options:
42     -c List undocumented commands and options
43     -d Detailed list of undocumented (implies -u)
44     -e Detailed list of new undocumented (implies -v)
45     -h Print this help message
46     -l Print bogus links
47     -n Print nits in POD pages
48     -o Causes -e/-v to count symbols added since 1.1.1 as new (implies -v)
49     -u Count undocumented functions
50     -v Count new undocumented functions
51 EOF
52     exit;
53 }
54
55 getopts('cdehlnouv');
56
57 help() if $opt_h;
58 $opt_u = 1 if $opt_d;
59 $opt_v = 1 if $opt_o || $opt_e;
60 die "Cannot use both -u and -v"
61     if $opt_u && $opt_v;
62 die "Cannot use both -d and -e"
63     if $opt_d && $opt_e;
64
65 # We only need to check c, l, n, u and v.
66 # Options d, e, o imply one of the above.
67 die "Need one of -[cdehlnouv] flags.\n"
68     unless $opt_c or $opt_l or $opt_n or $opt_u or $opt_v;
69
70
71 my $temp = '/tmp/docnits.txt';
72 my $OUT;
73 my %public;
74 my $status = 0;
75
76 my %mandatory_sections = (
77     '*' => [ 'NAME', 'DESCRIPTION', 'COPYRIGHT' ],
78     1   => [ 'SYNOPSIS', 'OPTIONS' ],
79     3   => [ 'SYNOPSIS', 'RETURN VALUES' ],
80     5   => [ ],
81     7   => [ ]
82 );
83
84
85 # Print error message, set $status.
86 sub err {
87     print join(" ", @_), "\n";
88     $status = 1
89 }
90
91 # Cross-check functions in the NAME and SYNOPSIS section.
92 sub name_synopsis {
93     my $id = shift;
94     my $filename = shift;
95     my $contents = shift;
96
97     # Get NAME section and all words in it.
98     return unless $contents =~ /=head1 NAME(.*)=head1 SYNOPSIS/ms;
99     my $tmp = $1;
100     $tmp =~ tr/\n/ /;
101     err($id, "trailing comma before - in NAME")
102         if $tmp =~ /, *-/;
103     $tmp =~ s/ -.*//g;
104     err($id, "POD markup among the names in NAME")
105         if $tmp =~ /[<>]/;
106     $tmp =~ s/  */ /g;
107     err($id, "missing comma in NAME")
108         if $tmp =~ /[^,] /;
109
110     my $dirname = dirname($filename);
111     my $simplename = basename(basename($filename, ".in"), ".pod");
112     my $foundfilename = 0;
113     my %foundfilenames = ();
114     my %names;
115     foreach my $n ( split ',', $tmp ) {
116         $n =~ s/^\s+//;
117         $n =~ s/\s+$//;
118         err($id, "the name '$n' contains white-space")
119             if $n =~ /\s/;
120         $names{$n} = 1;
121         $foundfilename++ if $n eq $simplename;
122         $foundfilenames{$n} = 1
123             if -f "$dirname/$n.pod" && $n ne $simplename;
124     }
125     err($id, "the following exist as other .pod files:",
126          sort keys %foundfilenames)
127         if %foundfilenames;
128     err($id, "$simplename (filename) missing from NAME section")
129         unless $foundfilename;
130     if ( $filename !~ /internal/ ) {
131         foreach my $n ( keys %names ) {
132             err($id, "$n is not public")
133                 if !defined $public{$n};
134         }
135     }
136
137     # Find all functions in SYNOPSIS
138     return unless $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms;
139     my $syn = $1;
140     foreach my $line ( split /\n+/, $syn ) {
141         next unless $line =~ /^\s/;
142         my $sym;
143         my $is_prototype = 1;
144         $line =~ s/STACK_OF\([^)]+\)/int/g;
145         $line =~ s/SPARSE_ARRAY_OF\([^)]+\)/int/g;
146         $line =~ s/__declspec\([^)]+\)//;
147         if ( $line =~ /typedef.*\(\*\S+\)\s+\(/ ) {
148             # a callback function with whitespace before the argument list:
149             # typedef ... (*NAME) (...
150             err($id, "function typedef has space before arg list: $line");
151         }
152         if ( $line =~ /env (\S*)=/ ) {
153             # environment variable env NAME=...
154             $sym = $1;
155         } elsif ( $line =~ /typedef.*\(\*(\S+)\)\s*\(/ ) {
156             # a callback function pointer: typedef ... (*NAME)(...
157             $sym = $1;
158         } elsif ( $line =~ /typedef.* (\S+)\(/ ) {
159             # a callback function signature: typedef ... NAME(...
160             $sym = $1;
161         } elsif ( $line =~ /typedef.* (\S+);/ ) {
162             # a simple typedef: typedef ... NAME;
163             $is_prototype = 0;
164             $sym = $1;
165         } elsif ( $line =~ /enum (\S*) \{/ ) {
166             # an enumeration: enum ... {
167             $sym = $1;
168         } elsif ( $line =~ /#(?:define|undef) ([A-Za-z0-9_]+)/ ) {
169             $is_prototype = 0;
170             $sym = $1;
171         } elsif ( $line =~ /([A-Za-z0-9_]+)\(/ ) {
172             $sym = $1;
173         }
174         else {
175             next;
176         }
177         err($id, "$sym missing from NAME section")
178             unless defined $names{$sym};
179         $names{$sym} = 2;
180
181         # Do some sanity checks on the prototype.
182         err($id, "prototype missing spaces around commas: $line")
183             if $is_prototype && $line =~ /[a-z0-9],[^ ]/;
184     }
185
186     foreach my $n ( keys %names ) {
187         next if $names{$n} == 2;
188         err($id, "$n missing from SYNOPSIS")
189     }
190 }
191
192 # Check if SECTION ($3) is located before BEFORE ($4)
193 sub check_section_location {
194     my $id = shift;
195     my $contents = shift;
196     my $section = shift;
197     my $before = shift;
198
199     return unless $contents =~ /=head1 $section/
200         and $contents =~ /=head1 $before/;
201     err($id, "$section should appear before $before section")
202         if $contents =~ /=head1 $before.*=head1 $section/ms;
203 }
204
205 # Check if a =head1 is duplicated, or a =headX is duplicated within a
206 # =head1.  Treats =head2 =head3 as equivalent -- it doesn't reset the head3
207 # sets if it finds a =head2 -- but that is good enough for now. Also check
208 # for proper capitalization, trailing periods, etc.
209 sub check_head_style {
210     my $id = shift;
211     my $contents = shift;
212     my %head1;
213     my %subheads;
214
215     foreach my $line ( split /\n+/, $contents ) {
216         next unless $line =~ /^=head/;
217         if ( $line =~ /head1/ ) {
218             err($id, "duplicate section $line")
219                 if defined $head1{$line};
220             $head1{$line} = 1;
221             %subheads = ();
222         } else {
223             err($id, "duplicate subsection $line")
224                 if defined $subheads{$line};
225             $subheads{$line} = 1;
226         }
227         err($id, "period in =head")
228             if $line =~ /\.[^\w]/ or $line =~ /\.$/;
229         err($id, "not all uppercase in =head1")
230             if $line =~ /head1.*[a-z]/;
231         err($id, "all uppercase in subhead")
232             if $line =~ /head[234][ A-Z0-9]+$/;
233     }
234 }
235
236 # Because we have options and symbols with extra markup, we need
237 # to take that into account, so we need a regexp that extracts
238 # markup chunks, including recursive markup.
239 # please read up on /(?R)/ in perlre(1)
240 # (note: order is important, (?R) needs to come before .)
241 # (note: non-greedy is important, or something like 'B<foo> and B<bar>'
242 # will be captured as one item)
243 my $markup_re =
244     qr/(                        # Capture group
245            [BIL]<               # The start of what we recurse on
246            (?:(?-1)|.)*?        # recurse the whole regexp (referring to
247                                 # the last opened capture group, i.e. the
248                                 # start of this regexp), or pick next
249                                 # character.  Do NOT be greedy!
250            >                    # The end of what we recurse on
251        )/x;                     # (the x allows this sort of split up regexp)
252
253 # Options must start with a dash, followed by a letter, possibly
254 # followed by letters, digits, dashes and underscores, and the last
255 # character must be a letter or a digit.
256 # We do also accept the single -? or -n, where n is a digit
257 my $option_re =
258     qr/(?:
259             \?                  # Single question mark
260             |
261             \d                  # Single digit
262             |
263             -                   # Single dash (--)
264             |
265             [[:alpha:]](?:[-_[:alnum:]]*?[[:alnum:]])?
266        )/x;
267
268 # Helper function to check if a given $thing is properly marked up
269 # option.  It returns one of these values:
270 #     undef         if it's not an option
271 #     ""            if it's a malformed option
272 #     $unwrapped    the option with the outermost B<> wrapping removed.
273 sub normalise_option {
274     my $id = shift;
275     my $filename = shift;
276     my $thing = shift;
277
278     my $unwrapped = $thing;
279     my $unmarked = $thing;
280
281     # $unwrapped is the option with the outer B<> markup removed
282     $unwrapped =~ s/^B<//;
283     $unwrapped =~ s/>$//;
284     # $unmarked is the option with *all* markup removed
285     $unmarked =~ s/[BIL]<|>//msg;
286
287
288     # If we found an option, check it, collect it
289     if ( $unwrapped =~ /^\s*-/ ) {
290         return $unwrapped       # return option with outer B<> removed
291             if $unmarked =~ /^-${option_re}$/;
292         return "";              # Malformed option
293     }
294     return undef;               # Something else
295 }
296
297 # Checks of command option (man1) formatting.  The man1 checks are
298 # restricted to the SYNOPSIS and OPTIONS sections, the rest is too
299 # free form, we simply cannot be too strict there.
300
301 sub option_check {
302     my $id = shift;
303     my $filename = shift;
304     my $contents = shift;
305
306     my $synopsis = ($contents =~ /=head1\s+SYNOPSIS(.*?)=head1/s, $1);
307
308     # Some pages have more than one OPTIONS section, let's make sure
309     # to get them all
310     my $options = '';
311     while ( $contents =~ /=head1\s+[A-Z ]*?OPTIONS$(.*?)(?==head1)/msg ) {
312         $options .= $1;
313     }
314
315     # Look for options with no or incorrect markup
316     while ( $synopsis =~
317             /(?<![-<[:alnum:]])-(?:$markup_re|.)*(?![->[:alnum:]])/msg ) {
318         err($id, "Malformed option [1] in SYNOPSIS: $&");
319     }
320
321     while ( $synopsis =~ /$markup_re/msg ) {
322         my $found = $&;
323         print STDERR "$id:DEBUG[option_check] SYNOPSIS: found $found\n"
324             if $debug;
325         my $option_uw = normalise_option($id, $filename, $found);
326         err($id, "Malformed option [2] in SYNOPSIS: $found")
327             if defined $option_uw && $option_uw eq '';
328     }
329
330     # In OPTIONS, we look for =item paragraphs.
331     # (?=^\s*$) detects an empty line.
332     while ( $options =~ /=item\s+(.*?)(?=^\s*$)/msg ) {
333         my $item = $&;
334
335         while ( $item =~ /(\[\s*)?($markup_re)/msg ) {
336             my $found = $2;
337             print STDERR "$id:DEBUG[option_check] OPTIONS: found $&\n"
338                 if $debug;
339             err($id, "Unexpected bracket in OPTIONS =item: $item")
340                 if ($1 // '') ne '' && $found =~ /^B<\s*-/;
341
342             my $option_uw = normalise_option($id, $filename, $found);
343             err($id, "Malformed option in OPTIONS: $found")
344                 if defined $option_uw && $option_uw eq '';
345         }
346     }
347 }
348
349 # Normal symbol form
350 my $symbol_re = qr/[[:alpha:]_][_[:alnum:]]*?/;
351
352 # Checks of function name (man3) formatting.  The man3 checks are
353 # easier than the man1 checks, we only check the names followed by (),
354 # and only the names that have POD markup.
355 sub functionname_check {
356     my $id = shift;
357     my $filename = shift;
358     my $contents = shift;
359
360     while ( $contents =~ /($markup_re)\(\)/msg ) {
361         print STDERR "$id:DEBUG[functionname_check] SYNOPSIS: found $&\n"
362             if $debug;
363
364         my $symbol = $1;
365         my $unmarked = $symbol;
366         $unmarked =~ s/[BIL]<|>//msg;
367
368         err($id, "Malformed symbol: $symbol")
369             unless $symbol =~ /^B<.*>$/ && $unmarked =~ /^${symbol_re}$/
370     }
371
372     # We can't do the kind of collecting coolness that option_check()
373     # does, because there are too many things that can't be found in
374     # name repositories like the NAME sections, such as symbol names
375     # with a variable part (typically marked up as B<foo_I<TYPE>_bar>
376 }
377
378 # This is from http://man7.org/linux/man-pages/man7/man-pages.7.html
379 my %preferred_words = (
380     'bitmask'       => 'bit mask',
381     'builtin'       => 'built-in',
382    #'epoch'         => 'Epoch', # handled specially, below
383     'file name'     => 'filename',
384     'file system'   => 'filesystem',
385     'host name'     => 'hostname',
386     'i-node'        => 'inode',
387     'lower case'    => 'lowercase',
388     'lower-case'    => 'lowercase',
389     'non-zero'      => 'nonzero',
390     'path name'     => 'pathname',
391     'pseudo-terminal' => 'pseudoterminal',
392     'reserved port' => 'privileged port',
393     'system port'   => 'privileged port',
394     'realtime'      => 'real-time',
395     'real time'     => 'real-time',
396     'runtime'       => 'run time',
397     'saved group ID'=> 'saved set-group-ID',
398     'saved set-GID' => 'saved set-group-ID',
399     'saved user ID' => 'saved set-user-ID',
400     'saved set-UID' => 'saved set-user-ID',
401     'set-GID'       => 'set-group-ID',
402     'setgid'        => 'set-group-ID',
403     'set-UID'       => 'set-user-ID',
404     'setuid'        => 'set-user-ID',
405     'super user'    => 'superuser',
406     'super-user'    => 'superuser',
407     'super block'   => 'superblock',
408     'super-block'   => 'superblock',
409     'time stamp'    => 'timestamp',
410     'time zone'     => 'timezone',
411     'upper case'    => 'uppercase',
412     'upper-case'    => 'uppercase',
413     'useable'       => 'usable',
414     'userspace'     => 'user space',
415     'user name'     => 'username',
416     'zeroes'        => 'zeros'
417 );
418
419 # Search manpage for words that have a different preferred use.
420 sub wording {
421     my $id = shift;
422     my $contents = shift;
423
424     foreach my $k ( keys %preferred_words ) {
425         # Sigh, trademark
426         next if $k eq 'file system'
427             and $contents =~ /Microsoft Encrypted File System/;
428         err($id, "found '$k' should use '$preferred_words{$k}'")
429             if $contents =~ /\b\Q$k\E\b/i;
430     }
431     err($id, "found 'epoch' should use 'Epoch'")
432         if $contents =~ /\bepoch\b/;
433 }
434
435 # Perform all sorts of nit/error checks on a manpage
436 sub check {
437     my $filename = shift;
438     my $dirname = basename(dirname($filename));
439
440     my $contents = '';
441     {
442         local $/ = undef;
443         open POD, $filename or die "Couldn't open $filename, $!";
444         $contents = <POD>;
445         close POD;
446     }
447
448     my $id = "${filename}:1:";
449     check_head_style($id, $contents);
450
451     # Check ordering of some sections in man3
452     if ( $filename =~ m|man3/| ) {
453         check_section_location($id, $contents, "RETURN VALUES", "EXAMPLES");
454         check_section_location($id, $contents, "SEE ALSO", "HISTORY");
455         check_section_location($id, $contents, "EXAMPLES", "SEE ALSO");
456     }
457
458     # Make sure every link has a section.
459     while ( $contents =~ /$markup_re/msg ) {
460         my $target = $1;
461         next unless $target =~ /^L<(.*)>$/;     # Skip if not L<...>
462         $target = $1;                           # Peal away L< and >
463         $target =~ s/\/[^\/]*$//;               # Peal away possible anchor
464         $target =~ s/.*\|//g;                   # Peal away possible link text
465         next if $target eq '';                  # Skip if links within page, or
466         next if $target =~ /::/;                #   links to a Perl module, or
467         next if $target =~ /^https?:/;          #   is a URL link, or
468         next if $target =~ /\([1357]\)$/;       #   it has a section
469         err($id, "Section missing in $target")
470     }
471     # Check for proper links to commands.
472     while ( $contents =~ /L<([^>]*)\(1\)(?:\/.*)?>/g ) {
473         my $target = $1;
474         next if $target =~ /openssl-?/;
475         next if -f "doc/man1/$target.pod";
476         # TODO: Filter out "foreign manual" links.
477         next if $target =~ /ps|apropos|sha1sum|procmail|perl/;
478         err($id, "Bad command link L<$target(1)>");
479     }
480     # Check for proper in-man-3 API links.
481     while ( $contents =~ /L<([^>]*)\(3\)(?:\/.*)?>/g ) {
482         my $target = $1;
483         err($id, "Bad L<$target>")
484             unless $target =~ /^[_[:alpha:]][_[:alnum:]]*$/
485     }
486
487     unless ( $contents =~ /=for openssl generic/ ) {
488         if ( $filename =~ m|man3/| ) {
489             name_synopsis($id, $filename, $contents);
490             functionname_check($id, $filename, $contents);
491         } elsif ( $filename =~ m|man1/| ) {
492             option_check($id, $filename, $contents)
493         }
494     }
495
496     wording($id, $contents);
497
498     err($id, "doesn't start with =pod")
499         if $contents !~ /^=pod/;
500     err($id, "doesn't end with =cut")
501         if $contents !~ /=cut\n$/;
502     err($id, "more than one cut line.")
503         if $contents =~ /=cut.*=cut/ms;
504     err($id, "EXAMPLE not EXAMPLES section.")
505         if $contents =~ /=head1 EXAMPLE[^S]/;
506     err($id, "WARNING not WARNINGS section.")
507         if $contents =~ /=head1 WARNING[^S]/;
508     err($id, "missing copyright")
509         if $contents !~ /Copyright .* The OpenSSL Project Authors/;
510     err($id, "copyright not last")
511         if $contents =~ /head1 COPYRIGHT.*=head/ms;
512     err($id, "head2 in All uppercase")
513         if $contents =~ /head2\s+[A-Z ]+\n/;
514     err($id, "extra space after head")
515         if $contents =~ /=head\d\s\s+/;
516     err($id, "period in NAME section")
517         if $contents =~ /=head1 NAME.*\.\n.*=head1 SYNOPSIS/ms;
518     err($id, "Duplicate $1 in L<>")
519         if $contents =~ /L<([^>]*)\|([^>]*)>/ && $1 eq $2;
520     err($id, "Bad =over $1")
521         if $contents =~ /=over([^ ][^24])/;
522     err($id, "Possible version style issue")
523         if $contents =~ /OpenSSL version [019]/;
524
525     if ( $contents !~ /=for openssl multiple includes/ ) {
526         # Look for multiple consecutive openssl #include lines
527         # (non-consecutive lines are okay; see man3/MD5.pod).
528         if ( $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms ) {
529             my $count = 0;
530             foreach my $line ( split /\n+/, $1 ) {
531                 if ( $line =~ m@include <openssl/@ ) {
532                     err($id, "has multiple includes")
533                         if ++$count == 2;
534                 } else {
535                     $count = 0;
536                 }
537             }
538         }
539     }
540
541     open my $OUT, '>', $temp
542         or die "Can't open $temp, $!";
543     podchecker($filename, $OUT);
544     close $OUT;
545     open $OUT, '<', $temp
546         or die "Can't read $temp, $!";
547     while ( <$OUT> ) {
548         next if /\(section\) in.*deprecated/;
549         print;
550     }
551     close $OUT;
552     unlink $temp || warn "Can't remove $temp, $!";
553
554     # Find what section this page is in; assume 3.
555     my $section = 3;
556     $section = $1 if $dirname =~ /man([1-9])/;
557
558     foreach ( (@{$mandatory_sections{'*'}}, @{$mandatory_sections{$section}}) ) {
559         err($id, "missing $_ head1 section")
560             if $contents !~ /^=head1\s+${_}\s*$/m;
561     }
562 }
563
564 # Parse libcrypto.num, etc., and return sorted list of what's there.
565 sub parsenum {
566     my $file = shift;
567     my @apis;
568
569     open my $IN, '<', $file
570         or die "Can't open $file, $!, stopped";
571
572     while ( <$IN> ) {
573         next if /^#/;
574         next if /\bNOEXIST\b/;
575         my @fields = split();
576         die "Malformed line $_"
577             if scalar @fields != 2 && scalar @fields != 4;
578         push @apis, $fields[0];
579     }
580
581     close $IN;
582
583     return sort @apis;
584 }
585
586 # Parse all the manpages, getting return map of what they document
587 # (by looking at their NAME sections).
588 # Map of links in each POD file; filename => [ "foo(1)", "bar(3)", ... ]
589 my %link_map = ();
590 # Map of names in each POD file; "name(s)" => filename
591 my %name_map = ();
592
593 # Load file of symbol names that we know aren't documented.
594 sub loadmissing($)
595 {
596     my $missingfile = shift;
597     my @missing;
598
599     open FH, $missingfile
600         or die "Can't open $missingfile";
601     while ( <FH> ) {
602         chomp;
603         next if /^#/;
604         push @missing, $_;
605     }
606     close FH;
607
608     for (@missing) {
609         err("$missingfile:", "$_ is documented in $name_map{$_}")
610             if exists $name_map{$_} && defined $name_map{$_};
611     }
612
613     return @missing;
614 }
615
616 # Check for undocumented macros; ignore those in the "missing" file
617 # and do simple check for #define in our header files.
618 sub checkmacros {
619     my $count = 0;
620     my %seen;
621     my @missing;
622
623     if ( $opt_o ) {
624         @missing = loadmissing('util/missingmacro111.txt');
625     } elsif ( $opt_v ) {
626         @missing = loadmissing('util/missingmacro.txt');
627     }
628
629     foreach my $f ( glob('include/openssl/*.h') ) {
630         # Skip some internals we don't want to document yet.
631         next if $f eq 'include/openssl/asn1.h';
632         next if $f eq 'include/openssl/asn1t.h';
633         next if $f eq 'include/openssl/err.h';
634         open(IN, $f)
635             or die "Can't open $f, $!";
636         while ( <IN> ) {
637             next unless /^#\s*define\s*(\S+)\(/;
638             my $macro = "$1(3)"; # We know they're all in section 3
639             next if exists $name_map{$macro} || defined $seen{$macro};
640             next if $macro =~ /^i2d_/
641                 || $macro =~ /^d2i_/
642                 || $macro =~ /^DEPRECATEDIN/
643                 || $macro =~ /\Q_fnsig(3)\E$/
644                 || $macro =~ /^IMPLEMENT_/
645                 || $macro =~ /^_?DECLARE_/;
646
647             # Skip macros known to be missing
648             next if $opt_v && grep( /^\Q$macro\E$/, @missing);
649
650             err("$f:", "macro $macro undocumented")
651                 if $opt_d || $opt_e;
652             $count++;
653             $seen{$macro} = 1;
654         }
655         close(IN);
656     }
657     err("# $count macros undocumented (count is approximate)")
658         if $count > 0;
659 }
660
661 # Find out what is undocumented (filtering out the known missing ones)
662 # and display them.
663 sub printem {
664     my $libname = shift;
665     my $numfile = shift;
666     my $missingfile = shift;
667     my $count = 0;
668     my %seen;
669
670     my @missing = loadmissing($missingfile) if $opt_v;
671
672     foreach my $func ( parsenum($numfile) ) {
673         $func .= '(3)';         # We know they're all in section 3
674         next if exists $name_map{$func} || defined $seen{$func};
675
676         # Skip ASN1 utilities
677         next if $func =~ /^ASN1_/;
678
679         # Skip functions known to be missing.
680         next if $opt_v && grep( /^\Q$func\E$/, @missing);
681
682         err("$libname:", "function $func undocumented")
683             if $opt_d || $opt_e;
684         $count++;
685         $seen{$func} = 1;
686     }
687     err("# $count in $numfile are not documented")
688         if $count > 0;
689 }
690
691 # Collect all the names in a manpage.
692 sub collectnames {
693     my $filename = shift;
694     $filename =~ m|man(\d)/|;
695     my $section = $1;
696     my $simplename = basename($filename, ".pod");
697     my $id = "${filename}:1:";
698     my %podinfo = extract_pod_info($filename, { debug => $debug });
699
700     unless ( grep { $simplename eq $_ } @{$podinfo{names}} ) {
701         err($id, "$simplename not in NAME section");
702         push @{$podinfo{names}}, $simplename;
703     }
704     foreach my $name ( @{$podinfo{names}} ) {
705         next if $name eq "";
706         err($id, "'$name' contains white space")
707             if $name =~ /\s/;
708         my $name_sec = "$name($section)";
709         if ( !exists $name_map{$name_sec} ) {
710             $name_map{$name_sec} = $filename;
711         } elsif ( $filename eq $name_map{$name_sec} ) {
712             err($id, "$name_sec duplicated in NAME section of",
713                  $name_map{$name_sec});
714         } else {
715             err($id, "$name_sec also in NAME section of",
716                  $name_map{$name_sec});
717         }
718     }
719
720     if ( $podinfo{contents} =~ /=for openssl foreign manual (.*)\n/ ) {
721         foreach my $f ( split / /, $1 ) {
722             $name_map{$f} = undef; # It still exists!
723         }
724     }
725
726     my @links =
727         $podinfo{contents} =~ /L<
728                               # if the link is of the form L<something|name(s)>,
729                               # then remove 'something'.  Note that 'something'
730                               # may contain POD codes as well...
731                               (?:(?:[^\|]|<[^>]*>)*\|)?
732                               # we're only interested in references that have
733                               # a one digit section number
734                               ([^\/>\(]+\(\d\))
735                              /gx;
736     $link_map{$filename} = [ @links ];
737 }
738
739 # Look for L<> ("link") references that point to files that do not exist.
740 sub checklinks {
741     foreach my $filename ( sort keys %link_map ) {
742         foreach my $link ( @{$link_map{$filename}} ) {
743             err("${filename}:1:", "reference to non-existing $link")
744                 unless exists $name_map{$link};
745         }
746     }
747 }
748
749 # Load the public symbol/macro names
750 sub publicize {
751     foreach my $name ( parsenum('util/libcrypto.num') ) {
752         $public{$name} = 1;
753     }
754     foreach my $name ( parsenum('util/libssl.num') ) {
755         $public{$name} = 1;
756     }
757     foreach my $name ( parsenum('util/other.syms') ) {
758         $public{$name} = 1;
759     }
760 }
761
762 # Cipher/digests to skip if they show up as "not implemented"
763 # because they are, via the "-*" construct.
764 my %skips = (
765     'aes128' => 1,
766     'aes192' => 1,
767     'aes256' => 1,
768     'aria128' => 1,
769     'aria192' => 1,
770     'aria256' => 1,
771     'camellia128' => 1,
772     'camellia192' => 1,
773     'camellia256' => 1,
774     'des' => 1,
775     'des3' => 1,
776     'idea' => 1,
777     'cipher' => 1,
778     'digest' => 1,
779 );
780
781 # Check the flags of a command and see if everything is in the manpage
782 sub checkflags {
783     my $cmd = shift;
784     my $doc = shift;
785     my %cmdopts;
786     my %docopts;
787     my %localskips;
788
789     # Get the list of options in the command.
790     open CFH, "./apps/openssl list --options $cmd|"
791         or die "Can list options for $cmd, $!";
792     while ( <CFH> ) {
793         chop;
794         s/ .$//;
795         $cmdopts{$_} = 1;
796     }
797     close CFH;
798
799     # Get the list of flags from the synopsis
800     open CFH, "<$doc"
801         or die "Can't open $doc, $!";
802     while ( <CFH> ) {
803         chop;
804         last if /DESCRIPTION/;
805         if ( /=for openssl ifdef (.*)/ ) {
806             foreach my $f ( split / /, $1 ) {
807                 $localskips{$f} = 1;
808             }
809             next;
810         }
811         my $opt;
812         if ( /\[B<-([^ >]+)/ ) {
813             $opt = $1;
814         } elsif ( /^B<-([^ >]+)/ ) {
815             $opt = $1;
816         } else {
817             next;
818         }
819         $opt = $1 if $opt =~ /I<(.*)/;
820         $docopts{$1} = 1;
821     }
822     close CFH;
823
824     # See what's in the command not the manpage.
825     my @undocced = sort grep { !defined $docopts{$_} } keys %cmdopts;
826     foreach ( @undocced ) {
827         next if /-/; # Skip the -- end-of-flags marker
828         err("$doc: undocumented option -$_");
829     }
830
831     # See what's in the command not the manpage.
832     my @unimpl = sort grep { !defined $cmdopts{$_} } keys %docopts;
833     foreach ( @unimpl ) {
834         next if defined $skips{$_} || defined $localskips{$_};
835         err("$doc: $cmd does not implement -$_");
836     }
837 }
838
839 ##
840 ##  MAIN()
841 ##  Do the work requested by the various getopt flags.
842 ##  The flags are parsed in alphabetical order, just because we have
843 ##  to have *some way* of listing them.
844 ##
845
846 if ( $opt_c ) {
847     my @commands = ();
848
849     # Get list of commands.
850     open FH, "./apps/openssl list -1 -commands|"
851         or die "Can't list commands, $!";
852     while ( <FH> ) {
853         chop;
854         push @commands, $_;
855     }
856     close FH;
857
858     # See if each has a manpage.
859     foreach my $cmd ( @commands ) {
860         next if $cmd eq 'help' || $cmd eq 'exit';
861         my $doc = "doc/man1/openssl-$cmd.pod";
862         # Handle "tsget" and "CA.pl" pod pages
863         $doc = "doc/man1/$cmd.pod" if -f "doc/man1/$cmd.pod";
864         if ( ! -f "$doc" ) {
865             err("$doc does not exist");
866         } else {
867             checkflags($cmd, $doc);
868         }
869     }
870
871     # See what help is missing.
872     open FH, "./apps/openssl list --missing-help |"
873         or die "Can't list missing help, $!";
874     while ( <FH> ) {
875         chop;
876         my ($cmd, $flag) = split;
877         err("$cmd has no help for -$flag");
878     }
879     close FH;
880
881     exit $status;
882 }
883
884 # Preparation for some options, populate %name_map and %link_map
885 if ( $opt_l || $opt_u || $opt_v ) {
886     foreach ( glob('doc/*/*.pod doc/internal/*/*.pod') ) {
887         collectnames($_);
888     }
889 }
890
891 if ( $opt_l ) {
892     foreach my $func ( loadmissing("util/missingcrypto.txt") ) {
893         $name_map{$func} = undef;
894     }
895     checklinks();
896 }
897
898 if ( $opt_n ) {
899     publicize();
900     foreach ( @ARGV ? @ARGV : glob('doc/*/*.pod doc/internal/*/*.pod') ) {
901         check($_);
902     }
903
904     # If not given args, check that all man1 commands are named properly.
905     if ( scalar @ARGV == 0 ) {
906         foreach ( glob('doc/man1/*.pod') ) {
907             next if /CA.pl/ || /openssl\.pod/ || /tsget\.pod/;
908             err("$_ doesn't start with openssl-") unless /openssl-/;
909         }
910     }
911 }
912
913 if ( $opt_u || $opt_v) {
914     if ( $opt_o ) {
915         printem('crypto', 'util/libcrypto.num', 'util/missingcrypto111.txt');
916         printem('ssl', 'util/libssl.num', 'util/missingssl111.txt');
917     } else {
918         printem('crypto', 'util/libcrypto.num', 'util/missingcrypto.txt');
919         printem('ssl', 'util/libssl.num', 'util/missingssl.txt');
920     }
921     checkmacros();
922 }
923
924 exit $status;