OpenPKG Specs: openpkg/lint-fsl.pl@c10fb90893b9 (annotated)

openpkg/lint-fsl.pl@c10fb90893b9 (annotated)

openpkg/lint-fsl.pl

Thu, 04 Oct 2012 20:30:05 +0200

author: Michael Schloh von Bennewitz <michael@schloh.com>
date: Thu, 04 Oct 2012 20:30:05 +0200
changeset 715: c10fb90893b9
permissions: -rw-r--r--

Correct out of date build configuration, porting to Solaris 11 network
link infrastructure and new libpcap logic. This additionally allows for
device drivers in subdirectories of /dev. Correct packaged nmap
personalities and signatures to work out of the box. Finally, hack
arpd logic to properly close sockets and quit on TERM by repeating
signaling in the run command script. Sadly, all this fails to correct
the run time behaviour of honeyd which fails to bind to the IP layer.

 ##
 ##  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;
 }

OpenPKG Specs / annotate

openpkg/lint-fsl.pl@c10fb90893b9 (annotated)

openpkg/lint-fsl.pl