OpenPKG Specs: openpkg/lint-fsl.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-fsl.pl -- OpenPKG fsl.* 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-fsl: ERROR: This command requires a full-size Perl installation!\n" .

    31             "lint-fsl: 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-fsl";

    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     ident

   109 ));

   110 my @checks = ();

   111 if ($check eq 'all') {

   112     @checks = @check_list;

   113 }

   114 else {

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

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

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

   118         }

   119         push(@checks, $c);

   120     }

   121 }

   123 #   global return code

   124 $main::GRC = 0;

   126 #   environment preparation

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

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

   130 #   iterate over all fsl. files

   131 foreach my $filename (@ARGV) {

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

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

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

   135     $io->close;

   136     foreach my $check (@checks) {

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

   138     }

   139 }

   141 #   environment cleanup

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

   144 #   die gracefully

   145 exit($main::GRC);

   147 ##  _________________________________________________________________

   148 ##

   149 ##  COMMON SUBROUTINES

   150 ##  _________________________________________________________________

   151 ##

   153 sub lines {

   154     my ($txt) = @_;

   155     my $l = 0;

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

   157     return $l;

   158 }

   160 sub lint_message {

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

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

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

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

   165         my $pos = $start;

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

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

   168     }

   169     else {

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

   171     }

   172 }

   174 sub lint_warning {

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

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

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

   178 }

   180 sub lint_error {

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

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

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

   184 }

   186 ##  _________________________________________________________________

   187 ##

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

   189 ##  _________________________________________________________________

   190 ##

   192 sub check_blank {

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

   195     #   check for CR-LF combination

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

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

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

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

   200         $done .= $this;

   201     }

   203     #   check for multiple blank lines

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

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

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

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

   208         $done .= $this;

   209     }

   211     #   check for trailing whitespaces

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

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

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

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

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

   217         }

   218         else {

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

   220         }

   221         $done .= $this;

   222     }

   224     #   check for bogus line continuations

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

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

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

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

   229         $done .= $this;

   230     }

   232     #   check for leading whitespaces before line continuations

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

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

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

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

   237         $done .= $this;

   238     }

   240     #   check for leading tabs

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

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

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

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

   245         $done .= $this;

   246     }

   248     #   check for mandatory/wished trailing blank line

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

   250         &lint_warning($file, $done, "", "mandatory/wished trailing blank line missing (expected one)");

   251     }

   252 }

   254 ##  _________________________________________________________________

   255 ##

   256 ##  CHECK "comment": sharp-comments

   257 ##  _________________________________________________________________

   258 ##

   260 sub check_comment {

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

   262     my ($pkg);

   264     #   determine package name

   265     $pkg = $file;

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

   267     $pkg =~ s|^fsl\.||;

   269     #   check comment header

   270     my $re = "";

   271     $re .= "##\\n##  fsl.$pkg -- OSSP fsl configuration\\n##\\n\\n";

   272     if ($spec !~ m|^$re|os) {

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

   274     }

   276     #   check for comment indentation

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

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

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

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

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

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

   283         }

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

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

   286         }

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

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

   289         }

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

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

   292         }

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

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

   295         }

   296         $done .= $this;

   297     }

   298 }

   300 ##  _________________________________________________________________

   301 ##

   302 ##  CHECK "ident"

   303 ##  _________________________________________________________________

   304 ##

   306 sub check_ident {

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

   308     my ($pkg, $section);

   310     #   determine package name

   311     $pkg = $file;

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

   313     $pkg =~ s|^fsl\.||;

   315     #   check sections with ident/facility regex

   316     my $done .= ""; my $this = ""; my $todo = $spec;

   317     while ($todo =~ m:\n(\w+)(\s+)(\S+)/(\S+)(\s+)q\{(.*?)\};:s) {

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

   319         my ($section, $ws1, $ident, $facility, $ws2, $body) = ($1, $2, $3, $4, $5, $6);

   321         if ($pkg eq "fsl") {

   322             #   enforce default section for fsl

   323             if ($section ne "default") {

   324                 &lint_warning($file, "", "", "section \"$section\" not allowed for package $pkg (expected default)");

   325             }

   326         }

   327         else {

   328             #   enforce ident section for any package othen than fsl

   329             if ($section ne "ident") {

   330                 &lint_warning($file, "", "", "section \"$section\" not allowed for package $pkg (expected ident)");

   331             }

   333             #   ident and facility wildcard-only would be a catch-all

   334             if ($ident =~ m/^[(]?\.[\+\*][)]?$/ and $facility =~ m/^[(]?\.[\+\*][)]?$/) {

   335                 &lint_warning($file, "", "", "wildcard not allowed for both ident and facility (found $ident/$facility");

   336             }

   337         }

   339         #   enforce a single space

   340         if (length($ws1) != 1) {

   341             &lint_warning($file, "", "", "whitespace count wrong between section ($section) and ident ($ident)");

   342         }

   344         #   enforce a single space

   345         if (length($ws2) != 1) {

   346             &lint_warning($file, "", "", "whitespace count wrong between facility ($facility) and end of line");

   347         }

   349         #   ident same as facility is likely to be a typo

   350         if ($ident eq $facility) {

   351             &lint_warning($file, "", "", "unusual constellation ident equal to facility (found $ident/$facility");

   352         }

   354         #   FIXME MTAs hardcoded here for /mail

   355         if ($facility eq "mail" and $pkg !~ m/^(sendmail|ssmtp|postfix|exim)$/) {

   356             &lint_warning($file, "", "", "only MTAs may match facility mail");

   357         }

   359         #   FIXME inn hardcoded here for /news

   360         if ($facility eq "news" and $pkg !~ m/^(inn)$/) {

   361             &lint_warning($file, "", "", "only inn may match facility news");

   362         }

   364         #   check prefix channel

   365         if ($body =~ m/\n([ ]*)prefix(\s*?)\((.*?)\)/s) {

   366             my ($ws1, $ws2, $options) = ($1, $2, $3);

   368             #   enforce eight spaces

   369             if (length($ws1) != 4) {

   370                 &lint_warning($file, "", "", "prefix channel whitespace count at start of line");

   371             }

   373             #   enforce zero spaces

   374             if (length($ws2) != 0) {

   375                 &lint_warning($file, "", "", "whitespace not allowed between prefix channel and round open bracket");

   376             }

   378             #   enforce prefix options in prefix channel

   379             if ($options !~ m/\sprefix="%b %d %H:%M:%S %N (<%L> )?\$1(\[%P\])?: "/) {

   380                 &lint_warning($file, "", "", "prefix option in prefix channel invalid or missing");

   381             }

   382             $options = $';

   383             $options =~ s/,//;

   385             #   detect superflous options in prefix channel

   386             if ($options =~ m/\S+/s) {

   387                 $options =~ s/\n/\\n/;

   388                 &lint_warning($file, "", "", "superflous option in prefix channel unseparated line detected: $options");

   389             }

   390         }

   391         else {

   392             &lint_warning($file, "", "", "prefix channel missing");

   393         }

   395         #   check path branch

   396         if ($body !~ m/\n([ ]*)->(\s*?)\{(.*)\}\n/s) {

   397             &lint_warning($file, "", "", "no path branch found");

   398             return;

   399         }

   400         my ($ws1, $ws2, $body) = ($1, $2, $3); #FIXME check ws1/ws2

   402         #   check path channel

   403         while ($body =~ m/\n([ ]*)(\w+):(\s+?)file(\s*?)\((.*?)\);/s) {

   404             my ($ws1, $level, $ws2, $ws3, $options) = ($1, $2, $3, $4, $5);

   405             $body = $';

   407             #   enforce eight spaces

   408             if (length($ws1) != 8) {

   409                 &lint_warning($file, "", "", "path channel whitespace count at start of line");

   410             }

   412             #   enforce spaces

   413             if (length($ws2) < 1) {

   414                 &lint_warning($file, "", "", "whitespace required between level and file");

   415             }

   417             #   enforce zero spaces

   418             if (length($ws3) != 0) {

   419                 &lint_warning($file, "", "", "path channel whitespace not allowed between file channel and round open bracket");

   420             }

   422             #   check for legal l2 level

   423             if ($level !~ m/^(panic|critical|error|warning|notice|info|trace|debug)$/) {

   424                 &lint_warning($file, "", "", "illegal l2 level $level detected");

   425             }

   427             #   enforce file option in file channel

   428             if ($options !~ m;path="\@l_prefix\@/var/$pkg/(log\S+|$pkg\.log)";) {

   429                 &lint_warning($file, "", "", "path option in file channel invalid or missing");

   430             }

   431             $options = $';

   432             $options =~ s/,//;

   434             #   enforce perm option in file channel

   435             if ($options !~ m;perm=0[0-7]{3};) {

   436                 &lint_warning($file, "", "", "perm option in file channel invalid or missing");

   437             }

   438             $options = $';

   439             $options =~ s/,//;

   441             #   detect superflous options in file channel

   442             if ($options =~ m/\S+/s) {

   443                 $options =~ s/\n/\\n/;

   444                 &lint_warning($file, "", "", "superflous option in prefix channel detected: $options");

   445             }

   446         }

   448         #   check path channel

   449         if ($body =~ m/\n([ ]*)(\w+):(\s*?)file(\s*?)\((.*?)\)/s) {

   450             my ($ws1, $level, $ws2, $ws3, $options) = ($1, $2, $3, $4, $5);

   452             #   enforce eight spaces

   453             if (length($ws1) != 8) {

   454                 &lint_warning($file, "", "", "path channel whitespace count at start of unseparated line");

   455             }

   457             #   enforce spaces

   458             if (length($ws2) < 1) {

   459                 &lint_warning($file, "", "", "path channel whitespace required between level and file of unseparated line");

   460             }

   462             #   enforce zero spaces

   463             if (length($ws3) != 0) {

   464                 &lint_warning($file, "", "", "whitespace not allowed between file channel and round open bracket");

   465             }

   467             #   check for legal l2 level

   468             if ($level !~ m/^(panic|critical|error|warning|notice|info|trace|debug)$/) {

   469                 &lint_warning($file, "", "", "illegal l2 level $level detected on unseparated line");

   470             }

   472             #   enforce file option in file channel

   473             if ($options !~ m;path="\@l_prefix\@/var/$pkg/(log\S+|$pkg\.log)";) {

   474                 &lint_warning($file, "", "", "XXX path option in file channel invalid or missing on unseparated line");

   475             }

   476             $options = $';

   477             $options =~ s/,//;

   479             #   enforce perm option in file channel

   480             if ($options !~ m;perm=0[0-7]{3};) {

   481                 &lint_warning($file, "", "", "perm option in file channel invalid or missing on unseparated line");

   482             }

   484             $options = $';

   485             $options =~ s/, jitter=[0-9]+//;

   486             $options =~ s/, monitor=[0-9]+//;

   487             $options =~ s/,//;

   489             #   detect superflous options in file channel

   490             if ($options =~ m/\S+/s) {

   491                 $options =~ s/\n/\\n/;

   492                 &lint_warning($file, "", "", "superflous option in file channel unseparated line detected: $options");

   493             }

   494         }

   495         else {

   496             &lint_warning($file, "", "", "file channel missing");

   497         }

   499         $done .= $this;

   500     }

   501     return;

   502 }

OpenPKG Specs / file revision

openpkg/lint-fsl.pl@a2c6460cfb16

openpkg/lint-fsl.pl