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