Commit | Line | Data |
---|---|---|
805e021f CE |
1 | #!/usr/bin/perl |
2 | # | |
3 | # Copyright (c) 2013 Sine Nomine Associates | |
4 | # All rights reserved. | |
5 | # | |
6 | # Redistribution and use in source and binary forms, with or without | |
7 | # modification, are permitted provided that the following conditions | |
8 | # are met: | |
9 | # | |
10 | # 1. Redistributions of source code must retain the above copyright | |
11 | # notice, this list of conditions and the following disclaimer. | |
12 | # | |
13 | # 2. Redistributions in binary form must reproduce the above copyright | |
14 | # notice, this list of conditions and the following disclaimer in the | |
15 | # documentation and/or other materials provided with the distribution. | |
16 | # | |
17 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS | |
18 | # IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, | |
19 | # THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR | |
20 | # PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR | |
21 | # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, | |
22 | # EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, | |
23 | # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; | |
24 | # OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, | |
25 | # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR | |
26 | # OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF | |
27 | # ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | |
28 | ||
29 | # checkman - run everything in the given directory of binaries, and try to | |
30 | # find mismatches between the -help output, and the man page for that command | |
31 | ||
32 | use strict; | |
33 | use warnings; | |
34 | ||
35 | use Getopt::Long; | |
36 | use File::Find; | |
37 | ||
38 | my $bindir; | |
39 | my $mandir; | |
40 | ||
41 | sub usage { | |
42 | print STDERR "WARNING: Running checkman can be dangerous, as it tries to \n"; | |
43 | print STDERR "blindly run almost everything in the given binaries dir.\n\n"; | |
44 | print STDERR "Usage: $0 --bindir <binaries_dir> --mandir <manpages_dir>"; | |
45 | } | |
46 | ||
47 | GetOptions( | |
48 | "b|bindir=s" => \$bindir, | |
49 | "M|mandir=s" => \$mandir, | |
50 | ) or die("Error while parsing options\n"); | |
51 | ||
52 | if (not defined($bindir)) { | |
53 | usage(); | |
54 | } | |
55 | if (not defined($mandir)) { | |
56 | usage(); | |
57 | } | |
58 | ||
59 | if (not -d $bindir) { | |
60 | die("--bindir $bindir is not a directory\n"); | |
61 | } | |
62 | if (not -d $mandir) { | |
63 | die("--mandir $mandir is not a directory\n"); | |
64 | } | |
65 | if (not -d "$mandir/man1") { | |
66 | die("--mandir must point to a dir containing man1, man8, etc\n"); | |
67 | } | |
68 | ||
69 | my %cmd_blacklist = ( | |
70 | rmtsysd => '', | |
71 | pagsh => '', | |
72 | 'pagsh.krb' => '', | |
73 | kpwvalid => '', | |
74 | 'afs.rc' => '', | |
75 | ); | |
76 | ||
77 | my %cmd_map; | |
78 | my $mismatch = 0; | |
79 | ||
80 | # find a list of all possible commands we can run, and map them to their full | |
81 | # path | |
82 | find(sub { | |
83 | if (-f and -x and -s) { | |
84 | $cmd_map{$_} = $File::Find::name; | |
85 | } | |
86 | }, $bindir); | |
87 | ||
88 | my %opt_map; | |
89 | my @error_cmds; | |
90 | ||
91 | sub parsehelp($$;$); | |
92 | ||
93 | sub | |
94 | check_opts($$) | |
95 | { | |
96 | my ($manstr, $helpout) = @_; | |
97 | ||
98 | my %help_opts; | |
99 | ||
100 | my %syn_opts; | |
101 | my %man_opts; | |
102 | my %man_just_opts; | |
103 | ||
104 | $helpout =~ tr/\n/ /; | |
105 | ||
106 | # match everything that looks like an option | |
107 | # basically, find stuff that begins with a hyphen, and is surrounded by | |
108 | # brackets or spaces, or precedes a '=' | |
109 | for ($helpout =~ m/(?:\[| )-([a-zA-Z0-9_-]+)(?=\s|[][]|=)/g) { | |
110 | #print " help str $manstr opt -$_\n" if ($manstr =~ /ptserver/); | |
111 | if ($_ eq 'c') { | |
112 | # Almost everything lists '-c' as an alias for '-cell'. | |
113 | # We don't put that in the first synopsis for each man | |
114 | # page, so just pretend it's not there. | |
115 | next; | |
116 | } | |
117 | $help_opts{$_} = 1; | |
118 | } | |
119 | ||
120 | my $manout = `man -s 8,1 -M '$mandir' $manstr 2>/dev/null`; | |
121 | ||
122 | my $insyn = 0; | |
123 | my $inopts = 0; | |
124 | ||
125 | my $syn_sections = 0; | |
126 | my $lastline; | |
127 | my $curline; | |
128 | ||
129 | for (split /^/, $manout) { | |
130 | $lastline = $curline if (defined($curline)); | |
131 | $curline = $_; | |
132 | ||
133 | if (m/^SYNOPSIS$/) { | |
134 | $insyn = 1; | |
135 | $inopts = 0; | |
136 | next; | |
137 | } | |
138 | if (m/^OPTIONS$/) { | |
139 | $insyn = 0; | |
140 | $inopts = 1; | |
141 | next; | |
142 | } | |
143 | if (m/^[A-Z]+$/) { | |
144 | if ($inopts) { | |
145 | # don't need anything after OPTIONS | |
146 | $inopts = 0; | |
147 | last; | |
148 | } | |
149 | $insyn = 0; | |
150 | next; | |
151 | } | |
152 | if (m/^\s+[a-z]/ and $insyn) { | |
153 | $syn_sections++; | |
154 | if ($syn_sections > 1) { | |
155 | # don't need anything in the synopsis after the first area | |
156 | $insyn = 0; | |
157 | next; | |
158 | } | |
159 | } | |
160 | ||
161 | if ($insyn) { | |
162 | # check for options in the synopsis... | |
163 | for (m/(?:\[|\s)-([a-zA-Z0-9_-]+)(?=\s|\]|\[)/g) { | |
164 | #print " man page $manstr syn opt -$_\n" if ($manstr =~ /ptserver/); | |
165 | $syn_opts{$_} = 1; | |
166 | } | |
167 | } | |
168 | if ($inopts) { | |
169 | # check for options in the OPTIONS section | |
170 | #print "last: $lastline, cur: $_\n"; | |
171 | if ($lastline =~ m/^(\s*|OPTIONS)$/ && m/^\s+-[a-zA-Z0-9_-]+/) { | |
172 | # Options only appear after a blank line (or right after the | |
173 | # OPTIONS line), so only go here if the last | |
174 | # line was blank, and we see what looks like an | |
175 | # option as the first thing on the current | |
176 | # line. | |
177 | ||
178 | # Find all options on the current line. Option | |
179 | # aliases can appear on the same =items line, | |
180 | # so get all of the aliases. | |
181 | for (m/\s-([a-zA-Z0-9_-]+)/g) { | |
182 | $man_just_opts{$_} = 1; | |
183 | if (exists $syn_opts{$_}) { | |
184 | # only count them if they also appeared in the synopsis earlier | |
185 | $man_opts{$_} = 1; | |
186 | } | |
187 | } | |
188 | } | |
189 | } | |
190 | } | |
191 | ||
192 | if (not %man_opts and not %syn_opts) { | |
193 | # we found no options in the man page output; so probably, we didn't | |
194 | # actually get a man page back. just print a single message, so we don't | |
195 | # print out something for every single option | |
196 | print "man page $manstr missing\n"; | |
197 | return; | |
198 | } | |
199 | ||
200 | for (keys %help_opts) { | |
201 | if (not exists $man_opts{$_}) { | |
202 | my $extra = ''; | |
203 | if (exists $syn_opts{$_}) { | |
204 | $extra = " from OPTIONS"; | |
205 | } elsif (exists $man_just_opts{$_}) { | |
206 | $extra = " from synopsis"; | |
207 | } | |
208 | ||
209 | print "man page $manstr missing option -$_$extra\n"; | |
210 | $mismatch = 1; | |
211 | } | |
212 | } | |
213 | my %tmphash = (%syn_opts, %man_just_opts); | |
214 | for (keys %tmphash) { | |
215 | if (not exists $help_opts{$_}) { | |
216 | my $extra = ''; | |
217 | if (not exists $syn_opts{$_}) { | |
218 | $extra = " in OPTIONS"; | |
219 | } elsif (not exists $man_just_opts{$_}) { | |
220 | $extra = " in synopsis"; | |
221 | } | |
222 | ||
223 | print "man page $manstr extra option -$_$extra\n"; | |
224 | $mismatch = 1; | |
225 | } | |
226 | } | |
227 | } | |
228 | ||
229 | sub | |
230 | parsehelp($$;$) { | |
231 | my ($cmd, $path, $subcmd) = @_; | |
232 | ||
233 | my $runstr; | |
234 | my $manstr; | |
235 | ||
236 | $runstr = $path; | |
237 | $manstr = $cmd; | |
238 | ||
239 | if (defined($subcmd)) { | |
240 | $runstr = "$path $subcmd"; | |
241 | if ($subcmd ne "initcmd") { | |
242 | $manstr = "$cmd"."_"."$subcmd"; | |
243 | } | |
244 | } | |
245 | ||
246 | if (defined($cmd_blacklist{$cmd})) { | |
247 | return; | |
248 | } | |
249 | ||
250 | my $out = `$runstr -help 2>&1`; | |
251 | if (defined($out)) { | |
252 | if ($out =~ m/^Usage: /) { | |
253 | # actual help output, listing options etc | |
254 | check_opts($manstr, $out); | |
255 | return; | |
256 | } | |
257 | ||
258 | if ($out =~ m/Commands are:$/m) { | |
259 | # multi-command program | |
260 | if (defined($subcmd)) { | |
261 | die("Subcommand $cmd $subcmd gave more subcommands?"); | |
262 | } | |
263 | ||
264 | if ($out =~ m/^initcmd.*initialize the program$/m) { | |
265 | # not actually multi-command; we just need to give the initcmd | |
266 | # pseudo-subcommand | |
267 | parsehelp($cmd, $path, "initcmd"); | |
268 | return; | |
269 | } | |
270 | ||
271 | # find all of the subcommands, and call parsehelp() on them | |
272 | for (split /^/, $out) { | |
273 | chomp; | |
274 | next if m/Commands are:$/; | |
275 | next if m/^apropos\s/ or m/^help\s/; | |
276 | if (m/^(\S+)\s+[\S ]+$/) { | |
277 | parsehelp($cmd, $path, $1); | |
278 | } else { | |
279 | print "for cmd $cmd got unmatched line $_\n"; | |
280 | } | |
281 | } | |
282 | ||
283 | return; | |
284 | } | |
285 | } | |
286 | ||
287 | if (not defined($subcmd)) { | |
288 | $subcmd = ""; | |
289 | } | |
290 | ||
291 | print "Skipped command $path $subcmd\n"; | |
292 | ||
293 | # not sure what to do about this one | |
294 | push @error_cmds, "$path $subcmd"; | |
295 | } | |
296 | ||
297 | for my $cmd (keys %cmd_map) { | |
298 | my $path = $cmd_map{$cmd}; | |
299 | ||
300 | parsehelp($cmd, $path); | |
301 | } | |
302 | ||
303 | exit($mismatch); |