1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/openpkg/lint-spec.pl Tue Jul 31 12:23:42 2012 +0200
1.3 @@ -0,0 +1,1388 @@
1.4 +##
1.5 +## lint-spec.pl -- OpenPKG *.spec File Checker
1.6 +## Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
1.7 +##
1.8 +## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
1.9 +## All rights reserved. Licenses which grant limited permission to use,
1.10 +## copy, modify and distribute this software are available from the
1.11 +## OpenPKG GmbH.
1.12 +##
1.13 +## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
1.14 +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
1.15 +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
1.16 +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
1.17 +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1.18 +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1.19 +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
1.20 +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1.21 +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1.22 +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
1.23 +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1.24 +## SUCH DAMAGE.
1.25 +##
1.26 +
1.27 +# Perl run-time requirement
1.28 +require 5;
1.29 +BEGIN {
1.30 + eval "use Getopt::Long; use IO;";
1.31 + if ($@) {
1.32 + print STDERR
1.33 + "lint-spec: ERROR: This command requires a full-size Perl installation!\n" .
1.34 + "lint-spec: HINT: Install OpenPKG \"perl\" package to use this command.\n";
1.35 + exit(1);
1.36 + }
1.37 +}
1.38 +
1.39 +# OpenPKG instance prefix
1.40 +my $my_prefix = $ENV{'OPENPKG_PREFIX'};
1.41 +delete $ENV{'OPENPKG_PREFIX'};
1.42 +
1.43 +# program information
1.44 +my $progname = "lint-spec";
1.45 +my $progvers = "1.0.0";
1.46 +
1.47 +# parameters (defaults)
1.48 +my $version = 0;
1.49 +my $verbose = 0;
1.50 +my $help = 0;
1.51 +my $check = 'all';
1.52 +my $tmpdir = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname";
1.53 +my $rpm = "$my_prefix/bin/openpkg rpm";
1.54 +
1.55 +# exception handling support
1.56 +$SIG{__DIE__} = sub {
1.57 + my ($err) = @_;
1.58 + $err =~ s|\s+at\s+.*||s if (not $verbose);
1.59 + print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n";
1.60 + exit(1);
1.61 +};
1.62 +
1.63 +# command line parsing
1.64 +Getopt::Long::Configure("bundling");
1.65 +my $result = GetOptions(
1.66 + 'V|version' => \$version,
1.67 + 'v|verbose' => \$verbose,
1.68 + 'h|help' => \$help,
1.69 + 'c|check=s' => \$check,
1.70 + 't|tmpdir=s' => \$tmpdir,
1.71 + 'r|rpm=s' => \$rpm,
1.72 +) || die "option parsing failed";
1.73 +if ($help) {
1.74 + print "Usage: $progname [options] [SPECFILE ...]\n" .
1.75 + "Available options:\n" .
1.76 + " -v,--verbose enable verbose run-time mode\n" .
1.77 + " -h,--help print out this usage page\n" .
1.78 + " -c,--check=CHECKS select checks to perform (default='all')\n" .
1.79 + " -r,--rpm=FILE filesystem path to RPM program\n" .
1.80 + " -t,--tmpdir=PATH filesystem path to temporary directory\n" .
1.81 + " -V,--version print program version\n";
1.82 + exit(0);
1.83 +}
1.84 +if ($version) {
1.85 + print "OpenPKG $progname $progvers\n";
1.86 + exit(0);
1.87 +}
1.88 +
1.89 +# verbose message printing
1.90 +sub msg_verbose {
1.91 + my ($msg) = @_;
1.92 + print STDERR "$msg\n" if ($verbose);
1.93 +}
1.94 +
1.95 +# warning message printing
1.96 +sub msg_warning {
1.97 + my ($msg) = @_;
1.98 + print STDERR "$progname:WARNING: $msg\n";
1.99 +}
1.100 +
1.101 +# error message printing
1.102 +sub msg_error {
1.103 + my ($msg) = @_;
1.104 + print STDERR "$progname:ERROR: $msg\n";
1.105 +}
1.106 +
1.107 +# determine check list
1.108 +my @check_list = (qw(
1.109 + blank
1.110 + comment
1.111 + license
1.112 + header
1.113 + section
1.114 + preproc
1.115 + script
1.116 + global
1.117 + sources
1.118 + digest
1.119 +));
1.120 +my @checks = ();
1.121 +if ($check eq 'all') {
1.122 + @checks = @check_list;
1.123 +}
1.124 +else {
1.125 + foreach my $c (split(/,/, $check)) {
1.126 + if (not grep($c, @check_list)) {
1.127 + die "invalid check \"$c\"";
1.128 + }
1.129 + push(@checks, $c);
1.130 + }
1.131 +}
1.132 +
1.133 +# global return code
1.134 +$main::GRC = 0;
1.135 +
1.136 +# iterate over all .spec files
1.137 +foreach my $filename (@ARGV) {
1.138 + my $io = new IO::File "<$filename"
1.139 + or die "unable to open file \"$filename\" for reading";
1.140 + my $spec; { local $/ = undef; $spec = <$io>; }
1.141 + $io->close;
1.142 + foreach my $check (@checks) {
1.143 + eval "\&check_$check(\$filename, \$spec);";
1.144 + }
1.145 +}
1.146 +
1.147 +# die gracefully
1.148 +exit($main::GRC);
1.149 +
1.150 +## _________________________________________________________________
1.151 +##
1.152 +## COMMON SUBROUTINES
1.153 +## _________________________________________________________________
1.154 +##
1.155 +
1.156 +sub lines {
1.157 + my ($txt) = @_;
1.158 + my $l = 0;
1.159 + $txt =~ s|\n|$l++, ''|sge;
1.160 + return $l;
1.161 +}
1.162 +
1.163 +sub lint_message {
1.164 + my ($type, $file, $done, $this, $msg) = @_;
1.165 + if (defined($done) and defined($this)) {
1.166 + my $start = &lines($done) + 1;
1.167 + my $end = $start + &lines($this);
1.168 + my $pos = $start;
1.169 + $pos .= "-". $end if ($end > $start);
1.170 + printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg);
1.171 + }
1.172 + else {
1.173 + printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg);
1.174 + }
1.175 +}
1.176 +
1.177 +sub lint_warning {
1.178 + my ($file, $done, $this, $msg) = @_;
1.179 + &lint_message("WARNING", $file, $done, $this, $msg);
1.180 + $main::GRC = 1 if ($main::GRC < 1);
1.181 +}
1.182 +
1.183 +sub lint_error {
1.184 + my ($file, $done, $this, $msg) = @_;
1.185 + &lint_message("ERROR", $file, $done, $this, $msg);
1.186 + $main::GRC = 2 if ($main::GRC < 2);
1.187 +}
1.188 +
1.189 +## _________________________________________________________________
1.190 +##
1.191 +## CHECK "blank": whitespace and blank lines
1.192 +## _________________________________________________________________
1.193 +##
1.194 +
1.195 +sub check_blank {
1.196 + my ($file, $spec) = @_;
1.197 +
1.198 + # check for CR-LF combination
1.199 + my $done = ''; my $this = ''; my $todo = $spec;
1.200 + while ($todo =~ m/\r\n/s) {
1.201 + $done .= $`; $this = $&; $todo = $';
1.202 + &lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)");
1.203 + $done .= $this;
1.204 + }
1.205 +
1.206 + # check for multiple blank lines
1.207 + $done = ''; $this = ''; $todo = $spec;
1.208 + while ($todo =~ m/(\r?\n[ \t]*){3,}/s) {
1.209 + $done .= $`; $this = $&; $todo = $';
1.210 + &lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)");
1.211 + $done .= $this;
1.212 + }
1.213 +
1.214 + # check for trailing whitespaces
1.215 + $done = ''; $this = ''; $todo = $spec;
1.216 + while ($todo =~ m/[ \t]+\r?\n/s) {
1.217 + $done .= $`; $this = $&; $todo = $';
1.218 + if ($done eq '' or $done =~ m|\n$|s) {
1.219 + &lint_warning($file, $done, $this, "whitespace on empty line (expected none)");
1.220 + }
1.221 + else {
1.222 + &lint_warning($file, $done, $this, "trailing whitespace (expected none)");
1.223 + }
1.224 + $done .= $this;
1.225 + }
1.226 +
1.227 + # check for bogus line continuations
1.228 + $done = ''; $this = ''; $todo = $spec;
1.229 + while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) {
1.230 + $done .= $`; $this = $&; $todo = $';
1.231 + &lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)");
1.232 + $done .= $this;
1.233 + }
1.234 +
1.235 + # check for leading whitespaces before line continuations
1.236 + $done = ''; $this = ''; $todo = $spec;
1.237 + while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) {
1.238 + $done .= $`; $this = $&; $todo = $';
1.239 + &lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)");
1.240 + $done .= $this;
1.241 + }
1.242 +
1.243 + # check for leading tabs
1.244 + $done = ''; $this = ''; $todo = $spec;
1.245 + while ($todo =~ m/^ *\t+ *[^ \t]/m) {
1.246 + $done .= $`; $this = $&; $todo = $';
1.247 + &lint_warning($file, $done, $this, "leading tabs (expected spaces)");
1.248 + $done .= $this;
1.249 + }
1.250 +
1.251 + # check for mandatory/wished trailing blank line
1.252 + if ($spec !~ m|\n\n$|) {
1.253 + &lint_warning($file, $spec, "", "mandatory/wished trailing blank line missing (expected one)");
1.254 + }
1.255 +}
1.256 +
1.257 +## _________________________________________________________________
1.258 +##
1.259 +## CHECK "comment": sharp-comments
1.260 +## _________________________________________________________________
1.261 +##
1.262 +
1.263 +sub check_comment {
1.264 + my ($file, $spec) = @_;
1.265 +
1.266 + # check for comment indentation and contents
1.267 + my $done = ''; my $this = ''; my $todo = $spec;
1.268 + while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) {
1.269 + $done .= $`; $this = $&; $todo = $';
1.270 + my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4);
1.271 + if (length($lead) % 2 != 0) {
1.272 + &lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)");
1.273 + }
1.274 + if (length($lead) > 1 && length($sharp) > 1) {
1.275 + &lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)");
1.276 + }
1.277 + if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) {
1.278 + &lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)");
1.279 + }
1.280 + if (length($pad) == 0 && length($text) > 0) {
1.281 + &lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)");
1.282 + }
1.283 + if (length($pad) > 0 && length($text) == 0) {
1.284 + &lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)");
1.285 + }
1.286 + $done .= $this;
1.287 + }
1.288 +
1.289 + # check for comment contents only
1.290 + if ($file !~ m|openpkg\.spec$|) {
1.291 + $done = ''; $this = ''; $todo = $spec;
1.292 + while ($todo =~ m/\n\n[ \t]*#[ \t]+([^\n]+)(?!\n([ \t]*#))/s) {
1.293 + $done .= $`; $this = $&; $todo = $';
1.294 + my $text = $1;
1.295 + if (length($text) > 0 and $text =~ m|^[A-Z][^A-Z]|) {
1.296 + &lint_warning($file, $done, $this, "comment text starts with upper-case letter (expected lower-case letter)");
1.297 + }
1.298 + $done .= $this;
1.299 + }
1.300 + }
1.301 +}
1.302 +
1.303 +## _________________________________________________________________
1.304 +##
1.305 +## CHECK "license": license header
1.306 +## _________________________________________________________________
1.307 +##
1.308 +
1.309 +sub check_license {
1.310 + my ($file, $spec) = @_;
1.311 +
1.312 + my $name = "[a-z][a-z0-9-]*";
1.313 + if ($file =~ m|^.*/([a-z][a-z0-9-]*)\.spec$|) {
1.314 + $name = $1;
1.315 + }
1.316 + elsif ($file =~ m|^([a-z][a-z0-9-]*)\.spec$|) {
1.317 + $name = $1;
1.318 + }
1.319 + my $re = "";
1.320 + $re .= "##\\n";
1.321 + $re .= "## $name\\.spec -- OpenPKG RPM Package Specification\\n";
1.322 + $re .= "## Copyright \\(c\\) 200[0-9]-2012 OpenPKG Foundation e\.V\. <http://openpkg\\.net/>\\n";
1.323 + $re .= "##\\n";
1.324 + $re .= "## Permission to use, copy, modify, and distribute this software for\\n";
1.325 + $re .= "## any purpose with or without fee is hereby granted, provided that\\n";
1.326 + $re .= "## the above copyright notice and this permission notice appear in all\\n";
1.327 + $re .= "## copies\\.\\n";
1.328 + $re .= "##\\n";
1.329 + $re .= "## THIS SOFTWARE IS PROVIDED \\`\\`AS IS'' AND ANY EXPRESSED OR IMPLIED\\n";
1.330 + $re .= "## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF\\n";
1.331 + $re .= "## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED\\.\\n";
1.332 + $re .= "## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR\\n";
1.333 + $re .= "## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\\n";
1.334 + $re .= "## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES \\(INCLUDING, BUT NOT\\n";
1.335 + $re .= "## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF\\n";
1.336 + $re .= "## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION\\) HOWEVER CAUSED AND\\n";
1.337 + $re .= "## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\\n";
1.338 + $re .= "## OR TORT \\(INCLUDING NEGLIGENCE OR OTHERWISE\\) ARISING IN ANY WAY OUT\\n";
1.339 + $re .= "## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF\\n";
1.340 + $re .= "## SUCH DAMAGE\\.\\n";
1.341 + $re .= "##\\n";
1.342 + if ($name ne "openpkg" and $spec !~ m|^$re|os) {
1.343 + &lint_warning($file, "", "", "invalid license header");
1.344 + }
1.345 +}
1.346 +
1.347 +## _________________________________________________________________
1.348 +##
1.349 +## CHECK "header": RPM headers
1.350 +## _________________________________________________________________
1.351 +##
1.352 +
1.353 +sub check_header {
1.354 + my ($file, $spec) = @_;
1.355 +
1.356 + my @headers = (qw(
1.357 + m:Name:^[a-z][a-z0-9-]*$
1.358 + m:Summary:^[A-Z]\S*(\s+([A-Z]\S*|of|for|from|in|at|on|\(\S+\)))*
1.359 + m:URL:^((https?|ftp)://.+|-)$
1.360 + m:Vendor:.+
1.361 + m:Packager:^(OpenPKG\sFoundation\se\.V\.|OpenPKG\sGmbH)$
1.362 + m:Distribution:^(OpenPKG|OpenPKG\sCommunity|OpenPKG\sEnterprise)$
1.363 + m:Class:^(BOOT|CORE|BASE|PLUS|EVAL|JUNK|PRIV)$
1.364 + m:Group:^[A-Z][a-zA-Z0-9]+$
1.365 + m:License:.+
1.366 + m:Version:^[^-]+$
1.367 + 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+|%\{[^\}]+\})$
1.368 + o:Source\d+:^((https?|ftp)://.+|[^/]+)$
1.369 + o:Patch\d+:^((https?|ftp)://.+|[^/]+)$
1.370 + o:Prefix:^%{l_prefix}$
1.371 + o:BuildRoot:^%{l_buildroot}$
1.372 + 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+)?)+)$
1.373 + 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+)?)+$
1.374 + o:AutoReq:^no$
1.375 + o:AutoReqProv:^no$
1.376 + o:Provides:^((,\s)?([a-z][a-z0-9-]*(\:\:with_[a-z][a-z0-9_]+)?|[A-Z][A-Z0-9-]*)(\s==?\s\S+)?)+$
1.377 + o:Conflicts:^((,\s)?([a-z][a-z0-9-]*(\:\:with_[a-z][a-z0-9_]+)?|[A-Z][A-Z0-9-]*)(\s(>=?|==?|<=?|!=)\s\S+)?)+$
1.378 + ));
1.379 + my @headers_def = (qw(
1.380 + Summary:^Badly\sPackaged\sProgram$
1.381 + Vendor:^John\sDoe$
1.382 + Group:^Unknown$
1.383 + License:^DoePL$
1.384 + ));
1.385 + my @headers_mult = (qw(
1.386 + BuildPreReq PreReq Provides Conflicts
1.387 + ));
1.388 +
1.389 + my @seen = ();
1.390 + my %count = ();
1.391 + my $done = ''; my $this = ''; my $todo = $spec;
1.392 + while ($todo =~ m/^(\S+):([ \t]*)(.*?)$/m) {
1.393 + $done .= $`; $this = $&; $todo = $';
1.394 + my ($header, $pad, $value) = ($1, $2, $3);
1.395 +
1.396 + # check for layouting
1.397 + if (length($value) == 0) {
1.398 + &lint_error($file, $done, $this, "empty RPM header value");
1.399 + }
1.400 + if (length($header.":".$pad) != 14) {
1.401 + &lint_warning($file, $done, $this, "invalid RPM header name/value padding (expected value at column 15)");
1.402 + }
1.403 +
1.404 + # check for valid header name and value
1.405 + if (not grep { $header =~ m|^$_$|s } map { m/^[^:]:([^:]+):/, $1 } @headers) {
1.406 + &lint_error($file, $done, $this, "invalid RPM header name \"$header\"");
1.407 + }
1.408 + else {
1.409 + my $hn = quotemeta((grep { $header =~ m|^$_$|s } map { m/^[^:]+:([^:]+):/, $1 } @headers)[0]);
1.410 + my $re = (map { m/^[^:]+:${hn}:(.+)$/s } @headers)[0];
1.411 + my $re_match = $re;
1.412 + $re_match =~ s|^\(|(?:|sg;
1.413 + $re_match =~ s|([^\\])\(|\1(?:|sg;
1.414 + if ( not ($file =~ m|openpkg\.spec$| and $header eq 'Provides' and $value eq '%{l_prefix}')
1.415 + and $value !~ m|${re_match}|s) {
1.416 + &lint_warning($file, $done, $this, "RPM header \"$header\": " .
1.417 + "invalid value \"$value\" (expected to match \"$re\")");
1.418 + }
1.419 + my $re_def = (map { m/^${hn}:(.+)$/s } @headers_def)[0];
1.420 + if (defined($re_def)) {
1.421 + my $re_def_match = $re_def;
1.422 + $re_def_match =~ s|^\(|(?:|sg;
1.423 + $re_def_match =~ s|([^\\])\(|\1(?:|sg;
1.424 + if ($value =~ m|${re_def_match}|s) {
1.425 + &lint_warning($file, $done, $this, "RPM header \"$header\": " .
1.426 + "default value \"$value\" (expected to match \"$re\", except for this)");
1.427 + }
1.428 + }
1.429 + if ($header =~ m/^Vendor/ and $value =~ m/et\sal/ and $value !~ m/et\sal\./) {
1.430 + &lint_warning($file, $done, $this, "RPM header \"$header\": " .
1.431 + "has value \"$value\" (expected \"et al.\" with dot)");
1.432 + }
1.433 + }
1.434 + push(@seen, $header);
1.435 + $count{$header}++;
1.436 + $done .= $this;
1.437 + }
1.438 +
1.439 + # check for existence of mandatory headers
1.440 + foreach my $header (@headers) {
1.441 + my ($type, $name, $regex) = split(/:/, $header, 3);
1.442 + if ($type eq 'm') {
1.443 + if ($file =~ m|openpkg\.spec$| and
1.444 + ($name eq "BuildPreReq" or $name eq "PreReq")) {
1.445 + # the bootstrap package is an obvious exception
1.446 + next;
1.447 + }
1.448 + if (not grep(/^$name$/, @seen)) {
1.449 + &lint_warning($file, undef, undef, "mandatory RPM header \"$name\" not found");
1.450 + }
1.451 + }
1.452 + }
1.453 +
1.454 + # check for multiple occurrence headers
1.455 + foreach my $seen (@seen) {
1.456 + if ($count{$seen} > 1 and not (grep { $_ eq $seen } @headers_mult)) {
1.457 + &lint_error($file, undef, undef, "RPM header \"$seen\" occurs multiple times (expected just once)");
1.458 + }
1.459 + }
1.460 +}
1.461 +
1.462 +## _________________________________________________________________
1.463 +##
1.464 +## CHECK "section": RPM sections
1.465 +## _________________________________________________________________
1.466 +##
1.467 +
1.468 +sub check_section {
1.469 + my ($file, $spec) = @_;
1.470 +
1.471 + my $require = qq{
1.472 + (%define,)*
1.473 + Name:,
1.474 + Summary:,
1.475 + URL:,
1.476 + Vendor:,
1.477 + Packager:,
1.478 + Distribution:,
1.479 + Class:,
1.480 + Group:,
1.481 + License:,
1.482 + Version:,
1.483 + Release:,
1.484 + (%option,)*
1.485 + (%define,|%undefine,)*
1.486 + (Source\\d+:,)*
1.487 + (Patch\\d+:,)*
1.488 + (%NoSource,)*
1.489 + (%NoPatch,)*
1.490 + (Prefix:,)?
1.491 + (BuildRoot:,)?
1.492 + ((BuildPreReq:,)
1.493 + |(PreReq:,))*
1.494 + (AutoReq:,)?
1.495 + (AutoReqProv:,)?
1.496 + (Provides:,)*
1.497 + (Conflicts:,)*
1.498 + %description,
1.499 + (%track,)?
1.500 + %prep,
1.501 + %build,
1.502 + %install,
1.503 + (%check,)?
1.504 + %files,
1.505 + %clean,
1.506 + (%pre,)?
1.507 + (%post,)?
1.508 + (%preun,)?
1.509 + (%postun,)?
1.510 + (%trigger,)?
1.511 + (%triggerin,)?
1.512 + (%triggerun,)?
1.513 + (%triggerpostun,)?
1.514 + (%verifyscript,)?
1.515 + };
1.516 +
1.517 + # check for order of headers
1.518 + my $sections = "";
1.519 + my $done = ''; my $this = ''; my $todo = $spec;
1.520 + while ($todo =~ m/^(\S+:|%\S+).*$/m) {
1.521 + $done .= $`; $this = $&; $todo = $';
1.522 + my $section = $1;
1.523 + next if ($section =~ m/^%(if|else|endif)/);
1.524 + $sections .= "$section,";
1.525 + $done .= $this;
1.526 + }
1.527 + my $regex = $require;
1.528 + $regex =~ s|\s+||sg;
1.529 + if ($sections !~ m/^$regex$/s) {
1.530 + $regex =~ s|,| |sg;
1.531 + &lint_error($file, undef, undef, "invalid RPM section order: $sections (expected \"$regex\")");
1.532 + }
1.533 +}
1.534 +
1.535 +## _________________________________________________________________
1.536 +##
1.537 +## CHECK "preproc": RPM macro pre-processor
1.538 +## _________________________________________________________________
1.539 +##
1.540 +
1.541 +sub check_preproc {
1.542 + my ($file, $spec) = @_;
1.543 +
1.544 + my $done = ''; my $this = ''; my $todo = $spec;
1.545 + while ($todo =~ m/^(%(?:if|else|endif|define|undefine|option))(.*)$/m) {
1.546 + $done .= $`; $this = $&; $todo = $';
1.547 + my ($cmd, $args) = ($1, $2);
1.548 + if ($cmd eq '%if') {
1.549 + # FIXME: either try to really parse the boolean expression
1.550 + # FIXME: or at least try to guess its correct syntax
1.551 + }
1.552 + elsif ($cmd eq '%else' or $cmd eq '%endif') {
1.553 + if (length($args) > 0) {
1.554 + &lint_warning($file, $done, $this, "garbage after pre-processor directive " .
1.555 + "\"$cmd\" (expected no arguments)");
1.556 + }
1.557 + }
1.558 + elsif ($cmd eq '%undefine') {
1.559 + if ($args =~ m|^\s+(\S+)\s*$|) {
1.560 + my $var = $1;
1.561 + if ($var !~ m/^(V|with)_[a-z][a-zA-Z0-9_]*$/) {
1.562 + &lint_warning($file, $done, $this, "unusually named macro: \"$var\" " .
1.563 + "(expected \"(V|with)_[a-z][a-zA-Z0-9_]*\")");
1.564 + next;
1.565 + }
1.566 + }
1.567 + else {
1.568 + &lint_error($file, $done, $this, "invalid number of arguments to pre-processor " .
1.569 + "directive \"$cmd\" (expected exactly 1 argument)");
1.570 + }
1.571 + }
1.572 + elsif ($cmd eq '%define' or $cmd eq '%option') {
1.573 + if ($args =~ m|^\s+(\S+)\s+(.*)$|) {
1.574 + my ($var, $val) = ($1, $2);
1.575 + if ($var !~ m/^(V|with)_[a-z][a-zA-Z0-9_]*$/) {
1.576 + &lint_warning($file, $done, $this, "unusually named macro: \"$var\" " .
1.577 + "(expected \"(V|with)_[a-z][a-zA-Z0-9_]*\")");
1.578 + next;
1.579 + }
1.580 + if (length($val) == 0) {
1.581 + &lint_error($file, $done, $this, "empty macro value");
1.582 + }
1.583 + }
1.584 + else {
1.585 + &lint_error($file, $done, $this, "invalid number of arguments to pre-processor " .
1.586 + "directive \"$cmd\" (expected exactly 2 arguments)");
1.587 + }
1.588 + }
1.589 + $done .= $this;
1.590 + }
1.591 +
1.592 + # check correct if/endif nesting
1.593 + my @stack = ();
1.594 + $done = ''; $this = ''; $todo = $spec;
1.595 + while ($todo =~ m/^(%(?:if|else|endif|define|undefine|option)).*$/m) {
1.596 + $done .= $`; $this = $&; $todo = $';
1.597 + my $directive = $1;
1.598 + if ($directive eq '%if') {
1.599 + push(@stack, &lines($done . $this));
1.600 + }
1.601 + elsif ($directive eq '%endif') {
1.602 + if (@stack == 0) {
1.603 + &lint_error($file, $done, $this, "found \%endif without corresponding opening \%if");
1.604 + last;
1.605 + }
1.606 + pop(@stack);
1.607 + }
1.608 + $done .= $this;
1.609 + }
1.610 + my $line;
1.611 + while (defined($line = pop(@stack))) {
1.612 + &lint_error($file, undef, undef, "\%if at line $line never closed by \%endif");
1.613 + }
1.614 +
1.615 + # check for indented preprocessor constructs
1.616 + $done = ''; $this = ''; $todo = $spec;
1.617 + while ($todo =~ m/^[ \t]+(%(?:if|else|endif|define|undefine|option)).*$/m) {
1.618 + $done .= $`; $this = $&; $todo = $';
1.619 + my $directive = $1;
1.620 + &lint_error($file, $done, $this, "found indented \"$directive\" preprocessor directive (expected no indentation)");
1.621 + $done .= $this;
1.622 + }
1.623 +}
1.624 +
1.625 +## _________________________________________________________________
1.626 +##
1.627 +## CHECK "script": shell scripts
1.628 +## _________________________________________________________________
1.629 +##
1.630 +
1.631 +sub check_script {
1.632 + my ($file, $spec) = @_;
1.633 +
1.634 + my $done = ''; my $this = ''; my $todo = $spec;
1.635 + 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) {
1.636 + $done .= $`; $this = $&; $todo = $';
1.637 + my ($section, $args, $script) = ($1, $2, $3);
1.638 +
1.639 + # perform checks for a single script section
1.640 + &check_script_section($file, $done, $this, $section, $args, $script);
1.641 +
1.642 + $done .= $this;
1.643 + }
1.644 +}
1.645 +
1.646 +sub check_script_section {
1.647 + my ($file, $outer_done, $outer_this, $section, $args, $script) = @_;
1.648 +
1.649 + # skip plain-text/non-scripting section %description
1.650 + return if ($section eq '%description');
1.651 +
1.652 + # remove comment contents
1.653 + $outer_this =~ s|^[ \t]*#[^\n]*||mg;
1.654 +
1.655 + # check shell redirections
1.656 + my $done = $outer_done; my $this = ''; my $todo = $outer_this;
1.657 + while ( $todo =~ m/[ \t]+(\d+)?[><][ \t]+\S+/s
1.658 + or $todo =~ m/[ \t]+[><](\&\d+)?[ \t]+\S+/s) {
1.659 + $done .= $`; $this = $&; $todo = $';
1.660 + &lint_warning($file, $done, $this, "section $section: whitespace after shell redirection (expected none)");
1.661 + $done .= $this;
1.662 + }
1.663 +
1.664 + # utility function: extract a single shell command
1.665 + sub command_extract {
1.666 + my ($script) = @_;
1.667 + my $cmd = '';
1.668 + while ($script ne '') {
1.669 + $script =~ s/^([ \t]*'[^']*')/ $cmd .= $1, ''/se && next;
1.670 + $script =~ s/^([ \t]*"[^"]*")/ $cmd .= $1, ''/se && next;
1.671 + $script =~ s/^([ \t]*[^ \t;\)\\\r\n]+)/$cmd .= $1, ''/se && next;
1.672 + $script =~ s/^([ \t]*\\[ \t]*\r?\n)/ $cmd .= $1, ''/se && next;
1.673 + last;
1.674 + }
1.675 + return ($cmd, $script);
1.676 + }
1.677 +
1.678 + # utility function: join a multi-line command
1.679 + sub multiline_join {
1.680 + my ($cmd) = @_;
1.681 + $cmd =~ s/([ \t]*\\[ \t]*\r?\n[ \t]*)/ /sg;
1.682 + return $cmd;
1.683 + }
1.684 +
1.685 + # utility function: split command into arguments
1.686 + sub shell_tokenize {
1.687 + my ($cmd) = @_;
1.688 + my @cmd = ();
1.689 + while ($cmd ne '') {
1.690 + $cmd =~ s/^\s*('[^']*')/push(@cmd, $1), ''/se && next;
1.691 + $cmd =~ s/^\s*("[^"]*")/push(@cmd, $1), ''/se && next;
1.692 + $cmd =~ s/^\s*(\S+)/ push(@cmd, $1), ''/se && next;
1.693 + $cmd =~ s/^\s*$/ ''/se && last;
1.694 + }
1.695 + return @cmd;
1.696 + }
1.697 +
1.698 + # check filesystem path style
1.699 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.700 + while ($todo =~ m/\%\{l_shtool\}\s+(\w+)\s+/s) {
1.701 + $done .= $`; $this = $&; $todo = $';
1.702 + ($this, $todo) = &command_extract($this . $todo);
1.703 +
1.704 + # check for shtool options with no space before argument
1.705 + my $subthis = $this;
1.706 + $subthis =~ s/\%{[A-Za-z][A-Za-z0-9_]*}//sg;
1.707 + $subthis =~ s/\%{[A-Za-z][A-Za-z0-9_]*(?:\s+[^}]+?)?}//sg;
1.708 + # remove content of quoted arguments as they might contain unrelated things to catch
1.709 + $subthis =~ s/'[^']*'/ARG/sg;
1.710 + $subthis =~ s/"[^"]*"/ARG/sg;
1.711 + $subthis =~ s/`[^`]*`/ARG/sg;
1.712 + # remove us completely if line ends with a quote as this indicates we are a quoted argument to ourselfs
1.713 + $subthis =~ s/[^']*'$//s;
1.714 + $subthis =~ s/[^"]*"$//s;
1.715 + $subthis =~ s/[^`]*`$//s;
1.716 + $subthis =~ s/[^']*' \\\n//s;
1.717 + $subthis =~ s/[^"]*" \\\n//s;
1.718 + $subthis =~ s/[^`]*` \\\n//s;
1.719 + # catch command termination by semicolon, pipe, or, and;
1.720 + $subthis =~ s/[;|&].*$//s;
1.721 + if ($subthis =~ m/\s-[a-zA-Z]\S/) {
1.722 + &lint_warning($file, $done, $this, "found use of shtool option with space omitted before argument");
1.723 + }
1.724 +
1.725 + # openpkg-rc is special because does bootstrap things
1.726 + last if ($file =~ m|openpkg-rc\.spec$|);
1.727 +
1.728 + my @cmd = &shell_tokenize(&multiline_join($this));
1.729 + if ($cmd[1] eq 'mkdir') {
1.730 + # join flags with their arguments
1.731 + for (my $i = 2; $i <= $#cmd; $i++) {
1.732 + if ($cmd[$i] eq '-m') {
1.733 + splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]);
1.734 + }
1.735 + }
1.736 + # check paths
1.737 + for (my $i = $#cmd; $i > 1 and $cmd[$i] !~ m|^-| and $cmd[$i] !~ m|^\d+$|; $i--) {
1.738 + if ($cmd[$i] =~ m|/$|) {
1.739 + &lint_warning($file, $done, $this, "section $section: superfluous trailing slash on " .
1.740 + "created path in \"shtool mkdir\" command (expected none)");
1.741 + }
1.742 + }
1.743 + }
1.744 + elsif ($cmd[1] eq 'install') {
1.745 + # join flags with their arguments
1.746 + for (my $i = 2; $i <= $#cmd; $i++) {
1.747 + if ($cmd[$i] =~ m/-(e|m|o|g)$/) {
1.748 + splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]);
1.749 + }
1.750 + elsif ($cmd[$i] eq '%{SOURCE') {
1.751 + splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]);
1.752 + }
1.753 + elsif ($cmd[$i] eq '%{l_value') {
1.754 + while ($i < $#cmd and $cmd[$i+1] !~ m|\}$|s) {
1.755 + splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]);
1.756 + }
1.757 + splice(@cmd, $i, 2);
1.758 + $i--;
1.759 + }
1.760 + }
1.761 +
1.762 + # determine last path argument
1.763 + my $i = $#cmd; $i-- while ($i > 1 and $cmd[$i] !~ m|^-| and $cmd[$i] !~ m|^\d+$|);
1.764 +
1.765 + # check paths
1.766 + if (($#cmd - $i) > 2 and $cmd[-1] !~ m|/$|) {
1.767 + # simple case: multiple sources require target to be a directory
1.768 + &lint_warning($file, $done, $this, "section $section: missing trailing slash on " .
1.769 + "destination path in \"shtool install\" command (expected one) 1");
1.770 + }
1.771 + elsif (($#cmd - $i) == 2 and $cmd[-1] !~ m|/$|) {
1.772 + # complex case: single source, so we can check only known destination paths
1.773 + if ( $cmd[-1] =~ m/\%\{l_prefix\}\/(bin|cgi|include|info|lib|pub|sbin)$/
1.774 + or $cmd[-1] =~ m/\%\{l_prefix\}\/(etc|libexec|man|share|var)(\/[^\/]+)?$/) {
1.775 + &lint_warning($file, $done, $this, "section $section: missing trailing slash on " .
1.776 + "destination path in \"shtool install\" command (expected one) 2");
1.777 + }
1.778 + }
1.779 + else {
1.780 + # special case: if any path contains '*', then globbing might occur
1.781 + for (my $i = 2; $i <= $#cmd; $i++) {
1.782 + if ($cmd[$i] =~ m/\*/ and $cmd[-1] !~ m|/$|) {
1.783 + &lint_warning($file, $done, $this, "section $section: missing trailing slash on " .
1.784 + "destination path in \"shtool install\" command (expected one) 3");
1.785 + last;
1.786 + }
1.787 + }
1.788 + }
1.789 + }
1.790 + $done .= $this;
1.791 + }
1.792 +
1.793 + # check for redundant 'export PATH' statements
1.794 + #$done = $outer_done; $this = ''; $todo = $outer_this;
1.795 + #while ($todo =~ m/\bexport[ \t]+([a-zA-Z_][a-zA-Z0-9_]*[ \t]+)*PATH\b/s) {
1.796 + # $done .= $`; $this = $&; $todo = $';
1.797 + # &lint_warning($file, $done, $this, "section $section: redundant \"export PATH\" statement (expected none)");
1.798 + # $done .= $this;
1.799 + #}
1.800 +
1.801 + # check for obsolete cpp build flags
1.802 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.803 + while ($todo =~ m/-I\%\{l_prefix\}\/include(\/([^ \t"';]+?))?[ \t"';]/s) {
1.804 + $done .= $`; $this = $&; $todo = $';
1.805 + my ($subdir) = $2;
1.806 + &lint_warning($file, $done, $this, "section $section: hard-coded C pre-processor path option " .
1.807 + "(use \"%{l_cppflags".($subdir ? " $subdir" : "")."}\" instead)");
1.808 + $done .= $this;
1.809 + }
1.810 +
1.811 + # check for obsolete ld build flags
1.812 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.813 + while ($todo =~ m/-L\%\{l_prefix\}\/lib(\/([^ \t"';]+?))?[ \t"';]/s) {
1.814 + $done .= $`; $this = $&; $todo = $';
1.815 + my ($subdir) = $2;
1.816 + &lint_warning($file, $done, $this, "section $section: hard-coded linker path option " .
1.817 + "(use \"%{l_ldflags".($subdir ? " $subdir" : "")."}\" instead)");
1.818 + $done .= $this;
1.819 + }
1.820 +
1.821 + # check for "raw" tool usage
1.822 + if ($section ne '%description' and $file !~ m|openpkg\.spec$|) {
1.823 + foreach my $token (&shell_tokenize($outer_this)) {
1.824 + if ($token =~ m/^(rpmtool|shtool|curl|bash|gzip|bzip2|tar|cc|cxx|make|patch)$/s) {
1.825 + &lint_warning($file, undef, undef, "section $section: raw usage of standard tool \"$token\"" .
1.826 + " (use \"%{l_${token}}\" instead)");
1.827 + }
1.828 + }
1.829 + }
1.830 +
1.831 + # check for setup and patch macro usage
1.832 + if ($section eq '%prep') {
1.833 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.834 + my @tokens = &shell_tokenize($outer_this);
1.835 + while ($todo =~ m/([^\n]*)\n/s) {
1.836 + $done .= $`; $this = $&; $todo = $';
1.837 + if ($this =~ m/^ *%setup.* .*$/) {
1.838 + &lint_warning($file, undef, undef, "section $section: multiple spaces in \"\%setup\" macro" .
1.839 + " (reduce to single space)");
1.840 + }
1.841 + if ($this =~ m/^ *%setup.*-[ab]$/ and grep(/^\%setup+$/, @tokens) == 1) {
1.842 + &lint_warning($file, undef, undef, "section $section: -[ab] option superflous for single \"\%setup\" macro" .
1.843 + " (remove it)");
1.844 + }
1.845 + if ($this =~ m/^ *%patch.* .*$/) {
1.846 + &lint_warning($file, undef, undef, "section $section: multiple spaces in \"\%patch\" macro" .
1.847 + " (reduce to single space)");
1.848 + }
1.849 + if ($this =~ m/^ *%patch.*-p +[01]/) {
1.850 + &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" .
1.851 + " (use -pN)");
1.852 + }
1.853 + if ($this =~ m/^ *%patch.*-P 0\s*$/ and grep(/^\%patch+$/, @tokens) == 1) {
1.854 + &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" .
1.855 + " (omit -P 0 for single patch)");
1.856 + }
1.857 + if ($this =~ m/^ *%patch.*-P [^0-9]/ and grep(/^\%patch+$/, @tokens) > 1) {
1.858 + &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" .
1.859 + " (use -P for multiple patches)");
1.860 + }
1.861 + $done .= $this;
1.862 + }
1.863 + if (grep(/^\%setup\d+$/, @tokens)) {
1.864 + &lint_warning($file, undef, undef, "section $section: numbered \"\%setup\" macro" .
1.865 + " (do not use %setup directly followed by a number, replace with %setup ... -[ab])");
1.866 + }
1.867 + if (grep(/^\%patch\d+$/, @tokens)) {
1.868 + &lint_warning($file, undef, undef, "section $section: numbered \"\%patch\" macro" .
1.869 + " (do not use %patch directly followed by a number, replace with %patch ... -P)");
1.870 + }
1.871 + }
1.872 +
1.873 + # check for hard-coded prefix in %pre[un],%post[un] scripts
1.874 + if ($section =~ m/^\%(preun|postun|pre|post)$/s and $file !~ m|openpkg\.spec$|) {
1.875 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.876 + while ($todo =~ m/\%\{l_prefix\}/s) {
1.877 + $done .= $`; $this = $&; $todo = $';
1.878 + &lint_warning($file, $done, $this, "section $section: hard-coded prefix (\%{l_prefix}) found " .
1.879 + "(use \"\$RPM_INSTALL_PREFIX\" to allow relocation)");
1.880 + $done .= $this;
1.881 + }
1.882 + }
1.883 +
1.884 + # check for sub-shell parenthesis style
1.885 + # (this is such complicated because the Bourne Shell has a
1.886 + # construct "case <value> in <pattern> ) <script> ;; ... esac"
1.887 + # where the closing parenthesis makes heavy problems for our
1.888 + # check. So we first have to get rid of this. Unfortunately this
1.889 + # is again not easy because there exists nested(!) case/esac
1.890 + # constructs. Hence, we have to use a small recursive descent
1.891 + # parser which replaces the ")" in case/esac constructs with
1.892 + # "PCLOSE". A similar thing is done with string literals, although
1.893 + # here the job is more trivial).
1.894 + if ($section !~ m/^\%files$/s) {
1.895 + $done = $outer_done; $this = ''; $todo = $outer_this;
1.896 + $todo =~ s/`[^`]*`/STRING/sg;
1.897 + $todo =~ s/'[^']*'/STRING/sg;
1.898 + $todo =~ s/"[^"]*"/STRING/sg;
1.899 + $todo = (&parse_sh("", $todo))[0];
1.900 + sub parse_sh {
1.901 + my ($done, $todo) = @_;
1.902 + while ($todo =~ m/^(.*?)(case|;;)/s) {
1.903 + if ($2 eq 'case') {
1.904 + ($done, $todo) = &parse_case($done.$1, $2.$');
1.905 + }
1.906 + else {
1.907 + ($done, $todo) = ($done.$1, $2.$');
1.908 + return ($done, $todo);
1.909 + }
1.910 + }
1.911 + ($done, $todo) = ($done . $todo, "");
1.912 + return ($done, $todo);
1.913 + }
1.914 + sub parse_case {
1.915 + my ($done, $todo) = @_;
1.916 + $todo =~ m|^\s*case\s+\S+\s+in\b|s or return (undef, undef);
1.917 + ($done, $todo) = ($done . $&, $');
1.918 + while ($todo =~ m|^(\s*[^)\n]+)(\))|s) {
1.919 + ($done, $todo) = ($done . $1 . "PCLOSE", $');
1.920 + ($done, $todo) = &parse_sh($done, $todo) or return (undef, undef);
1.921 + $todo =~ m|^\s*;;|s or return (undef, undef);
1.922 + ($done, $todo) = ($done . $&, $');
1.923 + }
1.924 + $todo =~ m|^\s*esac|s or return (undef, undef);
1.925 + ($done, $todo) = ($done . $&, $');
1.926 + return ($done, $todo);
1.927 + }
1.928 + if ($file !~ m|openpkg\.spec$| and $todo eq '') {
1.929 + &lint_warning($file, $outer_done, $outer_this,
1.930 + "unable to correctly parse case/esac constructs in shell-script" .
1.931 + " (sub-shell parenthesis check skipped)");
1.932 + }
1.933 + else {
1.934 + while ($todo =~ m/\)[ \t]*\n/s) {
1.935 + $done .= $`; $this = $&; $todo = $';
1.936 + &lint_warning($file, $done, $this, "problematic sub-shell construct without error handling " .
1.937 + "(use \"...) || exit \$?\" to make sure it correctly exits on nested failure)");
1.938 + $done .= $this;
1.939 + }
1.940 + }
1.941 + }
1.942 +}
1.943 +
1.944 +## _________________________________________________________________
1.945 +##
1.946 +## CHECK "global": globals
1.947 +## _________________________________________________________________
1.948 +##
1.949 +
1.950 +sub check_global {
1.951 + my ($file, $spec) = @_;
1.952 +
1.953 + # check for deprecated use of %{name} macro
1.954 + my $done = ''; my $this = ''; my $todo = $spec;
1.955 + while ($todo =~ m/\%\{name\}/s) {
1.956 + $done .= $`; $this = $&; $todo = $';
1.957 + &lint_warning($file, $done, $this, "deprecated usage of %{name} macro (expected none)");
1.958 + $done .= $this;
1.959 + }
1.960 +
1.961 + # FIXME: activate later
1.962 + # check for over-long lines
1.963 + #$done = ''; $this = ''; $todo = $spec;
1.964 + #while ($todo =~ m/([^\n]{80,})\n/s) {
1.965 + # $done .= $`; $this = $&; $todo = $';
1.966 + # &lint_warning($file, $done, $this, "over-long line with ".sprintf("%d", length($1))." characters " .
1.967 + # "(expected maximum of 79 characters)");
1.968 + # $done .= $this;
1.969 + #}
1.970 +
1.971 + # check for "shtool install" with -e on same line
1.972 + my $done = ''; my $this = ''; my $todo = $spec;
1.973 + while ($todo =~ m/%{l_shtool} install[^\n]*-e/s) {
1.974 + $done .= $`; $this = $&; $todo = $';
1.975 + &lint_warning($file, $done, $this, "found -e option of \"shtool install\" on same line (expected separate lines)");
1.976 + $done .= $this;
1.977 + }
1.978 +
1.979 + # check for "shtool install" with multiple -e on same line
1.980 + my $done = ''; my $this = ''; my $todo = $spec;
1.981 + while ($todo =~ m/%{l_shtool} install[^\n]+\\\n([^\n]*?-e[^\n]*?-e[^\n]*\\\n)+/s) {
1.982 + $done .= $`; $this = $&; $todo = $';
1.983 + &lint_warning($file, $done, $this, "found multiple -e options of \"shtool install\" on same line (expected separate lines)");
1.984 + $done .= $this;
1.985 + }
1.986 +
1.987 + # check for deprecated use of "shtool install|subst -e @l_...@ %{l_...}"
1.988 + if ($file !~ m|openpkg-tool|) {
1.989 + my $done = ''; my $this = ''; my $todo = $spec;
1.990 + while ($todo =~ m/%{l_shtool} (install|subst)(?:\\\n|[^\n])*?-e(?:\\\n|[^\n])*?\@l_(prefix|[smrn](usr|grp|uid|gid))\@[^n]+%{l_\2}/s) {
1.991 + $done .= $`; $this = $&; $todo = $';
1.992 + &lint_warning($file, $done, $this, "deprecated usage of \"shtool $1 -e \@l_$2\@\" (expected use of %{l_value -s -a})");
1.993 + $done .= $this;
1.994 + }
1.995 + }
1.996 +
1.997 + # check for constant "root" in %attr
1.998 + my $done = ''; my $this = ''; my $todo = $spec;
1.999 + while ($todo =~ m/%attr\(\s*(\d+)\s*,\s*root\s*,/s) {
1.1000 + $done .= $`; $this = $&; $todo = $';
1.1001 + &lint_warning($file, $done, $this, "found constant \"root\" in %attr (expected variable %{l_susr})");
1.1002 + $done .= $this;
1.1003 + }
1.1004 +
1.1005 + # check for valid RPM macro usage
1.1006 + if ($file !~ m|^(.+/)?openpkg\.spec$|s) {
1.1007 + my $ok = `$rpm --eval '\%dump' 2>&1 | egrep "^-*[0-9][0-9]*: l_" | sed -e 's;^[^:]*: *\\(l_[a-zA-Z0-9_]*\\).*;\\1;' | sort -u`;
1.1008 + my @ok = split(/\n/, $ok);
1.1009 + my $todo = $spec;
1.1010 + $todo =~ s|^([a-zA-Z][a-zA-Z0-9]+):\s+(.+)$|push(@ok, lc($1)), ''|mge;
1.1011 + $todo =~ s/^\%(?:define|option)\s+(\S+)\s+.+$/push(@ok, $1), ''/mge;
1.1012 + my $done = ''; my $this = ''; my $todo = $spec;
1.1013 + while ($todo =~ m|\%\{([a-zA-Z][a-zA-Z0-9_]+)|s) {
1.1014 + $done .= $`; $this = $&; $todo = $';
1.1015 + my $name = $1;
1.1016 + next if ($name =~ m/^(SOURCE|PATCH)\d*$/ or $name =~ m/^(expand|echo|warn|error)$/);
1.1017 + if (not grep(/^\Q$name\E$/, @ok)) {
1.1018 + &lint_error($file, $done, $this, "unknown macro \"\%{$name}\"");
1.1019 + }
1.1020 + $done .= $this;
1.1021 + }
1.1022 + }
1.1023 +}
1.1024 +
1.1025 +## _________________________________________________________________
1.1026 +##
1.1027 +## CHECK "sources": source file consistency
1.1028 +## _________________________________________________________________
1.1029 +##
1.1030 +
1.1031 +sub check_sources {
1.1032 + my ($file, $spec) = @_;
1.1033 +
1.1034 + ##
1.1035 + ## PREPARATION
1.1036 + ##
1.1037 +
1.1038 + my $D = {};
1.1039 + my $S = {};
1.1040 + my $i = 99;
1.1041 +
1.1042 + # determine defines values
1.1043 + my $done = ''; my $this = ''; my $todo = $spec;
1.1044 + while ($todo =~ m/^\%(define|option)\s+(\S+)\s+(.+)\s*$/m) {
1.1045 + $done .= $`; $this = $&; $todo = $';
1.1046 + my ($var, $val) = ($2, $3);
1.1047 + $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
1.1048 + $D->{$var} = $val;
1.1049 + $done .= $this;
1.1050 + }
1.1051 + $done = ''; $this = ''; $todo = $spec;
1.1052 + while ($todo =~ m/^([a-zA-Z][a-zA-Z0-9_]+):\s+(.*)$/m) {
1.1053 + $done .= $`; $this = $&; $todo = $';
1.1054 + my ($var, $val) = (lc($1), $2);
1.1055 + $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
1.1056 + $D->{$var} = $val;
1.1057 + $done .= $this;
1.1058 + }
1.1059 +
1.1060 + # expand define values (allow one level of nesting)
1.1061 + $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
1.1062 + $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
1.1063 +
1.1064 + # parse Source# and Patch# headers
1.1065 + $done = ''; $this = ''; $todo = $spec;
1.1066 + while ($todo =~ m/^(Source|Patch)(\d+):[ \t]*(.*?)$/m) {
1.1067 + $done .= $`; $this = $&; $todo = $';
1.1068 + my ($type, $num, $file) = (lc($1), $2, $3);
1.1069 + my $url = "";
1.1070 + if ($file =~ m|^(.+/)([^/]+)$|s) {
1.1071 + ($url, $file) = ($1, $2);
1.1072 + }
1.1073 + if (not defined($S->{"$type$num"})) {
1.1074 + $S->{"$type$num"} = {
1.1075 + -type => $type,
1.1076 + -num => $num,
1.1077 + -url => $url,
1.1078 + -file => $file,
1.1079 + -refhdr => 1,
1.1080 + -refcmd => 0,
1.1081 + -refmac => 0,
1.1082 + -refvar => 0,
1.1083 + };
1.1084 + }
1.1085 + else {
1.1086 + $S->{"$type$num"}->{-refhdr}++;
1.1087 + }
1.1088 + $done .= $this;
1.1089 + }
1.1090 +
1.1091 + # parse %setup and %patch commands
1.1092 + $done = ''; $this = ''; $todo = $spec;
1.1093 + $todo =~ s/^(\s*\%patch)((?:\s+-\S+|\s+-d\s+\S+)*)((?:\s+\d+)+)\s*$/&expand_patch($1, $2, $3)/mge;
1.1094 + sub expand_patch {
1.1095 + my ($cmd, $opts, $nums) = @_;
1.1096 + my $cmds = '';
1.1097 + $cmds .= "${cmd}0${opts}\n" if ($opts !~ m|\s+-P|s);
1.1098 + $opts =~ s|\s+-P||s;
1.1099 + while ($nums =~ s|^\s+(\d+)||) {
1.1100 + my $num = $1;
1.1101 + $cmds .= "${cmd}${num}${opts}\n";
1.1102 + }
1.1103 + return $cmds;
1.1104 + }
1.1105 + while ($todo =~ m/^\s*\%(setup|patch)(\d+)?(\s+.*)?$/m) {
1.1106 + $done .= $`; $this = $&; $todo = $';
1.1107 + my ($type, $num, $opts) = ($1, $2, $3);
1.1108 + $type = 'source' if ($type eq 'setup');
1.1109 + my $num_force = '';
1.1110 + if ($opts =~ m/\s-(?:a|b)\s*(\d+)/s) {
1.1111 + $num_force = $1;
1.1112 + }
1.1113 + if ($num ne '' and $num_force ne '' and $num ne $num_force) {
1.1114 + &lint_warning($file, $done, $this, "macro and enforced $type number conflict: $num <-> $num_force" .
1.1115 + " (expected either just enforced number or make them match)");
1.1116 + }
1.1117 + $num = $num_force if ($num_force ne '');
1.1118 + $num = 0 if ($num eq '');
1.1119 + next if ($opts =~ m|\s-T|s and $num == 0);
1.1120 + if (not defined($S->{"$type$num"})) {
1.1121 + $S->{"$type$num"} = {
1.1122 + -type => $type,
1.1123 + -num => $num,
1.1124 + -url => "",
1.1125 + -file => "",
1.1126 + -refhdr => 0,
1.1127 + -refcmd => 1,
1.1128 + -refmac => 0,
1.1129 + -refvar => 0,
1.1130 + };
1.1131 + }
1.1132 + else {
1.1133 + $S->{"$type$num"}->{-refcmd}++;
1.1134 + }
1.1135 + $done .= $this;
1.1136 + }
1.1137 +
1.1138 + # parse %{SOURCE#} and %{PATCH#} macros
1.1139 + $done = ''; $this = ''; $todo = $spec;
1.1140 + while ($todo =~ m/\%\{(SOURCE|PATCH)(\d+)\}/m) {
1.1141 + $done .= $`; $this = $&; $todo = $';
1.1142 + my ($type, $num) = (lc($1), $2);
1.1143 + if (not defined($S->{"$type$num"})) {
1.1144 + $S->{"$type$num"} = {
1.1145 + -type => $type,
1.1146 + -num => $num,
1.1147 + -url => "",
1.1148 + -file => "",
1.1149 + -refhdr => 0,
1.1150 + -refcmd => 0,
1.1151 + -refmac => 1,
1.1152 + -refvar => 0,
1.1153 + };
1.1154 + }
1.1155 + else {
1.1156 + $S->{"$type$num"}->{-refmac}++;
1.1157 + }
1.1158 + $done .= $this;
1.1159 + }
1.1160 +
1.1161 + # parse %{SOURCE ...} and %{PATCH ...} macros
1.1162 + $done = ''; $this = ''; $todo = $spec;
1.1163 + while ($todo =~ m/\%\{(SOURCE|PATCH)\s+([^\s}]+)\}/m) {
1.1164 + $done .= $`; $this = $&; $todo = $';
1.1165 + my ($type, $file) = (lc($1), $2);
1.1166 + my $key = "";
1.1167 + foreach my $src (keys(%{$S})) {
1.1168 + if ($S->{$src}->{-type} eq $type and $S->{$src}->{-file} eq $file) {
1.1169 + $key = $src;
1.1170 + }
1.1171 + }
1.1172 + if ($key eq '') {
1.1173 + $S->{"$type$i"} = {
1.1174 + -type => $type,
1.1175 + -num => $i,
1.1176 + -url => "",
1.1177 + -file => $file,
1.1178 + -refhdr => 0,
1.1179 + -refcmd => 0,
1.1180 + -refmac => 1,
1.1181 + -refvar => 0,
1.1182 + };
1.1183 + $i++;
1.1184 + }
1.1185 + else {
1.1186 + $S->{$key}->{-refmac}++;
1.1187 + }
1.1188 + $done .= $this;
1.1189 + }
1.1190 +
1.1191 + # parse $RPM_SOURCE_DIR based references
1.1192 + $done = ''; $this = ''; $todo = $spec;
1.1193 + while ($todo =~ m/\$RPM_SOURCE_DIR\/([^\s;"']+)/m) {
1.1194 + $done .= $`; $this = $&; $todo = $';
1.1195 + my ($file) = ($1);
1.1196 + my $key = "";
1.1197 + foreach my $src (keys(%{$S})) {
1.1198 + if ($S->{$src}->{-file} eq $file) {
1.1199 + $key = $src;
1.1200 + }
1.1201 + }
1.1202 + if ($key eq '') {
1.1203 + $S->{"source$i"} = {
1.1204 + -type => "source",
1.1205 + -num => $i,
1.1206 + -url => "",
1.1207 + -file => $file,
1.1208 + -refhdr => 0,
1.1209 + -refcmd => 0,
1.1210 + -refmac => 0,
1.1211 + -refvar => 1,
1.1212 + };
1.1213 + $i++;
1.1214 + }
1.1215 + else {
1.1216 + $S->{$key}->{-refmac}++;
1.1217 + }
1.1218 + $done .= $this;
1.1219 + }
1.1220 +
1.1221 + ##
1.1222 + ## CHECKING
1.1223 + ##
1.1224 +
1.1225 + # check reference counts
1.1226 + foreach my $src (%{$S}) {
1.1227 + my $s = $S->{$src};
1.1228 + my $str_hdr = ($s->{-type} eq 'source' ? 'Source' : 'Patch' ) . $s->{-num};
1.1229 + my $str_cmd = ($s->{-type} eq 'source' ? '%setup' : '%patch') . $s->{-num};
1.1230 + my $str_mac = ($s->{-type} eq 'source' ? '%{SOURCE ...}' : '%{PATCH ...}');
1.1231 + my $str_var = "\$RPM_SOURCE_DIR";
1.1232 + if ($file !~ m/\b(openpkg-.*|openpkg|vim|ncurses|openssh)\.spec$/) {
1.1233 + if ($s->{-refhdr} > 0) {
1.1234 + if ($s->{-refcmd} == 0 and $s->{-refmac} == 0 and $s->{-refvar} == 0) {
1.1235 + &lint_error($file, undef, undef, "source \"$str_hdr\" defined (file $s->{-file}), but never used" .
1.1236 + " (expected at least one reference via \"$str_cmd\", \"$str_mac\" or \"$str_var\")");
1.1237 + }
1.1238 + elsif ($s->{-refcmd} > 1) {
1.1239 + &lint_error($file, undef, undef, "source \"$str_hdr\" defined (file $s->{-file}), but used multiple times" .
1.1240 + " (expected just one reference via \"$str_cmd\")");
1.1241 + }
1.1242 + }
1.1243 + else {
1.1244 + if ($s->{-refcmd}+$s->{-refmac}+$s->{-refvar} > 0) {
1.1245 + &lint_error($file, undef, undef, "source \"$str_hdr\" not defined, but used ".
1.1246 + ($s->{-file} ? "(file ".$s->{-file}.")" : "").
1.1247 + " (expected at least one definition via \"$str_hdr\")");
1.1248 + }
1.1249 + }
1.1250 + }
1.1251 + }
1.1252 +
1.1253 + # check for existing of sources on filesystem
1.1254 + my $name = $file;
1.1255 + $name =~ s|.*/([^/]+)$|$1|s;
1.1256 + $name =~ s|\.spec$||s;
1.1257 + my $cvsdir = `$rpm --define 'name $name' --eval '%{_specdir}'`;
1.1258 + $cvsdir =~ s|\n$||s;
1.1259 + $cvsdir =~ s|/+$||s;
1.1260 + my $dstdir = `$rpm --define 'name $name' --eval '%{_sourcedir}'`;
1.1261 + $dstdir =~ s|\n$||s;
1.1262 + $dstdir =~ s|/+$||s;
1.1263 + foreach my $src (%{$S}) {
1.1264 + my $s = $S->{$src};
1.1265 + next if (not $s->{-refhdr});
1.1266 + if ($s->{-url} eq '' and not -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) {
1.1267 + &lint_error($file, undef, undef, "source \"$s->{-file}\" neither found in SRC nor DST locations (you have to provide it)");
1.1268 + }
1.1269 + elsif ($s->{-url} eq '' and not -f $cvsdir."/".$s->{-file} and -f $dstdir."/".$s->{-file}) {
1.1270 + &lint_error($file, undef, undef, "source \"$s->{-file}\" not found in SRC, but in DST (expected it in SRC or want URL)");
1.1271 + }
1.1272 + elsif ($s->{-url} ne '' and not -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) {
1.1273 + &lint_error($file, undef, undef, "source \"$s->{-file}\" neither found in SRC nor DST locations (you have to download it)");
1.1274 + }
1.1275 + elsif ($s->{-url} ne '' and -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) {
1.1276 + &lint_error($file, undef, undef, "source \"$s->{-file}\" not found in DST, but in SRC (expected it in DST or want URL)");
1.1277 + }
1.1278 + #if ($s->{-url} ne '' and $s->{-file} !~ m/\d/) {
1.1279 + # &lint_warning($file, undef, undef, "vendor source \"$s->{-file}\" not versioned");
1.1280 + #}
1.1281 + }
1.1282 +
1.1283 + # check for patch file naming
1.1284 + foreach my $src (%{$S}) {
1.1285 + my $s = $S->{$src};
1.1286 + next if (not $s->{-refhdr});
1.1287 + if ( $s->{-url} eq '' and $s->{-type} eq 'patch'
1.1288 + and $s->{-file} !~ m|^${name}\.patch(\.[^./]+)?$|) {
1.1289 + &lint_warning($file, undef, undef, "non-canonical patch filename \"$s->{-file}\"" .
1.1290 + " (expected to match \"${name}\\.patch(\\.[^./]+)?\$\")");
1.1291 + }
1.1292 + }
1.1293 +}
1.1294 +
1.1295 +## _________________________________________________________________
1.1296 +##
1.1297 +## CHECK "digest": digest consistency
1.1298 +## _________________________________________________________________
1.1299 +##
1.1300 +
1.1301 +sub check_digest {
1.1302 + my ($file, $spec) = @_;
1.1303 +
1.1304 + ##
1.1305 + ## PREPARATION
1.1306 + ##
1.1307 +
1.1308 + my $D = {};
1.1309 + my $S = {};
1.1310 +
1.1311 + # determine defines values
1.1312 + my $done = ''; my $this = ''; my $todo = $spec;
1.1313 + while ($todo =~ m/^\%(define|option)\s+(\S+)\s+(.+)\s*$/m) {
1.1314 + $done .= $`; $this = $&; $todo = $';
1.1315 + my ($var, $val) = ($2, $3);
1.1316 + $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
1.1317 + $D->{$var} = $val;
1.1318 + $done .= $this;
1.1319 + }
1.1320 + $done = ''; $this = ''; $todo = $spec;
1.1321 + while ($todo =~ m/^([a-zA-Z][a-zA-Z0-9_]+):\s+(.*)$/m) {
1.1322 + $done .= $`; $this = $&; $todo = $';
1.1323 + my ($var, $val) = (lc($1), $2);
1.1324 + $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
1.1325 + $D->{$var} = $val;
1.1326 + $done .= $this;
1.1327 + }
1.1328 +
1.1329 + # expand define values (allow one level of nesting)
1.1330 + $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
1.1331 + $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge;
1.1332 +
1.1333 + # determine locations
1.1334 + my $name = $file;
1.1335 + $name =~ s|.*/([^/]+)$|$1|s;
1.1336 + $name =~ s|\.spec$||s;
1.1337 + my $srcdir = `$rpm --define 'name $name' --eval '%{_specdir}'`;
1.1338 + $srcdir =~ s|\n$||s;
1.1339 + $srcdir =~ s|/+$||s;
1.1340 + my $dstdir = `$rpm --define 'name $name' --eval '%{_sourcedir}'`;
1.1341 + $dstdir =~ s|\n$||s;
1.1342 + $dstdir =~ s|/+$||s;
1.1343 +
1.1344 + # parse Source# and Patch# headers
1.1345 + $done = ''; $this = ''; $todo = $spec;
1.1346 + while ($todo =~ m/^(Source|Patch)(\d+):[ \t]*(.*?)$/m) {
1.1347 + $done .= $`; $this = $&; $todo = $';
1.1348 + my ($type, $num, $url) = (lc($1), $2, $3);
1.1349 + my $file;
1.1350 + if ($url =~ m|^.+/([^/]+)$|s) {
1.1351 + $file = "$dstdir/$1";
1.1352 + }
1.1353 + else {
1.1354 + $file = "$srcdir/$url";
1.1355 + }
1.1356 + if (not defined($S->{"$type$num"})) {
1.1357 + $S->{"$type$num"} = {
1.1358 + -type => $type,
1.1359 + -num => $num,
1.1360 + -url => $url,
1.1361 + -file => $file
1.1362 + };
1.1363 + }
1.1364 + else {
1.1365 + $S->{"$type$num"}->{-refhdr}++;
1.1366 + }
1.1367 + $done .= $this;
1.1368 + }
1.1369 +
1.1370 + # parse BuildPreReq headers
1.1371 + $done = ''; $this = ''; $todo = $spec;
1.1372 + while ($todo =~ m/^BuildPreReq:[ \t]+digest\(sha1:\%\{(.+?)\}\)[ \t]+=[ \t]+([0-9a-fA-F]+)$/m) {
1.1373 + $done .= $`; $this = $&; $todo = $';
1.1374 + my ($macro, $sha1) = ($1, $2);
1.1375 +
1.1376 + my $url = $S->{lc($macro)}->{-url};
1.1377 + my $filename = $S->{lc($macro)}->{-file};
1.1378 + my $basename = $filename;
1.1379 + $basename =~ s/^.+\/([^\/]+)$/$1/s;
1.1380 +
1.1381 + my $sha1_real = `$openssl sha1 $filename 2>/dev/null`;
1.1382 + $sha1_real =~ s/^SHA1\s*\(.+?\)\s*=\s*([0-9a-fA-F]+)\s*$/$1/s;
1.1383 +
1.1384 + if (lc($sha1) ne lc($sha1_real)) {
1.1385 + &lint_error($file, undef, undef, "source \"$basename\" (\%{$macro}) has a digest(sha1) requirement of \"$sha1\" (expected \"$sha1_real\")");
1.1386 + }
1.1387 +
1.1388 + $done .= $this;
1.1389 + }
1.1390 +}
1.1391 +
