OpenPKG Specs: openpkg/lint-rc.pl@a2c6460cfb16

Correct socket error reporting improvement with IPv6 portable code,
after helpful recommendation by Saúl Ibarra Corretgé on OSips devlist.

     1 ##

     2 ##  lint-rc.pl -- OpenPKG rc.* 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 ##

    24 #   Perl run-time requirement

    25 require 5;

    26 BEGIN {

    27     eval "use Getopt::Long; use IO;";

    28     if ($@) {

    29         print STDERR

    30             "lint-rc: ERROR: This command requires a full-size Perl installation!\n" .

    31             "lint-rc: HINT:  Install OpenPKG \"perl\" package to use this command.\n";

    32         exit(1);

    33     }

    34 }

    36 #   OpenPKG instance prefix

    37 my $my_prefix = $ENV{'OPENPKG_PREFIX'};

    38 delete $ENV{'OPENPKG_PREFIX'};

    40 #   program information

    41 my $progname = "lint-rc";

    42 my $progvers = "1.0.0";

    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";

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

    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 }

    86 #   verbose message printing

    87 sub msg_verbose {

    88     my ($msg) = @_;

    89     print STDERR "$msg\n" if ($verbose);

    90 }

    92 #   warning message printing

    93 sub msg_warning {

    94     my ($msg) = @_;

    95     print STDERR "$progname:WARNING: $msg\n";

    96 }

    98 #   error message printing

    99 sub msg_error {

   100     my ($msg) = @_;

   101     print STDERR "$progname:ERROR: $msg\n";

   102 }

   104 #   determine check list

   105 my @check_list = (qw(

   106     blank

   107     comment

   108     section

   109     script

   110     global

   111 ));

   112 my @checks = ();

   113 if ($check eq 'all') {

   114     @checks = @check_list;

   115 }

   116 else {

   117     foreach my $c (split(/,/, $check)) {

   118         if (not grep(/^$c$/, @check_list)) {

   119             die "invalid check \"$c\"";

   120         }

   121         push(@checks, $c);

   122     }

   123 }

   125 #   global return code

   126 $main::GRC = 0;

   128 #   environment preparation

   129 system("rm -rf $tmpdir");

   130 system("mkdir -p $tmpdir");

   132 #   iterate over all rc. files

   133 foreach my $filename (@ARGV) {

   134     my $io = new IO::File "<$filename"

   135         or die "unable to open file \"$filename\" for reading";

   136     my $spec; { local $/ = undef; $spec = <$io>; }

   137     $io->close;

   138     foreach my $check (@checks) {

   139         &msg_verbose("$check in $filename");

   140         eval "\&check_$check(\$filename, \$spec);";

   141     }

   142 }

   144 #   environment cleanup

   145 system("rm -rf $tmpdir");

   147 #   die gracefully

   148 exit($main::GRC);

   150 ##  _________________________________________________________________

   151 ##

   152 ##  COMMON SUBROUTINES

   153 ##  _________________________________________________________________

   154 ##

   156 sub lines {

   157     my ($txt) = @_;

   158     my $l = 0;

   159     $txt =~ s|\n|$l++, ''|sge;

   160     return $l;

   161 }

   163 sub lint_message {

   164     my ($type, $file, $done, $this, $msg) = @_;

   165     if (defined($done) and defined($this)) {

   166         my $start = &lines($done) + 1;

   167         my $end = $start + &lines($this);

   168         my $pos = $start;

   169         $pos .= "-". $end if ($end > $start);

   170         printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg);

   171     }

   172     else {

   173         printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg);

   174     }

   175 }

   177 sub lint_warning {

   178     my ($file, $done, $this, $msg) = @_;

   179     &lint_message("WARNING", $file, $done, $this, $msg);

   180     $main::GRC = 1 if ($main::GRC < 1);

   181 }

   183 sub lint_error {

   184     my ($file, $done, $this, $msg) = @_;

   185     &lint_message("ERROR", $file, $done, $this, $msg);

   186     $main::GRC = 2 if ($main::GRC < 2);

   187 }

   189 ##  _________________________________________________________________

   190 ##

   191 ##  CHECK "blank": whitespace and blank lines

   192 ##  _________________________________________________________________

   193 ##

   195 sub check_blank {

   196     my ($file, $spec) = @_;

   198     #   check for CR-LF combination

   199     my $done = ''; my $this = ''; my $todo = $spec;

   200     while ($todo =~ m/\r\n/s) {

   201         $done .= $`; $this = $&; $todo = $';

   202         &lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)");

   203         $done .= $this;

   204     }

   206     #   check for multiple blank lines

   207     $done = ''; $this = ''; $todo = $spec;

   208     while ($todo =~ m/(\r?\n[ \t]*){3,}/s) {

   209         $done .= $`; $this = $&; $todo = $';

   210         &lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)");

   211         $done .= $this;

   212     }

   214     #   check for trailing whitespaces

   215     $done = ''; $this = ''; $todo = $spec;

   216     while ($todo =~ m/[ \t]+\r?\n/s) {

   217         $done .= $`; $this = $&; $todo = $';

   218         if ($done eq '' or $done =~ m|\n$|s) {

   219             &lint_warning($file, $done, $this, "whitespace on empty line (expected none)");

   220         }

   221         else {

   222             &lint_warning($file, $done, $this, "trailing whitespace (expected none)");

   223         }

   224         $done .= $this;

   225     }

   227     #   check for bogus line continuations

   228     $done = ''; $this = ''; $todo = $spec;

   229     while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) {

   230         $done .= $`; $this = $&; $todo = $';

   231         &lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)");

   232         $done .= $this;

   233     }

   235     #   check for leading whitespaces before line continuations

   236     $done = ''; $this = ''; $todo = $spec;

   237     while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) {

   238         $done .= $`; $this = $&; $todo = $';

   239         &lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)");

   240         $done .= $this;

   241     }

   243     #   check for leading tabs

   244     $done = ''; $this = ''; $todo = $spec;

   245     while ($todo =~ m/^ *\t+ *[^ \t]/m) {

   246         $done .= $`; $this = $&; $todo = $';

   247         &lint_warning($file, $done, $this, "leading tabs (expected spaces)");

   248         $done .= $this;

   249     }

   251     #   check for mandatory/wished trailing blank line

   252     if ($spec !~ m|\n\n$|s) {

   253         &lint_warning($file, $done, "", "mandatory/wished trailing blank line at end of file missing (expected one)");

   254     }

   255 }

   257 ##  _________________________________________________________________

   258 ##

   259 ##  CHECK "comment": sharp-comments

   260 ##  _________________________________________________________________

   261 ##

   263 sub check_comment {

   264     my ($file, $spec) = @_;

   265     my ($pkg);

   267     #   determine package name

   268     $pkg = $file;

   269     $pkg =~ s|^.+/||;

   270     $pkg =~ s|^rc\.||;

   272     #   check "shebang" header

   273     my $re = "";

   274     $re .= "#!\@l_prefix\@/bin/openpkg rc\\n";

   275     if ($spec !~ m|^$re|s) {

   276         &lint_warning($file, "", "", "invalid shebang header (expected $re)");

   277     }

   279     #   check comment header

   280     my $re = "";

   281     $re .= ".*?\\n##\\n##  rc.$pkg -- Run-Commands\\n##\\n\\n";

   282     if ($pkg ne "openpkg" and $spec !~ m|^$re|s) {

   283         &lint_warning($file, "", "", "invalid comment header (expected $re)");

   284     }

   286     #   check for comment indentation

   287     my $done .= $`; my $this = $&; my $todo = $';

   288     while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) {

   289         $done .= $`; $this = $&; $todo = $';

   290         my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4);

   291         if (length($lead) % 2 != 0) {

   292             &lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)");

   293         }

   294         if (length($lead) > 1 && length($sharp) > 1) {

   295             &lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)");

   296         }

   297         if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) {

   298             &lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)");

   299         }

   300         if (length($pad) == 0 && length($text) > 0) {

   301             &lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)");

   302         }

   303         if (length($pad) > 0 && length($text) == 0) {

   304             &lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)");

   305         }

   306         $done .= $this;

   307     }

   308 }

   310 ##  _________________________________________________________________

   311 ##

   312 ##  CHECK "section": run command sections

   313 ##  _________________________________________________________________

   314 ##

   316 sub check_section {

   317     my ($file, $spec) = @_;

   319     my $require = qq{

   320         (%config,)?

   321         (%common,)?

   322         (%status,)?

   323         (%info,)?

   324         (%start,)?

   325         (%stop,)?

   326         (%restart,)?

   327         (%reload,)?

   328         (%quarterly,)?

   329         (%hourly,)?

   330         (%daily,)?

   331         (%weekly,)?

   332         (%monthly,)?

   333         (%env,)?

   334     };

   336     #   check for order of headers

   337     my $sections = "";

   338     my $done = ''; my $this = ''; my $todo = $spec;

   339     while ($todo =~ m/^(\S+:|%\S+).*$/m) {

   340         $done .= $`; $this = $&; $todo = $';

   341         my $section = $1;

   342         $sections .= "$section,";

   343         $done .= $this;

   344     }

   345     my $regex = $require;

   346     $regex =~ s|\s+||sg;

   347     if ($sections !~ m/^$regex$/s) {

   348         $regex =~ s|,| |sg;

   349         &lint_error($file, undef, undef, "invalid run command section order (expected \"$regex\")");

   350     }

   351 }

   353 ##  _________________________________________________________________

   354 ##

   355 ##  CHECK "script": shell scripts

   356 ##  _________________________________________________________________

   357 ##

   359 sub check_script {

   360     my ($file, $spec) = @_;

   362     my $done = ''; my $this = ''; my $todo = $spec;

   363     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) {

   364         $done .= $`; $this = $&; $todo = $';

   365         my ($section, $args, $script) = ($1, $2, $3);

   367         #   perform checks for a single script section

   368         &check_script_section($file, $done, $this, $section, $args, $script);

   370         $done .= $this;

   371     }

   372 }

   374 sub check_script_section {

   375     my ($file, $outer_done, $outer_this, $section, $args, $script) = @_;

   376     my ($done, $this, $todo);

   377     my ($pkg, $pkgu);

   379     #   determine package name

   380     $pkg = $file;

   381     $pkg =~ s|^.+/||;

   382     $pkg =~ s|^rc\.||;

   384     #   determine package name, dash becomes underscore

   385     $pkgu = $pkg;

   386     $pkgu =~ s|-|_|;

   388     #   remove comment contents

   389     $outer_this =~ s|^[ \t]*#[^\n]*\n||mg;

   391     #   check config

   392     if ($section =~ m/^%(config)$/) {

   394         #   check for badly prefixed variables

   395         $done = $outer_done; $this = ''; $todo = $outer_this;

   396         while ($todo =~ m/    [^=]+=[^\n]+/s) {

   397             $done .= $`; $this = $&; $todo = $';

   398             if ($this !~ m/    ([A-Z]+|$pkgu)_[a-z_][a-z0-9_]*=/) {

   399                 &lint_warning($file, $done, $this, "section $section: badly prefixed variable");

   400             }

   401             $done .= $this;

   402         }

   404         #   enforce _enable to default to openpkg_rc_def

   405         $done = $outer_done; $this = ''; $todo = $outer_this;

   406         if ( $todo =~ m/    [^=]+_enable=[^\n]+/s and $todo !~ m/    [^=]+_enable="\$openpkg_rc_def"\n+/s) {

   407             &lint_warning($file, $done, $this, "section $section: wrong default for ${pkgu}_enable");

   408         }

   410         if ($pkg eq "openpkg") {

   411             #   openpkg_rc before _enable, if used, must be the first variable

   412             $done = $outer_done; $this = ''; $todo = $outer_this;

   413             if ( $todo !~ m/%config\n(    [A-Z]+_[a-z_]+=[^\n]*\n)*    openpkg_rc_def=[^\n]+?\n    openpkg_rc_all=[^\n]+?\n    [^=]+_enable=[^\n]+/s) {

   414                 &lint_warning($file, $done, $this, "section $section: openpkg_rc_def, openpkg_rc_all and ${pkgu}_enable must be the first lowercase variable");

   415             }

   416         }

   417         else {

   418             #   _enable, if used, must be the first variable

   419             $done = $outer_done; $this = ''; $todo = $outer_this;

   420             if ( $todo =~ m/    [^=]+_enable=[^\n]+/s and $todo !~ m/%config\n(    [A-Z]+_[a-z_]+=[^\n]*\n)*    [^=]+_enable=[^\n]+/s) {

   421                 &lint_warning($file, $done, $this, "section $section: ${pkgu}_enable must be the first lowercase variable");

   422             }

   423         }

   424     }

   426     if ($section =~ m/^%(config|info|status)$/) {

   427         #   check illegal use of return/exit

   428         $done = $outer_done; $this = ''; $todo = $outer_this;

   429         if ( $todo =~ m/[^a-zA-Z0-9_](return|exit)\s/s ) {

   430             &lint_warning($file, $done, $this, "section $section: return or exit not allowed here");

   431         }

   432         return;

   433     }

   435     #   check rcService only used for enable|usable|active PR#232

   436     $done = $outer_done; $this = ''; $todo = $outer_this;

   437     while ( $todo =~ m/rcService\s+\w+\s+(\w+)/s )  {

   438         $done .= $`; $this = $&; $todo = $';

   439         if ( $1 !~ m/^(enable|usable|active)$/ ) {

   440             &lint_warning($file, $done, $this, "section $section: rcService must check for (enable|usable|active) only, found check for \"$1\"");

   441         }

   442         $done .= $this;

   443     }

   445     #   check rcService short circuit

   446     if ($section !~ m/^%(config|common|info)$/) {

   447         $done = $outer_done; $this = ''; $todo = $outer_this;

   448         if ( $todo !~ m/^[^\n]+\n    rcService $pkg enable yes \|\| exit 0\n/s ) {

   449             &lint_warning($file, $done, $this, "section $section: \"rcService ... enable yes\" short circuit missing");

   450         }

   451         else {

   452             #   check rcService package reference

   453             $done = $outer_done; $this = ''; $todo = $outer_this;

   454             if ( $todo !~ m/\brcService\s+$pkg\s+/s ) {

   455                 &lint_warning($file, $done, $this, "section $section: rcService referencing wrong package");

   456             }

   457         }

   458     }

   460     #   check shell redirections

   461     $done = $outer_done; $this = ''; $todo = $outer_this;

   462     while (   $todo =~ m/[ \t]+(\d+)?[><][ \t]+\S+/s

   463            or $todo =~ m/[ \t]+[><](\&\d+)?[ \t]+\S+/s) {

   464         $done .= $`; $this = $&; $todo = $';

   465         &lint_warning($file, $done, $this, "section $section: whitespace after shell redirection (expected none)");

   466         $done .= $this;

   467     }

   468 }

   470 ##  _________________________________________________________________

   471 ##

   472 ##  CHECK "global": globals

   473 ##  _________________________________________________________________

   474 ##

   476 sub check_global {

   477     my ($file, $spec) = @_;

   479     #   utility function: extract a single shell command

   480     sub command_extract {

   481         my ($script) = @_;

   482         my $cmd = '';

   483         while ($script ne '') {

   484             $script =~ s/^([ \t]*'[^']*')/         $cmd .= $1, ''/se && next;

   485             $script =~ s/^([ \t]*"[^"]*")/         $cmd .= $1, ''/se && next;

   486             $script =~ s/^([ \t]*[^ \t;\)\\\r\n]+)/$cmd .= $1, ''/se && next;

   487             $script =~ s/^([ \t]*\\[ \t]*\r?\n)/   $cmd .= $1, ''/se && next;

   488             last;

   489         }

   490         return ($cmd, $script);

   491     }

   493     #   check for deprecated use of opServiceEnabled function

   494     my $done = ''; my $this = ''; my $todo = $spec;

   495     while ($todo =~ m/\bopServiceEnabled\b/s) {

   496         $done .= $`; $this = $&; $todo = $';

   497         &lint_warning($file, $done, $this, "deprecated usage of opServiceEnabled macro (expected rcService ... enable yes)");

   498         $done .= $this;

   499     }

   501     my $done = ''; my $this = ''; my $todo = $spec;

   502     while ($todo =~ m/shtool\s+/s) {

   503         $done .= $`; $this = $&; $todo = $';

   504         ($this, $todo) = &command_extract($this . $todo);

   506         #   check for shtool options with no space before argument

   507         my $subthis = $this;

   508         $subthis =~ s/%{[^}]*?}//sg;

   509         $subthis =~ s/'[^']*'//sg;

   510         $subthis =~ s/"[^"]*"//sg;

   511         $subthis =~ s/[;|&].*$//s; # catch command termination by semicolon, pipe, or, and;

   512         if ($subthis =~ m/\s-[a-zA-Z]\S/) {

   513             &lint_warning($file, $done, $this, "found use of shtool option with space omitted before argument");

   514         }

   515         $done .= $this;

   516     }

   517 }

OpenPKG Specs / file revision

openpkg/lint-rc.pl@a2c6460cfb16

openpkg/lint-rc.pl