comparison: openpkg/lint-spec.pl
openpkg/lint-spec.pl
- changeset 782
- de3379343a7c
equal
deleted
inserted
replaced
| -1:000000000000 | 0:c310ee109529 |
|---|---|
| 1 ## | |
| 2 ## lint-spec.pl -- OpenPKG *.spec File Checker | |
| 3 ## Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/> | |
| 4 ## | |
| 5 ## This software is property of the OpenPKG GmbH, DE MUC HRB 160208. | |
| 6 ## All rights reserved. Licenses which grant limited permission to use, | |
| 7 ## copy, modify and distribute this software are available from the | |
| 8 ## OpenPKG GmbH. | |
| 9 ## | |
| 10 ## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED | |
| 11 ## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF | |
| 12 ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. | |
| 13 ## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR | |
| 14 ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | |
| 15 ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | |
| 16 ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF | |
| 17 ## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND | |
| 18 ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, | |
| 19 ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT | |
| 20 ## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF | |
| 21 ## SUCH DAMAGE. | |
| 22 ## | |
| 23 | |
| 24 # Perl run-time requirement | |
| 25 require 5; | |
| 26 BEGIN { | |
| 27 eval "use Getopt::Long; use IO;"; | |
| 28 if ($@) { | |
| 29 print STDERR | |
| 30 "lint-spec: ERROR: This command requires a full-size Perl installation!\n" . | |
| 31 "lint-spec: HINT: Install OpenPKG \"perl\" package to use this command.\n"; | |
| 32 exit(1); | |
| 33 } | |
| 34 } | |
| 35 | |
| 36 # OpenPKG instance prefix | |
| 37 my $my_prefix = $ENV{'OPENPKG_PREFIX'}; | |
| 38 delete $ENV{'OPENPKG_PREFIX'}; | |
| 39 | |
| 40 # program information | |
| 41 my $progname = "lint-spec"; | |
| 42 my $progvers = "1.0.0"; | |
| 43 | |
| 44 # parameters (defaults) | |
| 45 my $version = 0; | |
| 46 my $verbose = 0; | |
| 47 my $help = 0; | |
| 48 my $check = 'all'; | |
| 49 my $tmpdir = ($ENV{TMPDIR} || $ENV{TEMPDIR} || "/tmp") . "/$progname"; | |
| 50 my $rpm = "$my_prefix/bin/openpkg rpm"; | |
| 51 | |
| 52 # exception handling support | |
| 53 $SIG{__DIE__} = sub { | |
| 54 my ($err) = @_; | |
| 55 $err =~ s|\s+at\s+.*||s if (not $verbose); | |
| 56 print STDERR "$progname:ERROR: $err ". ($! ? "($!)" : "") . "\n"; | |
| 57 exit(1); | |
| 58 }; | |
| 59 | |
| 60 # command line parsing | |
| 61 Getopt::Long::Configure("bundling"); | |
| 62 my $result = GetOptions( | |
| 63 'V|version' => \$version, | |
| 64 'v|verbose' => \$verbose, | |
| 65 'h|help' => \$help, | |
| 66 'c|check=s' => \$check, | |
| 67 't|tmpdir=s' => \$tmpdir, | |
| 68 'r|rpm=s' => \$rpm, | |
| 69 ) || die "option parsing failed"; | |
| 70 if ($help) { | |
| 71 print "Usage: $progname [options] [SPECFILE ...]\n" . | |
| 72 "Available options:\n" . | |
| 73 " -v,--verbose enable verbose run-time mode\n" . | |
| 74 " -h,--help print out this usage page\n" . | |
| 75 " -c,--check=CHECKS select checks to perform (default='all')\n" . | |
| 76 " -r,--rpm=FILE filesystem path to RPM program\n" . | |
| 77 " -t,--tmpdir=PATH filesystem path to temporary directory\n" . | |
| 78 " -V,--version print program version\n"; | |
| 79 exit(0); | |
| 80 } | |
| 81 if ($version) { | |
| 82 print "OpenPKG $progname $progvers\n"; | |
| 83 exit(0); | |
| 84 } | |
| 85 | |
| 86 # verbose message printing | |
| 87 sub msg_verbose { | |
| 88 my ($msg) = @_; | |
| 89 print STDERR "$msg\n" if ($verbose); | |
| 90 } | |
| 91 | |
| 92 # warning message printing | |
| 93 sub msg_warning { | |
| 94 my ($msg) = @_; | |
| 95 print STDERR "$progname:WARNING: $msg\n"; | |
| 96 } | |
| 97 | |
| 98 # error message printing | |
| 99 sub msg_error { | |
| 100 my ($msg) = @_; | |
| 101 print STDERR "$progname:ERROR: $msg\n"; | |
| 102 } | |
| 103 | |
| 104 # determine check list | |
| 105 my @check_list = (qw( | |
| 106 blank | |
| 107 comment | |
| 108 license | |
| 109 header | |
| 110 section | |
| 111 preproc | |
| 112 script | |
| 113 global | |
| 114 sources | |
| 115 digest | |
| 116 )); | |
| 117 my @checks = (); | |
| 118 if ($check eq 'all') { | |
| 119 @checks = @check_list; | |
| 120 } | |
| 121 else { | |
| 122 foreach my $c (split(/,/, $check)) { | |
| 123 if (not grep($c, @check_list)) { | |
| 124 die "invalid check \"$c\""; | |
| 125 } | |
| 126 push(@checks, $c); | |
| 127 } | |
| 128 } | |
| 129 | |
| 130 # global return code | |
| 131 $main::GRC = 0; | |
| 132 | |
| 133 # iterate over all .spec files | |
| 134 foreach my $filename (@ARGV) { | |
| 135 my $io = new IO::File "<$filename" | |
| 136 or die "unable to open file \"$filename\" for reading"; | |
| 137 my $spec; { local $/ = undef; $spec = <$io>; } | |
| 138 $io->close; | |
| 139 foreach my $check (@checks) { | |
| 140 eval "\&check_$check(\$filename, \$spec);"; | |
| 141 } | |
| 142 } | |
| 143 | |
| 144 # die gracefully | |
| 145 exit($main::GRC); | |
| 146 | |
| 147 ## _________________________________________________________________ | |
| 148 ## | |
| 149 ## COMMON SUBROUTINES | |
| 150 ## _________________________________________________________________ | |
| 151 ## | |
| 152 | |
| 153 sub lines { | |
| 154 my ($txt) = @_; | |
| 155 my $l = 0; | |
| 156 $txt =~ s|\n|$l++, ''|sge; | |
| 157 return $l; | |
| 158 } | |
| 159 | |
| 160 sub lint_message { | |
| 161 my ($type, $file, $done, $this, $msg) = @_; | |
| 162 if (defined($done) and defined($this)) { | |
| 163 my $start = &lines($done) + 1; | |
| 164 my $end = $start + &lines($this); | |
| 165 my $pos = $start; | |
| 166 $pos .= "-". $end if ($end > $start); | |
| 167 printf("%s:%s: %s:%s: %s\n", $progname, $type, $file, $pos, $msg); | |
| 168 } | |
| 169 else { | |
| 170 printf("%s:%s: %s: %s\n", $progname, $type, $file, $msg); | |
| 171 } | |
| 172 } | |
| 173 | |
| 174 sub lint_warning { | |
| 175 my ($file, $done, $this, $msg) = @_; | |
| 176 &lint_message("WARNING", $file, $done, $this, $msg); | |
| 177 $main::GRC = 1 if ($main::GRC < 1); | |
| 178 } | |
| 179 | |
| 180 sub lint_error { | |
| 181 my ($file, $done, $this, $msg) = @_; | |
| 182 &lint_message("ERROR", $file, $done, $this, $msg); | |
| 183 $main::GRC = 2 if ($main::GRC < 2); | |
| 184 } | |
| 185 | |
| 186 ## _________________________________________________________________ | |
| 187 ## | |
| 188 ## CHECK "blank": whitespace and blank lines | |
| 189 ## _________________________________________________________________ | |
| 190 ## | |
| 191 | |
| 192 sub check_blank { | |
| 193 my ($file, $spec) = @_; | |
| 194 | |
| 195 # check for CR-LF combination | |
| 196 my $done = ''; my $this = ''; my $todo = $spec; | |
| 197 while ($todo =~ m/\r\n/s) { | |
| 198 $done .= $`; $this = $&; $todo = $'; | |
| 199 &lint_warning($file, $done, $this, "carriage-return (CR, 0x0d) line-feed (NL, 0x0a) combination (expected just line-feed)"); | |
| 200 $done .= $this; | |
| 201 } | |
| 202 | |
| 203 # check for multiple blank lines | |
| 204 $done = ''; $this = ''; $todo = $spec; | |
| 205 while ($todo =~ m/(\r?\n[ \t]*){3,}/s) { | |
| 206 $done .= $`; $this = $&; $todo = $'; | |
| 207 &lint_warning($file, $done, $this, "multiple subsequent blank lines (expected single blank line)"); | |
| 208 $done .= $this; | |
| 209 } | |
| 210 | |
| 211 # check for trailing whitespaces | |
| 212 $done = ''; $this = ''; $todo = $spec; | |
| 213 while ($todo =~ m/[ \t]+\r?\n/s) { | |
| 214 $done .= $`; $this = $&; $todo = $'; | |
| 215 if ($done eq '' or $done =~ m|\n$|s) { | |
| 216 &lint_warning($file, $done, $this, "whitespace on empty line (expected none)"); | |
| 217 } | |
| 218 else { | |
| 219 &lint_warning($file, $done, $this, "trailing whitespace (expected none)"); | |
| 220 } | |
| 221 $done .= $this; | |
| 222 } | |
| 223 | |
| 224 # check for bogus line continuations | |
| 225 $done = ''; $this = ''; $todo = $spec; | |
| 226 while ($todo =~ m/\\[ \t]*\r?\n(?=[ \t]*\r?\n)/s) { | |
| 227 $done .= $`; $this = $&; $todo = $'; | |
| 228 &lint_warning($file, $done, $this, "bogus line continuation for following empty line (expect no line continuation)"); | |
| 229 $done .= $this; | |
| 230 } | |
| 231 | |
| 232 # check for leading whitespaces before line continuations | |
| 233 $done = ''; $this = ''; $todo = $spec; | |
| 234 while ($todo =~ m/[ \t]{2,}\\[ \t]*\r?\n/s) { | |
| 235 $done .= $`; $this = $&; $todo = $'; | |
| 236 &lint_warning($file, $done, $this, "multiple leading whitespace before line continuation (expected just a single space)"); | |
| 237 $done .= $this; | |
| 238 } | |
| 239 | |
| 240 # check for leading tabs | |
| 241 $done = ''; $this = ''; $todo = $spec; | |
| 242 while ($todo =~ m/^ *\t+ *[^ \t]/m) { | |
| 243 $done .= $`; $this = $&; $todo = $'; | |
| 244 &lint_warning($file, $done, $this, "leading tabs (expected spaces)"); | |
| 245 $done .= $this; | |
| 246 } | |
| 247 | |
| 248 # check for mandatory/wished trailing blank line | |
| 249 if ($spec !~ m|\n\n$|) { | |
| 250 &lint_warning($file, $spec, "", "mandatory/wished trailing blank line missing (expected one)"); | |
| 251 } | |
| 252 } | |
| 253 | |
| 254 ## _________________________________________________________________ | |
| 255 ## | |
| 256 ## CHECK "comment": sharp-comments | |
| 257 ## _________________________________________________________________ | |
| 258 ## | |
| 259 | |
| 260 sub check_comment { | |
| 261 my ($file, $spec) = @_; | |
| 262 | |
| 263 # check for comment indentation and contents | |
| 264 my $done = ''; my $this = ''; my $todo = $spec; | |
| 265 while ($todo =~ m/^([ \t]*)(#+)([ \t]*)(.*?)$/m) { | |
| 266 $done .= $`; $this = $&; $todo = $'; | |
| 267 my ($lead, $sharp, $pad, $text) = ($1, $2, $3, $4); | |
| 268 if (length($lead) % 2 != 0) { | |
| 269 &lint_warning($file, $done, $this, "incorrect comment indentation (expected a multiple of 2 spaces)"); | |
| 270 } | |
| 271 if (length($lead) > 1 && length($sharp) > 1) { | |
| 272 &lint_warning($file, $done, $this, "indented comment has introduced with multiple sharps (expected single sharp character)"); | |
| 273 } | |
| 274 if (length($pad.$text) > 0 && length($sharp.$pad) % 4 != 0) { | |
| 275 &lint_warning($file, $done, $this, "incorrect comment text padding (expected a multiple of 4 sharps or spaces)"); | |
| 276 } | |
| 277 if (length($pad) == 0 && length($text) > 0) { | |
| 278 &lint_warning($file, $done, $this, "missing leading space before comment text (expected padding spaces)"); | |
| 279 } | |
| 280 if (length($pad) > 0 && length($text) == 0) { | |
| 281 &lint_warning($file, $done, $this, "empty comment text (expected a reasonable text)"); | |
| 282 } | |
| 283 $done .= $this; | |
| 284 } | |
| 285 | |
| 286 # check for comment contents only | |
| 287 if ($file !~ m|openpkg\.spec$|) { | |
| 288 $done = ''; $this = ''; $todo = $spec; | |
| 289 while ($todo =~ m/\n\n[ \t]*#[ \t]+([^\n]+)(?!\n([ \t]*#))/s) { | |
| 290 $done .= $`; $this = $&; $todo = $'; | |
| 291 my $text = $1; | |
| 292 if (length($text) > 0 and $text =~ m|^[A-Z][^A-Z]|) { | |
| 293 &lint_warning($file, $done, $this, "comment text starts with upper-case letter (expected lower-case letter)"); | |
| 294 } | |
| 295 $done .= $this; | |
| 296 } | |
| 297 } | |
| 298 } | |
| 299 | |
| 300 ## _________________________________________________________________ | |
| 301 ## | |
| 302 ## CHECK "license": license header | |
| 303 ## _________________________________________________________________ | |
| 304 ## | |
| 305 | |
| 306 sub check_license { | |
| 307 my ($file, $spec) = @_; | |
| 308 | |
| 309 my $name = "[a-z][a-z0-9-]*"; | |
| 310 if ($file =~ m|^.*/([a-z][a-z0-9-]*)\.spec$|) { | |
| 311 $name = $1; | |
| 312 } | |
| 313 elsif ($file =~ m|^([a-z][a-z0-9-]*)\.spec$|) { | |
| 314 $name = $1; | |
| 315 } | |
| 316 my $re = ""; | |
| 317 $re .= "##\\n"; | |
| 318 $re .= "## $name\\.spec -- OpenPKG RPM Package Specification\\n"; | |
| 319 $re .= "## Copyright \\(c\\) 200[0-9]-2012 OpenPKG Foundation e\.V\. <http://openpkg\\.net/>\\n"; | |
| 320 $re .= "##\\n"; | |
| 321 $re .= "## Permission to use, copy, modify, and distribute this software for\\n"; | |
| 322 $re .= "## any purpose with or without fee is hereby granted, provided that\\n"; | |
| 323 $re .= "## the above copyright notice and this permission notice appear in all\\n"; | |
| 324 $re .= "## copies\\.\\n"; | |
| 325 $re .= "##\\n"; | |
| 326 $re .= "## THIS SOFTWARE IS PROVIDED \\`\\`AS IS'' AND ANY EXPRESSED OR IMPLIED\\n"; | |
| 327 $re .= "## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF\\n"; | |
| 328 $re .= "## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED\\.\\n"; | |
| 329 $re .= "## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR\\n"; | |
| 330 $re .= "## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,\\n"; | |
| 331 $re .= "## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES \\(INCLUDING, BUT NOT\\n"; | |
| 332 $re .= "## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF\\n"; | |
| 333 $re .= "## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION\\) HOWEVER CAUSED AND\\n"; | |
| 334 $re .= "## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\\n"; | |
| 335 $re .= "## OR TORT \\(INCLUDING NEGLIGENCE OR OTHERWISE\\) ARISING IN ANY WAY OUT\\n"; | |
| 336 $re .= "## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF\\n"; | |
| 337 $re .= "## SUCH DAMAGE\\.\\n"; | |
| 338 $re .= "##\\n"; | |
| 339 if ($name ne "openpkg" and $spec !~ m|^$re|os) { | |
| 340 &lint_warning($file, "", "", "invalid license header"); | |
| 341 } | |
| 342 } | |
| 343 | |
| 344 ## _________________________________________________________________ | |
| 345 ## | |
| 346 ## CHECK "header": RPM headers | |
| 347 ## _________________________________________________________________ | |
| 348 ## | |
| 349 | |
| 350 sub check_header { | |
| 351 my ($file, $spec) = @_; | |
| 352 | |
| 353 my @headers = (qw( | |
| 354 m:Name:^[a-z][a-z0-9-]*$ | |
| 355 m:Summary:^[A-Z]\S*(\s+([A-Z]\S*|of|for|from|in|at|on|\(\S+\)))* | |
| 356 m:URL:^((https?|ftp)://.+|-)$ | |
| 357 m:Vendor:.+ | |
| 358 m:Packager:^(OpenPKG\sFoundation\se\.V\.|OpenPKG\sGmbH)$ | |
| 359 m:Distribution:^(OpenPKG|OpenPKG\sCommunity|OpenPKG\sEnterprise)$ | |
| 360 m:Class:^(BOOT|CORE|BASE|PLUS|EVAL|JUNK|PRIV)$ | |
| 361 m:Group:^[A-Z][a-zA-Z0-9]+$ | |
| 362 m:License:.+ | |
| 363 m:Version:^[^-]+$ | |
| 364 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+|%\{[^\}]+\})$ | |
| 365 o:Source\d+:^((https?|ftp)://.+|[^/]+)$ | |
| 366 o:Patch\d+:^((https?|ftp)://.+|[^/]+)$ | |
| 367 o:Prefix:^%{l_prefix}$ | |
| 368 o:BuildRoot:^%{l_buildroot}$ | |
| 369 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+)?)+)$ | |
| 370 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+)?)+$ | |
| 371 o:AutoReq:^no$ | |
| 372 o:AutoReqProv:^no$ | |
| 373 o:Provides:^((,\s)?([a-z][a-z0-9-]*(\:\:with_[a-z][a-z0-9_]+)?|[A-Z][A-Z0-9-]*)(\s==?\s\S+)?)+$ | |
| 374 o:Conflicts:^((,\s)?([a-z][a-z0-9-]*(\:\:with_[a-z][a-z0-9_]+)?|[A-Z][A-Z0-9-]*)(\s(>=?|==?|<=?|!=)\s\S+)?)+$ | |
| 375 )); | |
| 376 my @headers_def = (qw( | |
| 377 Summary:^Badly\sPackaged\sProgram$ | |
| 378 Vendor:^John\sDoe$ | |
| 379 Group:^Unknown$ | |
| 380 License:^DoePL$ | |
| 381 )); | |
| 382 my @headers_mult = (qw( | |
| 383 BuildPreReq PreReq Provides Conflicts | |
| 384 )); | |
| 385 | |
| 386 my @seen = (); | |
| 387 my %count = (); | |
| 388 my $done = ''; my $this = ''; my $todo = $spec; | |
| 389 while ($todo =~ m/^(\S+):([ \t]*)(.*?)$/m) { | |
| 390 $done .= $`; $this = $&; $todo = $'; | |
| 391 my ($header, $pad, $value) = ($1, $2, $3); | |
| 392 | |
| 393 # check for layouting | |
| 394 if (length($value) == 0) { | |
| 395 &lint_error($file, $done, $this, "empty RPM header value"); | |
| 396 } | |
| 397 if (length($header.":".$pad) != 14) { | |
| 398 &lint_warning($file, $done, $this, "invalid RPM header name/value padding (expected value at column 15)"); | |
| 399 } | |
| 400 | |
| 401 # check for valid header name and value | |
| 402 if (not grep { $header =~ m|^$_$|s } map { m/^[^:]:([^:]+):/, $1 } @headers) { | |
| 403 &lint_error($file, $done, $this, "invalid RPM header name \"$header\""); | |
| 404 } | |
| 405 else { | |
| 406 my $hn = quotemeta((grep { $header =~ m|^$_$|s } map { m/^[^:]+:([^:]+):/, $1 } @headers)[0]); | |
| 407 my $re = (map { m/^[^:]+:${hn}:(.+)$/s } @headers)[0]; | |
| 408 my $re_match = $re; | |
| 409 $re_match =~ s|^\(|(?:|sg; | |
| 410 $re_match =~ s|([^\\])\(|\1(?:|sg; | |
| 411 if ( not ($file =~ m|openpkg\.spec$| and $header eq 'Provides' and $value eq '%{l_prefix}') | |
| 412 and $value !~ m|${re_match}|s) { | |
| 413 &lint_warning($file, $done, $this, "RPM header \"$header\": " . | |
| 414 "invalid value \"$value\" (expected to match \"$re\")"); | |
| 415 } | |
| 416 my $re_def = (map { m/^${hn}:(.+)$/s } @headers_def)[0]; | |
| 417 if (defined($re_def)) { | |
| 418 my $re_def_match = $re_def; | |
| 419 $re_def_match =~ s|^\(|(?:|sg; | |
| 420 $re_def_match =~ s|([^\\])\(|\1(?:|sg; | |
| 421 if ($value =~ m|${re_def_match}|s) { | |
| 422 &lint_warning($file, $done, $this, "RPM header \"$header\": " . | |
| 423 "default value \"$value\" (expected to match \"$re\", except for this)"); | |
| 424 } | |
| 425 } | |
| 426 if ($header =~ m/^Vendor/ and $value =~ m/et\sal/ and $value !~ m/et\sal\./) { | |
| 427 &lint_warning($file, $done, $this, "RPM header \"$header\": " . | |
| 428 "has value \"$value\" (expected \"et al.\" with dot)"); | |
| 429 } | |
| 430 } | |
| 431 push(@seen, $header); | |
| 432 $count{$header}++; | |
| 433 $done .= $this; | |
| 434 } | |
| 435 | |
| 436 # check for existence of mandatory headers | |
| 437 foreach my $header (@headers) { | |
| 438 my ($type, $name, $regex) = split(/:/, $header, 3); | |
| 439 if ($type eq 'm') { | |
| 440 if ($file =~ m|openpkg\.spec$| and | |
| 441 ($name eq "BuildPreReq" or $name eq "PreReq")) { | |
| 442 # the bootstrap package is an obvious exception | |
| 443 next; | |
| 444 } | |
| 445 if (not grep(/^$name$/, @seen)) { | |
| 446 &lint_warning($file, undef, undef, "mandatory RPM header \"$name\" not found"); | |
| 447 } | |
| 448 } | |
| 449 } | |
| 450 | |
| 451 # check for multiple occurrence headers | |
| 452 foreach my $seen (@seen) { | |
| 453 if ($count{$seen} > 1 and not (grep { $_ eq $seen } @headers_mult)) { | |
| 454 &lint_error($file, undef, undef, "RPM header \"$seen\" occurs multiple times (expected just once)"); | |
| 455 } | |
| 456 } | |
| 457 } | |
| 458 | |
| 459 ## _________________________________________________________________ | |
| 460 ## | |
| 461 ## CHECK "section": RPM sections | |
| 462 ## _________________________________________________________________ | |
| 463 ## | |
| 464 | |
| 465 sub check_section { | |
| 466 my ($file, $spec) = @_; | |
| 467 | |
| 468 my $require = qq{ | |
| 469 (%define,)* | |
| 470 Name:, | |
| 471 Summary:, | |
| 472 URL:, | |
| 473 Vendor:, | |
| 474 Packager:, | |
| 475 Distribution:, | |
| 476 Class:, | |
| 477 Group:, | |
| 478 License:, | |
| 479 Version:, | |
| 480 Release:, | |
| 481 (%option,)* | |
| 482 (%define,|%undefine,)* | |
| 483 (Source\\d+:,)* | |
| 484 (Patch\\d+:,)* | |
| 485 (%NoSource,)* | |
| 486 (%NoPatch,)* | |
| 487 (Prefix:,)? | |
| 488 (BuildRoot:,)? | |
| 489 ((BuildPreReq:,) | |
| 490 |(PreReq:,))* | |
| 491 (AutoReq:,)? | |
| 492 (AutoReqProv:,)? | |
| 493 (Provides:,)* | |
| 494 (Conflicts:,)* | |
| 495 %description, | |
| 496 (%track,)? | |
| 497 %prep, | |
| 498 %build, | |
| 499 %install, | |
| 500 (%check,)? | |
| 501 %files, | |
| 502 %clean, | |
| 503 (%pre,)? | |
| 504 (%post,)? | |
| 505 (%preun,)? | |
| 506 (%postun,)? | |
| 507 (%trigger,)? | |
| 508 (%triggerin,)? | |
| 509 (%triggerun,)? | |
| 510 (%triggerpostun,)? | |
| 511 (%verifyscript,)? | |
| 512 }; | |
| 513 | |
| 514 # check for order of headers | |
| 515 my $sections = ""; | |
| 516 my $done = ''; my $this = ''; my $todo = $spec; | |
| 517 while ($todo =~ m/^(\S+:|%\S+).*$/m) { | |
| 518 $done .= $`; $this = $&; $todo = $'; | |
| 519 my $section = $1; | |
| 520 next if ($section =~ m/^%(if|else|endif)/); | |
| 521 $sections .= "$section,"; | |
| 522 $done .= $this; | |
| 523 } | |
| 524 my $regex = $require; | |
| 525 $regex =~ s|\s+||sg; | |
| 526 if ($sections !~ m/^$regex$/s) { | |
| 527 $regex =~ s|,| |sg; | |
| 528 &lint_error($file, undef, undef, "invalid RPM section order: $sections (expected \"$regex\")"); | |
| 529 } | |
| 530 } | |
| 531 | |
| 532 ## _________________________________________________________________ | |
| 533 ## | |
| 534 ## CHECK "preproc": RPM macro pre-processor | |
| 535 ## _________________________________________________________________ | |
| 536 ## | |
| 537 | |
| 538 sub check_preproc { | |
| 539 my ($file, $spec) = @_; | |
| 540 | |
| 541 my $done = ''; my $this = ''; my $todo = $spec; | |
| 542 while ($todo =~ m/^(%(?:if|else|endif|define|undefine|option))(.*)$/m) { | |
| 543 $done .= $`; $this = $&; $todo = $'; | |
| 544 my ($cmd, $args) = ($1, $2); | |
| 545 if ($cmd eq '%if') { | |
| 546 # FIXME: either try to really parse the boolean expression | |
| 547 # FIXME: or at least try to guess its correct syntax | |
| 548 } | |
| 549 elsif ($cmd eq '%else' or $cmd eq '%endif') { | |
| 550 if (length($args) > 0) { | |
| 551 &lint_warning($file, $done, $this, "garbage after pre-processor directive " . | |
| 552 "\"$cmd\" (expected no arguments)"); | |
| 553 } | |
| 554 } | |
| 555 elsif ($cmd eq '%undefine') { | |
| 556 if ($args =~ m|^\s+(\S+)\s*$|) { | |
| 557 my $var = $1; | |
| 558 if ($var !~ m/^(V|with)_[a-z][a-zA-Z0-9_]*$/) { | |
| 559 &lint_warning($file, $done, $this, "unusually named macro: \"$var\" " . | |
| 560 "(expected \"(V|with)_[a-z][a-zA-Z0-9_]*\")"); | |
| 561 next; | |
| 562 } | |
| 563 } | |
| 564 else { | |
| 565 &lint_error($file, $done, $this, "invalid number of arguments to pre-processor " . | |
| 566 "directive \"$cmd\" (expected exactly 1 argument)"); | |
| 567 } | |
| 568 } | |
| 569 elsif ($cmd eq '%define' or $cmd eq '%option') { | |
| 570 if ($args =~ m|^\s+(\S+)\s+(.*)$|) { | |
| 571 my ($var, $val) = ($1, $2); | |
| 572 if ($var !~ m/^(V|with)_[a-z][a-zA-Z0-9_]*$/) { | |
| 573 &lint_warning($file, $done, $this, "unusually named macro: \"$var\" " . | |
| 574 "(expected \"(V|with)_[a-z][a-zA-Z0-9_]*\")"); | |
| 575 next; | |
| 576 } | |
| 577 if (length($val) == 0) { | |
| 578 &lint_error($file, $done, $this, "empty macro value"); | |
| 579 } | |
| 580 } | |
| 581 else { | |
| 582 &lint_error($file, $done, $this, "invalid number of arguments to pre-processor " . | |
| 583 "directive \"$cmd\" (expected exactly 2 arguments)"); | |
| 584 } | |
| 585 } | |
| 586 $done .= $this; | |
| 587 } | |
| 588 | |
| 589 # check correct if/endif nesting | |
| 590 my @stack = (); | |
| 591 $done = ''; $this = ''; $todo = $spec; | |
| 592 while ($todo =~ m/^(%(?:if|else|endif|define|undefine|option)).*$/m) { | |
| 593 $done .= $`; $this = $&; $todo = $'; | |
| 594 my $directive = $1; | |
| 595 if ($directive eq '%if') { | |
| 596 push(@stack, &lines($done . $this)); | |
| 597 } | |
| 598 elsif ($directive eq '%endif') { | |
| 599 if (@stack == 0) { | |
| 600 &lint_error($file, $done, $this, "found \%endif without corresponding opening \%if"); | |
| 601 last; | |
| 602 } | |
| 603 pop(@stack); | |
| 604 } | |
| 605 $done .= $this; | |
| 606 } | |
| 607 my $line; | |
| 608 while (defined($line = pop(@stack))) { | |
| 609 &lint_error($file, undef, undef, "\%if at line $line never closed by \%endif"); | |
| 610 } | |
| 611 | |
| 612 # check for indented preprocessor constructs | |
| 613 $done = ''; $this = ''; $todo = $spec; | |
| 614 while ($todo =~ m/^[ \t]+(%(?:if|else|endif|define|undefine|option)).*$/m) { | |
| 615 $done .= $`; $this = $&; $todo = $'; | |
| 616 my $directive = $1; | |
| 617 &lint_error($file, $done, $this, "found indented \"$directive\" preprocessor directive (expected no indentation)"); | |
| 618 $done .= $this; | |
| 619 } | |
| 620 } | |
| 621 | |
| 622 ## _________________________________________________________________ | |
| 623 ## | |
| 624 ## CHECK "script": shell scripts | |
| 625 ## _________________________________________________________________ | |
| 626 ## | |
| 627 | |
| 628 sub check_script { | |
| 629 my ($file, $spec) = @_; | |
| 630 | |
| 631 my $done = ''; my $this = ''; my $todo = $spec; | |
| 632 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) { | |
| 633 $done .= $`; $this = $&; $todo = $'; | |
| 634 my ($section, $args, $script) = ($1, $2, $3); | |
| 635 | |
| 636 # perform checks for a single script section | |
| 637 &check_script_section($file, $done, $this, $section, $args, $script); | |
| 638 | |
| 639 $done .= $this; | |
| 640 } | |
| 641 } | |
| 642 | |
| 643 sub check_script_section { | |
| 644 my ($file, $outer_done, $outer_this, $section, $args, $script) = @_; | |
| 645 | |
| 646 # skip plain-text/non-scripting section %description | |
| 647 return if ($section eq '%description'); | |
| 648 | |
| 649 # remove comment contents | |
| 650 $outer_this =~ s|^[ \t]*#[^\n]*||mg; | |
| 651 | |
| 652 # check shell redirections | |
| 653 my $done = $outer_done; my $this = ''; my $todo = $outer_this; | |
| 654 while ( $todo =~ m/[ \t]+(\d+)?[><][ \t]+\S+/s | |
| 655 or $todo =~ m/[ \t]+[><](\&\d+)?[ \t]+\S+/s) { | |
| 656 $done .= $`; $this = $&; $todo = $'; | |
| 657 &lint_warning($file, $done, $this, "section $section: whitespace after shell redirection (expected none)"); | |
| 658 $done .= $this; | |
| 659 } | |
| 660 | |
| 661 # utility function: extract a single shell command | |
| 662 sub command_extract { | |
| 663 my ($script) = @_; | |
| 664 my $cmd = ''; | |
| 665 while ($script ne '') { | |
| 666 $script =~ s/^([ \t]*'[^']*')/ $cmd .= $1, ''/se && next; | |
| 667 $script =~ s/^([ \t]*"[^"]*")/ $cmd .= $1, ''/se && next; | |
| 668 $script =~ s/^([ \t]*[^ \t;\)\\\r\n]+)/$cmd .= $1, ''/se && next; | |
| 669 $script =~ s/^([ \t]*\\[ \t]*\r?\n)/ $cmd .= $1, ''/se && next; | |
| 670 last; | |
| 671 } | |
| 672 return ($cmd, $script); | |
| 673 } | |
| 674 | |
| 675 # utility function: join a multi-line command | |
| 676 sub multiline_join { | |
| 677 my ($cmd) = @_; | |
| 678 $cmd =~ s/([ \t]*\\[ \t]*\r?\n[ \t]*)/ /sg; | |
| 679 return $cmd; | |
| 680 } | |
| 681 | |
| 682 # utility function: split command into arguments | |
| 683 sub shell_tokenize { | |
| 684 my ($cmd) = @_; | |
| 685 my @cmd = (); | |
| 686 while ($cmd ne '') { | |
| 687 $cmd =~ s/^\s*('[^']*')/push(@cmd, $1), ''/se && next; | |
| 688 $cmd =~ s/^\s*("[^"]*")/push(@cmd, $1), ''/se && next; | |
| 689 $cmd =~ s/^\s*(\S+)/ push(@cmd, $1), ''/se && next; | |
| 690 $cmd =~ s/^\s*$/ ''/se && last; | |
| 691 } | |
| 692 return @cmd; | |
| 693 } | |
| 694 | |
| 695 # check filesystem path style | |
| 696 $done = $outer_done; $this = ''; $todo = $outer_this; | |
| 697 while ($todo =~ m/\%\{l_shtool\}\s+(\w+)\s+/s) { | |
| 698 $done .= $`; $this = $&; $todo = $'; | |
| 699 ($this, $todo) = &command_extract($this . $todo); | |
| 700 | |
| 701 # check for shtool options with no space before argument | |
| 702 my $subthis = $this; | |
| 703 $subthis =~ s/\%{[A-Za-z][A-Za-z0-9_]*}//sg; | |
| 704 $subthis =~ s/\%{[A-Za-z][A-Za-z0-9_]*(?:\s+[^}]+?)?}//sg; | |
| 705 # remove content of quoted arguments as they might contain unrelated things to catch | |
| 706 $subthis =~ s/'[^']*'/ARG/sg; | |
| 707 $subthis =~ s/"[^"]*"/ARG/sg; | |
| 708 $subthis =~ s/`[^`]*`/ARG/sg; | |
| 709 # remove us completely if line ends with a quote as this indicates we are a quoted argument to ourselfs | |
| 710 $subthis =~ s/[^']*'$//s; | |
| 711 $subthis =~ s/[^"]*"$//s; | |
| 712 $subthis =~ s/[^`]*`$//s; | |
| 713 $subthis =~ s/[^']*' \\\n//s; | |
| 714 $subthis =~ s/[^"]*" \\\n//s; | |
| 715 $subthis =~ s/[^`]*` \\\n//s; | |
| 716 # catch command termination by semicolon, pipe, or, and; | |
| 717 $subthis =~ s/[;|&].*$//s; | |
| 718 if ($subthis =~ m/\s-[a-zA-Z]\S/) { | |
| 719 &lint_warning($file, $done, $this, "found use of shtool option with space omitted before argument"); | |
| 720 } | |
| 721 | |
| 722 # openpkg-rc is special because does bootstrap things | |
| 723 last if ($file =~ m|openpkg-rc\.spec$|); | |
| 724 | |
| 725 my @cmd = &shell_tokenize(&multiline_join($this)); | |
| 726 if ($cmd[1] eq 'mkdir') { | |
| 727 # join flags with their arguments | |
| 728 for (my $i = 2; $i <= $#cmd; $i++) { | |
| 729 if ($cmd[$i] eq '-m') { | |
| 730 splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]); | |
| 731 } | |
| 732 } | |
| 733 # check paths | |
| 734 for (my $i = $#cmd; $i > 1 and $cmd[$i] !~ m|^-| and $cmd[$i] !~ m|^\d+$|; $i--) { | |
| 735 if ($cmd[$i] =~ m|/$|) { | |
| 736 &lint_warning($file, $done, $this, "section $section: superfluous trailing slash on " . | |
| 737 "created path in \"shtool mkdir\" command (expected none)"); | |
| 738 } | |
| 739 } | |
| 740 } | |
| 741 elsif ($cmd[1] eq 'install') { | |
| 742 # join flags with their arguments | |
| 743 for (my $i = 2; $i <= $#cmd; $i++) { | |
| 744 if ($cmd[$i] =~ m/-(e|m|o|g)$/) { | |
| 745 splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]); | |
| 746 } | |
| 747 elsif ($cmd[$i] eq '%{SOURCE') { | |
| 748 splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]); | |
| 749 } | |
| 750 elsif ($cmd[$i] eq '%{l_value') { | |
| 751 while ($i < $#cmd and $cmd[$i+1] !~ m|\}$|s) { | |
| 752 splice(@cmd, $i, 2, $cmd[$i].$cmd[$i+1]); | |
| 753 } | |
| 754 splice(@cmd, $i, 2); | |
| 755 $i--; | |
| 756 } | |
| 757 } | |
| 758 | |
| 759 # determine last path argument | |
| 760 my $i = $#cmd; $i-- while ($i > 1 and $cmd[$i] !~ m|^-| and $cmd[$i] !~ m|^\d+$|); | |
| 761 | |
| 762 # check paths | |
| 763 if (($#cmd - $i) > 2 and $cmd[-1] !~ m|/$|) { | |
| 764 # simple case: multiple sources require target to be a directory | |
| 765 &lint_warning($file, $done, $this, "section $section: missing trailing slash on " . | |
| 766 "destination path in \"shtool install\" command (expected one) 1"); | |
| 767 } | |
| 768 elsif (($#cmd - $i) == 2 and $cmd[-1] !~ m|/$|) { | |
| 769 # complex case: single source, so we can check only known destination paths | |
| 770 if ( $cmd[-1] =~ m/\%\{l_prefix\}\/(bin|cgi|include|info|lib|pub|sbin)$/ | |
| 771 or $cmd[-1] =~ m/\%\{l_prefix\}\/(etc|libexec|man|share|var)(\/[^\/]+)?$/) { | |
| 772 &lint_warning($file, $done, $this, "section $section: missing trailing slash on " . | |
| 773 "destination path in \"shtool install\" command (expected one) 2"); | |
| 774 } | |
| 775 } | |
| 776 else { | |
| 777 # special case: if any path contains '*', then globbing might occur | |
| 778 for (my $i = 2; $i <= $#cmd; $i++) { | |
| 779 if ($cmd[$i] =~ m/\*/ and $cmd[-1] !~ m|/$|) { | |
| 780 &lint_warning($file, $done, $this, "section $section: missing trailing slash on " . | |
| 781 "destination path in \"shtool install\" command (expected one) 3"); | |
| 782 last; | |
| 783 } | |
| 784 } | |
| 785 } | |
| 786 } | |
| 787 $done .= $this; | |
| 788 } | |
| 789 | |
| 790 # check for redundant 'export PATH' statements | |
| 791 #$done = $outer_done; $this = ''; $todo = $outer_this; | |
| 792 #while ($todo =~ m/\bexport[ \t]+([a-zA-Z_][a-zA-Z0-9_]*[ \t]+)*PATH\b/s) { | |
| 793 # $done .= $`; $this = $&; $todo = $'; | |
| 794 # &lint_warning($file, $done, $this, "section $section: redundant \"export PATH\" statement (expected none)"); | |
| 795 # $done .= $this; | |
| 796 #} | |
| 797 | |
| 798 # check for obsolete cpp build flags | |
| 799 $done = $outer_done; $this = ''; $todo = $outer_this; | |
| 800 while ($todo =~ m/-I\%\{l_prefix\}\/include(\/([^ \t"';]+?))?[ \t"';]/s) { | |
| 801 $done .= $`; $this = $&; $todo = $'; | |
| 802 my ($subdir) = $2; | |
| 803 &lint_warning($file, $done, $this, "section $section: hard-coded C pre-processor path option " . | |
| 804 "(use \"%{l_cppflags".($subdir ? " $subdir" : "")."}\" instead)"); | |
| 805 $done .= $this; | |
| 806 } | |
| 807 | |
| 808 # check for obsolete ld build flags | |
| 809 $done = $outer_done; $this = ''; $todo = $outer_this; | |
| 810 while ($todo =~ m/-L\%\{l_prefix\}\/lib(\/([^ \t"';]+?))?[ \t"';]/s) { | |
| 811 $done .= $`; $this = $&; $todo = $'; | |
| 812 my ($subdir) = $2; | |
| 813 &lint_warning($file, $done, $this, "section $section: hard-coded linker path option " . | |
| 814 "(use \"%{l_ldflags".($subdir ? " $subdir" : "")."}\" instead)"); | |
| 815 $done .= $this; | |
| 816 } | |
| 817 | |
| 818 # check for "raw" tool usage | |
| 819 if ($section ne '%description' and $file !~ m|openpkg\.spec$|) { | |
| 820 foreach my $token (&shell_tokenize($outer_this)) { | |
| 821 if ($token =~ m/^(rpmtool|shtool|curl|bash|gzip|bzip2|tar|cc|cxx|make|patch)$/s) { | |
| 822 &lint_warning($file, undef, undef, "section $section: raw usage of standard tool \"$token\"" . | |
| 823 " (use \"%{l_${token}}\" instead)"); | |
| 824 } | |
| 825 } | |
| 826 } | |
| 827 | |
| 828 # check for setup and patch macro usage | |
| 829 if ($section eq '%prep') { | |
| 830 $done = $outer_done; $this = ''; $todo = $outer_this; | |
| 831 my @tokens = &shell_tokenize($outer_this); | |
| 832 while ($todo =~ m/([^\n]*)\n/s) { | |
| 833 $done .= $`; $this = $&; $todo = $'; | |
| 834 if ($this =~ m/^ *%setup.* .*$/) { | |
| 835 &lint_warning($file, undef, undef, "section $section: multiple spaces in \"\%setup\" macro" . | |
| 836 " (reduce to single space)"); | |
| 837 } | |
| 838 if ($this =~ m/^ *%setup.*-[ab]$/ and grep(/^\%setup+$/, @tokens) == 1) { | |
| 839 &lint_warning($file, undef, undef, "section $section: -[ab] option superflous for single \"\%setup\" macro" . | |
| 840 " (remove it)"); | |
| 841 } | |
| 842 if ($this =~ m/^ *%patch.* .*$/) { | |
| 843 &lint_warning($file, undef, undef, "section $section: multiple spaces in \"\%patch\" macro" . | |
| 844 " (reduce to single space)"); | |
| 845 } | |
| 846 if ($this =~ m/^ *%patch.*-p +[01]/) { | |
| 847 &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" . | |
| 848 " (use -pN)"); | |
| 849 } | |
| 850 if ($this =~ m/^ *%patch.*-P 0\s*$/ and grep(/^\%patch+$/, @tokens) == 1) { | |
| 851 &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" . | |
| 852 " (omit -P 0 for single patch)"); | |
| 853 } | |
| 854 if ($this =~ m/^ *%patch.*-P [^0-9]/ and grep(/^\%patch+$/, @tokens) > 1) { | |
| 855 &lint_warning($file, undef, undef, "section $section: syntactically wrong space in \"\%patch\" macro" . | |
| 856 " (use -P for multiple patches)"); | |
| 857 } | |
| 858 $done .= $this; | |
| 859 } | |
| 860 if (grep(/^\%setup\d+$/, @tokens)) { | |
| 861 &lint_warning($file, undef, undef, "section $section: numbered \"\%setup\" macro" . | |
| 862 " (do not use %setup directly followed by a number, replace with %setup ... -[ab])"); | |
| 863 } | |
| 864 if (grep(/^\%patch\d+$/, @tokens)) { | |
| 865 &lint_warning($file, undef, undef, "section $section: numbered \"\%patch\" macro" . | |
| 866 " (do not use %patch directly followed by a number, replace with %patch ... -P)"); | |
| 867 } | |
| 868 } | |
| 869 | |
| 870 # check for hard-coded prefix in %pre[un],%post[un] scripts | |
| 871 if ($section =~ m/^\%(preun|postun|pre|post)$/s and $file !~ m|openpkg\.spec$|) { | |
| 872 $done = $outer_done; $this = ''; $todo = $outer_this; | |
| 873 while ($todo =~ m/\%\{l_prefix\}/s) { | |
| 874 $done .= $`; $this = $&; $todo = $'; | |
| 875 &lint_warning($file, $done, $this, "section $section: hard-coded prefix (\%{l_prefix}) found " . | |
| 876 "(use \"\$RPM_INSTALL_PREFIX\" to allow relocation)"); | |
| 877 $done .= $this; | |
| 878 } | |
| 879 } | |
| 880 | |
| 881 # check for sub-shell parenthesis style | |
| 882 # (this is such complicated because the Bourne Shell has a | |
| 883 # construct "case <value> in <pattern> ) <script> ;; ... esac" | |
| 884 # where the closing parenthesis makes heavy problems for our | |
| 885 # check. So we first have to get rid of this. Unfortunately this | |
| 886 # is again not easy because there exists nested(!) case/esac | |
| 887 # constructs. Hence, we have to use a small recursive descent | |
| 888 # parser which replaces the ")" in case/esac constructs with | |
| 889 # "PCLOSE". A similar thing is done with string literals, although | |
| 890 # here the job is more trivial). | |
| 891 if ($section !~ m/^\%files$/s) { | |
| 892 $done = $outer_done; $this = ''; $todo = $outer_this; | |
| 893 $todo =~ s/`[^`]*`/STRING/sg; | |
| 894 $todo =~ s/'[^']*'/STRING/sg; | |
| 895 $todo =~ s/"[^"]*"/STRING/sg; | |
| 896 $todo = (&parse_sh("", $todo))[0]; | |
| 897 sub parse_sh { | |
| 898 my ($done, $todo) = @_; | |
| 899 while ($todo =~ m/^(.*?)(case|;;)/s) { | |
| 900 if ($2 eq 'case') { | |
| 901 ($done, $todo) = &parse_case($done.$1, $2.$'); | |
| 902 } | |
| 903 else { | |
| 904 ($done, $todo) = ($done.$1, $2.$'); | |
| 905 return ($done, $todo); | |
| 906 } | |
| 907 } | |
| 908 ($done, $todo) = ($done . $todo, ""); | |
| 909 return ($done, $todo); | |
| 910 } | |
| 911 sub parse_case { | |
| 912 my ($done, $todo) = @_; | |
| 913 $todo =~ m|^\s*case\s+\S+\s+in\b|s or return (undef, undef); | |
| 914 ($done, $todo) = ($done . $&, $'); | |
| 915 while ($todo =~ m|^(\s*[^)\n]+)(\))|s) { | |
| 916 ($done, $todo) = ($done . $1 . "PCLOSE", $'); | |
| 917 ($done, $todo) = &parse_sh($done, $todo) or return (undef, undef); | |
| 918 $todo =~ m|^\s*;;|s or return (undef, undef); | |
| 919 ($done, $todo) = ($done . $&, $'); | |
| 920 } | |
| 921 $todo =~ m|^\s*esac|s or return (undef, undef); | |
| 922 ($done, $todo) = ($done . $&, $'); | |
| 923 return ($done, $todo); | |
| 924 } | |
| 925 if ($file !~ m|openpkg\.spec$| and $todo eq '') { | |
| 926 &lint_warning($file, $outer_done, $outer_this, | |
| 927 "unable to correctly parse case/esac constructs in shell-script" . | |
| 928 " (sub-shell parenthesis check skipped)"); | |
| 929 } | |
| 930 else { | |
| 931 while ($todo =~ m/\)[ \t]*\n/s) { | |
| 932 $done .= $`; $this = $&; $todo = $'; | |
| 933 &lint_warning($file, $done, $this, "problematic sub-shell construct without error handling " . | |
| 934 "(use \"...) || exit \$?\" to make sure it correctly exits on nested failure)"); | |
| 935 $done .= $this; | |
| 936 } | |
| 937 } | |
| 938 } | |
| 939 } | |
| 940 | |
| 941 ## _________________________________________________________________ | |
| 942 ## | |
| 943 ## CHECK "global": globals | |
| 944 ## _________________________________________________________________ | |
| 945 ## | |
| 946 | |
| 947 sub check_global { | |
| 948 my ($file, $spec) = @_; | |
| 949 | |
| 950 # check for deprecated use of %{name} macro | |
| 951 my $done = ''; my $this = ''; my $todo = $spec; | |
| 952 while ($todo =~ m/\%\{name\}/s) { | |
| 953 $done .= $`; $this = $&; $todo = $'; | |
| 954 &lint_warning($file, $done, $this, "deprecated usage of %{name} macro (expected none)"); | |
| 955 $done .= $this; | |
| 956 } | |
| 957 | |
| 958 # FIXME: activate later | |
| 959 # check for over-long lines | |
| 960 #$done = ''; $this = ''; $todo = $spec; | |
| 961 #while ($todo =~ m/([^\n]{80,})\n/s) { | |
| 962 # $done .= $`; $this = $&; $todo = $'; | |
| 963 # &lint_warning($file, $done, $this, "over-long line with ".sprintf("%d", length($1))." characters " . | |
| 964 # "(expected maximum of 79 characters)"); | |
| 965 # $done .= $this; | |
| 966 #} | |
| 967 | |
| 968 # check for "shtool install" with -e on same line | |
| 969 my $done = ''; my $this = ''; my $todo = $spec; | |
| 970 while ($todo =~ m/%{l_shtool} install[^\n]*-e/s) { | |
| 971 $done .= $`; $this = $&; $todo = $'; | |
| 972 &lint_warning($file, $done, $this, "found -e option of \"shtool install\" on same line (expected separate lines)"); | |
| 973 $done .= $this; | |
| 974 } | |
| 975 | |
| 976 # check for "shtool install" with multiple -e on same line | |
| 977 my $done = ''; my $this = ''; my $todo = $spec; | |
| 978 while ($todo =~ m/%{l_shtool} install[^\n]+\\\n([^\n]*?-e[^\n]*?-e[^\n]*\\\n)+/s) { | |
| 979 $done .= $`; $this = $&; $todo = $'; | |
| 980 &lint_warning($file, $done, $this, "found multiple -e options of \"shtool install\" on same line (expected separate lines)"); | |
| 981 $done .= $this; | |
| 982 } | |
| 983 | |
| 984 # check for deprecated use of "shtool install|subst -e @l_...@ %{l_...}" | |
| 985 if ($file !~ m|openpkg-tool|) { | |
| 986 my $done = ''; my $this = ''; my $todo = $spec; | |
| 987 while ($todo =~ m/%{l_shtool} (install|subst)(?:\\\n|[^\n])*?-e(?:\\\n|[^\n])*?\@l_(prefix|[smrn](usr|grp|uid|gid))\@[^n]+%{l_\2}/s) { | |
| 988 $done .= $`; $this = $&; $todo = $'; | |
| 989 &lint_warning($file, $done, $this, "deprecated usage of \"shtool $1 -e \@l_$2\@\" (expected use of %{l_value -s -a})"); | |
| 990 $done .= $this; | |
| 991 } | |
| 992 } | |
| 993 | |
| 994 # check for constant "root" in %attr | |
| 995 my $done = ''; my $this = ''; my $todo = $spec; | |
| 996 while ($todo =~ m/%attr\(\s*(\d+)\s*,\s*root\s*,/s) { | |
| 997 $done .= $`; $this = $&; $todo = $'; | |
| 998 &lint_warning($file, $done, $this, "found constant \"root\" in %attr (expected variable %{l_susr})"); | |
| 999 $done .= $this; | |
| 1000 } | |
| 1001 | |
| 1002 # check for valid RPM macro usage | |
| 1003 if ($file !~ m|^(.+/)?openpkg\.spec$|s) { | |
| 1004 my $ok = `$rpm --eval '\%dump' 2>&1 | egrep "^-*[0-9][0-9]*: l_" | sed -e 's;^[^:]*: *\\(l_[a-zA-Z0-9_]*\\).*;\\1;' | sort -u`; | |
| 1005 my @ok = split(/\n/, $ok); | |
| 1006 my $todo = $spec; | |
| 1007 $todo =~ s|^([a-zA-Z][a-zA-Z0-9]+):\s+(.+)$|push(@ok, lc($1)), ''|mge; | |
| 1008 $todo =~ s/^\%(?:define|option)\s+(\S+)\s+.+$/push(@ok, $1), ''/mge; | |
| 1009 my $done = ''; my $this = ''; my $todo = $spec; | |
| 1010 while ($todo =~ m|\%\{([a-zA-Z][a-zA-Z0-9_]+)|s) { | |
| 1011 $done .= $`; $this = $&; $todo = $'; | |
| 1012 my $name = $1; | |
| 1013 next if ($name =~ m/^(SOURCE|PATCH)\d*$/ or $name =~ m/^(expand|echo|warn|error)$/); | |
| 1014 if (not grep(/^\Q$name\E$/, @ok)) { | |
| 1015 &lint_error($file, $done, $this, "unknown macro \"\%{$name}\""); | |
| 1016 } | |
| 1017 $done .= $this; | |
| 1018 } | |
| 1019 } | |
| 1020 } | |
| 1021 | |
| 1022 ## _________________________________________________________________ | |
| 1023 ## | |
| 1024 ## CHECK "sources": source file consistency | |
| 1025 ## _________________________________________________________________ | |
| 1026 ## | |
| 1027 | |
| 1028 sub check_sources { | |
| 1029 my ($file, $spec) = @_; | |
| 1030 | |
| 1031 ## | |
| 1032 ## PREPARATION | |
| 1033 ## | |
| 1034 | |
| 1035 my $D = {}; | |
| 1036 my $S = {}; | |
| 1037 my $i = 99; | |
| 1038 | |
| 1039 # determine defines values | |
| 1040 my $done = ''; my $this = ''; my $todo = $spec; | |
| 1041 while ($todo =~ m/^\%(define|option)\s+(\S+)\s+(.+)\s*$/m) { | |
| 1042 $done .= $`; $this = $&; $todo = $'; | |
| 1043 my ($var, $val) = ($2, $3); | |
| 1044 $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge; | |
| 1045 $D->{$var} = $val; | |
| 1046 $done .= $this; | |
| 1047 } | |
| 1048 $done = ''; $this = ''; $todo = $spec; | |
| 1049 while ($todo =~ m/^([a-zA-Z][a-zA-Z0-9_]+):\s+(.*)$/m) { | |
| 1050 $done .= $`; $this = $&; $todo = $'; | |
| 1051 my ($var, $val) = (lc($1), $2); | |
| 1052 $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge; | |
| 1053 $D->{$var} = $val; | |
| 1054 $done .= $this; | |
| 1055 } | |
| 1056 | |
| 1057 # expand define values (allow one level of nesting) | |
| 1058 $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge; | |
| 1059 $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge; | |
| 1060 | |
| 1061 # parse Source# and Patch# headers | |
| 1062 $done = ''; $this = ''; $todo = $spec; | |
| 1063 while ($todo =~ m/^(Source|Patch)(\d+):[ \t]*(.*?)$/m) { | |
| 1064 $done .= $`; $this = $&; $todo = $'; | |
| 1065 my ($type, $num, $file) = (lc($1), $2, $3); | |
| 1066 my $url = ""; | |
| 1067 if ($file =~ m|^(.+/)([^/]+)$|s) { | |
| 1068 ($url, $file) = ($1, $2); | |
| 1069 } | |
| 1070 if (not defined($S->{"$type$num"})) { | |
| 1071 $S->{"$type$num"} = { | |
| 1072 -type => $type, | |
| 1073 -num => $num, | |
| 1074 -url => $url, | |
| 1075 -file => $file, | |
| 1076 -refhdr => 1, | |
| 1077 -refcmd => 0, | |
| 1078 -refmac => 0, | |
| 1079 -refvar => 0, | |
| 1080 }; | |
| 1081 } | |
| 1082 else { | |
| 1083 $S->{"$type$num"}->{-refhdr}++; | |
| 1084 } | |
| 1085 $done .= $this; | |
| 1086 } | |
| 1087 | |
| 1088 # parse %setup and %patch commands | |
| 1089 $done = ''; $this = ''; $todo = $spec; | |
| 1090 $todo =~ s/^(\s*\%patch)((?:\s+-\S+|\s+-d\s+\S+)*)((?:\s+\d+)+)\s*$/&expand_patch($1, $2, $3)/mge; | |
| 1091 sub expand_patch { | |
| 1092 my ($cmd, $opts, $nums) = @_; | |
| 1093 my $cmds = ''; | |
| 1094 $cmds .= "${cmd}0${opts}\n" if ($opts !~ m|\s+-P|s); | |
| 1095 $opts =~ s|\s+-P||s; | |
| 1096 while ($nums =~ s|^\s+(\d+)||) { | |
| 1097 my $num = $1; | |
| 1098 $cmds .= "${cmd}${num}${opts}\n"; | |
| 1099 } | |
| 1100 return $cmds; | |
| 1101 } | |
| 1102 while ($todo =~ m/^\s*\%(setup|patch)(\d+)?(\s+.*)?$/m) { | |
| 1103 $done .= $`; $this = $&; $todo = $'; | |
| 1104 my ($type, $num, $opts) = ($1, $2, $3); | |
| 1105 $type = 'source' if ($type eq 'setup'); | |
| 1106 my $num_force = ''; | |
| 1107 if ($opts =~ m/\s-(?:a|b)\s*(\d+)/s) { | |
| 1108 $num_force = $1; | |
| 1109 } | |
| 1110 if ($num ne '' and $num_force ne '' and $num ne $num_force) { | |
| 1111 &lint_warning($file, $done, $this, "macro and enforced $type number conflict: $num <-> $num_force" . | |
| 1112 " (expected either just enforced number or make them match)"); | |
| 1113 } | |
| 1114 $num = $num_force if ($num_force ne ''); | |
| 1115 $num = 0 if ($num eq ''); | |
| 1116 next if ($opts =~ m|\s-T|s and $num == 0); | |
| 1117 if (not defined($S->{"$type$num"})) { | |
| 1118 $S->{"$type$num"} = { | |
| 1119 -type => $type, | |
| 1120 -num => $num, | |
| 1121 -url => "", | |
| 1122 -file => "", | |
| 1123 -refhdr => 0, | |
| 1124 -refcmd => 1, | |
| 1125 -refmac => 0, | |
| 1126 -refvar => 0, | |
| 1127 }; | |
| 1128 } | |
| 1129 else { | |
| 1130 $S->{"$type$num"}->{-refcmd}++; | |
| 1131 } | |
| 1132 $done .= $this; | |
| 1133 } | |
| 1134 | |
| 1135 # parse %{SOURCE#} and %{PATCH#} macros | |
| 1136 $done = ''; $this = ''; $todo = $spec; | |
| 1137 while ($todo =~ m/\%\{(SOURCE|PATCH)(\d+)\}/m) { | |
| 1138 $done .= $`; $this = $&; $todo = $'; | |
| 1139 my ($type, $num) = (lc($1), $2); | |
| 1140 if (not defined($S->{"$type$num"})) { | |
| 1141 $S->{"$type$num"} = { | |
| 1142 -type => $type, | |
| 1143 -num => $num, | |
| 1144 -url => "", | |
| 1145 -file => "", | |
| 1146 -refhdr => 0, | |
| 1147 -refcmd => 0, | |
| 1148 -refmac => 1, | |
| 1149 -refvar => 0, | |
| 1150 }; | |
| 1151 } | |
| 1152 else { | |
| 1153 $S->{"$type$num"}->{-refmac}++; | |
| 1154 } | |
| 1155 $done .= $this; | |
| 1156 } | |
| 1157 | |
| 1158 # parse %{SOURCE ...} and %{PATCH ...} macros | |
| 1159 $done = ''; $this = ''; $todo = $spec; | |
| 1160 while ($todo =~ m/\%\{(SOURCE|PATCH)\s+([^\s}]+)\}/m) { | |
| 1161 $done .= $`; $this = $&; $todo = $'; | |
| 1162 my ($type, $file) = (lc($1), $2); | |
| 1163 my $key = ""; | |
| 1164 foreach my $src (keys(%{$S})) { | |
| 1165 if ($S->{$src}->{-type} eq $type and $S->{$src}->{-file} eq $file) { | |
| 1166 $key = $src; | |
| 1167 } | |
| 1168 } | |
| 1169 if ($key eq '') { | |
| 1170 $S->{"$type$i"} = { | |
| 1171 -type => $type, | |
| 1172 -num => $i, | |
| 1173 -url => "", | |
| 1174 -file => $file, | |
| 1175 -refhdr => 0, | |
| 1176 -refcmd => 0, | |
| 1177 -refmac => 1, | |
| 1178 -refvar => 0, | |
| 1179 }; | |
| 1180 $i++; | |
| 1181 } | |
| 1182 else { | |
| 1183 $S->{$key}->{-refmac}++; | |
| 1184 } | |
| 1185 $done .= $this; | |
| 1186 } | |
| 1187 | |
| 1188 # parse $RPM_SOURCE_DIR based references | |
| 1189 $done = ''; $this = ''; $todo = $spec; | |
| 1190 while ($todo =~ m/\$RPM_SOURCE_DIR\/([^\s;"']+)/m) { | |
| 1191 $done .= $`; $this = $&; $todo = $'; | |
| 1192 my ($file) = ($1); | |
| 1193 my $key = ""; | |
| 1194 foreach my $src (keys(%{$S})) { | |
| 1195 if ($S->{$src}->{-file} eq $file) { | |
| 1196 $key = $src; | |
| 1197 } | |
| 1198 } | |
| 1199 if ($key eq '') { | |
| 1200 $S->{"source$i"} = { | |
| 1201 -type => "source", | |
| 1202 -num => $i, | |
| 1203 -url => "", | |
| 1204 -file => $file, | |
| 1205 -refhdr => 0, | |
| 1206 -refcmd => 0, | |
| 1207 -refmac => 0, | |
| 1208 -refvar => 1, | |
| 1209 }; | |
| 1210 $i++; | |
| 1211 } | |
| 1212 else { | |
| 1213 $S->{$key}->{-refmac}++; | |
| 1214 } | |
| 1215 $done .= $this; | |
| 1216 } | |
| 1217 | |
| 1218 ## | |
| 1219 ## CHECKING | |
| 1220 ## | |
| 1221 | |
| 1222 # check reference counts | |
| 1223 foreach my $src (%{$S}) { | |
| 1224 my $s = $S->{$src}; | |
| 1225 my $str_hdr = ($s->{-type} eq 'source' ? 'Source' : 'Patch' ) . $s->{-num}; | |
| 1226 my $str_cmd = ($s->{-type} eq 'source' ? '%setup' : '%patch') . $s->{-num}; | |
| 1227 my $str_mac = ($s->{-type} eq 'source' ? '%{SOURCE ...}' : '%{PATCH ...}'); | |
| 1228 my $str_var = "\$RPM_SOURCE_DIR"; | |
| 1229 if ($file !~ m/\b(openpkg-.*|openpkg|vim|ncurses|openssh)\.spec$/) { | |
| 1230 if ($s->{-refhdr} > 0) { | |
| 1231 if ($s->{-refcmd} == 0 and $s->{-refmac} == 0 and $s->{-refvar} == 0) { | |
| 1232 &lint_error($file, undef, undef, "source \"$str_hdr\" defined (file $s->{-file}), but never used" . | |
| 1233 " (expected at least one reference via \"$str_cmd\", \"$str_mac\" or \"$str_var\")"); | |
| 1234 } | |
| 1235 elsif ($s->{-refcmd} > 1) { | |
| 1236 &lint_error($file, undef, undef, "source \"$str_hdr\" defined (file $s->{-file}), but used multiple times" . | |
| 1237 " (expected just one reference via \"$str_cmd\")"); | |
| 1238 } | |
| 1239 } | |
| 1240 else { | |
| 1241 if ($s->{-refcmd}+$s->{-refmac}+$s->{-refvar} > 0) { | |
| 1242 &lint_error($file, undef, undef, "source \"$str_hdr\" not defined, but used ". | |
| 1243 ($s->{-file} ? "(file ".$s->{-file}.")" : ""). | |
| 1244 " (expected at least one definition via \"$str_hdr\")"); | |
| 1245 } | |
| 1246 } | |
| 1247 } | |
| 1248 } | |
| 1249 | |
| 1250 # check for existing of sources on filesystem | |
| 1251 my $name = $file; | |
| 1252 $name =~ s|.*/([^/]+)$|$1|s; | |
| 1253 $name =~ s|\.spec$||s; | |
| 1254 my $cvsdir = `$rpm --define 'name $name' --eval '%{_specdir}'`; | |
| 1255 $cvsdir =~ s|\n$||s; | |
| 1256 $cvsdir =~ s|/+$||s; | |
| 1257 my $dstdir = `$rpm --define 'name $name' --eval '%{_sourcedir}'`; | |
| 1258 $dstdir =~ s|\n$||s; | |
| 1259 $dstdir =~ s|/+$||s; | |
| 1260 foreach my $src (%{$S}) { | |
| 1261 my $s = $S->{$src}; | |
| 1262 next if (not $s->{-refhdr}); | |
| 1263 if ($s->{-url} eq '' and not -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) { | |
| 1264 &lint_error($file, undef, undef, "source \"$s->{-file}\" neither found in SRC nor DST locations (you have to provide it)"); | |
| 1265 } | |
| 1266 elsif ($s->{-url} eq '' and not -f $cvsdir."/".$s->{-file} and -f $dstdir."/".$s->{-file}) { | |
| 1267 &lint_error($file, undef, undef, "source \"$s->{-file}\" not found in SRC, but in DST (expected it in SRC or want URL)"); | |
| 1268 } | |
| 1269 elsif ($s->{-url} ne '' and not -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) { | |
| 1270 &lint_error($file, undef, undef, "source \"$s->{-file}\" neither found in SRC nor DST locations (you have to download it)"); | |
| 1271 } | |
| 1272 elsif ($s->{-url} ne '' and -f $cvsdir."/".$s->{-file} and not -f $dstdir."/".$s->{-file}) { | |
| 1273 &lint_error($file, undef, undef, "source \"$s->{-file}\" not found in DST, but in SRC (expected it in DST or want URL)"); | |
| 1274 } | |
| 1275 #if ($s->{-url} ne '' and $s->{-file} !~ m/\d/) { | |
| 1276 # &lint_warning($file, undef, undef, "vendor source \"$s->{-file}\" not versioned"); | |
| 1277 #} | |
| 1278 } | |
| 1279 | |
| 1280 # check for patch file naming | |
| 1281 foreach my $src (%{$S}) { | |
| 1282 my $s = $S->{$src}; | |
| 1283 next if (not $s->{-refhdr}); | |
| 1284 if ( $s->{-url} eq '' and $s->{-type} eq 'patch' | |
| 1285 and $s->{-file} !~ m|^${name}\.patch(\.[^./]+)?$|) { | |
| 1286 &lint_warning($file, undef, undef, "non-canonical patch filename \"$s->{-file}\"" . | |
| 1287 " (expected to match \"${name}\\.patch(\\.[^./]+)?\$\")"); | |
| 1288 } | |
| 1289 } | |
| 1290 } | |
| 1291 | |
| 1292 ## _________________________________________________________________ | |
| 1293 ## | |
| 1294 ## CHECK "digest": digest consistency | |
| 1295 ## _________________________________________________________________ | |
| 1296 ## | |
| 1297 | |
| 1298 sub check_digest { | |
| 1299 my ($file, $spec) = @_; | |
| 1300 | |
| 1301 ## | |
| 1302 ## PREPARATION | |
| 1303 ## | |
| 1304 | |
| 1305 my $D = {}; | |
| 1306 my $S = {}; | |
| 1307 | |
| 1308 # determine defines values | |
| 1309 my $done = ''; my $this = ''; my $todo = $spec; | |
| 1310 while ($todo =~ m/^\%(define|option)\s+(\S+)\s+(.+)\s*$/m) { | |
| 1311 $done .= $`; $this = $&; $todo = $'; | |
| 1312 my ($var, $val) = ($2, $3); | |
| 1313 $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge; | |
| 1314 $D->{$var} = $val; | |
| 1315 $done .= $this; | |
| 1316 } | |
| 1317 $done = ''; $this = ''; $todo = $spec; | |
| 1318 while ($todo =~ m/^([a-zA-Z][a-zA-Z0-9_]+):\s+(.*)$/m) { | |
| 1319 $done .= $`; $this = $&; $todo = $'; | |
| 1320 my ($var, $val) = (lc($1), $2); | |
| 1321 $val =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge; | |
| 1322 $D->{$var} = $val; | |
| 1323 $done .= $this; | |
| 1324 } | |
| 1325 | |
| 1326 # expand define values (allow one level of nesting) | |
| 1327 $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge; | |
| 1328 $spec =~ s|(\%\{([a-zA-Z_][a-zA-Z0-9_]*)\})|defined($D->{$2}) ? $D->{$2} : $1|sge; | |
| 1329 | |
| 1330 # determine locations | |
| 1331 my $name = $file; | |
| 1332 $name =~ s|.*/([^/]+)$|$1|s; | |
| 1333 $name =~ s|\.spec$||s; | |
| 1334 my $srcdir = `$rpm --define 'name $name' --eval '%{_specdir}'`; | |
| 1335 $srcdir =~ s|\n$||s; | |
| 1336 $srcdir =~ s|/+$||s; | |
| 1337 my $dstdir = `$rpm --define 'name $name' --eval '%{_sourcedir}'`; | |
| 1338 $dstdir =~ s|\n$||s; | |
| 1339 $dstdir =~ s|/+$||s; | |
| 1340 | |
| 1341 # parse Source# and Patch# headers | |
| 1342 $done = ''; $this = ''; $todo = $spec; | |
| 1343 while ($todo =~ m/^(Source|Patch)(\d+):[ \t]*(.*?)$/m) { | |
| 1344 $done .= $`; $this = $&; $todo = $'; | |
| 1345 my ($type, $num, $url) = (lc($1), $2, $3); | |
| 1346 my $file; | |
| 1347 if ($url =~ m|^.+/([^/]+)$|s) { | |
| 1348 $file = "$dstdir/$1"; | |
| 1349 } | |
| 1350 else { | |
| 1351 $file = "$srcdir/$url"; | |
| 1352 } | |
| 1353 if (not defined($S->{"$type$num"})) { | |
| 1354 $S->{"$type$num"} = { | |
| 1355 -type => $type, | |
| 1356 -num => $num, | |
| 1357 -url => $url, | |
| 1358 -file => $file | |
| 1359 }; | |
| 1360 } | |
| 1361 else { | |
| 1362 $S->{"$type$num"}->{-refhdr}++; | |
| 1363 } | |
| 1364 $done .= $this; | |
| 1365 } | |
| 1366 | |
| 1367 # parse BuildPreReq headers | |
| 1368 $done = ''; $this = ''; $todo = $spec; | |
| 1369 while ($todo =~ m/^BuildPreReq:[ \t]+digest\(sha1:\%\{(.+?)\}\)[ \t]+=[ \t]+([0-9a-fA-F]+)$/m) { | |
| 1370 $done .= $`; $this = $&; $todo = $'; | |
| 1371 my ($macro, $sha1) = ($1, $2); | |
| 1372 | |
| 1373 my $url = $S->{lc($macro)}->{-url}; | |
| 1374 my $filename = $S->{lc($macro)}->{-file}; | |
| 1375 my $basename = $filename; | |
| 1376 $basename =~ s/^.+\/([^\/]+)$/$1/s; | |
| 1377 | |
| 1378 my $sha1_real = `$openssl sha1 $filename 2>/dev/null`; | |
| 1379 $sha1_real =~ s/^SHA1\s*\(.+?\)\s*=\s*([0-9a-fA-F]+)\s*$/$1/s; | |
| 1380 | |
| 1381 if (lc($sha1) ne lc($sha1_real)) { | |
| 1382 &lint_error($file, undef, undef, "source \"$basename\" (\%{$macro}) has a digest(sha1) requirement of \"$sha1\" (expected \"$sha1_real\")"); | |
| 1383 } | |
| 1384 | |
| 1385 $done .= $this; | |
| 1386 } | |
| 1387 } | |
| 1388 |
