|
1 ## |
|
2 ## lint-rc.pl -- OpenPKG rc.* File Checker |
|
3 ## Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/> |
|
4 ## |
|
5 ## This software is property of the OpenPKG GmbH, DE MUC HRB 160208. |
|
6 ## All rights reserved. Licenses which grant limited permission to use, |
|
7 ## copy, modify and distribute this software are available from the |
|
8 ## OpenPKG GmbH. |
|
9 ## |
|
10 ## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED |
|
11 ## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |
|
12 ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. |
|
13 ## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR |
|
14 ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
|
15 ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
|
16 ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF |
|
17 ## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND |
|
18 ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, |
|
19 ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT |
|
20 ## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
|
21 ## SUCH DAMAGE. |
|
22 ## |
|
23 |
|
24 # Perl run-time requirement |
|
25 require 5; |
|
26 BEGIN { |
|
27 eval "use Getopt::Long; use IO;"; |
|
28 if ($@) { |
|
29 print STDERR |
|
30 "lint-rc: ERROR: This command requires a full-size Perl installation!\n" . |
|
31 "lint-rc: HINT: Install OpenPKG \"perl\" package to use this command.\n"; |
|
32 exit(1); |
|
33 } |
|
34 } |
|
35 |
|
36 # OpenPKG instance prefix |
|
37 my $my_prefix = $ENV{'OPENPKG_PREFIX'}; |
|
38 delete $ENV{'OPENPKG_PREFIX'}; |
|
39 |
|
40 # program information |
|
41 my $progname = "lint-rc"; |
|
42 my $progvers = "1.0.0"; |
|
43 |
|
44 # parameters (defaults) |
|
45 my $version = 0; |
|
46 my $verbose = 0; |
|
47 my $help = 0; |
|
48 my $check = 'all'; |
|
49 my $tmpdir = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname"; |
|
50 my $rpm = "$my_prefix/bin/openpkg rpm"; |
|
51 |
|
52 # exception handling support |
|
53 $SIG{__DIE__} = sub { |
|
54 my ($err) = @_; |
|
55 $err =~ s|\s+at\s+.*||s if (not $verbose); |
|
56 print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n"; |
|
57 exit(1); |
|
58 }; |
|
59 |
|
60 # command line parsing |
|
61 Getopt::Long::Configure("bundling"); |
|
62 my $result = GetOptions( |
|
63 'V|version' => \$version, |
|
64 'v|verbose' => \$verbose, |
|
65 'h|help' => \$help, |
|
66 'c|check=s' => \$check, |
|
67 't|tmpdir=s' => \$tmpdir, |
|
68 'r|rpm=s' => \$rpm, |
|
69 ) || die "option parsing failed"; |
|
70 if ($help) { |
|
71 print "Usage: $progname [options] [RPMFILE ...]\n" . |
|
72 "Available options:\n" . |
|
73 " -v,--verbose enable verbose run-time mode\n" . |
|
74 " -h,--help print out this usage page\n" . |
|
75 " -c,--check=CHECKS select checks to perform (default='all')\n" . |
|
76 " -r,--rpm=FILE filesystem path to RPM program\n" . |
|
77 " -t,--tmpdir=PATH filesystem path to temporary directory\n" . |
|
78 " -V,--version print program version\n"; |
|
79 exit(0); |
|
80 } |
|
81 if ($version) { |
|
82 print "OpenPKG $progname $progvers\n"; |
|
83 exit(0); |
|
84 } |
|
85 |
|
86 # verbose message printing |
|
87 sub msg_verbose { |
|
88 my ($msg) = @_; |
|
89 print STDERR "$msg\n" if ($verbose); |
|
90 } |
|
91 |
|
92 # warning message printing |
|
93 sub msg_warning { |
|
94 my ($msg) = @_; |
|
95 print STDERR "$progname:WARNING: $msg\n"; |
|
96 } |
|
97 |
|
98 # error message printing |
|
99 sub msg_error { |
|
100 my ($msg) = @_; |
|
101 print STDERR "$progname:ERROR: $msg\n"; |
|
102 } |
|
103 |
|
104 # determine check list |
|
105 my @check_list = (qw( |
|
106 blank |
|
107 comment |
|
108 section |
|
109 script |
|
110 global |
|
111 )); |
|
112 my @checks = (); |
|
113 if ($check eq 'all') { |
|
114 @checks = @check_list; |
|
115 } |
|
116 else { |
|
117 foreach my $c (split(/,/, $check)) { |
|
118 if (not grep(/^$c$/, @check_list)) { |
|
119 die "invalid check \"$c\""; |
|
120 } |
|
121 push(@checks, $c); |
|
122 } |
|
123 } |
|
124 |
|
125 # global return code |
|
126 $main::GRC = 0; |
|
127 |
|
128 # environment preparation |
|
129 system("rm -rf $tmpdir"); |
|
130 system("mkdir -p $tmpdir"); |
|
131 |
|
132 # iterate over all rc. files |
|
133 foreach my $filename (@ARGV) { |
|
134 my $io = new IO::File "<$filename" |
|
135 or die "unable to open file \"$filename\" for reading"; |
|
136 my $spec; { local $/ = undef; $spec = <$io>; } |
|
137 $io->close; |
|
138 foreach my $check (@checks) { |
|
139 &msg_verbose("$check in $filename"); |
|
140 eval "\&check_$check(\$filename, \$spec);"; |
|
141 } |
|
142 } |
|
143 |
|
144 # environment cleanup |
|
145 system("rm -rf $tmpdir"); |
|
146 |
|
147 # die gracefully |
|
148 exit($main::GRC); |
|
149 |
|
150 ## _________________________________________________________________ |
|
151 ## |
|
152 ## COMMON SUBROUTINES |
|
153 ## _________________________________________________________________ |
|
154 ## |
|
155 |
|
156 sub lines { |
|
157 my ($txt) = @_; |
|
158 my $l = 0; |
|
159 $txt =~ s|\n|$l++, ''|sge; |
|
160 return $l; |
|
161 } |
|
162 |
|
163 sub lint_message { |
|
164 my ($type, $file, $done, $this, $msg) = @_; |
|
165 if (defined($done) and defined($this)) { |
|
166 my $start = &lines($done) + 1; |
|
167 my $end = $start + &lines($this); |
|
168 my $pos = $start; |
|
169 $pos .= "-". $end if ($end > $start); |
|
170 printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg); |
|
171 } |
|
172 else { |
|
173 printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg); |
|
174 } |
|
175 } |
|
176 |
|
177 sub lint_warning { |
|
178 my ($file, $done, $this, $msg) = @_; |
|
179 &lint_message("WARNING", $file, $done, $this, $msg); |
|
180 $main::GRC = 1 if ($main::GRC < 1); |
|
181 } |
|
182 |
|
183 sub lint_error { |
|
184 my ($file, $done, $this, $msg) = @_; |
|
185 &lint_message("ERROR", $file, $done, $this, $msg); |
|
186 $main::GRC = 2 if ($main::GRC < 2); |
|
187 } |
|
188 |
|
189 ## _________________________________________________________________ |
|
190 ## |
|
191 ## CHECK "blank": whitespace and blank lines |
|
192 ## _________________________________________________________________ |
|
193 ## |
|
194 |
|
195 sub check_blank { |
|
196 my ($file, $spec) = @_; |
|
197 |
|
198 # check for CR-LF combination |
|
199 my $done = ''; my $this = ''; my $todo = $spec; |
|
200 while ($todo =~ m/\r\n/s) { |
|
201 $done .= $`; $this = $&; $todo = $'; |
|
202 &lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)"); |
|
203 $done .= $this; |
|
204 } |
|
205 |
|
206 # check for multiple blank lines |
|
207 $done = ''; $this = ''; $todo = $spec; |
|
208 while ($todo =~ m/(\r?\n[ \t]*){3,}/s) { |
|
209 $done .= $`; $this = $&; $todo = $'; |
|
210 &lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)"); |
|
211 $done .= $this; |
|
212 } |
|
213 |
|
214 # check for trailing whitespaces |
|
215 $done = ''; $this = ''; $todo = $spec; |
|
216 while ($todo =~ m/[ \t]+\r?\n/s) { |
|
217 $done .= $`; $this = $&; $todo = $'; |
|
218 if ($done eq '' or $done =~ m|\n$|s) { |
|
219 &lint_warning($file, $done, $this, "whitespace on empty line (expected none)"); |
|
220 } |
|
221 else { |
|
222 &lint_warning($file, $done, $this, "trailing whitespace (expected none)"); |
|
223 } |
|
224 $done .= $this; |
|
225 } |
|
226 |
|
227 # check for bogus line continuations |
|
228 $done = ''; $this = ''; $todo = $spec; |
|
229 while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) { |
|
230 $done .= $`; $this = $&; $todo = $'; |
|
231 &lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)"); |
|
232 $done .= $this; |
|
233 } |
|
234 |
|
235 # check for leading whitespaces before line continuations |
|
236 $done = ''; $this = ''; $todo = $spec; |
|
237 while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) { |
|
238 $done .= $`; $this = $&; $todo = $'; |
|
239 &lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)"); |
|
240 $done .= $this; |
|
241 } |
|
242 |
|
243 # check for leading tabs |
|
244 $done = ''; $this = ''; $todo = $spec; |
|
245 while ($todo =~ m/^ *\t+ *[^ \t]/m) { |
|
246 $done .= $`; $this = $&; $todo = $'; |
|
247 &lint_warning($file, $done, $this, "leading tabs (expected spaces)"); |
|
248 $done .= $this; |
|
249 } |
|
250 |
|
251 # check for mandatory/wished trailing blank line |
|
252 if ($spec !~ m|\n\n$|s) { |
|
253 &lint_warning($file, $done, "", "mandatory/wished trailing blank line at end of file missing (expected one)"); |
|
254 } |
|
255 } |
|
256 |
|
257 ## _________________________________________________________________ |
|
258 ## |
|
259 ## CHECK "comment": sharp-comments |
|
260 ## _________________________________________________________________ |
|
261 ## |
|
262 |
|
263 sub check_comment { |
|
264 my ($file, $spec) = @_; |
|
265 my ($pkg); |
|
266 |
|
267 # determine package name |
|
268 $pkg = $file; |
|
269 $pkg =~ s|^.+/||; |
|
270 $pkg =~ s|^rc\.||; |
|
271 |
|
272 # check "shebang" header |
|
273 my $re = ""; |
|
274 $re .= "#!\@l_prefix\@/bin/openpkg rc\\n"; |
|
275 if ($spec !~ m|^$re|s) { |
|
276 &lint_warning($file, "", "", "invalid shebang header (expected $re)"); |
|
277 } |
|
278 |
|
279 # check comment header |
|
280 my $re = ""; |
|
281 $re .= ".*?\\n##\\n## rc.$pkg -- Run-Commands\\n##\\n\\n"; |
|
282 if ($pkg ne "openpkg" and $spec !~ m|^$re|s) { |
|
283 &lint_warning($file, "", "", "invalid comment header (expected $re)"); |
|
284 } |
|
285 |
|
286 # check for comment indentation |
|
287 my $done .= $`; my $this = $&; my $todo = $'; |
|
288 while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) { |
|
289 $done .= $`; $this = $&; $todo = $'; |
|
290 my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4); |
|
291 if (length($lead) % 2 != 0) { |
|
292 &lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)"); |
|
293 } |
|
294 if (length($lead) > 1 && length($sharp) > 1) { |
|
295 &lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)"); |
|
296 } |
|
297 if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) { |
|
298 &lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)"); |
|
299 } |
|
300 if (length($pad) == 0 && length($text) > 0) { |
|
301 &lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)"); |
|
302 } |
|
303 if (length($pad) > 0 && length($text) == 0) { |
|
304 &lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)"); |
|
305 } |
|
306 $done .= $this; |
|
307 } |
|
308 } |
|
309 |
|
310 ## _________________________________________________________________ |
|
311 ## |
|
312 ## CHECK "section": run command sections |
|
313 ## _________________________________________________________________ |
|
314 ## |
|
315 |
|
316 sub check_section { |
|
317 my ($file, $spec) = @_; |
|
318 |
|
319 my $require = qq{ |
|
320 (%config,)? |
|
321 (%common,)? |
|
322 (%status,)? |
|
323 (%info,)? |
|
324 (%start,)? |
|
325 (%stop,)? |
|
326 (%restart,)? |
|
327 (%reload,)? |
|
328 (%quarterly,)? |
|
329 (%hourly,)? |
|
330 (%daily,)? |
|
331 (%weekly,)? |
|
332 (%monthly,)? |
|
333 (%env,)? |
|
334 }; |
|
335 |
|
336 # check for order of headers |
|
337 my $sections = ""; |
|
338 my $done = ''; my $this = ''; my $todo = $spec; |
|
339 while ($todo =~ m/^(\S+:|%\S+).*$/m) { |
|
340 $done .= $`; $this = $&; $todo = $'; |
|
341 my $section = $1; |
|
342 $sections .= "$section,"; |
|
343 $done .= $this; |
|
344 } |
|
345 my $regex = $require; |
|
346 $regex =~ s|\s+||sg; |
|
347 if ($sections !~ m/^$regex$/s) { |
|
348 $regex =~ s|,| |sg; |
|
349 &lint_error($file, undef, undef, "invalid run command section order (expected \"$regex\")"); |
|
350 } |
|
351 } |
|
352 |
|
353 ## _________________________________________________________________ |
|
354 ## |
|
355 ## CHECK "script": shell scripts |
|
356 ## _________________________________________________________________ |
|
357 ## |
|
358 |
|
359 sub check_script { |
|
360 my ($file, $spec) = @_; |
|
361 |
|
362 my $done = ''; my $this = ''; my $todo = $spec; |
|
363 while ($todo =~ m/(\%(?:config|info|common|status|start|stop|restart|reload|quarterly|hourly|daily|weekly|env))([^\n]*)\n(.*?\n)(?=\%(?:config|info|common|status|start|stop|restart|reload|quarterly|hourly|daily|weekly|env)|$)/s) { |
|
364 $done .= $`; $this = $&; $todo = $'; |
|
365 my ($section, $args, $script) = ($1, $2, $3); |
|
366 |
|
367 # perform checks for a single script section |
|
368 &check_script_section($file, $done, $this, $section, $args, $script); |
|
369 |
|
370 $done .= $this; |
|
371 } |
|
372 } |
|
373 |
|
374 sub check_script_section { |
|
375 my ($file, $outer_done, $outer_this, $section, $args, $script) = @_; |
|
376 my ($done, $this, $todo); |
|
377 my ($pkg, $pkgu); |
|
378 |
|
379 # determine package name |
|
380 $pkg = $file; |
|
381 $pkg =~ s|^.+/||; |
|
382 $pkg =~ s|^rc\.||; |
|
383 |
|
384 # determine package name, dash becomes underscore |
|
385 $pkgu = $pkg; |
|
386 $pkgu =~ s|-|_|; |
|
387 |
|
388 # remove comment contents |
|
389 $outer_this =~ s|^[ \t]*#[^\n]*\n||mg; |
|
390 |
|
391 # check config |
|
392 if ($section =~ m/^%(config)$/) { |
|
393 |
|
394 # check for badly prefixed variables |
|
395 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
396 while ($todo =~ m/ [^=]+=[^\n]+/s) { |
|
397 $done .= $`; $this = $&; $todo = $'; |
|
398 if ($this !~ m/ ([A-Z]+|$pkgu)_[a-z_][a-z0-9_]*=/) { |
|
399 &lint_warning($file, $done, $this, "section $section: badly prefixed variable"); |
|
400 } |
|
401 $done .= $this; |
|
402 } |
|
403 |
|
404 # enforce _enable to default to openpkg_rc_def |
|
405 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
406 if ( $todo =~ m/ [^=]+_enable=[^\n]+/s and $todo !~ m/ [^=]+_enable="\$openpkg_rc_def"\n+/s) { |
|
407 &lint_warning($file, $done, $this, "section $section: wrong default for ${pkgu}_enable"); |
|
408 } |
|
409 |
|
410 if ($pkg eq "openpkg") { |
|
411 # openpkg_rc before _enable, if used, must be the first variable |
|
412 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
413 if ( $todo !~ m/%config\n( [A-Z]+_[a-z_]+=[^\n]*\n)* openpkg_rc_def=[^\n]+?\n openpkg_rc_all=[^\n]+?\n [^=]+_enable=[^\n]+/s) { |
|
414 &lint_warning($file, $done, $this, "section $section: openpkg_rc_def, openpkg_rc_all and ${pkgu}_enable must be the first lowercase variable"); |
|
415 } |
|
416 } |
|
417 else { |
|
418 # _enable, if used, must be the first variable |
|
419 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
420 if ( $todo =~ m/ [^=]+_enable=[^\n]+/s and $todo !~ m/%config\n( [A-Z]+_[a-z_]+=[^\n]*\n)* [^=]+_enable=[^\n]+/s) { |
|
421 &lint_warning($file, $done, $this, "section $section: ${pkgu}_enable must be the first lowercase variable"); |
|
422 } |
|
423 } |
|
424 } |
|
425 |
|
426 if ($section =~ m/^%(config|info|status)$/) { |
|
427 # check illegal use of return/exit |
|
428 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
429 if ( $todo =~ m/[^a-zA-Z0-9_](return|exit)\s/s ) { |
|
430 &lint_warning($file, $done, $this, "section $section: return or exit not allowed here"); |
|
431 } |
|
432 return; |
|
433 } |
|
434 |
|
435 # check rcService only used for enable|usable|active PR#232 |
|
436 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
437 while ( $todo =~ m/rcService\s+\w+\s+(\w+)/s ) { |
|
438 $done .= $`; $this = $&; $todo = $'; |
|
439 if ( $1 !~ m/^(enable|usable|active)$/ ) { |
|
440 &lint_warning($file, $done, $this, "section $section: rcService must check for (enable|usable|active) only, found check for \"$1\""); |
|
441 } |
|
442 $done .= $this; |
|
443 } |
|
444 |
|
445 # check rcService short circuit |
|
446 if ($section !~ m/^%(config|common|info)$/) { |
|
447 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
448 if ( $todo !~ m/^[^\n]+\n rcService $pkg enable yes \|\| exit 0\n/s ) { |
|
449 &lint_warning($file, $done, $this, "section $section: \"rcService ... enable yes\" short circuit missing"); |
|
450 } |
|
451 else { |
|
452 # check rcService package reference |
|
453 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
454 if ( $todo !~ m/\brcService\s+$pkg\s+/s ) { |
|
455 &lint_warning($file, $done, $this, "section $section: rcService referencing wrong package"); |
|
456 } |
|
457 } |
|
458 } |
|
459 |
|
460 # check shell redirections |
|
461 $done = $outer_done; $this = ''; $todo = $outer_this; |
|
462 while ( $todo =~ m/[ \t]+(\d+)?[><][ \t]+\S+/s |
|
463 or $todo =~ m/[ \t]+[><](\&\d+)?[ \t]+\S+/s) { |
|
464 $done .= $`; $this = $&; $todo = $'; |
|
465 &lint_warning($file, $done, $this, "section $section: whitespace after shell redirection (expected none)"); |
|
466 $done .= $this; |
|
467 } |
|
468 } |
|
469 |
|
470 ## _________________________________________________________________ |
|
471 ## |
|
472 ## CHECK "global": globals |
|
473 ## _________________________________________________________________ |
|
474 ## |
|
475 |
|
476 sub check_global { |
|
477 my ($file, $spec) = @_; |
|
478 |
|
479 # utility function: extract a single shell command |
|
480 sub command_extract { |
|
481 my ($script) = @_; |
|
482 my $cmd = ''; |
|
483 while ($script ne '') { |
|
484 $script =~ s/^([ \t]*'[^']*')/ $cmd .= $1, ''/se && next; |
|
485 $script =~ s/^([ \t]*"[^"]*")/ $cmd .= $1, ''/se && next; |
|
486 $script =~ s/^([ \t]*[^ \t;\)\\\r\n]+)/$cmd .= $1, ''/se && next; |
|
487 $script =~ s/^([ \t]*\\[ \t]*\r?\n)/ $cmd .= $1, ''/se && next; |
|
488 last; |
|
489 } |
|
490 return ($cmd, $script); |
|
491 } |
|
492 |
|
493 # check for deprecated use of opServiceEnabled function |
|
494 my $done = ''; my $this = ''; my $todo = $spec; |
|
495 while ($todo =~ m/\bopServiceEnabled\b/s) { |
|
496 $done .= $`; $this = $&; $todo = $'; |
|
497 &lint_warning($file, $done, $this, "deprecated usage of opServiceEnabled macro (expected rcService ... enable yes)"); |
|
498 $done .= $this; |
|
499 } |
|
500 |
|
501 my $done = ''; my $this = ''; my $todo = $spec; |
|
502 while ($todo =~ m/shtool\s+/s) { |
|
503 $done .= $`; $this = $&; $todo = $'; |
|
504 ($this, $todo) = &command_extract($this . $todo); |
|
505 |
|
506 # check for shtool options with no space before argument |
|
507 my $subthis = $this; |
|
508 $subthis =~ s/%{[^}]*?}//sg; |
|
509 $subthis =~ s/'[^']*'//sg; |
|
510 $subthis =~ s/"[^"]*"//sg; |
|
511 $subthis =~ s/[;|&].*$//s; # catch command termination by semicolon, pipe, or, and; |
|
512 if ($subthis =~ m/\s-[a-zA-Z]\S/) { |
|
513 &lint_warning($file, $done, $this, "found use of shtool option with space omitted before argument"); |
|
514 } |
|
515 $done .= $this; |
|
516 } |
|
517 } |