comparison: openpkg/lint-fsl.pl
openpkg/lint-fsl.pl
- changeset 540
- 6becb64fe77d
equal
deleted
inserted
replaced
| -1:000000000000 | 0:cebefb0d2d77 |
|---|---|
| 1 ## | |
| 2 ## lint-fsl.pl -- OpenPKG fsl.* 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-fsl: ERROR: This command requires a full-size Perl installation!\n" . | |
| 31 "lint-fsl: 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-fsl"; | |
| 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 ident | |
| 109 )); | |
| 110 my @checks = (); | |
| 111 if ($check eq 'all') { | |
| 112 @checks = @check_list; | |
| 113 } | |
| 114 else { | |
| 115 foreach my $c (split(/,/, $check)) { | |
| 116 if (not grep(/^$c$/, @check_list)) { | |
| 117 die "invalid check \"$c\""; | |
| 118 } | |
| 119 push(@checks, $c); | |
| 120 } | |
| 121 } | |
| 122 | |
| 123 # global return code | |
| 124 $main::GRC = 0; | |
| 125 | |
| 126 # environment preparation | |
| 127 system("rm -rf $tmpdir"); | |
| 128 system("mkdir -p $tmpdir"); | |
| 129 | |
| 130 # iterate over all fsl. files | |
| 131 foreach my $filename (@ARGV) { | |
| 132 my $io = new IO::File "<$filename" | |
| 133 or die "unable to open file \"$filename\" for reading"; | |
| 134 my $spec; { local $/ = undef; $spec = <$io>; } | |
| 135 $io->close; | |
| 136 foreach my $check (@checks) { | |
| 137 eval "\&check_$check(\$filename, \$spec);"; | |
| 138 } | |
| 139 } | |
| 140 | |
| 141 # environment cleanup | |
| 142 system("rm -rf $tmpdir"); | |
| 143 | |
| 144 # die gracefully | |
| 145 exit($main::GRC); | |
| 146 | |
| 147 ## _________________________________________________________________ | |
| 148 ## | |
| 149 ## COMMON SUBROUTINES | |
| 150 ## _________________________________________________________________ | |
| 151 ## | |
| 152 | |
| 153 sub lines { | |
| 154 my ($txt) = @_; | |
| 155 my $l = 0; | |
| 156 $txt =~ s|\n|$l++, ''|sge; | |
| 157 return $l; | |
| 158 } | |
| 159 | |
| 160 sub lint_message { | |
| 161 my ($type, $file, $done, $this, $msg) = @_; | |
| 162 if (defined($done) and defined($this)) { | |
| 163 my $start = &lines($done) + 1; | |
| 164 my $end = $start + &lines($this); | |
| 165 my $pos = $start; | |
| 166 $pos .= "-". $end if ($end > $start); | |
| 167 printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg); | |
| 168 } | |
| 169 else { | |
| 170 printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg); | |
| 171 } | |
| 172 } | |
| 173 | |
| 174 sub lint_warning { | |
| 175 my ($file, $done, $this, $msg) = @_; | |
| 176 &lint_message("WARNING", $file, $done, $this, $msg); | |
| 177 $main::GRC = 1 if ($main::GRC < 1); | |
| 178 } | |
| 179 | |
| 180 sub lint_error { | |
| 181 my ($file, $done, $this, $msg) = @_; | |
| 182 &lint_message("ERROR", $file, $done, $this, $msg); | |
| 183 $main::GRC = 2 if ($main::GRC < 2); | |
| 184 } | |
| 185 | |
| 186 ## _________________________________________________________________ | |
| 187 ## | |
| 188 ## CHECK "blank": whitespace and blank lines | |
| 189 ## _________________________________________________________________ | |
| 190 ## | |
| 191 | |
| 192 sub check_blank { | |
| 193 my ($file, $spec) = @_; | |
| 194 | |
| 195 # check for CR-LF combination | |
| 196 my $done = ''; my $this = ''; my $todo = $spec; | |
| 197 while ($todo =~ m/\r\n/s) { | |
| 198 $done .= $`; $this = $&; $todo = $'; | |
| 199 &lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)"); | |
| 200 $done .= $this; | |
| 201 } | |
| 202 | |
| 203 # check for multiple blank lines | |
| 204 $done = ''; $this = ''; $todo = $spec; | |
| 205 while ($todo =~ m/(\r?\n[ \t]*){3,}/s) { | |
| 206 $done .= $`; $this = $&; $todo = $'; | |
| 207 &lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)"); | |
| 208 $done .= $this; | |
| 209 } | |
| 210 | |
| 211 # check for trailing whitespaces | |
| 212 $done = ''; $this = ''; $todo = $spec; | |
| 213 while ($todo =~ m/[ \t]+\r?\n/s) { | |
| 214 $done .= $`; $this = $&; $todo = $'; | |
| 215 if ($done eq '' or $done =~ m|\n$|s) { | |
| 216 &lint_warning($file, $done, $this, "whitespace on empty line (expected none)"); | |
| 217 } | |
| 218 else { | |
| 219 &lint_warning($file, $done, $this, "trailing whitespace (expected none)"); | |
| 220 } | |
| 221 $done .= $this; | |
| 222 } | |
| 223 | |
| 224 # check for bogus line continuations | |
| 225 $done = ''; $this = ''; $todo = $spec; | |
| 226 while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) { | |
| 227 $done .= $`; $this = $&; $todo = $'; | |
| 228 &lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)"); | |
| 229 $done .= $this; | |
| 230 } | |
| 231 | |
| 232 # check for leading whitespaces before line continuations | |
| 233 $done = ''; $this = ''; $todo = $spec; | |
| 234 while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) { | |
| 235 $done .= $`; $this = $&; $todo = $'; | |
| 236 &lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)"); | |
| 237 $done .= $this; | |
| 238 } | |
| 239 | |
| 240 # check for leading tabs | |
| 241 $done = ''; $this = ''; $todo = $spec; | |
| 242 while ($todo =~ m/^ *\t+ *[^ \t]/m) { | |
| 243 $done .= $`; $this = $&; $todo = $'; | |
| 244 &lint_warning($file, $done, $this, "leading tabs (expected spaces)"); | |
| 245 $done .= $this; | |
| 246 } | |
| 247 | |
| 248 # check for mandatory/wished trailing blank line | |
| 249 if ($spec !~ m|\n\n$|) { | |
| 250 &lint_warning($file, $done, "", "mandatory/wished trailing blank line missing (expected one)"); | |
| 251 } | |
| 252 } | |
| 253 | |
| 254 ## _________________________________________________________________ | |
| 255 ## | |
| 256 ## CHECK "comment": sharp-comments | |
| 257 ## _________________________________________________________________ | |
| 258 ## | |
| 259 | |
| 260 sub check_comment { | |
| 261 my ($file, $spec) = @_; | |
| 262 my ($pkg); | |
| 263 | |
| 264 # determine package name | |
| 265 $pkg = $file; | |
| 266 $pkg =~ s|^.+/||; | |
| 267 $pkg =~ s|^fsl\.||; | |
| 268 | |
| 269 # check comment header | |
| 270 my $re = ""; | |
| 271 $re .= "##\\n## fsl.$pkg -- OSSP fsl configuration\\n##\\n\\n"; | |
| 272 if ($spec !~ m|^$re|os) { | |
| 273 &lint_warning($file, "", "", "invalid comment header (expected $re)"); | |
| 274 } | |
| 275 | |
| 276 # check for comment indentation | |
| 277 my $done .= $`; my $this = $&; my $todo = $'; | |
| 278 while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) { | |
| 279 $done .= $`; $this = $&; $todo = $'; | |
| 280 my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4); | |
| 281 if (length($lead) % 2 != 0) { | |
| 282 &lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)"); | |
| 283 } | |
| 284 if (length($lead) > 1 && length($sharp) > 1) { | |
| 285 &lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)"); | |
| 286 } | |
| 287 if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) { | |
| 288 &lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)"); | |
| 289 } | |
| 290 if (length($pad) == 0 && length($text) > 0) { | |
| 291 &lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)"); | |
| 292 } | |
| 293 if (length($pad) > 0 && length($text) == 0) { | |
| 294 &lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)"); | |
| 295 } | |
| 296 $done .= $this; | |
| 297 } | |
| 298 } | |
| 299 | |
| 300 ## _________________________________________________________________ | |
| 301 ## | |
| 302 ## CHECK "ident" | |
| 303 ## _________________________________________________________________ | |
| 304 ## | |
| 305 | |
| 306 sub check_ident { | |
| 307 my ($file, $spec) = @_; | |
| 308 my ($pkg, $section); | |
| 309 | |
| 310 # determine package name | |
| 311 $pkg = $file; | |
| 312 $pkg =~ s|^.+/||; | |
| 313 $pkg =~ s|^fsl\.||; | |
| 314 | |
| 315 # check sections with ident/facility regex | |
| 316 my $done .= ""; my $this = ""; my $todo = $spec; | |
| 317 while ($todo =~ m:\n(\w+)(\s+)(\S+)/(\S+)(\s+)q\{(.*?)\};:s) { | |
| 318 $done .= $`; $this = $&; $todo = $'; | |
| 319 my ($section, $ws1, $ident, $facility, $ws2, $body) = ($1, $2, $3, $4, $5, $6); | |
| 320 | |
| 321 if ($pkg eq "fsl") { | |
| 322 # enforce default section for fsl | |
| 323 if ($section ne "default") { | |
| 324 &lint_warning($file, "", "", "section \"$section\" not allowed for package $pkg (expected default)"); | |
| 325 } | |
| 326 } | |
| 327 else { | |
| 328 # enforce ident section for any package othen than fsl | |
| 329 if ($section ne "ident") { | |
| 330 &lint_warning($file, "", "", "section \"$section\" not allowed for package $pkg (expected ident)"); | |
| 331 } | |
| 332 | |
| 333 # ident and facility wildcard-only would be a catch-all | |
| 334 if ($ident =~ m/^[(]?\.[\+\*][)]?$/ and $facility =~ m/^[(]?\.[\+\*][)]?$/) { | |
| 335 &lint_warning($file, "", "", "wildcard not allowed for both ident and facility (found $ident/$facility"); | |
| 336 } | |
| 337 } | |
| 338 | |
| 339 # enforce a single space | |
| 340 if (length($ws1) != 1) { | |
| 341 &lint_warning($file, "", "", "whitespace count wrong between section ($section) and ident ($ident)"); | |
| 342 } | |
| 343 | |
| 344 # enforce a single space | |
| 345 if (length($ws2) != 1) { | |
| 346 &lint_warning($file, "", "", "whitespace count wrong between facility ($facility) and end of line"); | |
| 347 } | |
| 348 | |
| 349 # ident same as facility is likely to be a typo | |
| 350 if ($ident eq $facility) { | |
| 351 &lint_warning($file, "", "", "unusual constellation ident equal to facility (found $ident/$facility"); | |
| 352 } | |
| 353 | |
| 354 # FIXME MTAs hardcoded here for /mail | |
| 355 if ($facility eq "mail" and $pkg !~ m/^(sendmail|ssmtp|postfix|exim)$/) { | |
| 356 &lint_warning($file, "", "", "only MTAs may match facility mail"); | |
| 357 } | |
| 358 | |
| 359 # FIXME inn hardcoded here for /news | |
| 360 if ($facility eq "news" and $pkg !~ m/^(inn)$/) { | |
| 361 &lint_warning($file, "", "", "only inn may match facility news"); | |
| 362 } | |
| 363 | |
| 364 # check prefix channel | |
| 365 if ($body =~ m/\n([ ]*)prefix(\s*?)\((.*?)\)/s) { | |
| 366 my ($ws1, $ws2, $options) = ($1, $2, $3); | |
| 367 | |
| 368 # enforce eight spaces | |
| 369 if (length($ws1) != 4) { | |
| 370 &lint_warning($file, "", "", "prefix channel whitespace count at start of line"); | |
| 371 } | |
| 372 | |
| 373 # enforce zero spaces | |
| 374 if (length($ws2) != 0) { | |
| 375 &lint_warning($file, "", "", "whitespace not allowed between prefix channel and round open bracket"); | |
| 376 } | |
| 377 | |
| 378 # enforce prefix options in prefix channel | |
| 379 if ($options !~ m/\sprefix="%b %d %H:%M:%S %N (<%L> )?\$1(\[%P\])?: "/) { | |
| 380 &lint_warning($file, "", "", "prefix option in prefix channel invalid or missing"); | |
| 381 } | |
| 382 $options = $'; | |
| 383 $options =~ s/,//; | |
| 384 | |
| 385 # detect superflous options in prefix channel | |
| 386 if ($options =~ m/\S+/s) { | |
| 387 $options =~ s/\n/\\n/; | |
| 388 &lint_warning($file, "", "", "superflous option in prefix channel unseparated line detected: $options"); | |
| 389 } | |
| 390 } | |
| 391 else { | |
| 392 &lint_warning($file, "", "", "prefix channel missing"); | |
| 393 } | |
| 394 | |
| 395 # check path branch | |
| 396 if ($body !~ m/\n([ ]*)->(\s*?)\{(.*)\}\n/s) { | |
| 397 &lint_warning($file, "", "", "no path branch found"); | |
| 398 return; | |
| 399 } | |
| 400 my ($ws1, $ws2, $body) = ($1, $2, $3); #FIXME check ws1/ws2 | |
| 401 | |
| 402 # check path channel | |
| 403 while ($body =~ m/\n([ ]*)(\w+):(\s+?)file(\s*?)\((.*?)\);/s) { | |
| 404 my ($ws1, $level, $ws2, $ws3, $options) = ($1, $2, $3, $4, $5); | |
| 405 $body = $'; | |
| 406 | |
| 407 # enforce eight spaces | |
| 408 if (length($ws1) != 8) { | |
| 409 &lint_warning($file, "", "", "path channel whitespace count at start of line"); | |
| 410 } | |
| 411 | |
| 412 # enforce spaces | |
| 413 if (length($ws2) < 1) { | |
| 414 &lint_warning($file, "", "", "whitespace required between level and file"); | |
| 415 } | |
| 416 | |
| 417 # enforce zero spaces | |
| 418 if (length($ws3) != 0) { | |
| 419 &lint_warning($file, "", "", "path channel whitespace not allowed between file channel and round open bracket"); | |
| 420 } | |
| 421 | |
| 422 # check for legal l2 level | |
| 423 if ($level !~ m/^(panic|critical|error|warning|notice|info|trace|debug)$/) { | |
| 424 &lint_warning($file, "", "", "illegal l2 level $level detected"); | |
| 425 } | |
| 426 | |
| 427 # enforce file option in file channel | |
| 428 if ($options !~ m;path="\@l_prefix\@/var/$pkg/(log\S+|$pkg\.log)";) { | |
| 429 &lint_warning($file, "", "", "path option in file channel invalid or missing"); | |
| 430 } | |
| 431 $options = $'; | |
| 432 $options =~ s/,//; | |
| 433 | |
| 434 # enforce perm option in file channel | |
| 435 if ($options !~ m;perm=0[0-7]{3};) { | |
| 436 &lint_warning($file, "", "", "perm option in file channel invalid or missing"); | |
| 437 } | |
| 438 $options = $'; | |
| 439 $options =~ s/,//; | |
| 440 | |
| 441 # detect superflous options in file channel | |
| 442 if ($options =~ m/\S+/s) { | |
| 443 $options =~ s/\n/\\n/; | |
| 444 &lint_warning($file, "", "", "superflous option in prefix channel detected: $options"); | |
| 445 } | |
| 446 } | |
| 447 | |
| 448 # check path channel | |
| 449 if ($body =~ m/\n([ ]*)(\w+):(\s*?)file(\s*?)\((.*?)\)/s) { | |
| 450 my ($ws1, $level, $ws2, $ws3, $options) = ($1, $2, $3, $4, $5); | |
| 451 | |
| 452 # enforce eight spaces | |
| 453 if (length($ws1) != 8) { | |
| 454 &lint_warning($file, "", "", "path channel whitespace count at start of unseparated line"); | |
| 455 } | |
| 456 | |
| 457 # enforce spaces | |
| 458 if (length($ws2) < 1) { | |
| 459 &lint_warning($file, "", "", "path channel whitespace required between level and file of unseparated line"); | |
| 460 } | |
| 461 | |
| 462 # enforce zero spaces | |
| 463 if (length($ws3) != 0) { | |
| 464 &lint_warning($file, "", "", "whitespace not allowed between file channel and round open bracket"); | |
| 465 } | |
| 466 | |
| 467 # check for legal l2 level | |
| 468 if ($level !~ m/^(panic|critical|error|warning|notice|info|trace|debug)$/) { | |
| 469 &lint_warning($file, "", "", "illegal l2 level $level detected on unseparated line"); | |
| 470 } | |
| 471 | |
| 472 # enforce file option in file channel | |
| 473 if ($options !~ m;path="\@l_prefix\@/var/$pkg/(log\S+|$pkg\.log)";) { | |
| 474 &lint_warning($file, "", "", "XXX path option in file channel invalid or missing on unseparated line"); | |
| 475 } | |
| 476 $options = $'; | |
| 477 $options =~ s/,//; | |
| 478 | |
| 479 # enforce perm option in file channel | |
| 480 if ($options !~ m;perm=0[0-7]{3};) { | |
| 481 &lint_warning($file, "", "", "perm option in file channel invalid or missing on unseparated line"); | |
| 482 } | |
| 483 | |
| 484 $options = $'; | |
| 485 $options =~ s/, jitter=[0-9]+//; | |
| 486 $options =~ s/, monitor=[0-9]+//; | |
| 487 $options =~ s/,//; | |
| 488 | |
| 489 # detect superflous options in file channel | |
| 490 if ($options =~ m/\S+/s) { | |
| 491 $options =~ s/\n/\\n/; | |
| 492 &lint_warning($file, "", "", "superflous option in file channel unseparated line detected: $options"); | |
| 493 } | |
| 494 } | |
| 495 else { | |
| 496 &lint_warning($file, "", "", "file channel missing"); | |
| 497 } | |
| 498 | |
| 499 $done .= $this; | |
| 500 } | |
| 501 return; | |
| 502 } |
