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