]>
Commit | Line | Data |
---|---|---|
1bc74519 | 1 | #! /usr/bin/env perl |
05ea606a RS |
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 | ||
1bc74519 RS |
9 | |
10 | require 5.10.0; | |
11 | use warnings; | |
12 | use strict; | |
13 | use Pod::Checker; | |
14 | use File::Find; | |
169a8e39 | 15 | use File::Basename; |
35ea640a RS |
16 | use Getopt::Std; |
17 | ||
18 | our($opt_s); | |
1bc74519 | 19 | |
05ea606a RS |
20 | my $temp = '/tmp/docnits.txt'; |
21 | my $OUT; | |
22 | ||
169a8e39 RL |
23 | my %mandatory_sections = |
24 | ( '*' => [ 'NAME', 'DESCRIPTION', 'COPYRIGHT' ], | |
25 | 1 => [ 'SYNOPSIS', '(COMMAND\s+)?OPTIONS' ], | |
26 | 3 => [ 'SYNOPSIS', 'RETURN\s+VALUES' ], | |
27 | 5 => [ ], | |
28 | 7 => [ ] ); | |
29 | my %default_sections = | |
30 | ( apps => 1, | |
31 | crypto => 3, | |
32 | ssl => 3 ); | |
33 | ||
35ea640a RS |
34 | # Cross-check functions in the NAME and SYNOPSIS section. |
35 | sub name_synopsis() | |
36 | { | |
37 | my $id = shift; | |
38 | my $filename = shift; | |
39 | my $contents = shift; | |
40 | ||
41 | # If it's a generic page (all lowercase), or apps, skip it. | |
42 | return if $filename =~ /[a-z]+\.pod/; | |
43 | return if $filename =~ m@/apps/@; | |
44 | ||
45 | # Get NAME section and all words in it. | |
46 | return unless $contents =~ /=head1 NAME(.*)=head1 SYNOPSIS/ms; | |
47 | my $tmp = $1; | |
48 | $tmp =~ tr/\n/ /; | |
49 | $tmp =~ s/-.*//g; | |
50 | $tmp =~ s/,//g; | |
51 | my %names; | |
52 | foreach my $n ( split ' ', $tmp ) { | |
53 | $names{$n} = 1; | |
54 | } | |
55 | ||
56 | # Find all functions in SYNOPSIS | |
57 | return unless $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms; | |
58 | my $syn = $1; | |
59 | foreach my $line ( split /\n+/, $syn ) { | |
60 | next if $line =~ /typedef/; | |
61 | next if $line =~ /STACK_OF/; | |
62 | next unless $line =~ /([A-Za-z0-9_]+)\(/; | |
63 | print "$id $1 missing from NAME section\n" | |
64 | unless defined $names{$1}; | |
65 | $names{$1} = 2; | |
66 | } | |
67 | ||
68 | foreach my $n ( keys %names ) { | |
69 | next if $names{$n} == 2; | |
70 | print "$id $n missing from SYNOPSIS\n"; | |
71 | } | |
72 | } | |
73 | ||
1bc74519 RS |
74 | sub check() |
75 | { | |
169a8e39 RL |
76 | my $filename = shift; |
77 | my $dirname = basename(dirname($filename)); | |
843666ff | 78 | |
1bc74519 RS |
79 | my $contents = ''; |
80 | { | |
81 | local $/ = undef; | |
169a8e39 | 82 | open POD, $filename or die "Couldn't open $filename, $!"; |
1bc74519 RS |
83 | $contents = <POD>; |
84 | close POD; | |
85 | } | |
843666ff RS |
86 | |
87 | my $id = "${filename}:1:"; | |
35ea640a RS |
88 | |
89 | &name_synopsis($id, $filename, $contents); | |
90 | ||
91 | print "$id doesn't start with =pod\n" | |
05ea606a | 92 | if $contents !~ /^=pod/; |
35ea640a | 93 | print "$id doesn't end with =cut\n" |
05ea606a | 94 | if $contents !~ /=cut\n$/; |
35ea640a | 95 | print "$id more than one cut line.\n" |
05ea606a | 96 | if $contents =~ /=cut.*=cut/ms; |
35ea640a | 97 | print "$id missing copyright\n" |
05ea606a | 98 | if $contents !~ /Copyright .* The OpenSSL Project Authors/; |
35ea640a | 99 | print "$id copyright not last\n" |
05ea606a | 100 | if $contents =~ /head1 COPYRIGHT.*=head/ms; |
35ea640a | 101 | print "$id head2 in All uppercase\n" |
843666ff | 102 | if $contents =~ /head2\s+[A-Z ]+\n/; |
35ea640a RS |
103 | print "$id extra space after head\n" |
104 | if $contents =~ /=head\d\s\s+/; | |
105 | print "$id period in NAME section\n" | |
106 | if $contents =~ /=head1 NAME.*\.\n.*=head1 SYNOPSIS/ms; | |
107 | print "$id POD markup in NAME section\n" | |
108 | if $contents =~ /=head1 NAME.*[<>].*=head1 SYNOPSIS/ms; | |
843666ff RS |
109 | |
110 | # Look for multiple consecutive openssl #include lines. | |
111 | # Consecutive because of files like md5.pod. Sometimes it's okay | |
112 | # or necessary, as in ssl/SSL_set1_host.pod | |
113 | if ( $contents !~ /=for comment multiple includes/ ) { | |
114 | if ( $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms ) { | |
115 | my $count = 0; | |
116 | foreach my $line ( split /\n+/, $1 ) { | |
117 | if ( $line =~ m@include <openssl/@ ) { | |
118 | if ( ++$count == 2 ) { | |
35ea640a | 119 | print "$id has multiple includes\n"; |
843666ff RS |
120 | } |
121 | } else { | |
122 | $count = 0; | |
123 | } | |
124 | } | |
125 | } | |
126 | } | |
05ea606a | 127 | |
35ea640a RS |
128 | return unless $opt_s; |
129 | ||
843666ff RS |
130 | # Find what section this page is in. If run from "." assume |
131 | # section 3. | |
132 | my $section = $default_sections{$dirname} || 3; | |
169a8e39 RL |
133 | if ($contents =~ /^=for\s+comment\s+openssl_manual_section:\s*(\d+)\s*$/m) { |
134 | $section = $1; | |
135 | } | |
136 | ||
137 | foreach ((@{$mandatory_sections{'*'}}, @{$mandatory_sections{$section}})) { | |
35ea640a | 138 | print "$id doesn't have a head1 section matching $_\n" |
169a8e39 RL |
139 | if $contents !~ /^=head1\s+${_}\s*$/m; |
140 | } | |
141 | ||
35ea640a RS |
142 | open my $OUT, '>', $temp |
143 | or die "Can't open $temp, $!"; | |
169a8e39 | 144 | podchecker($filename, $OUT); |
35ea640a RS |
145 | close $OUT; |
146 | open $OUT, '<', $temp | |
147 | or die "Can't read $temp, $!"; | |
148 | while ( <$OUT> ) { | |
149 | next if /\(section\) in.*deprecated/; | |
150 | print; | |
151 | } | |
152 | close $OUT; | |
153 | unlink $temp || warn "Can't remove $temp, $!"; | |
05ea606a | 154 | } |
1bc74519 | 155 | |
35ea640a RS |
156 | getopts('s'); |
157 | ||
158 | foreach (@ARGV ? @ARGV : glob('doc/*/*.pod')) { | |
05ea606a | 159 | &check($_); |
1bc74519 | 160 | } |
05ea606a | 161 | |
35ea640a | 162 | exit; |