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