1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/openpkg/lint-fsl.pl Tue Jul 31 12:23:42 2012 +0200
1.3 @@ -0,0 +1,502 @@
1.4 +##
1.5 +## lint-fsl.pl -- OpenPKG fsl.* 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-fsl: ERROR: This command requires a full-size Perl installation!\n" .
1.34 + "lint-fsl: 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-fsl";
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 + ident
1.112 +));
1.113 +my @checks = ();
1.114 +if ($check eq 'all') {
1.115 + @checks = @check_list;
1.116 +}
1.117 +else {
1.118 + foreach my $c (split(/,/, $check)) {
1.119 + if (not grep(/^$c$/, @check_list)) {
1.120 + die "invalid check \"$c\"";
1.121 + }
1.122 + push(@checks, $c);
1.123 + }
1.124 +}
1.125 +
1.126 +# global return code
1.127 +$main::GRC = 0;
1.128 +
1.129 +# environment preparation
1.130 +system("rm -rf $tmpdir");
1.131 +system("mkdir -p $tmpdir");
1.132 +
1.133 +# iterate over all fsl. files
1.134 +foreach my $filename (@ARGV) {
1.135 + my $io = new IO::File "<$filename"
1.136 + or die "unable to open file \"$filename\" for reading";
1.137 + my $spec; { local $/ = undef; $spec = <$io>; }
1.138 + $io->close;
1.139 + foreach my $check (@checks) {
1.140 + eval "\&check_$check(\$filename, \$spec);";
1.141 + }
1.142 +}
1.143 +
1.144 +# environment cleanup
1.145 +system("rm -rf $tmpdir");
1.146 +
1.147 +# die gracefully
1.148 +exit($main::GRC);
1.149 +
1.150 +## _________________________________________________________________
1.151 +##
1.152 +## COMMON SUBROUTINES
1.153 +## _________________________________________________________________
1.154 +##
1.155 +
1.156 +sub lines {
1.157 + my ($txt) = @_;
1.158 + my $l = 0;
1.159 + $txt =~ s|\n|$l++, ''|sge;
1.160 + return $l;
1.161 +}
1.162 +
1.163 +sub lint_message {
1.164 + my ($type, $file, $done, $this, $msg) = @_;
1.165 + if (defined($done) and defined($this)) {
1.166 + my $start = &lines($done) + 1;
1.167 + my $end = $start + &lines($this);
1.168 + my $pos = $start;
1.169 + $pos .= "-". $end if ($end > $start);
1.170 + printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg);
1.171 + }
1.172 + else {
1.173 + printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg);
1.174 + }
1.175 +}
1.176 +
1.177 +sub lint_warning {
1.178 + my ($file, $done, $this, $msg) = @_;
1.179 + &lint_message("WARNING", $file, $done, $this, $msg);
1.180 + $main::GRC = 1 if ($main::GRC < 1);
1.181 +}
1.182 +
1.183 +sub lint_error {
1.184 + my ($file, $done, $this, $msg) = @_;
1.185 + &lint_message("ERROR", $file, $done, $this, $msg);
1.186 + $main::GRC = 2 if ($main::GRC < 2);
1.187 +}
1.188 +
1.189 +## _________________________________________________________________
1.190 +##
1.191 +## CHECK "blank": whitespace and blank lines
1.192 +## _________________________________________________________________
1.193 +##
1.194 +
1.195 +sub check_blank {
1.196 + my ($file, $spec) = @_;
1.197 +
1.198 + # check for CR-LF combination
1.199 + my $done = ''; my $this = ''; my $todo = $spec;
1.200 + while ($todo =~ m/\r\n/s) {
1.201 + $done .= $`; $this = $&; $todo = $';
1.202 + &lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)");
1.203 + $done .= $this;
1.204 + }
1.205 +
1.206 + # check for multiple blank lines
1.207 + $done = ''; $this = ''; $todo = $spec;
1.208 + while ($todo =~ m/(\r?\n[ \t]*){3,}/s) {
1.209 + $done .= $`; $this = $&; $todo = $';
1.210 + &lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)");
1.211 + $done .= $this;
1.212 + }
1.213 +
1.214 + # check for trailing whitespaces
1.215 + $done = ''; $this = ''; $todo = $spec;
1.216 + while ($todo =~ m/[ \t]+\r?\n/s) {
1.217 + $done .= $`; $this = $&; $todo = $';
1.218 + if ($done eq '' or $done =~ m|\n$|s) {
1.219 + &lint_warning($file, $done, $this, "whitespace on empty line (expected none)");
1.220 + }
1.221 + else {
1.222 + &lint_warning($file, $done, $this, "trailing whitespace (expected none)");
1.223 + }
1.224 + $done .= $this;
1.225 + }
1.226 +
1.227 + # check for bogus line continuations
1.228 + $done = ''; $this = ''; $todo = $spec;
1.229 + while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) {
1.230 + $done .= $`; $this = $&; $todo = $';
1.231 + &lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)");
1.232 + $done .= $this;
1.233 + }
1.234 +
1.235 + # check for leading whitespaces before line continuations
1.236 + $done = ''; $this = ''; $todo = $spec;
1.237 + while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) {
1.238 + $done .= $`; $this = $&; $todo = $';
1.239 + &lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)");
1.240 + $done .= $this;
1.241 + }
1.242 +
1.243 + # check for leading tabs
1.244 + $done = ''; $this = ''; $todo = $spec;
1.245 + while ($todo =~ m/^ *\t+ *[^ \t]/m) {
1.246 + $done .= $`; $this = $&; $todo = $';
1.247 + &lint_warning($file, $done, $this, "leading tabs (expected spaces)");
1.248 + $done .= $this;
1.249 + }
1.250 +
1.251 + # check for mandatory/wished trailing blank line
1.252 + if ($spec !~ m|\n\n$|) {
1.253 + &lint_warning($file, $done, "", "mandatory/wished trailing blank line missing (expected one)");
1.254 + }
1.255 +}
1.256 +
1.257 +## _________________________________________________________________
1.258 +##
1.259 +## CHECK "comment": sharp-comments
1.260 +## _________________________________________________________________
1.261 +##
1.262 +
1.263 +sub check_comment {
1.264 + my ($file, $spec) = @_;
1.265 + my ($pkg);
1.266 +
1.267 + # determine package name
1.268 + $pkg = $file;
1.269 + $pkg =~ s|^.+/||;
1.270 + $pkg =~ s|^fsl\.||;
1.271 +
1.272 + # check comment header
1.273 + my $re = "";
1.274 + $re .= "##\\n## fsl.$pkg -- OSSP fsl configuration\\n##\\n\\n";
1.275 + if ($spec !~ m|^$re|os) {
1.276 + &lint_warning($file, "", "", "invalid comment header (expected $re)");
1.277 + }
1.278 +
1.279 + # check for comment indentation
1.280 + my $done .= $`; my $this = $&; my $todo = $';
1.281 + while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) {
1.282 + $done .= $`; $this = $&; $todo = $';
1.283 + my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4);
1.284 + if (length($lead) % 2 != 0) {
1.285 + &lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)");
1.286 + }
1.287 + if (length($lead) > 1 && length($sharp) > 1) {
1.288 + &lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)");
1.289 + }
1.290 + if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) {
1.291 + &lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)");
1.292 + }
1.293 + if (length($pad) == 0 && length($text) > 0) {
1.294 + &lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)");
1.295 + }
1.296 + if (length($pad) > 0 && length($text) == 0) {
1.297 + &lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)");
1.298 + }
1.299 + $done .= $this;
1.300 + }
1.301 +}
1.302 +
1.303 +## _________________________________________________________________
1.304 +##
1.305 +## CHECK "ident"
1.306 +## _________________________________________________________________
1.307 +##
1.308 +
1.309 +sub check_ident {
1.310 + my ($file, $spec) = @_;
1.311 + my ($pkg, $section);
1.312 +
1.313 + # determine package name
1.314 + $pkg = $file;
1.315 + $pkg =~ s|^.+/||;
1.316 + $pkg =~ s|^fsl\.||;
1.317 +
1.318 + # check sections with ident/facility regex
1.319 + my $done .= ""; my $this = ""; my $todo = $spec;
1.320 + while ($todo =~ m:\n(\w+)(\s+)(\S+)/(\S+)(\s+)q\{(.*?)\};:s) {
1.321 + $done .= $`; $this = $&; $todo = $';
1.322 + my ($section, $ws1, $ident, $facility, $ws2, $body) = ($1, $2, $3, $4, $5, $6);
1.323 +
1.324 + if ($pkg eq "fsl") {
1.325 + # enforce default section for fsl
1.326 + if ($section ne "default") {
1.327 + &lint_warning($file, "", "", "section \"$section\" not allowed for package $pkg (expected default)");
1.328 + }
1.329 + }
1.330 + else {
1.331 + # enforce ident section for any package othen than fsl
1.332 + if ($section ne "ident") {
1.333 + &lint_warning($file, "", "", "section \"$section\" not allowed for package $pkg (expected ident)");
1.334 + }
1.335 +
1.336 + # ident and facility wildcard-only would be a catch-all
1.337 + if ($ident =~ m/^[(]?\.[\+\*][)]?$/ and $facility =~ m/^[(]?\.[\+\*][)]?$/) {
1.338 + &lint_warning($file, "", "", "wildcard not allowed for both ident and facility (found $ident/$facility");
1.339 + }
1.340 + }
1.341 +
1.342 + # enforce a single space
1.343 + if (length($ws1) != 1) {
1.344 + &lint_warning($file, "", "", "whitespace count wrong between section ($section) and ident ($ident)");
1.345 + }
1.346 +
1.347 + # enforce a single space
1.348 + if (length($ws2) != 1) {
1.349 + &lint_warning($file, "", "", "whitespace count wrong between facility ($facility) and end of line");
1.350 + }
1.351 +
1.352 + # ident same as facility is likely to be a typo
1.353 + if ($ident eq $facility) {
1.354 + &lint_warning($file, "", "", "unusual constellation ident equal to facility (found $ident/$facility");
1.355 + }
1.356 +
1.357 + # FIXME MTAs hardcoded here for /mail
1.358 + if ($facility eq "mail" and $pkg !~ m/^(sendmail|ssmtp|postfix|exim)$/) {
1.359 + &lint_warning($file, "", "", "only MTAs may match facility mail");
1.360 + }
1.361 +
1.362 + # FIXME inn hardcoded here for /news
1.363 + if ($facility eq "news" and $pkg !~ m/^(inn)$/) {
1.364 + &lint_warning($file, "", "", "only inn may match facility news");
1.365 + }
1.366 +
1.367 + # check prefix channel
1.368 + if ($body =~ m/\n([ ]*)prefix(\s*?)\((.*?)\)/s) {
1.369 + my ($ws1, $ws2, $options) = ($1, $2, $3);
1.370 +
1.371 + # enforce eight spaces
1.372 + if (length($ws1) != 4) {
1.373 + &lint_warning($file, "", "", "prefix channel whitespace count at start of line");
1.374 + }
1.375 +
1.376 + # enforce zero spaces
1.377 + if (length($ws2) != 0) {
1.378 + &lint_warning($file, "", "", "whitespace not allowed between prefix channel and round open bracket");
1.379 + }
1.380 +
1.381 + # enforce prefix options in prefix channel
1.382 + if ($options !~ m/\sprefix="%b %d %H:%M:%S %N (<%L> )?\$1(\[%P\])?: "/) {
1.383 + &lint_warning($file, "", "", "prefix option in prefix channel invalid or missing");
1.384 + }
1.385 + $options = $';
1.386 + $options =~ s/,//;
1.387 +
1.388 + # detect superflous options in prefix channel
1.389 + if ($options =~ m/\S+/s) {
1.390 + $options =~ s/\n/\\n/;
1.391 + &lint_warning($file, "", "", "superflous option in prefix channel unseparated line detected: $options");
1.392 + }
1.393 + }
1.394 + else {
1.395 + &lint_warning($file, "", "", "prefix channel missing");
1.396 + }
1.397 +
1.398 + # check path branch
1.399 + if ($body !~ m/\n([ ]*)->(\s*?)\{(.*)\}\n/s) {
1.400 + &lint_warning($file, "", "", "no path branch found");
1.401 + return;
1.402 + }
1.403 + my ($ws1, $ws2, $body) = ($1, $2, $3); #FIXME check ws1/ws2
1.404 +
1.405 + # check path channel
1.406 + while ($body =~ m/\n([ ]*)(\w+):(\s+?)file(\s*?)\((.*?)\);/s) {
1.407 + my ($ws1, $level, $ws2, $ws3, $options) = ($1, $2, $3, $4, $5);
1.408 + $body = $';
1.409 +
1.410 + # enforce eight spaces
1.411 + if (length($ws1) != 8) {
1.412 + &lint_warning($file, "", "", "path channel whitespace count at start of line");
1.413 + }
1.414 +
1.415 + # enforce spaces
1.416 + if (length($ws2) < 1) {
1.417 + &lint_warning($file, "", "", "whitespace required between level and file");
1.418 + }
1.419 +
1.420 + # enforce zero spaces
1.421 + if (length($ws3) != 0) {
1.422 + &lint_warning($file, "", "", "path channel whitespace not allowed between file channel and round open bracket");
1.423 + }
1.424 +
1.425 + # check for legal l2 level
1.426 + if ($level !~ m/^(panic|critical|error|warning|notice|info|trace|debug)$/) {
1.427 + &lint_warning($file, "", "", "illegal l2 level $level detected");
1.428 + }
1.429 +
1.430 + # enforce file option in file channel
1.431 + if ($options !~ m;path="\@l_prefix\@/var/$pkg/(log\S+|$pkg\.log)";) {
1.432 + &lint_warning($file, "", "", "path option in file channel invalid or missing");
1.433 + }
1.434 + $options = $';
1.435 + $options =~ s/,//;
1.436 +
1.437 + # enforce perm option in file channel
1.438 + if ($options !~ m;perm=0[0-7]{3};) {
1.439 + &lint_warning($file, "", "", "perm option in file channel invalid or missing");
1.440 + }
1.441 + $options = $';
1.442 + $options =~ s/,//;
1.443 +
1.444 + # detect superflous options in file channel
1.445 + if ($options =~ m/\S+/s) {
1.446 + $options =~ s/\n/\\n/;
1.447 + &lint_warning($file, "", "", "superflous option in prefix channel detected: $options");
1.448 + }
1.449 + }
1.450 +
1.451 + # check path channel
1.452 + if ($body =~ m/\n([ ]*)(\w+):(\s*?)file(\s*?)\((.*?)\)/s) {
1.453 + my ($ws1, $level, $ws2, $ws3, $options) = ($1, $2, $3, $4, $5);
1.454 +
1.455 + # enforce eight spaces
1.456 + if (length($ws1) != 8) {
1.457 + &lint_warning($file, "", "", "path channel whitespace count at start of unseparated line");
1.458 + }
1.459 +
1.460 + # enforce spaces
1.461 + if (length($ws2) < 1) {
1.462 + &lint_warning($file, "", "", "path channel whitespace required between level and file of unseparated line");
1.463 + }
1.464 +
1.465 + # enforce zero spaces
1.466 + if (length($ws3) != 0) {
1.467 + &lint_warning($file, "", "", "whitespace not allowed between file channel and round open bracket");
1.468 + }
1.469 +
1.470 + # check for legal l2 level
1.471 + if ($level !~ m/^(panic|critical|error|warning|notice|info|trace|debug)$/) {
1.472 + &lint_warning($file, "", "", "illegal l2 level $level detected on unseparated line");
1.473 + }
1.474 +
1.475 + # enforce file option in file channel
1.476 + if ($options !~ m;path="\@l_prefix\@/var/$pkg/(log\S+|$pkg\.log)";) {
1.477 + &lint_warning($file, "", "", "XXX path option in file channel invalid or missing on unseparated line");
1.478 + }
1.479 + $options = $';
1.480 + $options =~ s/,//;
1.481 +
1.482 + # enforce perm option in file channel
1.483 + if ($options !~ m;perm=0[0-7]{3};) {
1.484 + &lint_warning($file, "", "", "perm option in file channel invalid or missing on unseparated line");
1.485 + }
1.486 +
1.487 + $options = $';
1.488 + $options =~ s/, jitter=[0-9]+//;
1.489 + $options =~ s/, monitor=[0-9]+//;
1.490 + $options =~ s/,//;
1.491 +
1.492 + # detect superflous options in file channel
1.493 + if ($options =~ m/\S+/s) {
1.494 + $options =~ s/\n/\\n/;
1.495 + &lint_warning($file, "", "", "superflous option in file channel unseparated line detected: $options");
1.496 + }
1.497 + }
1.498 + else {
1.499 + &lint_warning($file, "", "", "file channel missing");
1.500 + }
1.501 +
1.502 + $done .= $this;
1.503 + }
1.504 + return;
1.505 +}
