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

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

openpkg/lint-spec.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-spec.pl -- OpenPKG *.spec 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-spec: ERROR: This command requires a full-size Perl installation!\n" .
             "lint-spec: 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-spec";
 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] [SPECFILE ...]\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
     license
     header
     section
     preproc
     script
     global
     sources
     digest
 ));
 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;
 #   iterate over all .spec 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);";
     }
 }
 #   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, $spec, "", "mandatory/wished trailing blank line missing (expected one)");
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "comment": sharp-comments
 ##  _________________________________________________________________
 ##
 sub check_comment {
     my ($file, $spec) = @_;
     #   check for comment indentation and contents
     my $done = ''; my $this = ''; my $todo = $spec;
     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 for comment contents only
     if ($file !~ m|openpkg\.spec$|) {
         $done = ''; $this = ''; $todo = $spec;
         while ($todo =~ m/\n\n[ \t]*#[ \t]+([^\n]+)(?!\n([ \t]*#))/s) {
             $done .= $`; $this = $&; $todo = $';
             my $text = $1;
             if (length($text) > 0 and $text =~ m|^[A-Z][^A-Z]|) {
                 &lint_warning($file, $done, $this, "comment text starts with upper-case letter (expected lower-case letter)");
             }
             $done .= $this;
         }
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "license": license header
 ##  _________________________________________________________________
 ##
 sub check_license {
     my ($file, $spec) = @_;
     my $name = "[a-z][a-z0-9-]*";
     if ($file =~ m|^.*/([a-z][a-z0-9-]*)\.spec$|) {
         $name = $1;
     }
     elsif ($file =~ m|^([a-z][a-z0-9-]*)\.spec$|) {
         $name = $1;
     }
     my $re = "";
     $re .= "##\\n";
     $re .= "##  $name\\.spec -- OpenPKG RPM Package Specification\\n";
     $re .= "##  Copyright \\(c\\) 200[0-9]-2012 OpenPKG Foundation e\.V\. <http://openpkg\\.net/>\\n";
     $re .= "##\\n";
     $re .= "##  Permission to use, copy, modify, and distribute this software for\\n";
     $re .= "##  any purpose with or without fee is hereby granted, provided that\\n";
     $re .= "##  the above copyright notice and this permission notice appear in all\\n";
     $re .= "##  copies\\.\\n";
     $re .= "##\\n";
     $re .= "##  THIS SOFTWARE IS PROVIDED \\`\\`AS IS'' AND ANY EXPRESSED OR IMPLIED\\n";
     $re .= "##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF\\n";
     $re .= "##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED\\.\\n";
     $re .= "##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR\\n";
     $re .= "##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\\n";
     $re .= "##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES \\(INCLUDING, BUT NOT\\n";
     $re .= "##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF\\n";
     $re .= "##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION\\) HOWEVER CAUSED AND\\n";
     $re .= "##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\\n";
     $re .= "##  OR TORT \\(INCLUDING NEGLIGENCE OR OTHERWISE\\) ARISING IN ANY WAY OUT\\n";
     $re .= "##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF\\n";
     $re .= "##  SUCH DAMAGE\\.\\n";
     $re .= "##\\n";
     if ($name ne "openpkg" and $spec !~ m|^$re|os) {
         &lint_warning($file, "", "", "invalid license header");
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "header": RPM headers
 ##  _________________________________________________________________
 ##
 sub check_header {
     my ($file, $spec) = @_;
     my @headers = (qw(
         m:Name:^[a-z][a-z0-9-]*$
         m:Summary:^[A-Z]\S*(\s+([A-Z]\S*|of|for|from|in|at|on|\(\S+\)))*
         m:URL:^((https?|ftp)://.+|-)$
         m:Vendor:.+
         m:Packager:^(OpenPKG\sFoundation\se\.V\.|OpenPKG\sGmbH)$
         m:Distribution:^(OpenPKG|OpenPKG\sCommunity|OpenPKG\sEnterprise)$
         m:Class:^(BOOT|CORE|BASE|PLUS|EVAL|JUNK|PRIV)$
         m:Group:^[A-Z][a-zA-Z0-9]+$
         m:License:.+
         m:Version:^[^-]+$
         m:Release:^(E?([1-9]\.)?20[0-9][0-9](0[1-9]|1[0-2])(0[1-9]|[1-2][0-9]|3[01])|E?[1-9]\.[0-9]\.\d+|%\{[^\}]+\})$
         o:Source\d+:^((https?|ftp)://.+|[^/]+)$
         o:Patch\d+:^((https?|ftp)://.+|[^/]+)$
         o:Prefix:^%{l_prefix}$
         o:BuildRoot:^%{l_buildroot}$
         m:BuildPreReq:^(((,\s+)?digest\\(sha1:\%\{(SOURCE|PATCH)\d+\}\\)\s+=\s+[0-9a-fA-F]+)+|(OpenPKG,\sopenpkg\s>=\s\S+)?((,\s)?([a-z][a-z0-9-]*(\:\:with_[a-z][a-z0-9_]+)?|[A-Z][A-Z0-9-]*)(\s(>=?|==?|<=?|!=)\s\S+)?)+)$
         m:PreReq:^(OpenPKG,\sopenpkg\s>=\s\S+)?((,\s)?([a-z][a-z0-9-]*(\:\:with_[a-z][a-z0-9_]+)?|[A-Z][A-Z0-9-]*)(\s(>=?|==?|<=?|!=)\s\S+)?)+$
         o:AutoReq:^no$
         o:AutoReqProv:^no$
         o:Provides:^((,\s)?([a-z][a-z0-9-]*(\:\:with_[a-z][a-z0-9_]+)?|[A-Z][A-Z0-9-]*)(\s==?\s\S+)?)+$
         o:Conflicts:^((,\s)?([a-z][a-z0-9-]*(\:\:with_[a-z][a-z0-9_]+)?|[A-Z][A-Z0-9-]*)(\s(>=?|==?|<=?|!=)\s\S+)?)+$
     ));
     my @headers_def = (qw(
         Summary:^Badly\sPackaged\sProgram$
         Vendor:^John\sDoe$
         Group:^Unknown$
         License:^DoePL$
     ));
     my @headers_mult = (qw(
         BuildPreReq PreReq Provides Conflicts
     ));
     my @seen = ();
     my %count = ();
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/^(\S+):([ \t]*)(.*?)$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($header, $pad, $value) = ($1, $2, $3);
         #   check for layouting
         if (length($value) == 0) {
             &lint_error($file, $done, $this, "empty RPM header value");
         }
         if (length($header.":".$pad) != 14) {
             &lint_warning($file, $done, $this, "invalid RPM header name/value padding (expected value at column 15)");
         }
         #   check for valid header name and value
         if (not grep { $header =~ m|^$_$|s } map { m/^[^:]:([^:]+):/, $1 } @headers) {
             &lint_error($file, $done, $this, "invalid RPM header name \"$header\"");
         }
         else {
             my $hn = quotemeta((grep { $header =~ m|^$_$|s } map { m/^[^:]+:([^:]+):/, $1 } @headers)[0]);
             my $re = (map { m/^[^:]+:${hn}:(.+)$/s } @headers)[0];
             my $re_match = $re;
             $re_match =~ s|^\(|(?:|sg;
             $re_match =~ s|([^\\])\(|\1(?:|sg;
             if (    not ($file =~ m|openpkg\.spec$| and $header eq 'Provides' and $value eq '%{l_prefix}')
                 and $value !~ m|${re_match}|s) {
                 &lint_warning($file, $done, $this, "RPM header \"$header\": " .
                               "invalid value \"$value\" (expected to match \"$re\")");
             }
             my $re_def = (map { m/^${hn}:(.+)$/s } @headers_def)[0];
             if (defined($re_def)) {
                 my $re_def_match = $re_def;
                 $re_def_match =~ s|^\(|(?:|sg;
                 $re_def_match =~ s|([^\\])\(|\1(?:|sg;
                 if ($value =~ m|${re_def_match}|s) {
                     &lint_warning($file, $done, $this, "RPM header \"$header\": " .
                                   "default value \"$value\" (expected to match \"$re\", except for this)");
                 }
             }
             if ($header =~ m/^Vendor/ and $value =~ m/et\sal/ and $value !~ m/et\sal\./) {
                 &lint_warning($file, $done, $this, "RPM header \"$header\": " .
                               "has value \"$value\" (expected \"et al.\" with dot)");
             }
         }
         push(@seen, $header);
         $count{$header}++;
         $done .= $this;
     }
     #   check for existence of mandatory headers
     foreach my $header (@headers) {
         my ($type, $name, $regex) = split(/:/, $header, 3);
         if ($type eq 'm') {
             if ($file =~ m|openpkg\.spec$| and
                 ($name eq "BuildPreReq" or $name eq "PreReq")) {
                 #   the bootstrap package is an obvious exception
                 next;
             }
             if (not grep(/^$name$/, @seen)) {
                 &lint_warning($file, undef, undef, "mandatory RPM header \"$name\" not found");
             }
         }
     }
     #   check for multiple occurrence headers
     foreach my $seen (@seen) {
         if ($count{$seen} > 1 and not (grep { $_ eq $seen } @headers_mult)) {
             &lint_error($file, undef, undef, "RPM header \"$seen\" occurs multiple times (expected just once)");
         }
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "section": RPM sections
 ##  _________________________________________________________________
 ##
 sub check_section {
     my ($file, $spec) = @_;
     my $require = qq{
         (%define,)*
         Name:,
         Summary:,
         URL:,
         Vendor:,
         Packager:,
         Distribution:,
         Class:,
         Group:,
         License:,
         Version:,
         Release:,
         (%option,)*
         (%define,|%undefine,)*
         (Source\\d+:,)*
         (Patch\\d+:,)*
         (%NoSource,)*
         (%NoPatch,)*
         (Prefix:,)?
         (BuildRoot:,)?
         ((BuildPreReq:,)
          |(PreReq:,))*
         (AutoReq:,)?
         (AutoReqProv:,)?
         (Provides:,)*
         (Conflicts:,)*
         %description,
         (%track,)?
         %prep,
         %build,
         %install,
         (%check,)?
         %files,
         %clean,
         (%pre,)?
         (%post,)?
         (%preun,)?
         (%postun,)?
         (%trigger,)?
         (%triggerin,)?
         (%triggerun,)?
         (%triggerpostun,)?
         (%verifyscript,)?
     };
     #   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;
         next if ($section =~ m/^%(if|else|endif)/);
         $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 RPM section order: $sections (expected \"$regex\")");
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "preproc": RPM macro pre-processor
 ##  _________________________________________________________________
 ##
 sub check_preproc {
     my ($file, $spec) = @_;
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/^(%(?:if|else|endif|define|undefine|option))(.*)$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($cmd, $args) = ($1, $2);
         if ($cmd eq '%if') {
             #   FIXME: either try to really parse the boolean expression
             #   FIXME: or at least try to guess its correct syntax
         }
         elsif ($cmd eq '%else' or $cmd eq '%endif') {
             if (length($args) > 0) {
                 &lint_warning($file, $done, $this, "garbage after pre-processor directive " .
                               "\"$cmd\" (expected no arguments)");
             }
         }
         elsif ($cmd eq '%undefine') {
             if ($args =~ m|^\s+(\S+)\s*$|) {
                 my $var = $1;
                 if ($var !~ m/^(V|with)_[a-z][a-zA-Z0-9_]*$/) {
                     &lint_warning($file, $done, $this, "unusually named macro: \"$var\" " .
                                   "(expected \"(V|with)_[a-z][a-zA-Z0-9_]*\")");
                     next;
                 }
             }
             else {
                 &lint_error($file, $done, $this, "invalid number of arguments to pre-processor " .
                             "directive \"$cmd\" (expected exactly 1 argument)");
             }
         }
         elsif ($cmd eq '%define' or $cmd eq '%option') {
             if ($args =~ m|^\s+(\S+)\s+(.*)$|) {
                 my ($var, $val) = ($1, $2);
                 if ($var !~ m/^(V|with)_[a-z][a-zA-Z0-9_]*$/) {
                     &lint_warning($file, $done, $this, "unusually named macro: \"$var\" " .
                                   "(expected \"(V|with)_[a-z][a-zA-Z0-9_]*\")");
                     next;
                 }
                 if (length($val) == 0) {
                     &lint_error($file, $done, $this, "empty macro value");
                 }
             }
             else {
                 &lint_error($file, $done, $this, "invalid number of arguments to pre-processor " .
                             "directive \"$cmd\" (expected exactly 2 arguments)");
             }
         }
         $done .= $this;
     }
     #   check correct if/endif nesting
     my @stack = ();
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/^(%(?:if|else|endif|define|undefine|option)).*$/m) {
         $done .= $`; $this = $&; $todo = $';
         my $directive = $1;
         if ($directive eq '%if') {
             push(@stack, &lines($done . $this));
         }
         elsif ($directive eq '%endif') {
             if (@stack == 0) {
                 &lint_error($file, $done, $this, "found \%endif without corresponding opening \%if");
                 last;
             }
             pop(@stack);
         }
         $done .= $this;
     }
     my $line;
     while (defined($line = pop(@stack))) {
         &lint_error($file, undef, undef, "\%if at line $line never closed by \%endif");
     }
     #   check for indented preprocessor constructs
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/^[ \t]+(%(?:if|else|endif|define|undefine|option)).*$/m) {
         $done .= $`; $this = $&; $todo = $';
         my $directive = $1;
         &lint_error($file, $done, $this, "found indented \"$directive\" preprocessor directive (expected no indentation)");
         $done .= $this;
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "script": shell scripts
 ##  _________________________________________________________________
 ##
 sub check_script {
     my ($file, $spec) = @_;
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/(\%(?:description|prep|build|install|check|files|clean|pre|post|preun|postun|trigger|triggerin|triggerun|triggerpostun|verifyscript))([^\n]*)\n(.*?\n)(?=\%(?:description|prep|build|install|check|files|clean|pre|post|preun|postun|trigger|triggerin|triggerun|triggerpostun|verifyscript)|$)/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) = @_;
     #   skip plain-text/non-scripting section %description
     return if ($section eq '%description');
     #   remove comment contents
     $outer_this =~ s|^[ \t]*#[^\n]*||mg;
     #   check shell redirections
     my $done = $outer_done; my $this = ''; my $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;
     }
     #   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);
     }
     #   utility function: join a multi-line command
     sub multiline_join {
         my ($cmd) = @_;
         $cmd =~ s/([ \t]*\\[ \t]*\r?\n[ \t]*)/ /sg;
         return $cmd;
     }
     #   utility function: split command into arguments
     sub shell_tokenize {
         my ($cmd) = @_;
         my @cmd = ();
         while ($cmd ne '') {
             $cmd =~ s/^\s*('[^']*')/push(@cmd, $1), ''/se && next;
             $cmd =~ s/^\s*("[^"]*")/push(@cmd, $1), ''/se && next;
             $cmd =~ s/^\s*(\S+)/    push(@cmd, $1), ''/se && next;
             $cmd =~ s/^\s*$/                        ''/se && last;
         }
         return @cmd;
     }
     #   check filesystem path style
     $done = $outer_done; $this = ''; $todo = $outer_this;
     while ($todo =~ m/\%\{l_shtool\}\s+(\w+)\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/\%{[A-Za-z][A-Za-z0-9_]*}//sg;
         $subthis =~ s/\%{[A-Za-z][A-Za-z0-9_]*(?:\s+[^}]+?)?}//sg;
         #   remove content of quoted arguments as they might contain unrelated things to catch
         $subthis =~ s/'[^']*'/ARG/sg;
         $subthis =~ s/"[^"]*"/ARG/sg;
         $subthis =~ s/`[^`]*`/ARG/sg;
         #   remove us completely if line ends with a quote as this indicates we are a quoted argument to ourselfs
         $subthis =~ s/[^']*'$//s;
         $subthis =~ s/[^"]*"$//s;
         $subthis =~ s/[^`]*`$//s;
         $subthis =~ s/[^']*' \\\n//s;
         $subthis =~ s/[^"]*" \\\n//s;
         $subthis =~ s/[^`]*` \\\n//s;
         #   catch command termination by semicolon, pipe, or, and;
         $subthis =~ s/[;|&].*$//s;
         if ($subthis =~ m/\s-[a-zA-Z]\S/) {
             &lint_warning($file, $done, $this, "found use of shtool option with space omitted before argument");
         }
         #   openpkg-rc is special because does bootstrap things
         last if ($file =~ m|openpkg-rc\.spec$|);
         my @cmd = &shell_tokenize(&multiline_join($this));
         if ($cmd[1] eq 'mkdir') {
             #   join flags with their arguments
             for (my $i = 2; $i <= $#cmd; $i++) {
                 if ($cmd[$i] eq '-m') {
                     splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]);
                 }
             }
             #   check paths
             for (my $i = $#cmd; $i > 1 and $cmd[$i] !~ m|^-| and $cmd[$i] !~ m|^\d+$|; $i--) {
                 if ($cmd[$i] =~ m|/$|) {
                     &lint_warning($file, $done, $this, "section $section: superfluous trailing slash on " .
                                   "created path in \"shtool mkdir\" command (expected none)");
                 }
             }
         }
         elsif ($cmd[1] eq 'install') {
             #   join flags with their arguments
             for (my $i = 2; $i <= $#cmd; $i++) {
                 if ($cmd[$i] =~ m/-(e|m|o|g)$/) {
                     splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]);
                 }
                 elsif ($cmd[$i] eq '%{SOURCE') {
                     splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]);
                 }
                 elsif ($cmd[$i] eq '%{l_value') {
                     while ($i < $#cmd and $cmd[$i+1] !~ m|\}$|s) {
                         splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]);
                     }
                     splice(@cmd, $i, 2);
                     $i--;
                 }
             }
             #   determine last path argument
             my $i = $#cmd; $i-- while ($i > 1 and $cmd[$i] !~ m|^-| and $cmd[$i] !~ m|^\d+$|);
             #   check paths
             if (($#cmd - $i) > 2 and $cmd[-1] !~ m|/$|) {
                 #   simple case: multiple sources require target to be a directory
                 &lint_warning($file, $done, $this, "section $section: missing trailing slash on " .
                               "destination path in \"shtool install\" command (expected one) 1");
             }
             elsif (($#cmd - $i) == 2 and $cmd[-1] !~ m|/$|) {
                 #   complex case: single source, so we can check only known destination paths
                 if (   $cmd[-1] =~ m/\%\{l_prefix\}\/(bin|cgi|include|info|lib|pub|sbin)$/
                     or $cmd[-1] =~ m/\%\{l_prefix\}\/(etc|libexec|man|share|var)(\/[^\/]+)?$/) {
                     &lint_warning($file, $done, $this, "section $section: missing trailing slash on " .
                                   "destination path in \"shtool install\" command (expected one) 2");
                 }
             }
             else {
                 #   special case: if any path contains '*', then globbing might occur
                 for (my $i = 2; $i <= $#cmd; $i++) {
                     if ($cmd[$i] =~ m/\*/ and $cmd[-1] !~ m|/$|) {
                         &lint_warning($file, $done, $this, "section $section: missing trailing slash on " .
                                       "destination path in \"shtool install\" command (expected one) 3");
                         last;
                     }
                 }
             }
         }
         $done .= $this;
     }
     #   check for redundant 'export PATH' statements
     #$done = $outer_done; $this = ''; $todo = $outer_this;
     #while ($todo =~ m/\bexport[ \t]+([a-zA-Z_][a-zA-Z0-9_]*[ \t]+)*PATH\b/s) {
     #    $done .= $`; $this = $&; $todo = $';
     #    &lint_warning($file, $done, $this, "section $section: redundant \"export PATH\" statement (expected none)");
     #    $done .= $this;
     #}
     #   check for obsolete cpp build flags
     $done = $outer_done; $this = ''; $todo = $outer_this;
     while ($todo =~ m/-I\%\{l_prefix\}\/include(\/([^ \t"';]+?))?[ \t"';]/s) {
         $done .= $`; $this = $&; $todo = $';
         my ($subdir) = $2;
         &lint_warning($file, $done, $this, "section $section: hard-coded C pre-processor path option " .
                       "(use \"%{l_cppflags".($subdir ? " $subdir" : "")."}\" instead)");
         $done .= $this;
     }
     #   check for obsolete ld build flags
     $done = $outer_done; $this = ''; $todo = $outer_this;
     while ($todo =~ m/-L\%\{l_prefix\}\/lib(\/([^ \t"';]+?))?[ \t"';]/s) {
         $done .= $`; $this = $&; $todo = $';
         my ($subdir) = $2;
         &lint_warning($file, $done, $this, "section $section: hard-coded linker path option " .
                       "(use \"%{l_ldflags".($subdir ? " $subdir" : "")."}\" instead)");
         $done .= $this;
     }
     #   check for "raw" tool usage
     if ($section ne '%description' and $file !~ m|openpkg\.spec$|) {
         foreach my $token (&shell_tokenize($outer_this)) {
             if ($token =~ m/^(rpmtool|shtool|curl|bash|gzip|bzip2|tar|cc|cxx|make|patch)$/s) {
                 &lint_warning($file, undef, undef, "section $section: raw usage of standard tool \"$token\"" .
                               " (use \"%{l_${token}}\" instead)");
             }
         }
     }
     #   check for setup and patch macro usage
     if ($section eq '%prep') {
         $done = $outer_done; $this = ''; $todo = $outer_this;
         my @tokens = &shell_tokenize($outer_this);
         while ($todo =~ m/([^\n]*)\n/s) {
             $done .= $`; $this = $&; $todo = $';
             if ($this =~ m/^ *%setup.*  .*$/) {
                 &lint_warning($file, undef, undef, "section $section: multiple spaces in \"\%setup\" macro" .
                               " (reduce to single space)");
             }
             if ($this =~ m/^ *%setup.*-[ab]$/ and grep(/^\%setup+$/, @tokens) == 1) {
                 &lint_warning($file, undef, undef, "section $section: -[ab] option superflous for single \"\%setup\" macro" .
                               " (remove it)");
             }
             if ($this =~ m/^ *%patch.*  .*$/) {
                 &lint_warning($file, undef, undef, "section $section: multiple spaces in \"\%patch\" macro" .
                               " (reduce to single space)");
             }
             if ($this =~ m/^ *%patch.*-p +[01]/) {
                 &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" .
                               " (use -pN)");
             }
             if ($this =~ m/^ *%patch.*-P 0\s*$/ and grep(/^\%patch+$/, @tokens) == 1) {
                 &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" .
                               " (omit -P 0 for single patch)");
             }
             if ($this =~ m/^ *%patch.*-P [^0-9]/ and grep(/^\%patch+$/, @tokens)  > 1) {
                 &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" .
                               " (use -P for multiple patches)");
             }
             $done .= $this;
         }
         if (grep(/^\%setup\d+$/, @tokens)) {
             &lint_warning($file, undef, undef, "section $section: numbered \"\%setup\" macro" .
                           " (do not use %setup directly followed by a number, replace with %setup ... -[ab])");
         }
         if (grep(/^\%patch\d+$/, @tokens)) {
             &lint_warning($file, undef, undef, "section $section: numbered \"\%patch\" macro" .
                           " (do not use %patch directly followed by a number, replace with %patch ... -P)");
         }
     }
     #   check for hard-coded prefix in %pre[un],%post[un] scripts
     if ($section =~ m/^\%(preun|postun|pre|post)$/s and $file !~ m|openpkg\.spec$|) {
         $done = $outer_done; $this = ''; $todo = $outer_this;
         while ($todo =~ m/\%\{l_prefix\}/s) {
             $done .= $`; $this = $&; $todo = $';
             &lint_warning($file, $done, $this, "section $section: hard-coded prefix (\%{l_prefix}) found " .
                           "(use \"\$RPM_INSTALL_PREFIX\" to allow relocation)");
             $done .= $this;
         }
     }
     #   check for sub-shell parenthesis style
     #   (this is such complicated because the Bourne Shell has a
     #   construct "case <value> in <pattern> ) <script> ;; ... esac"
     #   where the closing parenthesis makes heavy problems for our
     #   check. So we first have to get rid of this. Unfortunately this
     #   is again not easy because there exists nested(!) case/esac
     #   constructs. Hence, we have to use a small recursive descent
     #   parser which replaces the ")" in case/esac constructs with
     #   "PCLOSE". A similar thing is done with string literals, although
     #   here the job is more trivial).
     if ($section !~ m/^\%files$/s) {
         $done = $outer_done; $this = ''; $todo = $outer_this;
         $todo =~ s/`[^`]*`/STRING/sg;
         $todo =~ s/'[^']*'/STRING/sg;
         $todo =~ s/"[^"]*"/STRING/sg;
         $todo = (&parse_sh("", $todo))[0];
         sub parse_sh {
             my ($done, $todo) = @_;
             while ($todo =~ m/^(.*?)(case|;;)/s) {
                 if ($2 eq 'case') {
                     ($done, $todo) = &parse_case($done.$1, $2.$');
                 }
                 else {
                     ($done, $todo) = ($done.$1, $2.$');
                     return ($done, $todo);
                 }
             }
             ($done, $todo) = ($done . $todo, "");
             return ($done, $todo);
         }
         sub parse_case {
             my ($done, $todo) = @_;
             $todo =~ m|^\s*case\s+\S+\s+in\b|s or return (undef, undef);
             ($done, $todo) = ($done . $&, $');
             while ($todo =~ m|^(\s*[^)\n]+)(\))|s) {
                 ($done, $todo) = ($done . $1 . "PCLOSE", $');
                 ($done, $todo) = &parse_sh($done, $todo) or return (undef, undef);
                 $todo =~ m|^\s*;;|s or return (undef, undef);
                 ($done, $todo) = ($done . $&, $');
             }
             $todo =~ m|^\s*esac|s or return (undef, undef);
             ($done, $todo) = ($done . $&, $');
             return ($done, $todo);
         }
         if ($file !~ m|openpkg\.spec$| and $todo eq '') {
             &lint_warning($file, $outer_done, $outer_this,
                           "unable to correctly parse case/esac constructs in shell-script" .
                           " (sub-shell parenthesis check skipped)");
         }
         else {
             while ($todo =~ m/\)[ \t]*\n/s) {
                 $done .= $`; $this = $&; $todo = $';
                 &lint_warning($file, $done, $this, "problematic sub-shell construct without error handling " .
                               "(use \"...) || exit \$?\" to make sure it correctly exits on nested failure)");
                 $done .= $this;
             }
         }
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "global": globals
 ##  _________________________________________________________________
 ##
 sub check_global {
     my ($file, $spec) = @_;
     #   check for deprecated use of %{name} macro
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/\%\{name\}/s) {
         $done .= $`; $this = $&; $todo = $';
         &lint_warning($file, $done, $this, "deprecated usage of %{name} macro (expected none)");
         $done .= $this;
     }
     #   FIXME: activate later
     #   check for over-long lines
     #$done = ''; $this = ''; $todo = $spec;
     #while ($todo =~ m/([^\n]{80,})\n/s) {
     #    $done .= $`; $this = $&; $todo = $';
     #    &lint_warning($file, $done, $this, "over-long line with ".sprintf("%d", length($1))." characters " .
     #                  "(expected maximum of 79 characters)");
     #    $done .= $this;
     #}
     #   check for "shtool install" with -e on same line
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/%{l_shtool} install[^\n]*-e/s) {
         $done .= $`; $this = $&; $todo = $';
         &lint_warning($file, $done, $this, "found -e option of \"shtool install\" on same line (expected separate lines)");
         $done .= $this;
     }
     #   check for "shtool install" with multiple -e on same line
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/%{l_shtool} install[^\n]+\\\n([^\n]*?-e[^\n]*?-e[^\n]*\\\n)+/s) {
         $done .= $`; $this = $&; $todo = $';
         &lint_warning($file, $done, $this, "found multiple -e options of \"shtool install\" on same line (expected separate lines)");
         $done .= $this;
     }
     #   check for deprecated use of "shtool install|subst -e @l_...@ %{l_...}"
     if ($file !~ m|openpkg-tool|) {
         my $done = ''; my $this = ''; my $todo = $spec;
         while ($todo =~ m/%{l_shtool} (install|subst)(?:\\\n|[^\n])*?-e(?:\\\n|[^\n])*?\@l_(prefix|[smrn](usr|grp|uid|gid))\@[^n]+%{l_\2}/s) {
             $done .= $`; $this = $&; $todo = $';
             &lint_warning($file, $done, $this, "deprecated usage of \"shtool $1 -e \@l_$2\@\" (expected use of %{l_value -s -a})");
             $done .= $this;
         }
     }
     #   check for constant "root" in %attr
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/%attr\(\s*(\d+)\s*,\s*root\s*,/s) {
         $done .= $`; $this = $&; $todo = $';
         &lint_warning($file, $done, $this, "found constant \"root\" in %attr (expected variable %{l_susr})");
         $done .= $this;
     }
     #   check for valid RPM macro usage
     if ($file !~ m|^(.+/)?openpkg\.spec$|s) {
         my $ok = `$rpm --eval '\%dump' 2>&1 | egrep "^-*[0-9][0-9]*: l_" | sed -e 's;^[^:]*: *\\(l_[a-zA-Z0-9_]*\\).*;\\1;' | sort -u`;
         my @ok = split(/\n/, $ok);
         my $todo = $spec;
         $todo =~ s|^([a-zA-Z][a-zA-Z0-9]+):\s+(.+)$|push(@ok, lc($1)), ''|mge;
         $todo =~ s/^\%(?:define|option)\s+(\S+)\s+.+$/push(@ok, $1), ''/mge;
         my $done = ''; my $this = ''; my $todo = $spec;
         while ($todo =~ m|\%\{([a-zA-Z][a-zA-Z0-9_]+)|s) {
             $done .= $`; $this = $&; $todo = $';
             my $name = $1;
             next if ($name =~ m/^(SOURCE|PATCH)\d*$/ or $name =~ m/^(expand|echo|warn|error)$/);
             if (not grep(/^\Q$name\E$/, @ok)) {
                 &lint_error($file, $done, $this, "unknown macro \"\%{$name}\"");
             }
             $done .= $this;
         }
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "sources": source file consistency
 ##  _________________________________________________________________
 ##
 sub check_sources {
     my ($file, $spec) = @_;
     ##
     ##  PREPARATION
     ##
     my $D = {};
     my $S = {};
     my $i = 99;
     #   determine defines values
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/^\%(define|option)\s+(\S+)\s+(.+)\s*$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($var, $val) = ($2, $3);
         $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
         $D->{$var} = $val;
         $done .= $this;
     }
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/^([a-zA-Z][a-zA-Z0-9_]+):\s+(.*)$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($var, $val) = (lc($1), $2);
         $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
         $D->{$var} = $val;
         $done .= $this;
     }
     #   expand define values (allow one level of nesting)
     $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
     $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
     #   parse Source# and Patch# headers
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/^(Source|Patch)(\d+):[ \t]*(.*?)$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($type, $num, $file) = (lc($1), $2, $3);
         my $url = "";
         if ($file =~ m|^(.+/)([^/]+)$|s) {
             ($url, $file) = ($1, $2);
         }
         if (not defined($S->{"$type$num"})) {
             $S->{"$type$num"} = {
                 -type   => $type,
                 -num    => $num,
                 -url    => $url,
                 -file   => $file,
                 -refhdr => 1,
                 -refcmd => 0,
                 -refmac => 0,
                 -refvar => 0,
             };
         }
         else {
             $S->{"$type$num"}->{-refhdr}++;
         }
         $done .= $this;
     }
     #   parse %setup and %patch commands
     $done = ''; $this = ''; $todo = $spec;
     $todo =~ s/^(\s*\%patch)((?:\s+-\S+|\s+-d\s+\S+)*)((?:\s+\d+)+)\s*$/&expand_patch($1, $2, $3)/mge;
     sub expand_patch {
         my ($cmd, $opts, $nums) = @_;
         my $cmds = '';
         $cmds .= "${cmd}0${opts}\n" if ($opts !~ m|\s+-P|s);
         $opts =~ s|\s+-P||s;
         while ($nums =~ s|^\s+(\d+)||) {
             my $num = $1;
             $cmds .= "${cmd}${num}${opts}\n";
         }
         return $cmds;
     }
     while ($todo =~ m/^\s*\%(setup|patch)(\d+)?(\s+.*)?$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($type, $num, $opts) = ($1, $2, $3);
         $type = 'source' if ($type eq 'setup');
         my $num_force = '';
         if ($opts =~ m/\s-(?:a|b)\s*(\d+)/s) {
             $num_force = $1;
         }
         if ($num ne '' and $num_force ne '' and $num ne $num_force) {
             &lint_warning($file, $done, $this, "macro and enforced $type number conflict: $num <-> $num_force" .
                         " (expected either just enforced number or make them match)");
         }
         $num = $num_force if ($num_force ne '');
         $num = 0 if ($num eq '');
         next if ($opts =~ m|\s-T|s and $num == 0);
         if (not defined($S->{"$type$num"})) {
             $S->{"$type$num"} = {
                 -type   => $type,
                 -num    => $num,
                 -url    => "",
                 -file   => "",
                 -refhdr => 0,
                 -refcmd => 1,
                 -refmac => 0,
                 -refvar => 0,
             };
         }
         else {
             $S->{"$type$num"}->{-refcmd}++;
         }
         $done .= $this;
     }
     #   parse %{SOURCE#} and %{PATCH#} macros
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/\%\{(SOURCE|PATCH)(\d+)\}/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($type, $num) = (lc($1), $2);
         if (not defined($S->{"$type$num"})) {
             $S->{"$type$num"} = {
                 -type   => $type,
                 -num    => $num,
                 -url    => "",
                 -file   => "",
                 -refhdr => 0,
                 -refcmd => 0,
                 -refmac => 1,
                 -refvar => 0,
             };
         }
         else {
             $S->{"$type$num"}->{-refmac}++;
         }
         $done .= $this;
     }
     #   parse %{SOURCE ...} and %{PATCH ...} macros
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/\%\{(SOURCE|PATCH)\s+([^\s}]+)\}/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($type, $file) = (lc($1), $2);
         my $key = "";
         foreach my $src (keys(%{$S})) {
             if ($S->{$src}->{-type} eq $type and $S->{$src}->{-file} eq $file) {
                 $key = $src;
             }
         }
         if ($key eq '') {
             $S->{"$type$i"} = {
                 -type   => $type,
                 -num    => $i,
                 -url    => "",
                 -file   => $file,
                 -refhdr => 0,
                 -refcmd => 0,
                 -refmac => 1,
                 -refvar => 0,
             };
             $i++;
         }
         else {
             $S->{$key}->{-refmac}++;
         }
         $done .= $this;
     }
     #   parse $RPM_SOURCE_DIR based references
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/\$RPM_SOURCE_DIR\/([^\s;"']+)/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($file) = ($1);
         my $key = "";
         foreach my $src (keys(%{$S})) {
             if ($S->{$src}->{-file} eq $file) {
                 $key = $src;
             }
         }
         if ($key eq '') {
             $S->{"source$i"} = {
                 -type   => "source",
                 -num    => $i,
                 -url    => "",
                 -file   => $file,
                 -refhdr => 0,
                 -refcmd => 0,
                 -refmac => 0,
                 -refvar => 1,
             };
             $i++;
         }
         else {
             $S->{$key}->{-refmac}++;
         }
         $done .= $this;
     }
     ##
     ##  CHECKING
     ##
     #   check reference counts
     foreach my $src (%{$S}) {
         my $s = $S->{$src};
         my $str_hdr = ($s->{-type} eq 'source' ? 'Source' : 'Patch' ) . $s->{-num};
         my $str_cmd = ($s->{-type} eq 'source' ? '%setup' : '%patch') . $s->{-num};
         my $str_mac = ($s->{-type} eq 'source' ? '%{SOURCE ...}' : '%{PATCH ...}');
         my $str_var = "\$RPM_SOURCE_DIR";
         if ($file !~ m/\b(openpkg-.*|openpkg|vim|ncurses|openssh)\.spec$/) {
             if ($s->{-refhdr} > 0) {
                 if ($s->{-refcmd} == 0 and $s->{-refmac} == 0 and $s->{-refvar} == 0) {
                     &lint_error($file, undef, undef, "source \"$str_hdr\" defined (file $s->{-file}), but never used" .
                                 " (expected at least one reference via \"$str_cmd\", \"$str_mac\" or \"$str_var\")");
                 }
                 elsif ($s->{-refcmd} > 1) {
                     &lint_error($file, undef, undef, "source \"$str_hdr\" defined (file $s->{-file}), but used multiple times" .
                                 " (expected just one reference via \"$str_cmd\")");
                 }
             }
             else {
                 if ($s->{-refcmd}+$s->{-refmac}+$s->{-refvar} > 0) {
                     &lint_error($file, undef, undef, "source \"$str_hdr\" not defined, but used ".
                                 ($s->{-file} ? "(file ".$s->{-file}.")" : "").
                                 " (expected at least one definition via \"$str_hdr\")");
                 }
             }
         }
     }
     #   check for existing of sources on filesystem
     my $name = $file;
     $name =~ s|.*/([^/]+)$|$1|s;
     $name =~ s|\.spec$||s;
     my $cvsdir = `$rpm --define 'name $name' --eval '%{_specdir}'`;
     $cvsdir =~ s|\n$||s;
     $cvsdir =~ s|/+$||s;
     my $dstdir = `$rpm --define 'name $name' --eval '%{_sourcedir}'`;
     $dstdir =~ s|\n$||s;
     $dstdir =~ s|/+$||s;
     foreach my $src (%{$S}) {
         my $s = $S->{$src};
         next if (not $s->{-refhdr});
         if ($s->{-url} eq '' and not -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) {
             &lint_error($file, undef, undef, "source \"$s->{-file}\" neither found in SRC nor DST locations (you have to provide it)");
         }
         elsif ($s->{-url} eq '' and not -f $cvsdir."/".$s->{-file} and -f $dstdir."/".$s->{-file}) {
             &lint_error($file, undef, undef, "source \"$s->{-file}\" not found in SRC, but in DST (expected it in SRC or want URL)");
         }
         elsif ($s->{-url} ne '' and not -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) {
             &lint_error($file, undef, undef, "source \"$s->{-file}\" neither found in SRC nor DST locations (you have to download it)");
         }
         elsif ($s->{-url} ne '' and -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) {
             &lint_error($file, undef, undef, "source \"$s->{-file}\" not found in DST, but in SRC (expected it in DST or want URL)");
         }
         #if ($s->{-url} ne '' and $s->{-file} !~ m/\d/) {
         #    &lint_warning($file, undef, undef, "vendor source \"$s->{-file}\" not versioned");
         #}
     }
     #   check for patch file naming
     foreach my $src (%{$S}) {
         my $s = $S->{$src};
         next if (not $s->{-refhdr});
         if (    $s->{-url} eq '' and $s->{-type} eq 'patch'
             and $s->{-file} !~ m|^${name}\.patch(\.[^./]+)?$|) {
             &lint_warning($file, undef, undef, "non-canonical patch filename \"$s->{-file}\"" .
                           " (expected to match \"${name}\\.patch(\\.[^./]+)?\$\")");
         }
     }
 }
 ##  _________________________________________________________________
 ##
 ##  CHECK "digest": digest consistency
 ##  _________________________________________________________________
 ##
 sub check_digest {
     my ($file, $spec) = @_;
     ##
     ##  PREPARATION
     ##
     my $D = {};
     my $S = {};
     #   determine defines values
     my $done = ''; my $this = ''; my $todo = $spec;
     while ($todo =~ m/^\%(define|option)\s+(\S+)\s+(.+)\s*$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($var, $val) = ($2, $3);
         $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
         $D->{$var} = $val;
         $done .= $this;
     }
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/^([a-zA-Z][a-zA-Z0-9_]+):\s+(.*)$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($var, $val) = (lc($1), $2);
         $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
         $D->{$var} = $val;
         $done .= $this;
     }
     #   expand define values (allow one level of nesting)
     $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
     $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
     #   determine locations
     my $name = $file;
     $name =~ s|.*/([^/]+)$|$1|s;
     $name =~ s|\.spec$||s;
     my $srcdir = `$rpm --define 'name $name' --eval '%{_specdir}'`;
     $srcdir =~ s|\n$||s;
     $srcdir =~ s|/+$||s;
     my $dstdir = `$rpm --define 'name $name' --eval '%{_sourcedir}'`;
     $dstdir =~ s|\n$||s;
     $dstdir =~ s|/+$||s;
     #   parse Source# and Patch# headers
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/^(Source|Patch)(\d+):[ \t]*(.*?)$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($type, $num, $url) = (lc($1), $2, $3);
         my $file;
         if ($url =~ m|^.+/([^/]+)$|s) {
             $file = "$dstdir/$1";
         }
         else {
             $file = "$srcdir/$url";
         }
         if (not defined($S->{"$type$num"})) {
             $S->{"$type$num"} = {
                 -type   => $type,
                 -num    => $num,
                 -url    => $url,
                 -file   => $file
             };
         }
         else {
             $S->{"$type$num"}->{-refhdr}++;
         }
         $done .= $this;
     }
     #   parse BuildPreReq headers
     $done = ''; $this = ''; $todo = $spec;
     while ($todo =~ m/^BuildPreReq:[ \t]+digest\(sha1:\%\{(.+?)\}\)[ \t]+=[ \t]+([0-9a-fA-F]+)$/m) {
         $done .= $`; $this = $&; $todo = $';
         my ($macro, $sha1) = ($1, $2);
         my $url = $S->{lc($macro)}->{-url};
         my $filename = $S->{lc($macro)}->{-file};
         my $basename = $filename;
         $basename =~ s/^.+\/([^\/]+)$/$1/s;
         my $sha1_real = `$openssl sha1 $filename 2>/dev/null`;
         $sha1_real =~ s/^SHA1\s*\(.+?\)\s*=\s*([0-9a-fA-F]+)\s*$/$1/s;
         if (lc($sha1) ne lc($sha1_real)) {
             &lint_error($file, undef, undef, "source \"$basename\" (\%{$macro}) has a digest(sha1) requirement of \"$sha1\" (expected \"$sha1_real\")");
         }
         $done .= $this;
     }
 }

OpenPKG Specs / annotate

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

openpkg/lint-spec.pl