substitutedeps

   1 #!/usr/bin/perl -w
   2
   3 ################################################################
   4 #
   5 # Copyright (c) 1995-2014 SUSE Linux Products GmbH
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License version 2 or 3 as
   9 # published by the Free Software Foundation.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program (see the file COPYING); if not, write to the
  18 # Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
  20 #
  21 ################################################################
  22
  23 BEGIN {
  24   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
  25 }
  26
  27 use strict;
  28
  29 use Build;
  30
  31 sub expand {
  32   my ($config, $str) = @_;
  33   my @xspec;
  34   my %cf = %$config;
  35   $cf{'save_expanded'} = 1;
  36   Build::Rpm::parse(\%cf, [ "$str" ], \@xspec);
  37   return @xspec && ref($xspec[0]) ? $xspec[0]->[1] : '';
  38 }
  39
  40 my ($dist, $buildroot, $rpmdeps, $archs, $configdir, $release, $changelog);
  41
  42 $configdir = ($::ENV{'BUILD_DIR'} || '/usr/lib/build') . '/configs';
  43
  44 while (@ARGV)  {
  45   if ($ARGV[0] eq '--root') {
  46     shift @ARGV;
  47     $buildroot = shift @ARGV;
  48     next;
  49   }
  50   if ($ARGV[0] eq '--dist') {
  51     shift @ARGV;
  52     $dist = shift @ARGV;
  53     next;
  54   }
  55   if ($ARGV[0] eq '--archpath') {
  56     shift @ARGV;
  57     $archs = shift @ARGV;
  58     next;
  59   }
  60   if ($ARGV[0] eq '--configdir') {
  61     shift @ARGV;
  62     $configdir = shift @ARGV;
  63     next;
  64   }
  65   if ($ARGV[0] eq '--release') {
  66     shift @ARGV;
  67     $release = shift @ARGV;
  68     next;
  69   }
  70   if ($ARGV[0] eq '--changelog') {
  71     shift @ARGV;
  72     $changelog = shift @ARGV;
  73     next;
  74   }
  75   last;
  76 }
  77 die("Usage: substitutedeps --dist <dist> --archpath <archpath> [--configdir <configdir>] <specin> <specout>\n") unless @ARGV == 2;
  78 my $spec = $ARGV[0];
  79 my $specdir = $spec;
  80 $specdir =~ s/[^\/]*$//;
  81 $specdir = "./" if $specdir eq '';
  82
  83 my $newspec = $ARGV[1];
  84
  85 my $cf = Build::read_config_dist($dist, $archs, $configdir);
  86 $cf->{'warnings'} = 1;
  87
  88 #######################################################################
  89
  90 my $xspec = [];
  91 my $d = Build::parse($cf, $spec, $xspec) || {};
  92 my @sdeps = @{$d->{'deps'} || []};
  93 my @neg = map {substr($_, 1)} grep {/^-/} @{$d->{'deps'} || []};
  94 my %neg = map {$_ => 1} @neg;
  95 @sdeps = grep {!$neg{$_}} @sdeps;
  96 @sdeps = Build::do_subst($cf, @sdeps);
  97 @sdeps = grep {!$neg{$_}} @sdeps;
  98 my %sdeps = map {$_ => 1} @sdeps;
  99
 100 open(F, '>', $newspec) || die("$newspec: $!\n");
 101
 102 my $used;
 103 my $inchangelog = 0;
 104 my $mainpkg = '';
 105 my $pkg;
 106
 107 for my $line (@$xspec) {
 108   $used = 1;
 109   if (ref($line)) {
 110     if (!defined($line->[1])) {
 111       $used = 0;
 112       $line = $line->[0];
 113     } else {
 114       $line = $line->[1];
 115     }
 116   }
 117
 118   if ($inchangelog) {
 119     $inchangelog = 0 if $line =~ /^\s*%[^%]/;
 120     next if $inchangelog;
 121   }
 122   if ($changelog && ($line =~ /\s*\%changelog\b/)) {
 123     $inchangelog = 1;
 124     next;
 125   }
 126
 127   if ($line =~ /^Name\s*:\s*(\S+)/i) {
 128     $pkg = $mainpkg = $1 unless $mainpkg;
 129   }
 130   if ($line =~ /^\s*%package\s+(-n\s+)?(\S+)/) {
 131     if ($1) {
 132       $pkg = $2;
 133     } else {
 134       $pkg = "$mainpkg-$2";
 135     }
 136   }
 137
 138   if ($line =~ /^Release\s*:\s*(.*?)\s*$/i) {
 139     my $spec_rel = $1; # User-provided value
 140     my $oldl = $line;
 141     if (defined $release) {
 142       if (!($line =~ s/<RELEASE\d*>/$release/g)) {
 143         if ($line =~ /<(?:CI_CNT|B_CNT)>/) {
 144           # XXX: should pass ci_cnt/b_cnt instead
 145           if ($release =~ /(\d+)\.(\d+)$/) {
 146             my ($ci, $b) = ($1, $2);
 147             $line =~ s/<CI_CNT>/$ci/;
 148             $line =~ s/<B_CNT>/$b/;
 149           } elsif ($release =~ /(\d+)$/) {
 150             my $b = $1;
 151             $b = '0' if $line =~ s/<CI_CNT>/$b/;
 152             $line =~ s/<B_CNT>/$b/;
 153           }
 154         } else {
 155           # no special replacement rules in the line, simply replace
 156           $line =~ s/^(Release\s*:\s*).*/$1$release/i;
 157           $line =~ s/<SPEC_REL>/$spec_rel/g;
 158         }
 159       }
 160       $line =~ s/<SPEC_REL>//g; # no recursion please
 161     } else {
 162       # remove macros, as rpm doesn't like them
 163       $line =~ s/<RELEASE\d*>/0/;
 164       $line =~ s/<CI_CNT>/0/;
 165       $line =~ s/<B_CNT>/0/;
 166     }
 167
 168     if ($cf->{'releasesuffix'}) {
 169       my $suffix = $cf->{'releasesuffix'};
 170       if ($suffix =~ /^file:(.+)$/) {
 171         my $file = $1;
 172         if ($file =~ /\//s || $file =~ /^\./) {
 173           $suffix = "error:illegal release suffix";
 174         } else {
 175           if (open(RP, '<', "$specdir$file")) {
 176             $suffix = "error:no suffix in $file";
 177             for (<RP>) {
 178               chomp;
 179               s/^\s+//;
 180               s/\s+$//;
 181               $suffix = $_ if $_ && !/^#/;
 182             }
 183             close RP;
 184           } else {
 185             $suffix = "error:$file file does not exist";
 186           }
 187         }
 188       }
 189       if ($suffix =~ /^error:(.*)$/) {
 190         $suffix = $1;
 191         $suffix =~ s/^\s+//;
 192         $suffix =~ s/\s+$//;
 193         $suffix = "Error: $suffix";
 194       }
 195       $line =~ s/^(Release\s*:\s*.*?)\s*$/$1$suffix/i if $suffix;
 196     }
 197
 198     # this is to be compatible to legacy autobuild.
 199     # you can specify a releaseprg in the project configuration,
 200     # if your package contains this file it is executed and its
 201     # output is used as a release.
 202     # use only if you really must.
 203     if ($cf->{'releaseprg'} && -f "$specdir$cf->{'releaseprg'}") {
 204       my $newl = $line;
 205       $newl =~ s/^Release:\s*//;
 206       $oldl =~ s/^Release:\s*//;
 207       my $project = expand($cf, "%?_project") || 'BUILD_BASENAME';
 208       my $arch = expand($cf, "%?_target_cpu") || 'noarch';
 209       $::ENV{'BUILD_OLDRELEASE'} = $oldl;
 210       my @nl;
 211       my $interpreter = "/bin/bash";
 212       if (open(RP, '<', "$specdir$cf->{'releaseprg'}")) {
 213         @nl = <RP>;
 214         close RP;
 215         if (@nl && $nl[0] =~ /^#!\s*(\S*)/) {
 216           $interpreter = $1;
 217         }
 218       }
 219       if ($buildroot) {
 220         my $sd = $specdir;
 221         $sd =~ s/^\Q$buildroot\E//;
 222         open(RP, "-|", 'chroot', $buildroot, $interpreter, "$sd$cf->{'releaseprg'}", $project, $newl, $pkg, $arch) || die("$cf->{'releaseprg'}: $!\n");
 223       } else {
 224         open(RP, "-|", $interpreter, "$specdir$cf->{'releaseprg'}", $project, $newl, $pkg, $arch) || die("$cf->{'releaseprg'}: $!\n");
 225       }
 226       @nl = grep {$_ ne ''} <RP>;
 227       if (!close(RP)) {
 228         warn("$cf->{'releaseprg'} failed: $?\n");
 229       }
 230       # and another compatibility hack: if the prg returns pkg:<package>,
 231       # the release of the package will be used. yuck...
 232       if (@nl && $nl[0] =~ s/^pkg://) {
 233         my $relpkg = $nl[0];
 234         chomp $relpkg;
 235         if ($buildroot) {
 236           open(RP, "-|", 'chroot', $buildroot, 'rpm', '-q', '--qf', '%{RELEASE}', $relpkg) || die("rpm: $!\n");
 237         } else {
 238           open(RP, "-|", 'rpm', '-q', '--qf', '%{RELEASE}', $relpkg) || die("rpm: $!\n");
 239         }
 240         @nl = grep {$_ ne ''} <RP>;
 241         if (!close(RP)) {
 242           warn("rpm package query of '$relpkg' failed: $?\n");
 243         }
 244       }
 245       if ($nl[0]) {
 246         chomp $nl[0];
 247         $line =~ s/^(Release:\s*).*/$1$nl[0]/i;
 248         if (defined $release) {
 249           if (!($line =~ s/<RELEASE\d*>/$release/g)) {
 250             if ($line =~ /<(?:CI_CNT|B_CNT)>/) {
 251               # XXX: should pass ci_cnt/b_cnt instead
 252               if ($release =~ /(\d+)\.(\d+)$/) {
 253                 my ($ci, $b) = ($1, $2);
 254                 $line =~ s/<CI_CNT>/$ci/;
 255                 $line =~ s/<B_CNT>/$b/;
 256               } elsif ($release =~ /(\d+)$/) {
 257                 my $b = $1;
 258                 $line =~ s/<B_CNT>/$b/ unless $line =~ s/<CI_CNT>/$b/;
 259               }
 260             }
 261           }
 262         }
 263       }
 264     }
 265     # all compat stuff done. we return to your scheduled program
 266   }
 267
 268   if (!$used || ($line !~ /^(?:Build)?Requires:/i)) {
 269     print F "$line\n";
 270     next;
 271   }
 272   if ($line =~ /%\(/) {
 273     # too hard for us
 274     print F "$line\n";
 275     next;
 276   }
 277
 278   my $isbuildrequires = 0;
 279   $isbuildrequires = 1 if $line =~ /^BuildRequires:/i;
 280   my $r = $line;
 281   $r =~ s/^[^:]*:\s*//;
 282   my @deps = $r =~ /([^\s\[,]+)(\s+[<=>]+\s+[^\s\[,]+)?[\s,]*/g;
 283   my @ndeps = ();
 284   my $replace = 0;
 285   my @f2 = Build::do_subst_vers($cf, @deps);
 286   my %f2 = @f2;
 287   if ($isbuildrequires) {
 288     delete $f2{$_} for @neg;
 289     delete $f2{$_} for grep {/^-/} keys %f2;
 290   }
 291   while (@deps) {
 292     my ($pack, $vers) = splice(@deps, 0, 2);
 293     $vers = '' unless defined $vers;
 294     if (($isbuildrequires && $sdeps{$pack}) || exists($f2{$pack})) {
 295       push @ndeps, "$pack$vers";
 296       delete $f2{$pack};
 297     } else {
 298       $replace = 1;
 299     }
 300   }
 301   if (%f2) {
 302     while (@f2) {
 303       my ($pack, $vers) = splice(@f2, 0, 2);
 304       next unless exists $f2{$pack};
 305       $vers = '' unless defined $vers;
 306       push @ndeps, "$pack$vers";
 307     }
 308     $replace = 1
 309   }
 310   if ($replace) {
 311     $line =~ /^(.*?:\s*)/;
 312     print F $1.join(' ', @ndeps)."\n" if @ndeps;
 313   } else {
 314     print F "$line\n";
 315   }
 316 }
 317
 318 if ($changelog) {
 319   print F "%changelog\n";
 320   if (open(CF, '<', $changelog)) {
 321     while(<CF>) {
 322       print F $_;
 323     }
 324     close CF;
 325   }
 326 }
 327
 328 close(F) || die("close: $!\n");
 329
 330 exit(0);