head 1.7;
access;
symbols;
locks; strict;
comment @# @;
1.7
date 2004.04.09.20.45.07; author rse; state dead;
branches;
next 1.6;
1.6
date 2004.01.16.11.49.10; author ms; state Exp;
branches;
next 1.5;
1.5
date 2003.10.10.18.42.38; author ms; state Exp;
branches;
next 1.4;
1.4
date 2003.07.22.07.00.38; author thl; state Exp;
branches;
next 1.3;
1.3
date 2003.07.15.10.01.55; author thl; state Exp;
branches;
next 1.2;
1.2
date 2003.07.14.15.13.12; author thl; state Exp;
branches;
next 1.1;
1.1
date 2003.07.08.07.42.27; author thl; state Exp;
branches;
next ;
desc
@@
1.7
log
@remove some files which are either obsolete or are now part of openpkg-tools
@
text
@#!/bin/sh -- # -*- perl -*-
eval 'exec perl -S $0 ${1+"$@@"}'
if $running_under_some_shell;
##
## fsllint -- OpenPKG fsl. File Checker
## Copyright (c) 2003 The OpenPKG Project
## Copyright (c) 2003 Ralf S. Engelschall
## Copyright (c) 2003 Cable & Wireless
##
## Permission to use, copy, modify, and distribute this software for
## any purpose with or without fee is hereby granted, provided that
## the above copyright notice and this permission notice appear in all
## copies.
##
## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
## SUCH DAMAGE.
##
require 5;
use Getopt::Long;
use IO;
use strict;
# program information
my $progname = "fsllint";
my $progvers = "0.0.1";
# parameters (defaults)
my $version = 0;
my $verbose = 0;
my $help = 0;
my $check = 'all';
my $tmpdir = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
my $rpm = 'rpm';
my $rpm2cpio = 'rpm2cpio';
# exception handling support
$SIG{__DIE__} = sub {
my ($err) = @@_;
$err =~ s|\s+at\s+.*||s if (not $verbose);
print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
exit(1);
};
# command line parsing
Getopt::Long::Configure("bundling");
my $result = GetOptions(
'V|version' => \$version,
'v|verbose' => \$verbose,
'h|help' => \$help,
'c|check=s' => \$check,
't|tmpdir=s' => \$tmpdir,
'r|rpm=s' => \$rpm,
) || die "option parsing failed";
if ($help) {
print "Usage: $progname [options] [RPMFILE ...]\n" .
"Available options:\n" .
" -v,--verbose enable verbose run-time mode\n" .
" -h,--help print out this usage page\n" .
" -c,--check=CHECKS select checks to perform (default='all')\n" .
" -r,--rpm=FILE filesystem path to RPM program\n" .
" -t,--tmpdir=PATH filesystem path to temporary directory\n" .
" -V,--version print program version\n" .
exit(0);
}
if ($version) {
print "OpenPKG $progname $progvers\n";
exit(0);
}
# verbose message printing
sub msg_verbose {
my ($msg) = @@_;
print STDERR "$msg\n" if ($verbose);
}
# warning message printing
sub msg_warning {
my ($msg) = @@_;
print STDERR "$progname:WARNING: $msg\n";
}
# error message printing
sub msg_error {
my ($msg) = @@_;
print STDERR "$progname:ERROR: $msg\n";
}
# determine check list
my @@check_list = (qw(
blank
comment
ident
));
my @@checks = ();
if ($check eq 'all') {
@@checks = @@check_list;
}
else {
foreach my $c (split(/,/, $check)) {
if (not grep(/^$c$/, @@check_list)) {
die "invalid check \"$c\"";
}
push(@@checks, $c);
}
}
# global return code
$main::GRC = 0;
# environment preparation
system("rm -rf $tmpdir");
system("mkdir -p $tmpdir");
# iterate over all fsl. files
foreach my $filename (@@ARGV) {
my $io = new IO::File "<$filename"
or die "unable to open file \"$filename\" for reading";
my $spec; { local $/ = undef; $spec = <$io>; }
$io->close;
foreach my $check (@@checks) {
eval "\&check_$check(\$filename, \$spec);";
}
}
# environment cleanup
system("rm -rf $tmpdir");
# die gracefully
exit($main::GRC);
## _________________________________________________________________
##
## COMMON SUBROUTINES
## _________________________________________________________________
##
sub lines {
my ($txt) = @@_;
my $l = 0;
$txt =~ s|\n|$l++, ''|sge;
return $l;
}
sub lint_message {
my ($type, $file, $done, $this, $msg) = @@_;
if (defined($done) and defined($this)) {
my $start = &lines($done) + 1;
my $end = $start + &lines($this);
my $pos = $start;
$pos .= "-". $end if ($end > $start);
printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg);
}
else {
printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg);
}
}
sub lint_warning {
my ($file, $done, $this, $msg) = @@_;
&lint_message("WARNING", $file, $done, $this, $msg);
$main::GRC = 1 if ($main::GRC < 1);
}
sub lint_error {
my ($file, $done, $this, $msg) = @@_;
&lint_message("ERROR", $file, $done, $this, $msg);
$main::GRC = 2 if ($main::GRC < 2);
}
## _________________________________________________________________
##
## CHECK "blank": whitespace and blank lines
## _________________________________________________________________
##
sub check_blank {
my ($file, $spec) = @@_;
# check for CR-LF combination
my $done = ''; my $this = ''; my $todo = $spec;
while ($todo =~ m/\r\n/s) {
$done .= $`; $this = $&; $todo = $';
&lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)");
$done .= $this;
}
# check for multiple blank lines
$done = ''; $this = ''; $todo = $spec;
while ($todo =~ m/(\r?\n[ \t]*){3,}/s) {
$done .= $`; $this = $&; $todo = $';
&lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)");
$done .= $this;
}
# check for trailing whitespaces
$done = ''; $this = ''; $todo = $spec;
while ($todo =~ m/[ \t]+\r?\n/s) {
$done .= $`; $this = $&; $todo = $';
if ($done eq '' or $done =~ m|\n$|s) {
&lint_warning($file, $done, $this, "whitespace on empty line (expected none)");
}
else {
&lint_warning($file, $done, $this, "trailing whitespace (expected none)");
}
$done .= $this;
}
# check for bogus line continuations
$done = ''; $this = ''; $todo = $spec;
while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) {
$done .= $`; $this = $&; $todo = $';
&lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)");
$done .= $this;
}
# check for leading whitespaces before line continuations
$done = ''; $this = ''; $todo = $spec;
while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) {
$done .= $`; $this = $&; $todo = $';
&lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)");
$done .= $this;
}
# check for leading tabs
$done = ''; $this = ''; $todo = $spec;
while ($todo =~ m/^ *\t+ *[^ \t]/m) {
$done .= $`; $this = $&; $todo = $';
&lint_warning($file, $done, $this, "leading tabs (expected spaces)");
$done .= $this;
}
# check for mandatory/wished trailing blank line
if ($spec !~ m|\n\n$|) {
&lint_warning($file, $done, "", "mandatory/wished trailing blank line missing (expected one)");
}
}
## _________________________________________________________________
##
## CHECK "comment": sharp-comments
## _________________________________________________________________
##
sub check_comment {
my ($file, $spec) = @@_;
my ($pkg);
# determine package name
$pkg = $file;
$pkg =~ s|^.+/||;
$pkg =~ s|^fsl\.||;
# check comment header
my $re = "";
$re .= "##\\n## fsl.$pkg -- OSSP fsl configuration\\n##\\n\\n";
if ($spec !~ m|^$re|os) {
&lint_warning($file, "", "", "invalid comment header (expected $re)");
}
# check for comment indentation
my $done .= $`; my $this = $&; my $todo = $';
while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) {
$done .= $`; $this = $&; $todo = $';
my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4);
if (length($lead) % 2 != 0) {
&lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)");
}
if (length($lead) > 1 && length($sharp) > 1) {
&lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)");
}
if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) {
&lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)");
}
if (length($pad) == 0 && length($text) > 0) {
&lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)");
}
if (length($pad) > 0 && length($text) == 0) {
&lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)");
}
$done .= $this;
}
}
## _________________________________________________________________
##
## CHECK "ident"
## _________________________________________________________________
##
sub check_ident {
my ($file, $spec) = @@_;
my ($pkg, $section);
# determine package name
$pkg = $file;
$pkg =~ s|^.+/||;
$pkg =~ s|^fsl\.||;
# check sections with ident/facility regex
my $done .= ""; my $this = ""; my $todo = $spec;
while ($todo =~ m:\n(\w+)(\s+)(\S+)/(\S+)(\s+)q\{(.*?)\};:s) {
$done .= $`; $this = $&; $todo = $';
my ($section, $ws1, $ident, $facility, $ws2, $body) = ($1, $2, $3, $4, $5, $6);
if ($pkg eq "fsl") {
# enforce default section for fsl
if ($section ne "default") {
&lint_warning($file, "", "", "section \"$section\" not allowed for package $pkg (expected default)");
}
}
else {
# enforce ident section for any package othen than fsl
if ($section ne "ident") {
&lint_warning($file, "", "", "section \"$section\" not allowed for package $pkg (expected ident)");
}
# ident and facility wildcard-only would be a catch-all
if ($ident =~ m/^[(]?\.[\+\*][)]?$/ and $facility =~ m/^[(]?\.[\+\*][)]?$/) {
&lint_warning($file, "", "", "wildcard not allowed for both ident and facility (found $ident/$facility");
}
}
# enforce a single space
if (length($ws1) != 1) {
&lint_warning($file, "", "", "whitespace count wrong between section ($section) and ident ($ident)");
}
# enforce a single space
if (length($ws2) != 1) {
&lint_warning($file, "", "", "whitespace count wrong between facility ($facility) and end of line");
}
# ident same as facility is likely to be a typo
if ($ident eq $facility) {
&lint_warning($file, "", "", "unusual constellation ident equal to facility (found $ident/$facility");
}
# FIXME MTAs hardcoded here for /mail
if ($facility eq "mail" and $pkg !~ m/^(sendmail|ssmtp|postfix|exim)$/) {
&lint_warning($file, "", "", "only MTAs may match facility mail");
}
# FIXME inn hardcoded here for /news
if ($facility eq "news" and $pkg !~ m/^(inn)$/) {
&lint_warning($file, "", "", "only inn may match facility news");
}
# check prefix channel
if ($body =~ m/\n([ ]*)prefix(\s*?)\((.*?)\)/s) {
my ($ws1, $ws2, $options) = ($1, $2, $3);
# enforce eight spaces
if (length($ws1) != 4) {
&lint_warning($file, "", "", "prefix channel whitespace count at start of line");
}
# enforce zero spaces
if (length($ws2) != 0) {
&lint_warning($file, "", "", "whitespace not allowed between prefix channel and round open bracket");
}
# enforce prefix options in prefix channel
if ($options !~ m/\sprefix="%b %d %H:%M:%S %N (<%L> )?\$1(\[%P\])?: "/) {
&lint_warning($file, "", "", "prefix option in prefix channel invalid or missing");
}
$options = $';
$options =~ s/,//;
# detect superflous options in prefix channel
if ($options =~ m/\S+/s) {
$options =~ s/\n/\\n/;
&lint_warning($file, "", "", "superflous option in prefix channel unseparated line detected: $options");
}
}
else {
&lint_warning($file, "", "", "prefix channel missing");
}
# check path branch
if ($body !~ m/\n([ ]*)->(\s*?)\{(.*)\}\n/s) {
&lint_warning($file, "", "", "no path branch found");
return;
}
my ($ws1, $ws2, $body) = ($1, $2, $3); #FIXME check ws1/ws2
# check path channel
while ($body =~ m/\n([ ]*)(\w+):(\s+?)file(\s*?)\((.*?)\);/s) {
my ($ws1, $level, $ws2, $ws3, $options) = ($1, $2, $3, $4, $5);
$body = $';
# enforce eight spaces
if (length($ws1) != 8) {
&lint_warning($file, "", "", "path channel whitespace count at start of line");
}
# enforce spaces
if (length($ws2) < 1) {
&lint_warning($file, "", "", "whitespace required between level and file");
}
# enforce zero spaces
if (length($ws3) != 0) {
&lint_warning($file, "", "", "path channel whitespace not allowed between file channel and round open bracket");
}
# check for legal l2 level
if ($level !~ m/^(panic|critical|error|warning|notice|info|trace|debug)$/) {
&lint_warning($file, "", "", "illegal l2 level $level detected");
}
# enforce file option in file channel
if ($options !~ m;path="\@@l_prefix\@@/var/$pkg/(log\S+|$pkg\.log)";) {
&lint_warning($file, "", "", "path option in file channel invalid or missing");
}
$options = $';
$options =~ s/,//;
# enforce perm option in file channel
if ($options !~ m;perm=0[0-7]{3};) {
&lint_warning($file, "", "", "perm option in file channel invalid or missing");
}
$options = $';
$options =~ s/,//;
# detect superflous options in file channel
if ($options =~ m/\S+/s) {
$options =~ s/\n/\\n/;
&lint_warning($file, "", "", "superflous option in prefix channel detected: $options");
}
}
# check path channel
if ($body =~ m/\n([ ]*)(\w+):(\s*?)file(\s*?)\((.*?)\)/s) {
my ($ws1, $level, $ws2, $ws3, $options) = ($1, $2, $3, $4, $5);
# enforce eight spaces
if (length($ws1) != 8) {
&lint_warning($file, "", "", "path channel whitespace count at start of unseparated line");
}
# enforce spaces
if (length($ws2) < 1) {
&lint_warning($file, "", "", "path channel whitespace required between level and file of unseparated line");
}
# enforce zero spaces
if (length($ws3) != 0) {
&lint_warning($file, "", "", "whitespace not allowed between file channel and round open bracket");
}
# check for legal l2 level
if ($level !~ m/^(panic|critical|error|warning|notice|info|trace|debug)$/) {
&lint_warning($file, "", "", "illegal l2 level $level detected on unseparated line");
}
# enforce file option in file channel
if ($options !~ m;path="\@@l_prefix\@@/var/$pkg/(log\S+|$pkg\.log)";) {
&lint_warning($file, "", "", "XXX path option in file channel invalid or missing on unseparated line");
}
$options = $';
$options =~ s/,//;
# enforce perm option in file channel
if ($options !~ m;perm=0[0-7]{3};) {
&lint_warning($file, "", "", "perm option in file channel invalid or missing on unseparated line");
}
$options = $';
$options =~ s/, jitter=[0-9]+//;
$options =~ s/, monitor=[0-9]+//;
$options =~ s/,//;
# detect superflous options in file channel
if ($options =~ m/\S+/s) {
$options =~ s/\n/\\n/;
&lint_warning($file, "", "", "superflous option in file channel unseparated line detected: $options");
}
}
else {
&lint_warning($file, "", "", "file channel missing");
}
$done .= $this;
}
return;
}
@
1.6
log
@lint our lint scripts and remove trailing whitespace
@
text
@@
1.5
log
@Correct jitter and add new l2 monitor options
@
text
@d47 1
a47 1
# exception handling support
d214 1
a214 1
&lint_warning($file, $done, $this, "trailing whitespace (expected none)");
d379 1
a379 1
d428 1
a428 1
d435 1
a435 1
d473 1
a473 1
d483 1
a483 1
@
1.4
log
@support (ignore) optional jitter=1 construct; fix warning message
@
text
@d480 2
a481 1
$options =~ s/, jitter=1//;
@
1.3
log
@add ident/default checking
@
text
@d478 1
d480 1
d486 1
a486 1
&lint_warning($file, "", "", "superflous option in prefix channel unseparated line detected: $options");
@
1.2
log
@add comment header check
@
text
@d103 1
d295 200
@
1.1
log
@first cut for a fsl. file lint; code taken from speclint/rpmlint
@
text
@d256 13
@