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

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

openpkg/lint-rc.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-rc.pl -- OpenPKG rc.* 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-rc: ERROR: This command requires a full-size Perl installation!\n" .
             "lint-rc: 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-rc";
 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
     section
     script
     global
 ));
 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 rc. 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) {
         &msg_verbose("$check in $filename");
         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$|s) {
         &lint_warning($file, $done, "", "mandatory/wished trailing blank line at end of file missing (expected one)");
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "comment": sharp-comments
 ##  _________________________________________________________________
 ##
 sub check_comment {
     my ($file, $spec) = @_;
     my ($pkg);
     #   determine package name
     $pkg = $file;
     $pkg =~ s|^.+/||;
     $pkg =~ s|^rc\.||;
     #   check "shebang" header
     my $re = "";
     $re .= "#!\@l_prefix\@/bin/openpkg rc\\n";
     if ($spec !~ m|^$re|s) {
         &lint_warning($file, "", "", "invalid shebang header (expected $re)");
     }
     #   check comment header
     my $re = "";
     $re .= ".*?\\n##\\n##  rc.$pkg -- Run-Commands\\n##\\n\\n";
     if ($pkg ne "openpkg" and $spec !~ m|^$re|s) {
         &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 "section": run command sections
 ##  _________________________________________________________________
 ##
 sub check_section {
     my ($file, $spec) = @_;
     my $require = qq{
         (%config,)?
         (%common,)?
         (%status,)?
         (%info,)?
         (%start,)?
         (%stop,)?
         (%restart,)?
         (%reload,)?
         (%quarterly,)?
         (%hourly,)?
         (%daily,)?
         (%weekly,)?
         (%monthly,)?
         (%env,)?
     };
     #   check for order of headers
     my $sections = "";
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/^(\S+:|%\S+).*$/m) {
         $done .= $`; $this = $&; $todo = $';
         my $section = $1;
         $sections .= "$section,";
         $done .= $this;
     }
     my $regex = $require;
     $regex =~ s|\s+||sg;
     if ($sections !~ m/^$regex$/s) {
         $regex =~ s|,| |sg;
         &lint_error($file, undef, undef, "invalid run command section order (expected \"$regex\")");
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "script": shell scripts
 ##  _________________________________________________________________
 ##
 sub check_script {
     my ($file, $spec) = @_;
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/(\%(?:config|info|common|status|start|stop|restart|reload|quarterly|hourly|daily|weekly|env))([^\n]*)\n(.*?\n)(?=\%(?:config|info|common|status|start|stop|restart|reload|quarterly|hourly|daily|weekly|env)|$)/s) {
         $done .= $`; $this = $&; $todo = $';
         my ($section, $args, $script) = ($1, $2, $3);
         #   perform checks for a single script section
         &check_script_section($file, $done, $this, $section, $args, $script);
         $done .= $this;
     }
 }
 sub check_script_section {
     my ($file, $outer_done, $outer_this, $section, $args, $script) = @_;
     my ($done, $this, $todo);
     my ($pkg, $pkgu);
     #   determine package name
     $pkg = $file;
     $pkg =~ s|^.+/||;
     $pkg =~ s|^rc\.||;
     #   determine package name, dash becomes underscore
     $pkgu = $pkg;
     $pkgu =~ s|-|_|;
     #   remove comment contents
     $outer_this =~ s|^[ \t]*#[^\n]*\n||mg;
     #   check config
     if ($section =~ m/^%(config)$/) {
         #   check for badly prefixed variables
         $done = $outer_done; $this = ''; $todo = $outer_this;
         while ($todo =~ m/    [^=]+=[^\n]+/s) {
             $done .= $`; $this = $&; $todo = $';
             if ($this !~ m/    ([A-Z]+|$pkgu)_[a-z_][a-z0-9_]*=/) {
                 &lint_warning($file, $done, $this, "section $section: badly prefixed variable");
             }
             $done .= $this;
         }
         #   enforce _enable to default to openpkg_rc_def
         $done = $outer_done; $this = ''; $todo = $outer_this;
         if ( $todo =~ m/    [^=]+_enable=[^\n]+/s and $todo !~ m/    [^=]+_enable="\$openpkg_rc_def"\n+/s) {
             &lint_warning($file, $done, $this, "section $section: wrong default for ${pkgu}_enable");
         }
         if ($pkg eq "openpkg") {
             #   openpkg_rc before _enable, if used, must be the first variable
             $done = $outer_done; $this = ''; $todo = $outer_this;
             if ( $todo !~ m/%config\n(    [A-Z]+_[a-z_]+=[^\n]*\n)*    openpkg_rc_def=[^\n]+?\n    openpkg_rc_all=[^\n]+?\n    [^=]+_enable=[^\n]+/s) {
                 &lint_warning($file, $done, $this, "section $section: openpkg_rc_def, openpkg_rc_all and ${pkgu}_enable must be the first lowercase variable");
             }
         }
         else {
             #   _enable, if used, must be the first variable
             $done = $outer_done; $this = ''; $todo = $outer_this;
             if ( $todo =~ m/    [^=]+_enable=[^\n]+/s and $todo !~ m/%config\n(    [A-Z]+_[a-z_]+=[^\n]*\n)*    [^=]+_enable=[^\n]+/s) {
                 &lint_warning($file, $done, $this, "section $section: ${pkgu}_enable must be the first lowercase variable");
             }
         }
     }
     if ($section =~ m/^%(config|info|status)$/) {
         #   check illegal use of return/exit
         $done = $outer_done; $this = ''; $todo = $outer_this;
         if ( $todo =~ m/[^a-zA-Z0-9_](return|exit)\s/s ) {
             &lint_warning($file, $done, $this, "section $section: return or exit not allowed here");
         }
         return;
     }
     #   check rcService only used for enable|usable|active PR#232
     $done = $outer_done; $this = ''; $todo = $outer_this;
     while ( $todo =~ m/rcService\s+\w+\s+(\w+)/s )  {
         $done .= $`; $this = $&; $todo = $';
         if ( $1 !~ m/^(enable|usable|active)$/ ) {
             &lint_warning($file, $done, $this, "section $section: rcService must check for (enable|usable|active) only, found check for \"$1\"");
         }
         $done .= $this;
     }
     #   check rcService short circuit
     if ($section !~ m/^%(config|common|info)$/) {
         $done = $outer_done; $this = ''; $todo = $outer_this;
         if ( $todo !~ m/^[^\n]+\n    rcService $pkg enable yes \|\| exit 0\n/s ) {
             &lint_warning($file, $done, $this, "section $section: \"rcService ... enable yes\" short circuit missing");
         }
         else {
             #   check rcService package reference
             $done = $outer_done; $this = ''; $todo = $outer_this;
             if ( $todo !~ m/\brcService\s+$pkg\s+/s ) {
                 &lint_warning($file, $done, $this, "section $section: rcService referencing wrong package");
             }
         }
     }
     #   check shell redirections
     $done = $outer_done; $this = ''; $todo = $outer_this;
     while (   $todo =~ m/[ \t]+(\d+)?[><][ \t]+\S+/s
            or $todo =~ m/[ \t]+[><](\&\d+)?[ \t]+\S+/s) {
         $done .= $`; $this = $&; $todo = $';
         &lint_warning($file, $done, $this, "section $section: whitespace after shell redirection (expected none)");
         $done .= $this;
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "global": globals
 ##  _________________________________________________________________
 ##
 sub check_global {
     my ($file, $spec) = @_;
     #   utility function: extract a single shell command
     sub command_extract {
         my ($script) = @_;
         my $cmd = '';
         while ($script ne '') {
             $script =~ s/^([ \t]*'[^']*')/         $cmd .= $1, ''/se && next;
             $script =~ s/^([ \t]*"[^"]*")/         $cmd .= $1, ''/se && next;
             $script =~ s/^([ \t]*[^ \t;\)\\\r\n]+)/$cmd .= $1, ''/se && next;
             $script =~ s/^([ \t]*\\[ \t]*\r?\n)/   $cmd .= $1, ''/se && next;
             last;
         }
         return ($cmd, $script);
     }
     #   check for deprecated use of opServiceEnabled function
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/\bopServiceEnabled\b/s) {
         $done .= $`; $this = $&; $todo = $';
         &lint_warning($file, $done, $this, "deprecated usage of opServiceEnabled macro (expected rcService ... enable yes)");
         $done .= $this;
     }
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/shtool\s+/s) {
         $done .= $`; $this = $&; $todo = $';
         ($this, $todo) = &command_extract($this . $todo);
         #   check for shtool options with no space before argument
         my $subthis = $this;
         $subthis =~ s/%{[^}]*?}//sg;
         $subthis =~ s/'[^']*'//sg;
         $subthis =~ s/"[^"]*"//sg;
         $subthis =~ s/[;|&].*$//s; # catch command termination by semicolon, pipe, or, and;
         if ($subthis =~ m/\s-[a-zA-Z]\S/) {
             &lint_warning($file, $done, $this, "found use of shtool option with space omitted before argument");
         }
         $done .= $this;
     }
 }

OpenPKG Specs / annotate

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

openpkg/lint-rc.pl