1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/openpkg/lint-rc.pl Tue Jul 31 12:23:42 2012 +0200
1.3 @@ -0,0 +1,517 @@
1.4 +##
1.5 +## lint-rc.pl -- OpenPKG rc.* File Checker
1.6 +## Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
1.7 +##
1.8 +## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
1.9 +## All rights reserved. Licenses which grant limited permission to use,
1.10 +## copy, modify and distribute this software are available from the
1.11 +## OpenPKG GmbH.
1.12 +##
1.13 +## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
1.14 +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
1.15 +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
1.16 +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
1.17 +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1.18 +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1.19 +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
1.20 +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1.21 +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1.22 +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
1.23 +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1.24 +## SUCH DAMAGE.
1.25 +##
1.26 +
1.27 +# Perl run-time requirement
1.28 +require 5;
1.29 +BEGIN {
1.30 + eval "use Getopt::Long; use IO;";
1.31 + if ($@) {
1.32 + print STDERR
1.33 + "lint-rc: ERROR: This command requires a full-size Perl installation!\n" .
1.34 + "lint-rc: HINT: Install OpenPKG \"perl\" package to use this command.\n";
1.35 + exit(1);
1.36 + }
1.37 +}
1.38 +
1.39 +# OpenPKG instance prefix
1.40 +my $my_prefix = $ENV{'OPENPKG_PREFIX'};
1.41 +delete $ENV{'OPENPKG_PREFIX'};
1.42 +
1.43 +# program information
1.44 +my $progname = "lint-rc";
1.45 +my $progvers = "1.0.0";
1.46 +
1.47 +# parameters (defaults)
1.48 +my $version = 0;
1.49 +my $verbose = 0;
1.50 +my $help = 0;
1.51 +my $check = 'all';
1.52 +my $tmpdir = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
1.53 +my $rpm = "$my_prefix/bin/openpkg rpm";
1.54 +
1.55 +# exception handling support
1.56 +$SIG{__DIE__} = sub {
1.57 + my ($err) = @_;
1.58 + $err =~ s|\s+at\s+.*||s if (not $verbose);
1.59 + print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
1.60 + exit(1);
1.61 +};
1.62 +
1.63 +# command line parsing
1.64 +Getopt::Long::Configure("bundling");
1.65 +my $result = GetOptions(
1.66 + 'V|version' => \$version,
1.67 + 'v|verbose' => \$verbose,
1.68 + 'h|help' => \$help,
1.69 + 'c|check=s' => \$check,
1.70 + 't|tmpdir=s' => \$tmpdir,
1.71 + 'r|rpm=s' => \$rpm,
1.72 +) || die "option parsing failed";
1.73 +if ($help) {
1.74 + print "Usage: $progname [options] [RPMFILE ...]\n" .
1.75 + "Available options:\n" .
1.76 + " -v,--verbose enable verbose run-time mode\n" .
1.77 + " -h,--help print out this usage page\n" .
1.78 + " -c,--check=CHECKS select checks to perform (default='all')\n" .
1.79 + " -r,--rpm=FILE filesystem path to RPM program\n" .
1.80 + " -t,--tmpdir=PATH filesystem path to temporary directory\n" .
1.81 + " -V,--version print program version\n";
1.82 + exit(0);
1.83 +}
1.84 +if ($version) {
1.85 + print "OpenPKG $progname $progvers\n";
1.86 + exit(0);
1.87 +}
1.88 +
1.89 +# verbose message printing
1.90 +sub msg_verbose {
1.91 + my ($msg) = @_;
1.92 + print STDERR "$msg\n" if ($verbose);
1.93 +}
1.94 +
1.95 +# warning message printing
1.96 +sub msg_warning {
1.97 + my ($msg) = @_;
1.98 + print STDERR "$progname:WARNING: $msg\n";
1.99 +}
1.100 +
1.101 +# error message printing
1.102 +sub msg_error {
1.103 + my ($msg) = @_;
1.104 + print STDERR "$progname:ERROR: $msg\n";
1.105 +}
1.106 +
1.107 +# determine check list
1.108 +my @check_list = (qw(
1.109 + blank
1.110 + comment
1.111 + section
1.112 + script
1.113 + global
1.114 +));
1.115 +my @checks = ();
1.116 +if ($check eq 'all') {
1.117 + @checks = @check_list;
1.118 +}
1.119 +else {
1.120 + foreach my $c (split(/,/, $check)) {
1.121 + if (not grep(/^$c$/, @check_list)) {
1.122 + die "invalid check \"$c\"";
1.123 + }
1.124 + push(@checks, $c);
1.125 + }
1.126 +}
1.127 +
1.128 +# global return code
1.129 +$main::GRC = 0;
1.130 +
1.131 +# environment preparation
1.132 +system("rm -rf $tmpdir");
1.133 +system("mkdir -p $tmpdir");
1.134 +
1.135 +# iterate over all rc. files
1.136 +foreach my $filename (@ARGV) {
1.137 + my $io = new IO::File "<$filename"
1.138 + or die "unable to open file \"$filename\" for reading";
1.139 + my $spec; { local $/ = undef; $spec = <$io>; }
1.140 + $io->close;
1.141 + foreach my $check (@checks) {
1.142 + &msg_verbose("$check in $filename");
1.143 + eval "\&check_$check(\$filename, \$spec);";
1.144 + }
1.145 +}
1.146 +
1.147 +# environment cleanup
1.148 +system("rm -rf $tmpdir");
1.149 +
1.150 +# die gracefully
1.151 +exit($main::GRC);
1.152 +
1.153 +## _________________________________________________________________
1.154 +##
1.155 +## COMMON SUBROUTINES
1.156 +## _________________________________________________________________
1.157 +##
1.158 +
1.159 +sub lines {
1.160 + my ($txt) = @_;
1.161 + my $l = 0;
1.162 + $txt =~ s|\n|$l++, ''|sge;
1.163 + return $l;
1.164 +}
1.165 +
1.166 +sub lint_message {
1.167 + my ($type, $file, $done, $this, $msg) = @_;
1.168 + if (defined($done) and defined($this)) {
1.169 + my $start = &lines($done) + 1;
1.170 + my $end = $start + &lines($this);
1.171 + my $pos = $start;
1.172 + $pos .= "-". $end if ($end > $start);
1.173 + printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg);
1.174 + }
1.175 + else {
1.176 + printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg);
1.177 + }
1.178 +}
1.179 +
1.180 +sub lint_warning {
1.181 + my ($file, $done, $this, $msg) = @_;
1.182 + &lint_message("WARNING", $file, $done, $this, $msg);
1.183 + $main::GRC = 1 if ($main::GRC < 1);
1.184 +}
1.185 +
1.186 +sub lint_error {
1.187 + my ($file, $done, $this, $msg) = @_;
1.188 + &lint_message("ERROR", $file, $done, $this, $msg);
1.189 + $main::GRC = 2 if ($main::GRC < 2);
1.190 +}
1.191 +
1.192 +## _________________________________________________________________
1.193 +##
1.194 +## CHECK "blank": whitespace and blank lines
1.195 +## _________________________________________________________________
1.196 +##
1.197 +
1.198 +sub check_blank {
1.199 + my ($file, $spec) = @_;
1.200 +
1.201 + # check for CR-LF combination
1.202 + my $done = ''; my $this = ''; my $todo = $spec;
1.203 + while ($todo =~ m/\r\n/s) {
1.204 + $done .= $`; $this = $&; $todo = $';
1.205 + &lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)");
1.206 + $done .= $this;
1.207 + }
1.208 +
1.209 + # check for multiple blank lines
1.210 + $done = ''; $this = ''; $todo = $spec;
1.211 + while ($todo =~ m/(\r?\n[ \t]*){3,}/s) {
1.212 + $done .= $`; $this = $&; $todo = $';
1.213 + &lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)");
1.214 + $done .= $this;
1.215 + }
1.216 +
1.217 + # check for trailing whitespaces
1.218 + $done = ''; $this = ''; $todo = $spec;
1.219 + while ($todo =~ m/[ \t]+\r?\n/s) {
1.220 + $done .= $`; $this = $&; $todo = $';
1.221 + if ($done eq '' or $done =~ m|\n$|s) {
1.222 + &lint_warning($file, $done, $this, "whitespace on empty line (expected none)");
1.223 + }
1.224 + else {
1.225 + &lint_warning($file, $done, $this, "trailing whitespace (expected none)");
1.226 + }
1.227 + $done .= $this;
1.228 + }
1.229 +
1.230 + # check for bogus line continuations
1.231 + $done = ''; $this = ''; $todo = $spec;
1.232 + while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) {
1.233 + $done .= $`; $this = $&; $todo = $';
1.234 + &lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)");
1.235 + $done .= $this;
1.236 + }
1.237 +
1.238 + # check for leading whitespaces before line continuations
1.239 + $done = ''; $this = ''; $todo = $spec;
1.240 + while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) {
1.241 + $done .= $`; $this = $&; $todo = $';
1.242 + &lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)");
1.243 + $done .= $this;
1.244 + }
1.245 +
1.246 + # check for leading tabs
1.247 + $done = ''; $this = ''; $todo = $spec;
1.248 + while ($todo =~ m/^ *\t+ *[^ \t]/m) {
1.249 + $done .= $`; $this = $&; $todo = $';
1.250 + &lint_warning($file, $done, $this, "leading tabs (expected spaces)");
1.251 + $done .= $this;
1.252 + }
1.253 +
1.254 + # check for mandatory/wished trailing blank line
1.255 + if ($spec !~ m|\n\n$|s) {
1.256 + &lint_warning($file, $done, "", "mandatory/wished trailing blank line at end of file missing (expected one)");
1.257 + }
1.258 +}
1.259 +
1.260 +## _________________________________________________________________
1.261 +##
1.262 +## CHECK "comment": sharp-comments
1.263 +## _________________________________________________________________
1.264 +##
1.265 +
1.266 +sub check_comment {
1.267 + my ($file, $spec) = @_;
1.268 + my ($pkg);
1.269 +
1.270 + # determine package name
1.271 + $pkg = $file;
1.272 + $pkg =~ s|^.+/||;
1.273 + $pkg =~ s|^rc\.||;
1.274 +
1.275 + # check "shebang" header
1.276 + my $re = "";
1.277 + $re .= "#!\@l_prefix\@/bin/openpkg rc\\n";
1.278 + if ($spec !~ m|^$re|s) {
1.279 + &lint_warning($file, "", "", "invalid shebang header (expected $re)");
1.280 + }
1.281 +
1.282 + # check comment header
1.283 + my $re = "";
1.284 + $re .= ".*?\\n##\\n## rc.$pkg -- Run-Commands\\n##\\n\\n";
1.285 + if ($pkg ne "openpkg" and $spec !~ m|^$re|s) {
1.286 + &lint_warning($file, "", "", "invalid comment header (expected $re)");
1.287 + }
1.288 +
1.289 + # check for comment indentation
1.290 + my $done .= $`; my $this = $&; my $todo = $';
1.291 + while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) {
1.292 + $done .= $`; $this = $&; $todo = $';
1.293 + my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4);
1.294 + if (length($lead) % 2 != 0) {
1.295 + &lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)");
1.296 + }
1.297 + if (length($lead) > 1 && length($sharp) > 1) {
1.298 + &lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)");
1.299 + }
1.300 + if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) {
1.301 + &lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)");
1.302 + }
1.303 + if (length($pad) == 0 && length($text) > 0) {
1.304 + &lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)");
1.305 + }
1.306 + if (length($pad) > 0 && length($text) == 0) {
1.307 + &lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)");
1.308 + }
1.309 + $done .= $this;
1.310 + }
1.311 +}
1.312 +
1.313 +## _________________________________________________________________
1.314 +##
1.315 +## CHECK "section": run command sections
1.316 +## _________________________________________________________________
1.317 +##
1.318 +
1.319 +sub check_section {
1.320 + my ($file, $spec) = @_;
1.321 +
1.322 + my $require = qq{
1.323 + (%config,)?
1.324 + (%common,)?
1.325 + (%status,)?
1.326 + (%info,)?
1.327 + (%start,)?
1.328 + (%stop,)?
1.329 + (%restart,)?
1.330 + (%reload,)?
1.331 + (%quarterly,)?
1.332 + (%hourly,)?
1.333 + (%daily,)?
1.334 + (%weekly,)?
1.335 + (%monthly,)?
1.336 + (%env,)?
1.337 + };
1.338 +
1.339 + # check for order of headers
1.340 + my $sections = "";
1.341 + my $done = ''; my $this = ''; my $todo = $spec;
1.342 + while ($todo =~ m/^(\S+:|%\S+).*$/m) {
1.343 + $done .= $`; $this = $&; $todo = $';
1.344 + my $section = $1;
1.345 + $sections .= "$section,";
1.346 + $done .= $this;
1.347 + }
1.348 + my $regex = $require;
1.349 + $regex =~ s|\s+||sg;
1.350 + if ($sections !~ m/^$regex$/s) {
1.351 + $regex =~ s|,| |sg;
1.352 + &lint_error($file, undef, undef, "invalid run command section order (expected \"$regex\")");
1.353 + }
1.354 +}
1.355 +
1.356 +## _________________________________________________________________
1.357 +##
1.358 +## CHECK "script": shell scripts
1.359 +## _________________________________________________________________
1.360 +##
1.361 +
1.362 +sub check_script {
1.363 + my ($file, $spec) = @_;
1.364 +
1.365 + my $done = ''; my $this = ''; my $todo = $spec;
1.366 + 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) {
1.367 + $done .= $`; $this = $&; $todo = $';
1.368 + my ($section, $args, $script) = ($1, $2, $3);
1.369 +
1.370 + # perform checks for a single script section
1.371 + &check_script_section($file, $done, $this, $section, $args, $script);
1.372 +
1.373 + $done .= $this;
1.374 + }
1.375 +}
1.376 +
1.377 +sub check_script_section {
1.378 + my ($file, $outer_done, $outer_this, $section, $args, $script) = @_;
1.379 + my ($done, $this, $todo);
1.380 + my ($pkg, $pkgu);
1.381 +
1.382 + # determine package name
1.383 + $pkg = $file;
1.384 + $pkg =~ s|^.+/||;
1.385 + $pkg =~ s|^rc\.||;
1.386 +
1.387 + # determine package name, dash becomes underscore
1.388 + $pkgu = $pkg;
1.389 + $pkgu =~ s|-|_|;
1.390 +
1.391 + # remove comment contents
1.392 + $outer_this =~ s|^[ \t]*#[^\n]*\n||mg;
1.393 +
1.394 + # check config
1.395 + if ($section =~ m/^%(config)$/) {
1.396 +
1.397 + # check for badly prefixed variables
1.398 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.399 + while ($todo =~ m/ [^=]+=[^\n]+/s) {
1.400 + $done .= $`; $this = $&; $todo = $';
1.401 + if ($this !~ m/ ([A-Z]+|$pkgu)_[a-z_][a-z0-9_]*=/) {
1.402 + &lint_warning($file, $done, $this, "section $section: badly prefixed variable");
1.403 + }
1.404 + $done .= $this;
1.405 + }
1.406 +
1.407 + # enforce _enable to default to openpkg_rc_def
1.408 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.409 + if ( $todo =~ m/ [^=]+_enable=[^\n]+/s and $todo !~ m/ [^=]+_enable="\$openpkg_rc_def"\n+/s) {
1.410 + &lint_warning($file, $done, $this, "section $section: wrong default for ${pkgu}_enable");
1.411 + }
1.412 +
1.413 + if ($pkg eq "openpkg") {
1.414 + # openpkg_rc before _enable, if used, must be the first variable
1.415 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.416 + if ( $todo !~ m/%config\n( [A-Z]+_[a-z_]+=[^\n]*\n)* openpkg_rc_def=[^\n]+?\n openpkg_rc_all=[^\n]+?\n [^=]+_enable=[^\n]+/s) {
1.417 + &lint_warning($file, $done, $this, "section $section: openpkg_rc_def, openpkg_rc_all and ${pkgu}_enable must be the first lowercase variable");
1.418 + }
1.419 + }
1.420 + else {
1.421 + # _enable, if used, must be the first variable
1.422 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.423 + if ( $todo =~ m/ [^=]+_enable=[^\n]+/s and $todo !~ m/%config\n( [A-Z]+_[a-z_]+=[^\n]*\n)* [^=]+_enable=[^\n]+/s) {
1.424 + &lint_warning($file, $done, $this, "section $section: ${pkgu}_enable must be the first lowercase variable");
1.425 + }
1.426 + }
1.427 + }
1.428 +
1.429 + if ($section =~ m/^%(config|info|status)$/) {
1.430 + # check illegal use of return/exit
1.431 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.432 + if ( $todo =~ m/[^a-zA-Z0-9_](return|exit)\s/s ) {
1.433 + &lint_warning($file, $done, $this, "section $section: return or exit not allowed here");
1.434 + }
1.435 + return;
1.436 + }
1.437 +
1.438 + # check rcService only used for enable|usable|active PR#232
1.439 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.440 + while ( $todo =~ m/rcService\s+\w+\s+(\w+)/s ) {
1.441 + $done .= $`; $this = $&; $todo = $';
1.442 + if ( $1 !~ m/^(enable|usable|active)$/ ) {
1.443 + &lint_warning($file, $done, $this, "section $section: rcService must check for (enable|usable|active) only, found check for \"$1\"");
1.444 + }
1.445 + $done .= $this;
1.446 + }
1.447 +
1.448 + # check rcService short circuit
1.449 + if ($section !~ m/^%(config|common|info)$/) {
1.450 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.451 + if ( $todo !~ m/^[^\n]+\n rcService $pkg enable yes \|\| exit 0\n/s ) {
1.452 + &lint_warning($file, $done, $this, "section $section: \"rcService ... enable yes\" short circuit missing");
1.453 + }
1.454 + else {
1.455 + # check rcService package reference
1.456 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.457 + if ( $todo !~ m/\brcService\s+$pkg\s+/s ) {
1.458 + &lint_warning($file, $done, $this, "section $section: rcService referencing wrong package");
1.459 + }
1.460 + }
1.461 + }
1.462 +
1.463 + # check shell redirections
1.464 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.465 + while ( $todo =~ m/[ \t]+(\d+)?[><][ \t]+\S+/s
1.466 + or $todo =~ m/[ \t]+[><](\&\d+)?[ \t]+\S+/s) {
1.467 + $done .= $`; $this = $&; $todo = $';
1.468 + &lint_warning($file, $done, $this, "section $section: whitespace after shell redirection (expected none)");
1.469 + $done .= $this;
1.470 + }
1.471 +}
1.472 +
1.473 +## _________________________________________________________________
1.474 +##
1.475 +## CHECK "global": globals
1.476 +## _________________________________________________________________
1.477 +##
1.478 +
1.479 +sub check_global {
1.480 + my ($file, $spec) = @_;
1.481 +
1.482 + # utility function: extract a single shell command
1.483 + sub command_extract {
1.484 + my ($script) = @_;
1.485 + my $cmd = '';
1.486 + while ($script ne '') {
1.487 + $script =~ s/^([ \t]*'[^']*')/ $cmd .= $1, ''/se && next;
1.488 + $script =~ s/^([ \t]*"[^"]*")/ $cmd .= $1, ''/se && next;
1.489 + $script =~ s/^([ \t]*[^ \t;\)\\\r\n]+)/$cmd .= $1, ''/se && next;
1.490 + $script =~ s/^([ \t]*\\[ \t]*\r?\n)/ $cmd .= $1, ''/se && next;
1.491 + last;
1.492 + }
1.493 + return ($cmd, $script);
1.494 + }
1.495 +
1.496 + # check for deprecated use of opServiceEnabled function
1.497 + my $done = ''; my $this = ''; my $todo = $spec;
1.498 + while ($todo =~ m/\bopServiceEnabled\b/s) {
1.499 + $done .= $`; $this = $&; $todo = $';
1.500 + &lint_warning($file, $done, $this, "deprecated usage of opServiceEnabled macro (expected rcService ... enable yes)");
1.501 + $done .= $this;
1.502 + }
1.503 +
1.504 + my $done = ''; my $this = ''; my $todo = $spec;
1.505 + while ($todo =~ m/shtool\s+/s) {
1.506 + $done .= $`; $this = $&; $todo = $';
1.507 + ($this, $todo) = &command_extract($this . $todo);
1.508 +
1.509 + # check for shtool options with no space before argument
1.510 + my $subthis = $this;
1.511 + $subthis =~ s/%{[^}]*?}//sg;
1.512 + $subthis =~ s/'[^']*'//sg;
1.513 + $subthis =~ s/"[^"]*"//sg;
1.514 + $subthis =~ s/[;|&].*$//s; # catch command termination by semicolon, pipe, or, and;
1.515 + if ($subthis =~ m/\s-[a-zA-Z]\S/) {
1.516 + &lint_warning($file, $done, $this, "found use of shtool option with space omitted before argument");
1.517 + }
1.518 + $done .= $this;
1.519 + }
1.520 +}
