OpenPKG CVS Repository
  http://cvs.openpkg.org/
  ____________________________________________________________________________

  Server: cvs.openpkg.org                  Name:   Thomas Lotterer
  Root:   /e/openpkg/cvs                   Email:  [EMAIL PROTECTED]
  Module: openpkg-re                       Date:   15-Jul-2003 12:01:56
  Branch: HEAD                             Handle: 2003071511015500

  Modified files:
    openpkg-re              fsllint.pl

  Log:
    add ident/default checking

  Summary:
    Revision    Changes     Path
    1.3         +201 -0     openpkg-re/fsllint.pl
  ____________________________________________________________________________

  patch -p0 <<'@@ .'
  Index: openpkg-re/fsllint.pl
  ============================================================================
  $ cvs diff -u -r1.2 -r1.3 fsllint.pl
  --- openpkg-re/fsllint.pl     14 Jul 2003 15:13:12 -0000      1.2
  +++ openpkg-re/fsllint.pl     15 Jul 2003 10:01:55 -0000      1.3
  @@ -100,6 +100,7 @@
   my @check_list = (qw(
       blank
       comment
  +    ident
   ));
   my @checks = ();
   if ($check eq 'all') {
  @@ -291,3 +292,203 @@
       }
   }
   
  +##  _________________________________________________________________
  +##
  +##  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="[EMAIL 
PROTECTED]@/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="[EMAIL 
PROTECTED]@/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/,//;
  +            
  +            #   detect superflous options in file 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, "", "", "file channel missing");
  +        }
  +
  +        $done .= $this;
  +    }
  +    return;
  +}
  @@ .
______________________________________________________________________
The OpenPKG Project                                    www.openpkg.org
CVS Repository Commit List                     [EMAIL PROTECTED]

Reply via email to