]>
Commit | Line | Data |
---|---|---|
1bc74519 | 1 | #! /usr/bin/env perl |
4333b89f | 2 | # Copyright 2002-2021 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 | |
1624ebdb | 14 | use Carp qw(:DEFAULT cluck); |
1bc74519 RS |
15 | use Pod::Checker; |
16 | use File::Find; | |
169a8e39 | 17 | use File::Basename; |
71a8b855 | 18 | use File::Spec::Functions; |
35ea640a | 19 | use Getopt::Std; |
1624ebdb RL |
20 | use FindBin; |
21 | use lib "$FindBin::Bin/perl"; | |
22 | ||
71a8b855 | 23 | use OpenSSL::Util::Pod; |
35ea640a | 24 | |
1624ebdb RL |
25 | use lib '.'; |
26 | use configdata; | |
27 | ||
a397aca4 RS |
28 | # Set to 1 for debug output |
29 | my $debug = 0; | |
705128b0 | 30 | |
71a8b855 | 31 | # Options. |
8d50b9c1 | 32 | our($opt_d); |
b5283535 MC |
33 | our($opt_e); |
34 | our($opt_s); | |
a03749a8 | 35 | our($opt_o); |
71a8b855 | 36 | our($opt_h); |
9e183d22 | 37 | our($opt_l); |
414823d2 | 38 | our($opt_m); |
8d50b9c1 | 39 | our($opt_n); |
274d1bee | 40 | our($opt_p); |
8d50b9c1 | 41 | our($opt_u); |
b5283535 | 42 | our($opt_v); |
e75138ab | 43 | our($opt_c); |
71a8b855 | 44 | |
185ec4be | 45 | # Print usage message and exit. |
fbad6e79 | 46 | sub help { |
71a8b855 RS |
47 | print <<EOF; |
48 | Find small errors (nits) in documentation. Options: | |
5be56c49 | 49 | -c List undocumented commands, undocumented options and unimplemented options. |
8d50b9c1 | 50 | -d Detailed list of undocumented (implies -u) |
b5283535 | 51 | -e Detailed list of new undocumented (implies -v) |
185ec4be | 52 | -h Print this help message |
9e183d22 | 53 | -l Print bogus links |
414823d2 | 54 | -m Name(s) of manuals to focus on. Default: man1,man3,man5,man7 |
71a8b855 | 55 | -n Print nits in POD pages |
185ec4be | 56 | -o Causes -e/-v to count symbols added since 1.1.1 as new (implies -v) |
ee4afacd | 57 | -u Count undocumented functions |
b5283535 | 58 | -v Count new undocumented functions |
71a8b855 RS |
59 | EOF |
60 | exit; | |
61 | } | |
1bc74519 | 62 | |
414823d2 | 63 | getopts('cdehlm:nouv'); |
185ec4be RS |
64 | |
65 | help() if $opt_h; | |
66 | $opt_u = 1 if $opt_d; | |
67 | $opt_v = 1 if $opt_o || $opt_e; | |
68 | die "Cannot use both -u and -v" | |
69 | if $opt_u && $opt_v; | |
70 | die "Cannot use both -d and -e" | |
71 | if $opt_d && $opt_e; | |
72 | ||
73 | # We only need to check c, l, n, u and v. | |
74 | # Options d, e, o imply one of the above. | |
75 | die "Need one of -[cdehlnouv] flags.\n" | |
76 | unless $opt_c or $opt_l or $opt_n or $opt_u or $opt_v; | |
77 | ||
78 | ||
05ea606a RS |
79 | my $temp = '/tmp/docnits.txt'; |
80 | my $OUT; | |
fbad6e79 | 81 | my $status = 0; |
05ea606a | 82 | |
414823d2 DDO |
83 | $opt_m = "man1,man3,man5,man7" unless $opt_m; |
84 | die "Argument of -m option may contain only man1, man3, man5, and/or man7" | |
85 | unless $opt_m =~ /^(man[1357][, ]?)*$/; | |
86 | my @sections = ( split /[, ]/, $opt_m ); | |
87 | ||
a397aca4 RS |
88 | my %mandatory_sections = ( |
89 | '*' => [ 'NAME', 'DESCRIPTION', 'COPYRIGHT' ], | |
90 | 1 => [ 'SYNOPSIS', 'OPTIONS' ], | |
91 | 3 => [ 'SYNOPSIS', 'RETURN VALUES' ], | |
92 | 5 => [ ], | |
93 | 7 => [ ] | |
8270c479 RL |
94 | ); |
95 | ||
96 | # Symbols that we ignored. | |
3b1bfd21 | 97 | # They are reserved macros that we currently don't document |
8270c479 RL |
98 | my $ignored = qr/(?| ^i2d_ |
99 | | ^d2i_ | |
100 | | ^DEPRECATEDIN | |
3b1bfd21 | 101 | | ^OSSL_DEPRECATED |
8270c479 RL |
102 | | \Q_fnsig(3)\E$ |
103 | | ^IMPLEMENT_ | |
104 | | ^_?DECLARE_ | |
89b46350 MC |
105 | | ^sk_ |
106 | | ^SKM_DEFINE_STACK_OF_INTERNAL | |
282de1cc | 107 | | ^lh_ |
5317b6ee | 108 | | ^DEFINE_LHASH_OF_(INTERNAL|DEPRECATED) |
8270c479 | 109 | )/x; |
a397aca4 | 110 | |
b1415dc1 RL |
111 | # A common regexp for C symbol names |
112 | my $C_symbol = qr/\b[[:alpha:]][_[:alnum:]]*\b/; | |
113 | ||
1624ebdb RL |
114 | # Collect all POD files, both internal and public, and regardless of location |
115 | # We collect them in a hash table with each file being a key, so we can attach | |
116 | # tags to them. For example, internal docs will have the word "internal" | |
117 | # attached to them. | |
118 | my %files = (); | |
119 | # We collect files names on the fly, on known tag basis | |
120 | my %collected_tags = (); | |
121 | # We cache results based on tags | |
122 | my %collected_results = (); | |
123 | ||
124 | # files OPTIONS | |
125 | # | |
126 | # Example: | |
127 | # | |
128 | # files(TAGS => 'manual'); | |
129 | # files(TAGS => [ 'manual', 'man1' ]); | |
130 | # | |
131 | # This function returns an array of files corresponding to a set of tags | |
132 | # given with the options "TAGS". The value of this option can be a single | |
133 | # word, or an array of several words, which work as inclusive or exclusive | |
134 | # selectors. Inclusive selectors are used to add one more set of files to | |
135 | # the returned array, while exclusive selectors limit the set of files added | |
136 | # to the array. The recognised tag values are: | |
137 | # | |
138 | # 'public_manual' - inclusive selector, adds public manuals to the | |
139 | # returned array of files. | |
140 | # 'internal_manual' - inclusive selector, adds internal manuals to the | |
141 | # returned array of files. | |
142 | # 'manual' - inclusive selector, adds any manual to the returned | |
143 | # array of files. This is really a shorthand for | |
144 | # 'public_manual' and 'internal_manual' combined. | |
145 | # 'public_header' - inclusive selector, adds public headers to the | |
146 | # returned array of files. | |
147 | # 'header' - inclusive selector, adds any header file to the | |
148 | # returned array of files. Since we currently only | |
149 | # care about public headers, this is exactly | |
150 | # equivalent to 'public_header', but is present for | |
151 | # consistency. | |
152 | # | |
153 | # 'man1', 'man3', 'man5', 'man7' | |
154 | # - exclusive selectors, only applicable together with | |
155 | # any of the manual selectors. If any of these are | |
156 | # present, only the manuals from the given sections | |
414823d2 | 157 | # will be included. If none of these are present, |
1624ebdb RL |
158 | # the manuals from all sections will be returned. |
159 | # | |
160 | # All returned manual files come from configdata.pm. | |
161 | # All returned header files come from looking inside | |
162 | # "$config{sourcedir}/include/openssl" | |
163 | # | |
164 | sub files { | |
165 | my %opts = ( @_ ); # Make a copy of the arguments | |
166 | ||
167 | $opts{TAGS} = [ $opts{TAGS} ] if ref($opts{TAGS}) eq ''; | |
168 | ||
169 | croak "No tags given, or not an array" | |
170 | unless exists $opts{TAGS} && ref($opts{TAGS}) eq 'ARRAY'; | |
171 | ||
172 | my %tags = map { $_ => 1 } @{$opts{TAGS}}; | |
173 | $tags{public_manual} = 1 | |
174 | if $tags{manual} && ($tags{public} // !$tags{internal}); | |
175 | $tags{internal_manual} = 1 | |
176 | if $tags{manual} && ($tags{internal} // !$tags{public}); | |
177 | $tags{public_header} = 1 | |
178 | if $tags{header} && ($tags{public} // !$tags{internal}); | |
179 | delete $tags{manual}; | |
180 | delete $tags{header}; | |
181 | delete $tags{public}; | |
182 | delete $tags{internal}; | |
183 | ||
184 | my $tags_as_key = join(':', sort keys %tags); | |
185 | ||
186 | cluck "DEBUG[files]: This is how we got here!" if $debug; | |
187 | print STDERR "DEBUG[files]: tags: $tags_as_key\n" if $debug; | |
188 | ||
189 | my %tags_to_collect = ( map { $_ => 1 } | |
190 | grep { !exists $collected_tags{$_} } | |
191 | keys %tags ); | |
192 | ||
193 | if ($tags_to_collect{public_manual}) { | |
194 | print STDERR "DEBUG[files]: collecting public manuals\n" | |
195 | if $debug; | |
196 | ||
197 | # The structure in configdata.pm is that $unified_info{mandocs} | |
198 | # contains lists of man files, and in turn, $unified_info{depends} | |
199 | # contains hash tables showing which POD file each of those man | |
200 | # files depend on. We use that information to find the POD files, | |
201 | # and to attach the man section they belong to as tags | |
202 | foreach my $mansect ( @sections ) { | |
203 | foreach ( map { @{$unified_info{depends}->{$_}} } | |
204 | @{$unified_info{mandocs}->{$mansect}} ) { | |
205 | $files{$_} = { $mansect => 1, public_manual => 1 }; | |
206 | } | |
207 | } | |
208 | $collected_tags{public_manual} = 1; | |
209 | } | |
210 | ||
211 | if ($tags_to_collect{internal_manual}) { | |
212 | print STDERR "DEBUG[files]: collecting internal manuals\n" | |
213 | if $debug; | |
214 | ||
215 | # We don't have the internal docs in configdata.pm. However, they | |
216 | # are all in the source tree, so they're easy to find. | |
217 | foreach my $mansect ( @sections ) { | |
218 | foreach ( glob(catfile($config{sourcedir}, | |
219 | 'doc', 'internal', $mansect, '*.pod')) ) { | |
220 | $files{$_} = { $mansect => 1, internal_manual => 1 }; | |
221 | } | |
222 | } | |
223 | $collected_tags{internal_manual} = 1; | |
224 | } | |
225 | ||
226 | if ($tags_to_collect{public_header}) { | |
227 | print STDERR "DEBUG[files]: collecting public headers\n" | |
228 | if $debug; | |
229 | ||
230 | foreach ( glob(catfile($config{sourcedir}, | |
231 | 'include', 'openssl', '*.h')) ) { | |
232 | $files{$_} = { public_header => 1 }; | |
233 | } | |
234 | } | |
235 | ||
236 | my @result = @{$collected_results{$tags_as_key} // []}; | |
237 | ||
238 | if (!@result) { | |
239 | # Produce a result based on caller tags | |
240 | foreach my $type ( ( 'public_manual', 'internal_manual' ) ) { | |
241 | next unless $tags{$type}; | |
242 | ||
243 | # If caller asked for specific sections, we care about sections. | |
244 | # Otherwise, we give back all of them. | |
245 | my @selected_sections = | |
246 | grep { $tags{$_} } @sections; | |
247 | @selected_sections = @sections unless @selected_sections; | |
248 | ||
249 | foreach my $section ( ( @selected_sections ) ) { | |
250 | push @result, | |
251 | ( sort { basename($a) cmp basename($b) } | |
252 | grep { $files{$_}->{$type} && $files{$_}->{$section} } | |
253 | keys %files ); | |
254 | } | |
255 | } | |
256 | if ($tags{public_header}) { | |
257 | push @result, | |
258 | ( sort { basename($a) cmp basename($b) } | |
259 | grep { $files{$_}->{public_header} } | |
260 | keys %files ); | |
261 | } | |
262 | ||
263 | if ($debug) { | |
264 | print STDERR "DEBUG[files]: result:\n"; | |
265 | print STDERR "DEBUG[files]: $_\n" foreach @result; | |
266 | } | |
267 | $collected_results{$tags_as_key} = [ @result ]; | |
268 | } | |
269 | ||
270 | return @result; | |
271 | } | |
169a8e39 | 272 | |
fbad6e79 RS |
273 | # Print error message, set $status. |
274 | sub err { | |
275 | print join(" ", @_), "\n"; | |
276 | $status = 1 | |
277 | } | |
278 | ||
35ea640a | 279 | # Cross-check functions in the NAME and SYNOPSIS section. |
fbad6e79 | 280 | sub name_synopsis { |
35ea640a RS |
281 | my $id = shift; |
282 | my $filename = shift; | |
283 | my $contents = shift; | |
284 | ||
35ea640a RS |
285 | # Get NAME section and all words in it. |
286 | return unless $contents =~ /=head1 NAME(.*)=head1 SYNOPSIS/ms; | |
287 | my $tmp = $1; | |
288 | $tmp =~ tr/\n/ /; | |
ad090d57 | 289 | err($id, "Trailing comma before - in NAME") |
fbad6e79 | 290 | if $tmp =~ /, *-/; |
2bcb232e | 291 | $tmp =~ s/ -.*//g; |
fbad6e79 RS |
292 | err($id, "POD markup among the names in NAME") |
293 | if $tmp =~ /[<>]/; | |
2bcb232e | 294 | $tmp =~ s/ */ /g; |
ad090d57 | 295 | err($id, "Missing comma in NAME") |
fbad6e79 | 296 | if $tmp =~ /[^,] /; |
fbba5d11 RS |
297 | |
298 | my $dirname = dirname($filename); | |
1624ebdb RL |
299 | my $section = basename($dirname); |
300 | my $simplename = basename($filename, ".pod"); | |
fbba5d11 RS |
301 | my $foundfilename = 0; |
302 | my %foundfilenames = (); | |
35ea640a | 303 | my %names; |
23ab880d RL |
304 | foreach my $n ( split ',', $tmp ) { |
305 | $n =~ s/^\s+//; | |
306 | $n =~ s/\s+$//; | |
ad090d57 | 307 | err($id, "The name '$n' contains white-space") |
23ab880d | 308 | if $n =~ /\s/; |
35ea640a | 309 | $names{$n} = 1; |
fbba5d11 RS |
310 | $foundfilename++ if $n eq $simplename; |
311 | $foundfilenames{$n} = 1 | |
1624ebdb RL |
312 | if ( ( grep { basename($_) eq "$n.pod" } |
313 | files(TAGS => [ 'manual', $section ]) ) | |
314 | && $n ne $simplename ); | |
35ea640a | 315 | } |
ad090d57 | 316 | err($id, "The following exist as other .pod files:", |
fbad6e79 | 317 | sort keys %foundfilenames) |
fbba5d11 | 318 | if %foundfilenames; |
fbad6e79 | 319 | err($id, "$simplename (filename) missing from NAME section") |
fbba5d11 | 320 | unless $foundfilename; |
35ea640a RS |
321 | |
322 | # Find all functions in SYNOPSIS | |
323 | return unless $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms; | |
324 | my $syn = $1; | |
8eca4617 | 325 | my $ignore_until = undef; # If defined, this is a regexp |
d3cb5904 RL |
326 | # Remove all non-code lines |
327 | $syn =~ s/^(?:\s*?|\S.*?)$//msg; | |
328 | # Remove all comments | |
329 | $syn =~ s/\/\*.*?\*\///msg; | |
330 | while ( $syn ) { | |
331 | # "env" lines end at a newline. | |
332 | # Preprocessor lines start with a # and end at a newline. | |
333 | # Other lines end with a semicolon, and may cover more than | |
334 | # one physical line. | |
335 | if ( $syn !~ /^ \s*(env .*?|#.*?|.*?;)\s*$/ms ) { | |
336 | err($id, "Can't parse rest of synopsis:\n$syn\n(declarations not ending with a semicolon (;)?)"); | |
337 | last; | |
338 | } | |
339 | my $line = $1; | |
340 | $syn = $'; | |
341 | ||
8eca4617 RL |
342 | print STDERR "DEBUG[name_synopsis] \$line = '$line'\n" if $debug; |
343 | ||
344 | # Special code to skip over documented structures | |
345 | if ( defined $ignore_until) { | |
346 | next if $line !~ /$ignore_until/; | |
347 | $ignore_until = undef; | |
348 | next; | |
349 | } | |
350 | if ( $line =~ /^\s*(?:typedef\s+)?struct(?:\s+\S+)\s*\{/ ) { | |
351 | $ignore_until = qr/\}.*?;/; | |
352 | next; | |
353 | } | |
354 | ||
8162f6f5 | 355 | my $sym; |
31d3a759 | 356 | my $is_prototype = 1; |
de3379c9 | 357 | $line =~ s/LHASH_OF\([^)]+\)/int/g; |
c952780c | 358 | $line =~ s/STACK_OF\([^)]+\)/int/g; |
4460ad90 | 359 | $line =~ s/SPARSE_ARRAY_OF\([^)]+\)/int/g; |
c952780c | 360 | $line =~ s/__declspec\([^)]+\)//; |
93e32043 RL |
361 | |
362 | ## We don't prohibit that space, to allow typedefs looking like | |
363 | ## this: | |
364 | ## | |
365 | ## typedef int (fantastically_long_name_breaks_80char_limit) | |
366 | ## (fantastically_long_name_breaks_80char_limit *something); | |
367 | ## | |
368 | #if ( $line =~ /typedef.*\(\*?\S+\)\s+\(/ ) { | |
369 | # # a callback function with whitespace before the argument list: | |
370 | # # typedef ... (*NAME) (... | |
371 | # # typedef ... (NAME) (... | |
372 | # err($id, "Function typedef has space before arg list: $line"); | |
373 | #} | |
374 | ||
121677b4 RS |
375 | if ( $line =~ /env (\S*)=/ ) { |
376 | # environment variable env NAME=... | |
377 | $sym = $1; | |
b1415dc1 | 378 | } elsif ( $line =~ /typedef.*\(\*?($C_symbol)\)\s*\(/ ) { |
0ed78e78 | 379 | # a callback function pointer: typedef ... (*NAME)(... |
93e32043 | 380 | # a callback function signature: typedef ... (NAME)(... |
0ed78e78 | 381 | $sym = $1; |
b1415dc1 | 382 | } elsif ( $line =~ /typedef.*($C_symbol)\s*\(/ ) { |
0ed78e78 | 383 | # a callback function signature: typedef ... NAME(... |
121677b4 | 384 | $sym = $1; |
b1415dc1 | 385 | } elsif ( $line =~ /typedef.*($C_symbol);/ ) { |
121677b4 | 386 | # a simple typedef: typedef ... NAME; |
31d3a759 | 387 | $is_prototype = 0; |
8162f6f5 | 388 | $sym = $1; |
b1415dc1 | 389 | } elsif ( $line =~ /enum ($C_symbol) \{/ ) { |
d4ea9659 RS |
390 | # an enumeration: enum ... { |
391 | $sym = $1; | |
b1415dc1 | 392 | } elsif ( $line =~ /#\s*(?:define|undef) ($C_symbol)/ ) { |
31d3a759 | 393 | $is_prototype = 0; |
8162f6f5 | 394 | $sym = $1; |
b1415dc1 | 395 | } elsif ( $line =~ /^[^\(]*?\(\*($C_symbol)\s*\(/ ) { |
8eca4617 RL |
396 | # a function returning a function pointer: TYPE (*NAME(args))(args) |
397 | $sym = $1; | |
b1415dc1 | 398 | } elsif ( $line =~ /^[^\(]*?($C_symbol)\s*\(/ ) { |
8eca4617 | 399 | # a simple function declaration |
8162f6f5 RS |
400 | $sym = $1; |
401 | } | |
402 | else { | |
403 | next; | |
404 | } | |
8eca4617 RL |
405 | |
406 | print STDERR "DEBUG[name_synopsis] \$sym = '$sym'\n" if $debug; | |
407 | ||
fbad6e79 | 408 | err($id, "$sym missing from NAME section") |
8162f6f5 RS |
409 | unless defined $names{$sym}; |
410 | $names{$sym} = 2; | |
aebb9aac RS |
411 | |
412 | # Do some sanity checks on the prototype. | |
ad090d57 | 413 | err($id, "Prototype missing spaces around commas: $line") |
93e32043 | 414 | if $is_prototype && $line =~ /[a-z0-9],[^\s]/; |
35ea640a RS |
415 | } |
416 | ||
417 | foreach my $n ( keys %names ) { | |
418 | next if $names{$n} == 2; | |
fbad6e79 | 419 | err($id, "$n missing from SYNOPSIS") |
35ea640a RS |
420 | } |
421 | } | |
422 | ||
39a117d1 | 423 | # Check if SECTION ($3) is located before BEFORE ($4) |
fbad6e79 | 424 | sub check_section_location { |
39a117d1 | 425 | my $id = shift; |
cc838ee2 | 426 | my $contents = shift; |
95f92d57 JL |
427 | my $section = shift; |
428 | my $before = shift; | |
cc838ee2 | 429 | |
485d3361 RS |
430 | return unless $contents =~ /=head1 $section/ |
431 | and $contents =~ /=head1 $before/; | |
fbad6e79 | 432 | err($id, "$section should appear before $before section") |
95f92d57 | 433 | if $contents =~ /=head1 $before.*=head1 $section/ms; |
cc838ee2 PY |
434 | } |
435 | ||
485d3361 RS |
436 | # Check if a =head1 is duplicated, or a =headX is duplicated within a |
437 | # =head1. Treats =head2 =head3 as equivalent -- it doesn't reset the head3 | |
438 | # sets if it finds a =head2 -- but that is good enough for now. Also check | |
439 | # for proper capitalization, trailing periods, etc. | |
fbad6e79 | 440 | sub check_head_style { |
485d3361 RS |
441 | my $id = shift; |
442 | my $contents = shift; | |
443 | my %head1; | |
444 | my %subheads; | |
445 | ||
446 | foreach my $line ( split /\n+/, $contents ) { | |
447 | next unless $line =~ /^=head/; | |
448 | if ( $line =~ /head1/ ) { | |
ad090d57 | 449 | err($id, "Duplicate section $line") |
485d3361 RS |
450 | if defined $head1{$line}; |
451 | $head1{$line} = 1; | |
452 | %subheads = (); | |
453 | } else { | |
ad090d57 | 454 | err($id, "Duplicate subsection $line") |
485d3361 RS |
455 | if defined $subheads{$line}; |
456 | $subheads{$line} = 1; | |
457 | } | |
ad090d57 | 458 | err($id, "Period in =head") |
485d3361 | 459 | if $line =~ /\.[^\w]/ or $line =~ /\.$/; |
fbad6e79 | 460 | err($id, "not all uppercase in =head1") |
485d3361 | 461 | if $line =~ /head1.*[a-z]/; |
ad090d57 | 462 | err($id, "All uppercase in subhead") |
485d3361 RS |
463 | if $line =~ /head[234][ A-Z0-9]+$/; |
464 | } | |
465 | } | |
466 | ||
705128b0 RL |
467 | # Because we have options and symbols with extra markup, we need |
468 | # to take that into account, so we need a regexp that extracts | |
469 | # markup chunks, including recursive markup. | |
470 | # please read up on /(?R)/ in perlre(1) | |
471 | # (note: order is important, (?R) needs to come before .) | |
472 | # (note: non-greedy is important, or something like 'B<foo> and B<bar>' | |
473 | # will be captured as one item) | |
474 | my $markup_re = | |
475 | qr/( # Capture group | |
476 | [BIL]< # The start of what we recurse on | |
79c44b4e | 477 | (?:(?-1)|.)*? # recurse the whole regexp (referring to |
705128b0 RL |
478 | # the last opened capture group, i.e. the |
479 | # start of this regexp), or pick next | |
480 | # character. Do NOT be greedy! | |
481 | > # The end of what we recurse on | |
482 | )/x; # (the x allows this sort of split up regexp) | |
483 | ||
484 | # Options must start with a dash, followed by a letter, possibly | |
485 | # followed by letters, digits, dashes and underscores, and the last | |
486 | # character must be a letter or a digit. | |
487 | # We do also accept the single -? or -n, where n is a digit | |
488 | my $option_re = | |
489 | qr/(?: | |
490 | \? # Single question mark | |
491 | | | |
492 | \d # Single digit | |
493 | | | |
494 | - # Single dash (--) | |
495 | | | |
496 | [[:alpha:]](?:[-_[:alnum:]]*?[[:alnum:]])? | |
497 | )/x; | |
498 | ||
499 | # Helper function to check if a given $thing is properly marked up | |
500 | # option. It returns one of these values: | |
a397aca4 RS |
501 | # undef if it's not an option |
502 | # "" if it's a malformed option | |
503 | # $unwrapped the option with the outermost B<> wrapping removed. | |
705128b0 RL |
504 | sub normalise_option { |
505 | my $id = shift; | |
506 | my $filename = shift; | |
507 | my $thing = shift; | |
508 | ||
509 | my $unwrapped = $thing; | |
510 | my $unmarked = $thing; | |
511 | ||
512 | # $unwrapped is the option with the outer B<> markup removed | |
513 | $unwrapped =~ s/^B<//; | |
514 | $unwrapped =~ s/>$//; | |
515 | # $unmarked is the option with *all* markup removed | |
516 | $unmarked =~ s/[BIL]<|>//msg; | |
517 | ||
518 | ||
519 | # If we found an option, check it, collect it | |
520 | if ( $unwrapped =~ /^\s*-/ ) { | |
521 | return $unwrapped # return option with outer B<> removed | |
522 | if $unmarked =~ /^-${option_re}$/; | |
523 | return ""; # Malformed option | |
524 | } | |
525 | return undef; # Something else | |
526 | } | |
527 | ||
528 | # Checks of command option (man1) formatting. The man1 checks are | |
529 | # restricted to the SYNOPSIS and OPTIONS sections, the rest is too | |
530 | # free form, we simply cannot be too strict there. | |
531 | ||
532 | sub option_check { | |
533 | my $id = shift; | |
534 | my $filename = shift; | |
535 | my $contents = shift; | |
536 | ||
537 | my $synopsis = ($contents =~ /=head1\s+SYNOPSIS(.*?)=head1/s, $1); | |
538 | ||
539 | # Some pages have more than one OPTIONS section, let's make sure | |
540 | # to get them all | |
541 | my $options = ''; | |
542 | while ( $contents =~ /=head1\s+[A-Z ]*?OPTIONS$(.*?)(?==head1)/msg ) { | |
543 | $options .= $1; | |
544 | } | |
545 | ||
546 | # Look for options with no or incorrect markup | |
547 | while ( $synopsis =~ | |
548 | /(?<![-<[:alnum:]])-(?:$markup_re|.)*(?![->[:alnum:]])/msg ) { | |
549 | err($id, "Malformed option [1] in SYNOPSIS: $&"); | |
550 | } | |
551 | ||
9c158280 | 552 | my @synopsis; |
705128b0 RL |
553 | while ( $synopsis =~ /$markup_re/msg ) { |
554 | my $found = $&; | |
9c158280 | 555 | push @synopsis, $found if $found =~ /^B<-/; |
705128b0 RL |
556 | print STDERR "$id:DEBUG[option_check] SYNOPSIS: found $found\n" |
557 | if $debug; | |
558 | my $option_uw = normalise_option($id, $filename, $found); | |
559 | err($id, "Malformed option [2] in SYNOPSIS: $found") | |
560 | if defined $option_uw && $option_uw eq ''; | |
561 | } | |
562 | ||
563 | # In OPTIONS, we look for =item paragraphs. | |
564 | # (?=^\s*$) detects an empty line. | |
9c158280 | 565 | my @options; |
705128b0 RL |
566 | while ( $options =~ /=item\s+(.*?)(?=^\s*$)/msg ) { |
567 | my $item = $&; | |
568 | ||
569 | while ( $item =~ /(\[\s*)?($markup_re)/msg ) { | |
570 | my $found = $2; | |
571 | print STDERR "$id:DEBUG[option_check] OPTIONS: found $&\n" | |
572 | if $debug; | |
573 | err($id, "Unexpected bracket in OPTIONS =item: $item") | |
574 | if ($1 // '') ne '' && $found =~ /^B<\s*-/; | |
575 | ||
576 | my $option_uw = normalise_option($id, $filename, $found); | |
577 | err($id, "Malformed option in OPTIONS: $found") | |
578 | if defined $option_uw && $option_uw eq ''; | |
9c158280 DDO |
579 | if ($found =~ /^B<-/) { |
580 | push @options, $found; | |
581 | err($id, "OPTIONS entry $found missing from SYNOPSIS") | |
582 | unless (grep /^\Q$found\E$/, @synopsis) | |
583 | || $id =~ /(openssl|-options)\.pod:1:$/; | |
584 | } | |
705128b0 RL |
585 | } |
586 | } | |
9c158280 DDO |
587 | foreach (@synopsis) { |
588 | my $option = $_; | |
589 | err($id, "SYNOPSIS entry $option missing from OPTIONS") | |
590 | unless (grep /^\Q$option\E$/, @options); | |
591 | } | |
705128b0 RL |
592 | } |
593 | ||
594 | # Normal symbol form | |
595 | my $symbol_re = qr/[[:alpha:]_][_[:alnum:]]*?/; | |
596 | ||
597 | # Checks of function name (man3) formatting. The man3 checks are | |
598 | # easier than the man1 checks, we only check the names followed by (), | |
599 | # and only the names that have POD markup. | |
705128b0 RL |
600 | sub functionname_check { |
601 | my $id = shift; | |
602 | my $filename = shift; | |
603 | my $contents = shift; | |
604 | ||
605 | while ( $contents =~ /($markup_re)\(\)/msg ) { | |
606 | print STDERR "$id:DEBUG[functionname_check] SYNOPSIS: found $&\n" | |
607 | if $debug; | |
608 | ||
609 | my $symbol = $1; | |
610 | my $unmarked = $symbol; | |
611 | $unmarked =~ s/[BIL]<|>//msg; | |
612 | ||
613 | err($id, "Malformed symbol: $symbol") | |
8270c479 | 614 | unless $symbol =~ /^B<.*?>$/ && $unmarked =~ /^${symbol_re}$/ |
705128b0 RL |
615 | } |
616 | ||
617 | # We can't do the kind of collecting coolness that option_check() | |
618 | # does, because there are too many things that can't be found in | |
619 | # name repositories like the NAME sections, such as symbol names | |
620 | # with a variable part (typically marked up as B<foo_I<TYPE>_bar> | |
621 | } | |
622 | ||
60a7817c RS |
623 | # This is from http://man7.org/linux/man-pages/man7/man-pages.7.html |
624 | my %preferred_words = ( | |
490c8711 | 625 | '16bit' => '16-bit', |
8c1cbc72 | 626 | 'a.k.a.' => 'aka', |
60a7817c RS |
627 | 'bitmask' => 'bit mask', |
628 | 'builtin' => 'built-in', | |
629 | #'epoch' => 'Epoch', # handled specially, below | |
52b0bb38 | 630 | 'fall-back' => 'fallback', |
60a7817c RS |
631 | 'file name' => 'filename', |
632 | 'file system' => 'filesystem', | |
633 | 'host name' => 'hostname', | |
634 | 'i-node' => 'inode', | |
635 | 'lower case' => 'lowercase', | |
636 | 'lower-case' => 'lowercase', | |
490c8711 GN |
637 | 'manpage' => 'man page', |
638 | 'non-blocking' => 'nonblocking', | |
639 | 'non-default' => 'nondefault', | |
640 | 'non-empty' => 'nonempty', | |
641 | 'non-negative' => 'nonnegative', | |
60a7817c RS |
642 | 'non-zero' => 'nonzero', |
643 | 'path name' => 'pathname', | |
490c8711 | 644 | 'pre-allocated' => 'preallocated', |
60a7817c | 645 | 'pseudo-terminal' => 'pseudoterminal', |
60a7817c | 646 | 'real time' => 'real-time', |
490c8711 GN |
647 | 'realtime' => 'real-time', |
648 | 'reserved port' => 'privileged port', | |
60a7817c RS |
649 | 'runtime' => 'run time', |
650 | 'saved group ID'=> 'saved set-group-ID', | |
651 | 'saved set-GID' => 'saved set-group-ID', | |
60a7817c | 652 | 'saved set-UID' => 'saved set-user-ID', |
490c8711 | 653 | 'saved user ID' => 'saved set-user-ID', |
60a7817c | 654 | 'set-GID' => 'set-group-ID', |
60a7817c | 655 | 'set-UID' => 'set-user-ID', |
490c8711 | 656 | 'setgid' => 'set-group-ID', |
60a7817c | 657 | 'setuid' => 'set-user-ID', |
490c8711 | 658 | 'sub-system' => 'subsystem', |
60a7817c RS |
659 | 'super block' => 'superblock', |
660 | 'super-block' => 'superblock', | |
490c8711 GN |
661 | 'super user' => 'superuser', |
662 | 'super-user' => 'superuser', | |
663 | 'system port' => 'privileged port', | |
60a7817c RS |
664 | 'time stamp' => 'timestamp', |
665 | 'time zone' => 'timezone', | |
666 | 'upper case' => 'uppercase', | |
667 | 'upper-case' => 'uppercase', | |
668 | 'useable' => 'usable', | |
60a7817c | 669 | 'user name' => 'username', |
490c8711 | 670 | 'userspace' => 'user space', |
60a7817c RS |
671 | 'zeroes' => 'zeros' |
672 | ); | |
673 | ||
a397aca4 | 674 | # Search manpage for words that have a different preferred use. |
60a7817c RS |
675 | sub wording { |
676 | my $id = shift; | |
677 | my $contents = shift; | |
678 | ||
679 | foreach my $k ( keys %preferred_words ) { | |
9c0586d5 RS |
680 | # Sigh, trademark |
681 | next if $k eq 'file system' | |
682 | and $contents =~ /Microsoft Encrypted File System/; | |
ad090d57 | 683 | err($id, "Found '$k' should use '$preferred_words{$k}'") |
60a7817c RS |
684 | if $contents =~ /\b\Q$k\E\b/i; |
685 | } | |
ad090d57 | 686 | err($id, "Found 'epoch' should use 'Epoch'") |
60a7817c | 687 | if $contents =~ /\bepoch\b/; |
4b537191 RS |
688 | if ( $id =~ m@man1/@ ) { |
689 | err($id, "found 'tool' in NAME, should use 'command'") | |
690 | if $contents =~ /=head1 NAME.*\btool\b.*=head1 SYNOPSIS/s; | |
691 | err($id, "found 'utility' in NAME, should use 'command'") | |
692 | if $contents =~ /NAME.*\butility\b.*=head1 SYNOPSIS/s; | |
693 | ||
694 | } | |
60a7817c RS |
695 | } |
696 | ||
a397aca4 | 697 | # Perform all sorts of nit/error checks on a manpage |
fbad6e79 | 698 | sub check { |
8270c479 RL |
699 | my %podinfo = @_; |
700 | my $filename = $podinfo{filename}; | |
169a8e39 | 701 | my $dirname = basename(dirname($filename)); |
8270c479 | 702 | my $contents = $podinfo{contents}; |
843666ff RS |
703 | |
704 | my $id = "${filename}:1:"; | |
fbad6e79 | 705 | check_head_style($id, $contents); |
35ea640a | 706 | |
39a117d1 RS |
707 | # Check ordering of some sections in man3 |
708 | if ( $filename =~ m|man3/| ) { | |
fbad6e79 RS |
709 | check_section_location($id, $contents, "RETURN VALUES", "EXAMPLES"); |
710 | check_section_location($id, $contents, "SEE ALSO", "HISTORY"); | |
711 | check_section_location($id, $contents, "EXAMPLES", "SEE ALSO"); | |
39a117d1 RS |
712 | } |
713 | ||
6e4618a0 RS |
714 | # Make sure every link has a section. |
715 | while ( $contents =~ /$markup_re/msg ) { | |
716 | my $target = $1; | |
76fde1db RL |
717 | next unless $target =~ /^L<(.*)>$/; # Skip if not L<...> |
718 | $target = $1; # Peal away L< and > | |
719 | $target =~ s/\/[^\/]*$//; # Peal away possible anchor | |
720 | $target =~ s/.*\|//g; # Peal away possible link text | |
721 | next if $target eq ''; # Skip if links within page, or | |
6e4618a0 | 722 | next if $target =~ /::/; # links to a Perl module, or |
76fde1db RL |
723 | next if $target =~ /^https?:/; # is a URL link, or |
724 | next if $target =~ /\([1357]\)$/; # it has a section | |
6e4618a0 RS |
725 | err($id, "Section missing in $target") |
726 | } | |
1903a9b7 RS |
727 | # Check for proper links to commands. |
728 | while ( $contents =~ /L<([^>]*)\(1\)(?:\/.*)?>/g ) { | |
729 | my $target = $1; | |
730 | next if $target =~ /openssl-?/; | |
1624ebdb RL |
731 | next if ( grep { basename($_) eq "$target.pod" } |
732 | files(TAGS => [ 'manual', 'man1' ]) ); | |
1903a9b7 | 733 | next if $target =~ /ps|apropos|sha1sum|procmail|perl/; |
414823d2 | 734 | err($id, "Bad command link L<$target(1)>") if grep /man1/, @sections; |
1903a9b7 | 735 | } |
6e4618a0 RS |
736 | # Check for proper in-man-3 API links. |
737 | while ( $contents =~ /L<([^>]*)\(3\)(?:\/.*)?>/g ) { | |
738 | my $target = $1; | |
739 | err($id, "Bad L<$target>") | |
740 | unless $target =~ /^[_[:alpha:]][_[:alnum:]]*$/ | |
741 | } | |
742 | ||
8270c479 | 743 | unless ( $contents =~ /^=for openssl generic/ms ) { |
705128b0 RL |
744 | if ( $filename =~ m|man3/| ) { |
745 | name_synopsis($id, $filename, $contents); | |
746 | functionname_check($id, $filename, $contents); | |
747 | } elsif ( $filename =~ m|man1/| ) { | |
748 | option_check($id, $filename, $contents) | |
749 | } | |
750 | } | |
35ea640a | 751 | |
60a7817c RS |
752 | wording($id, $contents); |
753 | ||
ad090d57 | 754 | err($id, "Doesn't start with =pod") |
05ea606a | 755 | if $contents !~ /^=pod/; |
ad090d57 | 756 | err($id, "Doesn't end with =cut") |
05ea606a | 757 | if $contents !~ /=cut\n$/; |
ad090d57 | 758 | err($id, "More than one cut line.") |
05ea606a | 759 | if $contents =~ /=cut.*=cut/ms; |
fbad6e79 | 760 | err($id, "EXAMPLE not EXAMPLES section.") |
cda77422 | 761 | if $contents =~ /=head1 EXAMPLE[^S]/; |
fbad6e79 | 762 | err($id, "WARNING not WARNINGS section.") |
5e0d9c86 | 763 | if $contents =~ /=head1 WARNING[^S]/; |
ad090d57 | 764 | err($id, "Missing copyright") |
05ea606a | 765 | if $contents !~ /Copyright .* The OpenSSL Project Authors/; |
ad090d57 | 766 | err($id, "Copyright not last") |
05ea606a | 767 | if $contents =~ /head1 COPYRIGHT.*=head/ms; |
fbad6e79 | 768 | err($id, "head2 in All uppercase") |
843666ff | 769 | if $contents =~ /head2\s+[A-Z ]+\n/; |
ad090d57 | 770 | err($id, "Extra space after head") |
35ea640a | 771 | if $contents =~ /=head\d\s\s+/; |
ad090d57 | 772 | err($id, "Period in NAME section") |
35ea640a | 773 | if $contents =~ /=head1 NAME.*\.\n.*=head1 SYNOPSIS/ms; |
fbad6e79 | 774 | err($id, "Duplicate $1 in L<>") |
5a3371e2 | 775 | if $contents =~ /L<([^>]*)\|([^>]*)>/ && $1 eq $2; |
fbad6e79 | 776 | err($id, "Bad =over $1") |
2f61bc2e | 777 | if $contents =~ /=over([^ ][^24])/; |
fbad6e79 | 778 | err($id, "Possible version style issue") |
e90fc053 | 779 | if $contents =~ /OpenSSL version [019]/; |
843666ff | 780 | |
bb82531f | 781 | if ( $contents !~ /=for openssl multiple includes/ ) { |
a95d7574 RS |
782 | # Look for multiple consecutive openssl #include lines |
783 | # (non-consecutive lines are okay; see man3/MD5.pod). | |
843666ff RS |
784 | if ( $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms ) { |
785 | my $count = 0; | |
786 | foreach my $line ( split /\n+/, $1 ) { | |
787 | if ( $line =~ m@include <openssl/@ ) { | |
ad090d57 | 788 | err($id, "Has multiple includes") |
fbad6e79 | 789 | if ++$count == 2; |
843666ff RS |
790 | } else { |
791 | $count = 0; | |
792 | } | |
793 | } | |
794 | } | |
795 | } | |
05ea606a | 796 | |
35ea640a RS |
797 | open my $OUT, '>', $temp |
798 | or die "Can't open $temp, $!"; | |
bf57cab7 RL |
799 | err($id, "POD errors") |
800 | if podchecker($filename, $OUT) != 0; | |
35ea640a RS |
801 | close $OUT; |
802 | open $OUT, '<', $temp | |
803 | or die "Can't read $temp, $!"; | |
804 | while ( <$OUT> ) { | |
805 | next if /\(section\) in.*deprecated/; | |
806 | print; | |
807 | } | |
808 | close $OUT; | |
809 | unlink $temp || warn "Can't remove $temp, $!"; | |
a95d7574 RS |
810 | |
811 | # Find what section this page is in; assume 3. | |
812 | my $section = 3; | |
813 | $section = $1 if $dirname =~ /man([1-9])/; | |
814 | ||
a397aca4 | 815 | foreach ( (@{$mandatory_sections{'*'}}, @{$mandatory_sections{$section}}) ) { |
ad090d57 | 816 | err($id, "Missing $_ head1 section") |
a95d7574 RS |
817 | if $contents !~ /^=head1\s+${_}\s*$/m; |
818 | } | |
05ea606a | 819 | } |
1bc74519 | 820 | |
8270c479 RL |
821 | # Information database ############################################### |
822 | ||
823 | # Map of links in each POD file; filename => [ "foo(1)", "bar(3)", ... ] | |
824 | my %link_map = (); | |
825 | # Map of names in each POD file or from "missing" files; possible values are: | |
826 | # If found in a POD files, "name(s)" => filename | |
827 | # If found in a "missing" file or external, "name(s)" => '' | |
828 | my %name_map = (); | |
829 | ||
830 | # State of man-page names. | |
831 | # %state is affected by loading util/*.num and util/*.syms | |
832 | # Values may be one of: | |
833 | # 'crypto' : belongs in libcrypto (loaded from libcrypto.num) | |
834 | # 'ssl' : belongs in libssl (loaded from libssl.num) | |
835 | # 'other' : belongs in libcrypto or libssl (loaded from other.syms) | |
836 | # 'internal' : Internal | |
837 | # 'public' : Public (generic name or external documentation) | |
838 | # Any of these values except 'public' may be prefixed with 'missing_' | |
839 | # to indicate that they are known to be missing. | |
840 | my %state; | |
841 | # %missing is affected by loading util/missing*.txt. Values may be one of: | |
842 | # 'crypto' : belongs in libcrypto (loaded from libcrypto.num) | |
843 | # 'ssl' : belongs in libssl (loaded from libssl.num) | |
844 | # 'other' : belongs in libcrypto or libssl (loaded from other.syms) | |
845 | # 'internal' : Internal | |
846 | my %missing; | |
847 | ||
a397aca4 | 848 | # Parse libcrypto.num, etc., and return sorted list of what's there. |
8270c479 | 849 | sub loadnum ($;$) { |
71a8b855 | 850 | my $file = shift; |
8270c479 RL |
851 | my $type = shift; |
852 | my @symbols; | |
71a8b855 | 853 | |
1624ebdb | 854 | open my $IN, '<', catfile($config{sourcedir}, $file) |
71a8b855 RS |
855 | or die "Can't open $file, $!, stopped"; |
856 | ||
857 | while ( <$IN> ) { | |
274d1bee | 858 | next if /^#/; |
71a8b855 | 859 | next if /\bNOEXIST\b/; |
1722496f | 860 | my @fields = split(); |
bc6ca4cb | 861 | die "Malformed line $. in $file: $_" |
1722496f | 862 | if scalar @fields != 2 && scalar @fields != 4; |
8270c479 | 863 | $state{$fields[0].'(3)'} = $type // 'internal'; |
71a8b855 | 864 | } |
71a8b855 | 865 | close $IN; |
71a8b855 RS |
866 | } |
867 | ||
a397aca4 | 868 | # Load file of symbol names that we know aren't documented. |
8270c479 | 869 | sub loadmissing($;$) |
b5283535 MC |
870 | { |
871 | my $missingfile = shift; | |
8270c479 | 872 | my $type = shift; |
b5283535 | 873 | |
1624ebdb | 874 | open FH, catfile($config{sourcedir}, $missingfile) |
fadb57e5 | 875 | or die "Can't open $missingfile"; |
b5283535 MC |
876 | while ( <FH> ) { |
877 | chomp; | |
878 | next if /^#/; | |
8270c479 | 879 | $missing{$_} = $type // 'internal'; |
b5283535 MC |
880 | } |
881 | close FH; | |
8270c479 | 882 | } |
b5283535 | 883 | |
8270c479 RL |
884 | # Check that we have consistent public / internal documentation and declaration |
885 | sub checkstate () { | |
886 | # Collect all known names, no matter where they come from | |
887 | my %names = map { $_ => 1 } (keys %name_map, keys %state, keys %missing); | |
888 | ||
889 | # Check section 3, i.e. functions and macros | |
890 | foreach ( grep { $_ =~ /\(3\)$/ } sort keys %names ) { | |
891 | next if ( $name_map{$_} // '') eq '' || $_ =~ /$ignored/; | |
892 | ||
893 | # If a man-page isn't recorded public or if it's recorded missing | |
894 | # and internal, it's declared to be internal. | |
895 | my $declared_internal = | |
896 | ($state{$_} // 'internal') eq 'internal' | |
897 | || ($missing{$_} // '') eq 'internal'; | |
898 | # If a man-page isn't recorded internal or if it's recorded missing | |
899 | # and not internal, it's declared to be public | |
900 | my $declared_public = | |
901 | ($state{$_} // 'internal') ne 'internal' | |
902 | || ($missing{$_} // 'internal') ne 'internal'; | |
903 | ||
904 | err("$_ is supposedly public but is documented as internal") | |
905 | if ( $declared_public && $name_map{$_} =~ /\/internal\// ); | |
bf973d06 | 906 | err("$_ is supposedly internal (maybe missing from other.syms) but is documented as public") |
8270c479 | 907 | if ( $declared_internal && $name_map{$_} !~ /\/internal\// ); |
17fa385d | 908 | } |
b5283535 MC |
909 | } |
910 | ||
a397aca4 RS |
911 | # Check for undocumented macros; ignore those in the "missing" file |
912 | # and do simple check for #define in our header files. | |
fbad6e79 | 913 | sub checkmacros { |
9a2dfc0f | 914 | my $count = 0; |
ee4afacd | 915 | my %seen; |
b5283535 | 916 | |
1624ebdb | 917 | foreach my $f ( files(TAGS => 'public_header') ) { |
9a2dfc0f | 918 | # Skip some internals we don't want to document yet. |
1624ebdb RL |
919 | my $b = basename($f); |
920 | next if $b eq 'asn1.h'; | |
921 | next if $b eq 'asn1t.h'; | |
922 | next if $b eq 'err.h'; | |
fadb57e5 RS |
923 | open(IN, $f) |
924 | or die "Can't open $f, $!"; | |
9a2dfc0f RS |
925 | while ( <IN> ) { |
926 | next unless /^#\s*define\s*(\S+)\(/; | |
b4350db5 | 927 | my $macro = "$1(3)"; # We know they're all in section 3 |
8270c479 RL |
928 | next if defined $name_map{$macro} |
929 | || defined $missing{$macro} | |
930 | || defined $seen{$macro} | |
931 | || $macro =~ /$ignored/; | |
14ee781e | 932 | |
185ec4be | 933 | err("$f:", "macro $macro undocumented") |
fbad6e79 | 934 | if $opt_d || $opt_e; |
9a2dfc0f | 935 | $count++; |
ee4afacd | 936 | $seen{$macro} = 1; |
9a2dfc0f RS |
937 | } |
938 | close(IN); | |
939 | } | |
185ec4be RS |
940 | err("# $count macros undocumented (count is approximate)") |
941 | if $count > 0; | |
9a2dfc0f RS |
942 | } |
943 | ||
a397aca4 RS |
944 | # Find out what is undocumented (filtering out the known missing ones) |
945 | # and display them. | |
8270c479 RL |
946 | sub printem ($) { |
947 | my $type = shift; | |
71a8b855 | 948 | my $count = 0; |
b5283535 | 949 | |
c4de5d22 RL |
950 | foreach my $func ( grep { $state{$_} eq $type } sort keys %state ) { |
951 | next if defined $name_map{$func} | |
952 | || defined $missing{$func}; | |
8270c479 RL |
953 | |
954 | err("$type:", "function $func undocumented") | |
fbad6e79 | 955 | if $opt_d || $opt_e; |
71a8b855 RS |
956 | $count++; |
957 | } | |
8270c479 | 958 | err("# $count lib$type names are not documented") |
185ec4be | 959 | if $count > 0; |
71a8b855 RS |
960 | } |
961 | ||
a397aca4 | 962 | # Collect all the names in a manpage. |
9e183d22 | 963 | sub collectnames { |
8270c479 RL |
964 | my %podinfo = @_; |
965 | my $filename = $podinfo{filename}; | |
9e183d22 RS |
966 | $filename =~ m|man(\d)/|; |
967 | my $section = $1; | |
a397aca4 | 968 | my $simplename = basename($filename, ".pod"); |
9e183d22 | 969 | my $id = "${filename}:1:"; |
8270c479 | 970 | my $is_generic = $podinfo{contents} =~ /^=for openssl generic/ms; |
9e183d22 | 971 | |
b4350db5 | 972 | unless ( grep { $simplename eq $_ } @{$podinfo{names}} ) { |
d2b194d7 | 973 | err($id, "$simplename not in NAME section"); |
b4350db5 | 974 | push @{$podinfo{names}}, $simplename; |
9e183d22 | 975 | } |
fadb57e5 | 976 | foreach my $name ( @{$podinfo{names}} ) { |
9e183d22 | 977 | next if $name eq ""; |
6f72b210 | 978 | err($id, "'$name' contains whitespace") |
d2b194d7 | 979 | if $name =~ /\s/; |
9e183d22 | 980 | my $name_sec = "$name($section)"; |
8270c479 | 981 | if ( !defined $name_map{$name_sec} ) { |
a397aca4 | 982 | $name_map{$name_sec} = $filename; |
c4de5d22 | 983 | $state{$name_sec} //= |
8270c479 RL |
984 | ( $filename =~ /\/internal\// ? 'internal' : 'public' ) |
985 | if $is_generic; | |
a397aca4 | 986 | } elsif ( $filename eq $name_map{$name_sec} ) { |
b4350db5 | 987 | err($id, "$name_sec duplicated in NAME section of", |
a397aca4 | 988 | $name_map{$name_sec}); |
8270c479 | 989 | } elsif ( $name_map{$name_sec} ne '' ) { |
fbad6e79 | 990 | err($id, "$name_sec also in NAME section of", |
a397aca4 | 991 | $name_map{$name_sec}); |
9e183d22 RS |
992 | } |
993 | } | |
994 | ||
fadb57e5 RS |
995 | if ( $podinfo{contents} =~ /=for openssl foreign manual (.*)\n/ ) { |
996 | foreach my $f ( split / /, $1 ) { | |
8270c479 RL |
997 | $name_map{$f} = ''; # It still exists! |
998 | $state{$f} = 'public'; # We assume! | |
fadb57e5 | 999 | } |
9e183d22 RS |
1000 | } |
1001 | ||
0e7e3b9b RL |
1002 | my @links = (); |
1003 | # Don't use this regexp directly on $podinfo{contents}, as it causes | |
1004 | # a regexp recursion, which fails on really big PODs. Instead, use | |
1005 | # $markup_re to pick up general markup, and use this regexp to check | |
1006 | # that the markup that was found is indeed a link. | |
1007 | my $linkre = qr/L< | |
1008 | # if the link is of the form L<something|name(s)>, | |
1009 | # then remove 'something'. Note that 'something' | |
1010 | # may contain POD codes as well... | |
1011 | (?:(?:[^\|]|<[^>]*>)*\|)? | |
1012 | # we're only interested in references that have | |
1013 | # a one digit section number | |
1014 | ([^\/>\(]+\(\d\)) | |
1015 | /x; | |
1016 | while ( $podinfo{contents} =~ /$markup_re/msg ) { | |
1017 | my $x = $1; | |
1018 | ||
1019 | if ($x =~ $linkre) { | |
1020 | push @links, $1; | |
1021 | } | |
1022 | } | |
a397aca4 | 1023 | $link_map{$filename} = [ @links ]; |
9e183d22 RS |
1024 | } |
1025 | ||
a397aca4 | 1026 | # Look for L<> ("link") references that point to files that do not exist. |
9e183d22 | 1027 | sub checklinks { |
fadb57e5 RS |
1028 | foreach my $filename ( sort keys %link_map ) { |
1029 | foreach my $link ( @{$link_map{$filename}} ) { | |
fbad6e79 | 1030 | err("${filename}:1:", "reference to non-existing $link") |
8270c479 RL |
1031 | unless defined $name_map{$link} || defined $missing{$link}; |
1032 | err("${filename}:1:", "reference of internal $link in public documentation $filename") | |
1033 | if ( ( ($state{$link} // '') eq 'internal' | |
1034 | || ($missing{$link} // '') eq 'internal' ) | |
1035 | && $filename !~ /\/internal\// ); | |
9e183d22 RS |
1036 | } |
1037 | } | |
1038 | } | |
1039 | ||
a397aca4 RS |
1040 | # Cipher/digests to skip if they show up as "not implemented" |
1041 | # because they are, via the "-*" construct. | |
e75138ab RS |
1042 | my %skips = ( |
1043 | 'aes128' => 1, | |
1044 | 'aes192' => 1, | |
1045 | 'aes256' => 1, | |
1046 | 'aria128' => 1, | |
1047 | 'aria192' => 1, | |
1048 | 'aria256' => 1, | |
1049 | 'camellia128' => 1, | |
1050 | 'camellia192' => 1, | |
1051 | 'camellia256' => 1, | |
1052 | 'des' => 1, | |
1053 | 'des3' => 1, | |
1054 | 'idea' => 1, | |
1738c0ce RS |
1055 | 'cipher' => 1, |
1056 | 'digest' => 1, | |
e75138ab RS |
1057 | ); |
1058 | ||
f2431fe7 DDO |
1059 | my %genopts; # generic options parsed from apps/include/opt.h |
1060 | ||
a397aca4 | 1061 | # Check the flags of a command and see if everything is in the manpage |
fbad6e79 | 1062 | sub checkflags { |
e75138ab | 1063 | my $cmd = shift; |
bc5a8091 | 1064 | my $doc = shift; |
f2431fe7 | 1065 | my @cmdopts; |
e75138ab | 1066 | my %docopts; |
e75138ab | 1067 | |
f2431fe7 DDO |
1068 | # Get the list of options in the command source file. |
1069 | my $active = 0; | |
1070 | my $expect_helpstr = ""; | |
1071 | open CFH, "apps/$cmd.c" | |
1072 | or die "Can't open apps/$cmd.c to list options for $cmd, $!"; | |
e75138ab RS |
1073 | while ( <CFH> ) { |
1074 | chop; | |
f2431fe7 DDO |
1075 | if ($active) { |
1076 | last if m/^\s*};/; | |
1077 | if ($expect_helpstr ne "") { | |
1078 | next if m/^\s*#\s*if/; | |
1079 | err("$cmd does not implement help for -$expect_helpstr") unless m/^\s*"/; | |
1080 | $expect_helpstr = ""; | |
e34307b8 | 1081 | } |
14d3bb06 DDO |
1082 | if (m/\{\s*"([^"]+)"\s*,\s*OPT_[A-Z0-9_]+\s*,\s*('[-\/:<>cEfFlMnNpsuU]'|0)(.*)$/ |
1083 | && !($cmd eq "s_client" && $1 eq "wdebug")) { | |
f2431fe7 DDO |
1084 | push @cmdopts, $1; |
1085 | $expect_helpstr = $1; | |
14d3bb06 | 1086 | $expect_helpstr = "" if $3 =~ m/^\s*,\s*"/; |
f2431fe7 DDO |
1087 | } elsif (m/[\s,](OPT_[A-Z]+_OPTIONS?)\s*(,|$)/) { |
1088 | push @cmdopts, @{ $genopts{$1} }; | |
1089 | } | |
1090 | } elsif (m/^const\s+OPTIONS\s*/) { | |
1091 | $active = 1; | |
1092 | } | |
e75138ab RS |
1093 | } |
1094 | close CFH; | |
1095 | ||
1096 | # Get the list of flags from the synopsis | |
bc5a8091 | 1097 | open CFH, "<$doc" |
fadb57e5 | 1098 | or die "Can't open $doc, $!"; |
e75138ab RS |
1099 | while ( <CFH> ) { |
1100 | chop; | |
1101 | last if /DESCRIPTION/; | |
65718c51 RS |
1102 | my $opt; |
1103 | if ( /\[B<-([^ >]+)/ ) { | |
1104 | $opt = $1; | |
1105 | } elsif ( /^B<-([^ >]+)/ ) { | |
1106 | $opt = $1; | |
1107 | } else { | |
1108 | next; | |
1109 | } | |
1738c0ce | 1110 | $opt = $1 if $opt =~ /I<(.*)/; |
e75138ab RS |
1111 | $docopts{$1} = 1; |
1112 | } | |
1113 | close CFH; | |
1114 | ||
1115 | # See what's in the command not the manpage. | |
f2431fe7 | 1116 | my @undocced = sort grep { !defined $docopts{$_} } @cmdopts; |
a397aca4 | 1117 | foreach ( @undocced ) { |
5be56c49 | 1118 | err("$doc: undocumented $cmd option -$_"); |
e75138ab RS |
1119 | } |
1120 | ||
1121 | # See what's in the command not the manpage. | |
f2431fe7 | 1122 | my @unimpl = sort grep { my $e = $_; !(grep /^\Q$e\E$/, @cmdopts) } keys %docopts; |
a397aca4 | 1123 | foreach ( @unimpl ) { |
f2431fe7 | 1124 | next if $_ eq "-"; # Skip the -- end-of-flags marker |
47c88d45 | 1125 | next if defined $skips{$_}; |
65718c51 | 1126 | err("$doc: $cmd does not implement -$_"); |
e75138ab | 1127 | } |
e75138ab RS |
1128 | } |
1129 | ||
a397aca4 RS |
1130 | ## |
1131 | ## MAIN() | |
1132 | ## Do the work requested by the various getopt flags. | |
1133 | ## The flags are parsed in alphabetical order, just because we have | |
1134 | ## to have *some way* of listing them. | |
1135 | ## | |
1136 | ||
e75138ab | 1137 | if ( $opt_c ) { |
e75138ab | 1138 | my @commands = (); |
3dfda1a6 | 1139 | |
f2431fe7 DDO |
1140 | # Get the lists of generic options. |
1141 | my $active = ""; | |
f7a19d64 | 1142 | open OFH, catdir($config{sourcedir}, "apps/include/opt.h") |
f2431fe7 DDO |
1143 | or die "Can't open apps/include/opt.h to list generic options, $!"; |
1144 | while ( <OFH> ) { | |
e75138ab | 1145 | chop; |
f2431fe7 DDO |
1146 | push @{ $genopts{$active} }, $1 if $active ne "" && m/^\s+\{\s*"([^"]+)"\s*,\s*OPT_/; |
1147 | $active = $1 if m/^\s*#\s*define\s+(OPT_[A-Z]+_OPTIONS?)\s*\\\s*$/; | |
1148 | $active = "" if m/^\s*$/; | |
e75138ab | 1149 | } |
f2431fe7 DDO |
1150 | close OFH; |
1151 | ||
1152 | # Get list of commands. | |
1153 | opendir(DIR, "apps"); | |
1154 | @commands = grep(/\.c$/, readdir(DIR)); | |
1155 | closedir(DIR); | |
e75138ab RS |
1156 | |
1157 | # See if each has a manpage. | |
bc5a8091 | 1158 | foreach my $cmd ( @commands ) { |
f2431fe7 | 1159 | $cmd =~ s/\.c$//; |
ee56cec7 | 1160 | next if $cmd eq 'progs' || $cmd eq 'vms_decc_init'; |
1624ebdb RL |
1161 | my @doc = ( grep { basename($_) eq "openssl-$cmd.pod" |
1162 | # For "tsget" and "CA.pl" pod pages | |
1163 | || basename($_) eq "$cmd.pod" } | |
1164 | files(TAGS => [ 'manual', 'man1' ]) ); | |
1165 | my $num = scalar @doc; | |
1166 | if ($num > 1) { | |
1167 | err("$num manuals for 'openssl $cmd': ".join(", ", @doc)); | |
1168 | } elsif ($num < 1) { | |
1169 | err("no manual for 'openssl $cmd'"); | |
e75138ab | 1170 | } else { |
1624ebdb | 1171 | checkflags($cmd, @doc); |
e75138ab | 1172 | } |
71a8b855 RS |
1173 | } |
1174 | } | |
9e183d22 | 1175 | |
8270c479 RL |
1176 | # Populate %state |
1177 | loadnum('util/libcrypto.num', 'crypto'); | |
1178 | loadnum('util/libssl.num', 'ssl'); | |
1179 | loadnum('util/other.syms', 'other'); | |
1180 | loadnum('util/other-internal.syms'); | |
1181 | if ( $opt_o ) { | |
1182 | loadmissing('util/missingmacro111.txt', 'crypto'); | |
1183 | loadmissing('util/missingcrypto111.txt', 'crypto'); | |
1184 | loadmissing('util/missingssl111.txt', 'ssl'); | |
e3ce33b3 | 1185 | } elsif ( !$opt_u ) { |
8270c479 RL |
1186 | loadmissing('util/missingmacro.txt', 'crypto'); |
1187 | loadmissing('util/missingcrypto.txt', 'crypto'); | |
1188 | loadmissing('util/missingssl.txt', 'ssl'); | |
1189 | loadmissing('util/missingcrypto-internal.txt'); | |
1190 | loadmissing('util/missingssl-internal.txt'); | |
1191 | } | |
1192 | ||
1193 | if ( $opt_n || $opt_l || $opt_u || $opt_v ) { | |
1194 | my @files_to_read = ( $opt_n && @ARGV ) ? @ARGV : files(TAGS => 'manual'); | |
1195 | ||
1196 | foreach (@files_to_read) { | |
1197 | my %podinfo = extract_pod_info($_, { debug => $debug }); | |
1198 | ||
1199 | collectnames(%podinfo) | |
1200 | if ( $opt_l || $opt_u || $opt_v ); | |
1201 | ||
1202 | check(%podinfo) | |
1203 | if ( $opt_n ); | |
9e183d22 | 1204 | } |
b4350db5 RL |
1205 | } |
1206 | ||
1207 | if ( $opt_l ) { | |
9e183d22 RS |
1208 | checklinks(); |
1209 | } | |
1210 | ||
e75138ab | 1211 | if ( $opt_n ) { |
a6dd3a3a | 1212 | # If not given args, check that all man1 commands are named properly. |
414823d2 | 1213 | if ( scalar @ARGV == 0 && grep /man1/, @sections ) { |
1624ebdb | 1214 | foreach ( files(TAGS => [ 'public_manual', 'man1' ]) ) { |
6b480ee3 DDO |
1215 | next if /openssl\.pod/ |
1216 | || /CA\.pl/ || /tsget\.pod/; # these commands are special cases | |
a6dd3a3a RS |
1217 | err("$_ doesn't start with openssl-") unless /openssl-/; |
1218 | } | |
1219 | } | |
e75138ab RS |
1220 | } |
1221 | ||
8270c479 RL |
1222 | checkstate(); |
1223 | ||
b5283535 | 1224 | if ( $opt_u || $opt_v) { |
8270c479 RL |
1225 | printem('crypto'); |
1226 | printem('ssl'); | |
fbad6e79 | 1227 | checkmacros(); |
1bc74519 | 1228 | } |
05ea606a | 1229 | |
fbad6e79 | 1230 | exit $status; |