diff -r 71503088f51b -r f880f219c566 openpkg/lint-fsl.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/openpkg/lint-fsl.pl	Tue Jul 31 12:23:42 2012 +0200
@@ -0,0 +1,502 @@
+##
+##  lint-fsl.pl -- OpenPKG fsl.* File Checker
+##  Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
+##
+##  This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
+##  All rights reserved. Licenses which grant limited permission to use,
+##  copy, modify and distribute this software are available from the
+##  OpenPKG GmbH.
+##
+##  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.
+##
+
+#   Perl run-time requirement
+require 5;
+BEGIN {
+    eval "use Getopt::Long; use IO;";
+    if ($@) {
+        print STDERR
+            "lint-fsl: ERROR: This command requires a full-size Perl installation!\n" .
+            "lint-fsl: HINT:  Install OpenPKG \"perl\" package to use this command.\n";
+        exit(1);
+    }
+}
+
+#   OpenPKG instance prefix
+my $my_prefix = $ENV{'OPENPKG_PREFIX'};
+delete $ENV{'OPENPKG_PREFIX'};
+
+#   program information
+my $progname = "lint-fsl";
+my $progvers = "1.0.0";
+
+#   parameters (defaults)
+my $version  = 0;
+my $verbose  = 0;
+my $help     = 0;
+my $check    = 'all';
+my $tmpdir   = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
+my $rpm      = "$my_prefix/bin/openpkg rpm";
+
+#   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;
+}