Build.pm

   1 package Build;
   2
   3 use strict;
   4 use Digest::MD5;
   5 use Build::Rpm;
   6 use Data::Dumper;
   7
   8 our $expand_dbg;
   9
  10 our $do_rpm;
  11 our $do_deb;
  12 our $do_kiwi;
  13 our $do_arch;
  14
  15 sub import {
  16   for (@_) {
  17     $do_rpm = 1 if $_ eq ':rpm';
  18     $do_deb = 1 if $_ eq ':deb';
  19     $do_kiwi = 1 if $_ eq ':kiwi';
  20     $do_arch = 1 if $_ eq ':arch';
  21   }
  22   $do_rpm = $do_deb = $do_kiwi = $do_arch = 1 if !$do_rpm && !$do_deb && !$do_kiwi && !$do_arch;
  23   if ($do_deb) {
  24     require Build::Deb;
  25   }
  26   if ($do_kiwi) {
  27     require Build::Kiwi;
  28   }
  29   if ($do_arch) {
  30     require Build::Arch;
  31   }
  32 }
  33
  34 package Build::Features;
  35 our $preinstallimage = 1;       # on sale now
  36 package Build;
  37
  38 my $std_macros = q{
  39 %define nil
  40 %define ix86 i386 i486 i586 i686 athlon
  41 %define arm armv4l armv5l armv6l armv7l armv4b armv5l armv5b armv5el armv5eb armv5tel armv5teb armv6el armv6eb armv7el armv7eb armv7hl armv7nhl armv8el
  42 %define arml armv4l armv5l armv6l armv7l armv5tel armv5el armv6el armv7el armv7hl armv7nhl armv8el
  43 %define armb armv4b armv5b armv5teb armv5eb armv6eb armv7eb
  44 %define sparc sparc sparcv8 sparcv9 sparcv9v sparc64 sparc64v
  45 };
  46 my $extra_macros = '';
  47
  48 sub unify {
  49   my %h = map {$_ => 1} @_;
  50   return grep(delete($h{$_}), @_);
  51 }
  52
  53 sub define($)
  54 {
  55   my $def = shift;
  56   $extra_macros .= '%define '.$def."\n";
  57 }
  58
  59 sub init_helper_hashes {
  60   my ($config) = @_;
  61
  62   $config->{'preferh'} = { map {$_ => 1} @{$config->{'prefer'}} };
  63
  64   my %ignore;
  65   for (@{$config->{'ignore'}}) {
  66     if (!/:/) {
  67       $ignore{$_} = 1;
  68       next;
  69     }
  70     my @s = split(/[,:]/, $_);
  71     my $s = shift @s;
  72     $ignore{"$s:$_"} = 1 for @s;
  73   }
  74   $config->{'ignoreh'} = \%ignore;
  75
  76   my %conflicts;
  77   for (@{$config->{'conflict'}}) {
  78     my @s = split(/[,:]/, $_);
  79     my $s = shift @s;
  80     push @{$conflicts{$s}}, @s;
  81     push @{$conflicts{$_}}, $s for @s;
  82   }
  83   for (keys %conflicts) {
  84     $conflicts{$_} = [ unify(@{$conflicts{$_}}) ]
  85   }
  86   $config->{'conflicth'} = \%conflicts;
  87 }
  88
  89 # 'canonicalize' dist string as found in rpm dist tags
  90 sub dist_canon($$) {
  91   my ($rpmdist, $arch) = @_;
  92   $rpmdist = lc($rpmdist);
  93   $rpmdist =~ s/-/_/g;
  94   $rpmdist =~ s/opensuse/suse linux/;
  95   my $rpmdista;
  96   if ($rpmdist =~ /\(/) {
  97     $rpmdista = $rpmdist;
  98     $rpmdista =~ s/.*\(//;
  99     $rpmdista =~ s/\).*//;
 100   } else {
 101     $rpmdista = $arch;
 102   }
 103   $rpmdista =~ s/i[456]86/i386/;
 104   $rpmdist = '' unless $rpmdista =~ /^(i386|x86_64|ia64|ppc|ppc64|s390|s390x)$/;
 105   my $dist = 'default';
 106   if ($rpmdist =~ /unitedlinux 1\.0.*/) {
 107     $dist = "ul1-$rpmdista";
 108   } elsif ($rpmdist =~ /suse sles_(\d+)/) {
 109     $dist = "sles$1-$rpmdista";
 110   } elsif ($rpmdist =~ /suse linux enterprise (\d+)/) {
 111     $dist = "sles$1-$rpmdista";
 112   } elsif ($rpmdist =~ /suse linux (\d+)\.(\d+)\.[4-9]\d/) {
 113     # alpha version
 114     $dist = "$1.".($2 + 1)."-$rpmdista";
 115   } elsif ($rpmdist =~ /suse linux (\d+\.\d+)/) {
 116     $dist = "$1-$rpmdista";
 117   }
 118   return $dist;
 119 }
 120
 121 sub read_config_dist {
 122   my ($dist, $archpath, $configdir) = @_;
 123
 124   my $arch = $archpath;
 125   $arch = 'noarch' unless defined $arch;
 126   $arch =~ s/:.*//;
 127   $arch = 'noarch' if $arch eq '';
 128   die("Please specify a distribution!\n") unless defined $dist;
 129   if ($dist !~ /\//) {
 130     my $saved = $dist;
 131     $configdir = '.' unless defined $configdir;
 132     $dist =~ s/-.*//;
 133     $dist = "sl$dist" if $dist =~ /^\d/;
 134     $dist = "$configdir/$dist.conf";
 135     if (! -e $dist) {
 136       $dist =~ s/-.*//;
 137       $dist = "sl$dist" if $dist =~ /^\d/;
 138       $dist = "$configdir/$dist.conf";
 139     }
 140     if (! -e $dist) {
 141       warn "$saved.conf not found, using default.conf\n" unless $saved eq 'default';
 142       $dist = "$configdir/default.conf";
 143     }
 144   }
 145   die("$dist: $!\n") unless -e $dist;
 146   my $cf = read_config($arch, $dist);
 147   die("$dist: parse error\n") unless $cf;
 148   return $cf;
 149 }
 150
 151 sub read_config {
 152   my ($arch, $cfile) = @_;
 153   my @macros = split("\n", $std_macros.$extra_macros);
 154   push @macros, "%define _target_cpu $arch";
 155   push @macros, "%define _target_os linux";
 156   my $config = {'macros' => \@macros, 'arch' => $arch};
 157   my @config;
 158   if (ref($cfile)) {
 159     @config = @$cfile;
 160   } elsif (defined($cfile)) {
 161     local *CONF;
 162     return undef unless open(CONF, '<', $cfile);
 163     @config = <CONF>;
 164     close CONF;
 165     chomp @config;
 166   }
 167   # create verbatim macro blobs
 168   my @newconfig;
 169   while (@config) {
 170     push @newconfig, shift @config;
 171     next unless $newconfig[-1] =~ /^\s*macros:\s*$/si;
 172     $newconfig[-1] = "macros:\n";
 173     while (@config) {
 174       my $l = shift @config;
 175       last if $l =~ /^\s*:macros\s*$/si;
 176       $newconfig[-1] .= "$l\n";
 177     }
 178   }
 179   my @spec;
 180   $config->{'save_expanded'} = 1;
 181   Build::Rpm::parse($config, \@newconfig, \@spec);
 182   delete $config->{'save_expanded'};
 183   $config->{'preinstall'} = [];
 184   $config->{'vminstall'} = [];
 185   $config->{'cbpreinstall'} = [];
 186   $config->{'cbinstall'} = [];
 187   $config->{'runscripts'} = [];
 188   $config->{'required'} = [];
 189   $config->{'support'} = [];
 190   $config->{'keep'} = [];
 191   $config->{'prefer'} = [];
 192   $config->{'ignore'} = [];
 193   $config->{'conflict'} = [];
 194   $config->{'substitute'} = {};
 195   $config->{'substitute_vers'} = {};
 196   $config->{'optflags'} = {};
 197   $config->{'order'} = {};
 198   $config->{'exportfilter'} = {};
 199   $config->{'publishfilter'} = [];
 200   $config->{'rawmacros'} = '';
 201   $config->{'release'} = '<CI_CNT>.<B_CNT>';
 202   $config->{'repotype'} = [];
 203   $config->{'patterntype'} = [];
 204   $config->{'fileprovides'} = {};
 205   $config->{'constraint'} = [];
 206   for my $l (@spec) {
 207     $l = $l->[1] if ref $l;
 208     next unless defined $l;
 209     my @l = split(' ', $l);
 210     next unless @l;
 211     my $ll = shift @l;
 212     my $l0 = lc($ll);
 213     if ($l0 eq 'macros:') {
 214       $l =~ s/.*?\n//s;
 215       if ($l =~ /^!\n/s) {
 216         $config->{'rawmacros'} = substr($l, 2);
 217       } else {
 218         $config->{'rawmacros'} .= $l;
 219       }
 220       next;
 221     }
 222     if ($l0 eq 'preinstall:' || $l0 eq 'vminstall:' || $l0 eq 'cbpreinstall:' || $l0 eq 'cbinstall:' || $l0 eq 'required:' || $l0 eq 'support:' || $l0 eq 'keep:' || $l0 eq 'prefer:' || $l0 eq 'ignore:' || $l0 eq 'conflict:' || $l0 eq 'runscripts:') {
 223       my $t = substr($l0, 0, -1);
 224       for my $l (@l) {
 225         if ($l eq '!*') {
 226           $config->{$t} = [];
 227         } elsif ($l =~ /^!/) {
 228           $config->{$t} = [ grep {"!$_" ne $l} @{$config->{$t}} ];
 229         } else {
 230           push @{$config->{$t}}, $l;
 231         }
 232       }
 233     } elsif ($l0 eq 'substitute:') {
 234       next unless @l;
 235       $ll = shift @l;
 236       if ($ll eq '!*') {
 237         $config->{'substitute'} = {};
 238       } elsif ($ll =~ /^!(.*)$/) {
 239         delete $config->{'substitute'}->{$1};
 240       } else {
 241         $config->{'substitute'}->{$ll} = [ @l ];
 242       }
 243     } elsif ($l0 eq 'fileprovides:') {
 244       next unless @l;
 245       $ll = shift @l;
 246       if ($ll eq '!*') {
 247         $config->{'fileprovides'} = {};
 248       } elsif ($ll =~ /^!(.*)$/) {
 249         delete $config->{'fileprovides'}->{$1};
 250       } else {
 251         $config->{'fileprovides'}->{$ll} = [ @l ];
 252       }
 253     } elsif ($l0 eq 'exportfilter:') {
 254       next unless @l;
 255       $ll = shift @l;
 256       $config->{'exportfilter'}->{$ll} = [ @l ];
 257     } elsif ($l0 eq 'publishfilter:') {
 258       $config->{'publishfilter'} = [ @l ];
 259     } elsif ($l0 eq 'optflags:') {
 260       next unless @l;
 261       $ll = shift @l;
 262       $config->{'optflags'}->{$ll} = join(' ', @l);
 263     } elsif ($l0 eq 'order:') {
 264       for my $l (@l) {
 265         if ($l eq '!*') {
 266           $config->{'order'} = {};
 267         } elsif ($l =~ /^!(.*)$/) {
 268           delete $config->{'order'}->{$1};
 269         } else {
 270           $config->{'order'}->{$l} = 1;
 271         }
 272       }
 273     } elsif ($l0 eq 'repotype:') { #type of generated repository data
 274       $config->{'repotype'} = [ @l ];
 275     } elsif ($l0 eq 'type:') { #kind of packaging system (spec,dsc,arch,kiwi,...)
 276       $config->{'type'} = $l[0];
 277     } elsif ($l0 eq 'binarytype:') { #rpm,deb,arch,...
 278       $config->{'binarytype'} = $l[0];
 279     } elsif ($l0 eq 'patterntype:') { #kind of generated patterns in repository
 280       $config->{'patterntype'} = [ @l ];
 281     } elsif ($l0 eq 'release:') {
 282       $config->{'release'} = $l[0];
 283     } elsif ($l0 eq 'cicntstart:') {
 284       $config->{'cicntstart'} = $l[0];
 285     } elsif ($l0 eq 'releaseprg:') {
 286       $config->{'releaseprg'} = $l[0];
 287     } elsif ($l0 eq 'changetarget:' || $l0 eq 'target:') {
 288       $config->{'target'} = join(' ', @l);
 289       push @macros, "%define _target_cpu ".(split('-', $config->{'target'}))[0] if $config->{'target'};
 290     } elsif ($l0 eq 'hostarch:') {
 291       $config->{'hostarch'} = join(' ', @l);
 292     } elsif ($l0 eq 'constraint:') {
 293       my $l = join(' ', @l);
 294       if ($l eq '!*') {
 295         $config->{'constraint'} = [];
 296       } else {
 297         push @{$config->{'constraint'}}, $l;
 298       }
 299     } elsif ($l0 !~ /^[#%]/) {
 300       warn("unknown keyword in config: $l0\n");
 301     }
 302   }
 303   for my $l (qw{preinstall vminstall cbpreinstall cbinstall required support keep runscripts repotype patterntype}) {
 304     $config->{$l} = [ unify(@{$config->{$l}}) ];
 305   }
 306   for my $l (keys %{$config->{'substitute'}}) {
 307     $config->{'substitute_vers'}->{$l} = [ map {/^(.*?)(=)?$/g} unify(@{$config->{'substitute'}->{$l}}) ];
 308     $config->{'substitute'}->{$l} = [ unify(@{$config->{'substitute'}->{$l}}) ];
 309     s/=$// for @{$config->{'substitute'}->{$l}};
 310   }
 311   init_helper_hashes($config);
 312   if (!$config->{'type'}) {
 313     # Fallback to old guessing method if no type (spec, dsc or kiwi) is defined
 314     if (grep {$_ eq 'rpm'} @{$config->{'preinstall'} || []}) {
 315       $config->{'type'} = 'spec';
 316     } elsif (grep {$_ eq 'debianutils'} @{$config->{'preinstall'} || []}) {
 317       $config->{'type'} = 'dsc';
 318     } elsif (grep {$_ eq 'pacman'} @{$config->{'preinstall'} || []}) {
 319       $config->{'type'} = 'arch';
 320     } else {
 321       $config->{'type'} = 'UNDEFINED';
 322     }
 323   }
 324   if (!$config->{'binarytype'}) {
 325     $config->{'binarytype'} = 'rpm' if $config->{'type'} eq 'spec' || $config->{'type'} eq 'kiwi';
 326     $config->{'binarytype'} = 'deb' if $config->{'type'} eq 'dsc';
 327     $config->{'binarytype'} = 'arch' if $config->{'type'} eq 'arch';
 328     $config->{'binarytype'} ||= 'UNDEFINED';
 329   }
 330   # add rawmacros to our macro list
 331   if ($config->{'rawmacros'} ne '') {
 332     for my $rm (split("\n", $config->{'rawmacros'})) {
 333       if (@macros && $macros[-1] =~ /\\$/) {
 334         if ($rm =~ /\\$/) {
 335           push @macros, '...\\';
 336         } else {
 337           push @macros, '...';
 338         }
 339       } elsif ($rm !~ /^%/) {
 340         push @macros, $rm;
 341       } else {
 342         push @macros, "%define ".substr($rm, 1);
 343       }
 344     }
 345   }
 346   return $config;
 347 }
 348
 349 sub do_subst {
 350   my ($config, @deps) = @_;
 351   my @res;
 352   my %done;
 353   my $subst = $config->{'substitute'};
 354   while (@deps) {
 355     my $d = shift @deps;
 356     next if $done{$d};
 357     my $ds = $d;
 358     $ds =~ s/\s*[<=>].*$//s;
 359     if ($subst->{$ds}) {
 360       unshift @deps, @{$subst->{$ds}};
 361       push @res, $d if grep {$_ eq $ds} @{$subst->{$ds}};
 362     } else {
 363       push @res, $d;
 364     }
 365     $done{$d} = 1;
 366   }
 367   return @res;
 368 }
 369
 370 sub do_subst_vers {
 371   my ($config, @deps) = @_;
 372   my @res;
 373   my %done;
 374   my $subst = $config->{'substitute_vers'};
 375   while (@deps) {
 376     my ($d, $dv) = splice(@deps, 0, 2);
 377     next if $done{$d};
 378     if ($subst->{$d}) {
 379       unshift @deps, map {defined($_) && $_ eq '=' ? $dv : $_} @{$subst->{$d}};
 380       push @res, $d, $dv if grep {defined($_) && $_ eq $d} @{$subst->{$d}};
 381     } else {
 382       push @res, $d, $dv;
 383     }
 384     $done{$d} = 1;
 385   }
 386   return @res;
 387 }
 388
 389 # Delivers all packages which get used for building
 390 sub get_build {
 391   my ($config, $subpacks, @deps) = @_;
 392   my @ndeps = grep {/^-/} @deps;
 393   my @support = @{$config->{'support'}};
 394   if (@{$config->{'keep'} || []}) {
 395     my %keep = map {$_ => 1} (@deps, @{$config->{'keep'} || []}, @{$config->{'preinstall'}});
 396     for (@{$subpacks || []}) {
 397       push @ndeps, "-$_" unless $keep{$_};
 398     }
 399   } else {
 400     # new "empty keep" mode, filter subpacks from support
 401     my %subpacks = map {$_ => 1} @{$subpacks || []};
 402     @support = grep {!$subpacks{$_}} @support;
 403   }
 404   my %ndeps = map {$_ => 1} @ndeps;
 405   @deps = grep {!$ndeps{$_}} @deps;
 406   push @deps, @{$config->{'preinstall'}};
 407   push @deps, @{$config->{'required'}};
 408   push @deps, @support;
 409   @deps = grep {!$ndeps{"-$_"}} @deps;
 410   @deps = do_subst($config, @deps);
 411   @deps = grep {!$ndeps{"-$_"}} @deps;
 412   @deps = expand($config, @deps, @ndeps);
 413   return @deps;
 414 }
 415
 416 # Delivers all packages which shall have an influence to other package builds (get_build reduced by support packages)
 417 sub get_deps {
 418   my ($config, $subpacks, @deps) = @_;
 419   my @ndeps = grep {/^-/} @deps;
 420   my %keep = map {$_ => 1} (@deps, @{$config->{'keep'} || []}, @{$config->{'preinstall'}});
 421   %keep = () unless @{$config->{'keep'} || []};
 422   for (@{$subpacks || []}) {
 423     push @ndeps, "-$_" unless $keep{$_};
 424   }
 425   my %ndeps = map {$_ => 1} @ndeps;
 426   @deps = grep {!$ndeps{$_}} @deps;
 427   push @deps, @{$config->{'required'}};
 428   @deps = grep {!$ndeps{"-$_"}} @deps;
 429   @deps = do_subst($config, @deps);
 430   @deps = grep {!$ndeps{"-$_"}} @deps;
 431   my %bdeps = map {$_ => 1} (@{$config->{'preinstall'}}, @{$config->{'support'}});
 432   delete $bdeps{$_} for @deps;
 433   @deps = expand($config, @deps, @ndeps);
 434   if (@deps && $deps[0]) {
 435     my $r = shift @deps;
 436     @deps = grep {!$bdeps{$_}} @deps;
 437     unshift @deps, $r;
 438   }
 439   return @deps;
 440 }
 441
 442 sub get_preinstalls {
 443   my ($config) = @_;
 444   return @{$config->{'preinstall'}};
 445 }
 446
 447 sub get_vminstalls {
 448   my ($config) = @_;
 449   return @{$config->{'vminstall'}};
 450 }
 451
 452 sub get_cbpreinstalls {
 453   my ($config) = @_;
 454   return @{$config->{'cbpreinstall'}};
 455 }
 456
 457 sub get_cbinstalls {
 458   my ($config) = @_;
 459   return @{$config->{'cbinstall'}};
 460 }
 461
 462 sub get_runscripts {
 463   my ($config) = @_;
 464   return @{$config->{'runscripts'}};
 465 }
 466
 467 ###########################################################################
 468
 469 sub readdeps {
 470   my ($config, $pkginfo, @depfiles) = @_;
 471
 472   my %requires = ();
 473   local *F;
 474   my %provides;
 475   my $dofileprovides = %{$config->{'fileprovides'}};
 476   for my $depfile (@depfiles) {
 477     if (ref($depfile) eq 'HASH') {
 478       for my $rr (keys %$depfile) {
 479         $provides{$rr} = $depfile->{$rr}->{'provides'};
 480         $requires{$rr} = $depfile->{$rr}->{'requires'};
 481       }
 482       next;
 483     }
 484     # XXX: we don't support different architectures per file
 485     open(F, "<$depfile") || die("$depfile: $!\n");
 486     while(<F>) {
 487       my @s = split(' ', $_);
 488       my $s = shift @s;
 489       my @ss;
 490       while (@s) {
 491         if (!$dofileprovides && $s[0] =~ /^\//) {
 492           shift @s;
 493           next;
 494         }
 495         if ($s[0] =~ /^rpmlib\(/) {
 496             splice(@s, 0, 3);
 497             next;
 498         }
 499         push @ss, shift @s;
 500         while (@s) {
 501           if ($s[0] =~ /^[\(<=>|]/) {
 502             $ss[-1] .= " $s[0] $s[1]";
 503             $ss[-1] =~ s/ \((.*)\)/ $1/;
 504             $ss[-1] =~ s/(<|>){2}/$1/;
 505             splice(@s, 0, 2);
 506           } else {
 507             last;
 508           }
 509         }
 510       }
 511       my %ss;
 512       @ss = grep {!$ss{$_}++} @ss;
 513       if ($s =~ /^(P|R):(.*)\.(.*)-\d+\/\d+\/\d+:$/) {
 514         my $pkgid = $2;
 515         my $arch = $3;
 516         if ($1 eq "R") {
 517           $requires{$pkgid} = \@ss;
 518           $pkginfo->{$pkgid}->{'requires'} = \@ss if $pkginfo;
 519           next;
 520         }
 521         # handle provides
 522         $provides{$pkgid} = \@ss;
 523         if ($pkginfo) {
 524           # extract ver and rel from self provides
 525           my ($v, $r) = map { /\Q$pkgid\E = ([^-]+)(?:-(.+))?$/ } @ss;
 526           die("$pkgid: no self provides\n") unless $v;
 527           $pkginfo->{$pkgid}->{'name'} = $pkgid;
 528           $pkginfo->{$pkgid}->{'version'} = $v;
 529           $pkginfo->{$pkgid}->{'release'} = $r if defined($r);
 530           $pkginfo->{$pkgid}->{'arch'} = $arch;
 531           $pkginfo->{$pkgid}->{'provides'} = \@ss;
 532         }
 533       }
 534     }
 535     close F;
 536   }
 537   $config->{'providesh'} = \%provides;
 538   $config->{'requiresh'} = \%requires;
 539   makewhatprovidesh($config);
 540 }
 541
 542 sub makewhatprovidesh {
 543   my ($config) = @_;
 544
 545   my %whatprovides;
 546   my $provides = $config->{'providesh'};
 547
 548   for my $p (keys %$provides) {
 549     my @pp = @{$provides->{$p}};
 550     s/[ <=>].*// for @pp;
 551     push @{$whatprovides{$_}}, $p for unify(@pp);
 552   }
 553   for my $p (keys %{$config->{'fileprovides'}}) {
 554     my @pp = map {@{$whatprovides{$_} || []}} @{$config->{'fileprovides'}->{$p}};
 555     @{$whatprovides{$p}} = unify(@{$whatprovides{$p} || []}, @pp) if @pp;
 556   }
 557   $config->{'whatprovidesh'} = \%whatprovides;
 558 }
 559
 560 sub setdeps {
 561   my ($config, $provides, $whatprovides, $requires) = @_;
 562   $config->{'providesh'} = $provides;
 563   $config->{'whatprovidesh'} = $whatprovides;
 564   $config->{'requiresh'} = $requires;
 565 }
 566
 567 sub forgetdeps {
 568   my ($config) = @_;
 569   delete $config->{'providesh'};
 570   delete $config->{'whatprovidesh'};
 571   delete $config->{'requiresh'};
 572 }
 573
 574 my %addproviders_fm = (
 575   '>'  => 1,
 576   '='  => 2,
 577   '>=' => 3,
 578   '<'  => 4,
 579   '<=' => 6,
 580 );
 581
 582 sub addproviders {
 583   my ($config, $r) = @_;
 584
 585   my @p;
 586   my $whatprovides = $config->{'whatprovidesh'};
 587   $whatprovides->{$r} = \@p;
 588   if ($r =~ /\|/) {
 589     for my $or (split(/\s*\|\s*/, $r)) {
 590       push @p, @{$whatprovides->{$or} || addproviders($config, $or)};
 591     }
 592     @p = unify(@p) if @p > 1;
 593     return \@p;
 594   }
 595   return \@p if $r !~ /^(.*?)\s*([<=>]{1,2})\s*(.*?)$/;
 596   my $rn = $1;
 597   my $rv = $3;
 598   my $rf = $addproviders_fm{$2};
 599   return \@p unless $rf;
 600   my $provides = $config->{'providesh'};
 601   my @rp = @{$whatprovides->{$rn} || []};
 602   for my $rp (@rp) {
 603     for my $pp (@{$provides->{$rp} || []}) {
 604       if ($pp eq $rn) {
 605         # debian: unversioned provides do not match
 606         # kiwi: supports only rpm, so we need to hand it like it
 607         next if $config->{'binarytype'} eq 'deb';
 608         push @p, $rp;
 609         last;
 610       }
 611       next unless $pp =~ /^\Q$rn\E\s*([<=>]{1,2})\s*(.*?)$/;
 612       my $pv = $2;
 613       my $pf = $addproviders_fm{$1};
 614       next unless $pf;
 615       if ($pf & $rf & 5) {
 616         push @p, $rp;
 617         last;
 618       }
 619       if ($pv eq $rv) {
 620         next unless $pf & $rf & 2;
 621         push @p, $rp;
 622         last;
 623       }
 624       my $rr = $rf == 2 ? $pf : ($rf ^ 5);
 625       $rr &= 5 unless $pf & 2;
 626       # verscmp for spec and kiwi types
 627       my $vv;
 628       if ($config->{'binarytype'} eq 'deb') {
 629         $vv = Build::Deb::verscmp($pv, $rv, 1);
 630       } else {
 631         $vv = Build::Rpm::verscmp($pv, $rv, 1);
 632       }
 633       if ($rr & (1 << ($vv + 1))) {
 634         push @p, $rp;
 635         last;
 636       }
 637     }
 638   }
 639   @p = unify(@p) if @p > 1;
 640   return \@p;
 641 }
 642
 643 sub expand {
 644   my ($config, @p) = @_;
 645
 646   my $conflicts = $config->{'conflicth'};
 647   my $prefer = $config->{'preferh'};
 648   my $ignore = $config->{'ignoreh'};
 649
 650   my $whatprovides = $config->{'whatprovidesh'};
 651   my $requires = $config->{'requiresh'};
 652
 653   my %xignore = map {substr($_, 1) => 1} grep {/^-/} @p;
 654   @p = grep {!/^-/} @p;
 655
 656   my %p;                # expanded packages
 657   my %aconflicts;       # packages we are conflicting with
 658
 659   # add direct dependency packages. this is different from below,
 660   # because we add packages even if to dep is already provided and
 661   # we break ambiguities if the name is an exact match.
 662   for my $p (splice @p) {
 663     my @q = @{$whatprovides->{$p} || addproviders($config, $p)};
 664     if (@q > 1) {
 665       my $pn = $p;
 666       $pn =~ s/ .*//;
 667       @q = grep {$_ eq $pn} @q;
 668     }
 669     if (@q != 1) {
 670       push @p, $p;
 671       next;
 672     }
 673     print "added $q[0] because of $p (direct dep)\n" if $expand_dbg;
 674     push @p, $q[0];
 675     $p{$q[0]} = 1;
 676     $aconflicts{$_} = 1 for @{$conflicts->{$q[0]} || []};
 677   }
 678
 679   my @pamb = ();
 680   my $doamb = 0;
 681   while (@p) {
 682     my @error = ();
 683     my @rerror = ();
 684     for my $p (splice @p) {
 685       for my $r (@{$requires->{$p} || [$p]}) {
 686         my $ri = (split(/[ <=>]/, $r, 2))[0];
 687         next if $ignore->{"$p:$ri"} || $xignore{"$p:$ri"};
 688         next if $ignore->{$ri} || $xignore{$ri};
 689         my @q = @{$whatprovides->{$r} || addproviders($config, $r)};
 690         next if grep {$p{$_}} @q;
 691         next if grep {$xignore{$_}} @q;
 692         next if grep {$ignore->{"$p:$_"} || $xignore{"$p:$_"}} @q;
 693         @q = grep {!$aconflicts{$_}} @q;
 694         if (!@q) {
 695           if ($r eq $p) {
 696             push @rerror, "nothing provides $r";
 697           } else {
 698             next if $r =~ /^\//;
 699             push @rerror, "nothing provides $r needed by $p";
 700           }
 701           next;
 702         }
 703         if (@q > 1 && !$doamb) {
 704           push @pamb, $p unless @pamb && $pamb[-1] eq $p;
 705           print "undecided about $p:$r: @q\n" if $expand_dbg;
 706           next;
 707         }
 708         if (@q > 1) {
 709           my @pq = grep {!$prefer->{"-$_"} && !$prefer->{"-$p:$_"}} @q;
 710           @q = @pq if @pq;
 711           @pq = grep {$prefer->{$_} || $prefer->{"$p:$_"}} @q;
 712           if (@pq > 1) {
 713             my %pq = map {$_ => 1} @pq;
 714             @q = (grep {$pq{$_}} @{$config->{'prefer'}})[0];
 715           } elsif (@pq == 1) {
 716             @q = @pq;
 717           }
 718         }
 719         if (@q > 1 && $r =~ /\|/) {
 720             # choice op, implicit prefer of first match...
 721             my %pq = map {$_ => 1} @q;
 722             for my $rr (split(/\s*\|\s*/, $r)) {
 723                 next unless $whatprovides->{$rr};
 724                 my @pq = grep {$pq{$_}} @{$whatprovides->{$rr}};
 725                 next unless @pq;
 726                 @q = @pq;
 727                 last;
 728             }
 729         }
 730         if (@q > 1) {
 731           if ($r ne $p) {
 732             push @error, "have choice for $r needed by $p: @q";
 733           } else {
 734             push @error, "have choice for $r: @q";
 735           }
 736           push @pamb, $p unless @pamb && $pamb[-1] eq $p;
 737           next;
 738         }
 739         push @p, $q[0];
 740         print "added $q[0] because of $p:$r\n" if $expand_dbg;
 741         $p{$q[0]} = 1;
 742         $aconflicts{$_} = 1 for @{$conflicts->{$q[0]} || []};
 743         @error = ();
 744         $doamb = 0;
 745       }
 746     }
 747     return undef, @rerror if @rerror;
 748     next if @p;         # still work to do
 749
 750     # only ambig stuff left
 751     if (@pamb && !$doamb) {
 752       @p = @pamb;
 753       @pamb = ();
 754       $doamb = 1;
 755       print "now doing undecided dependencies\n" if $expand_dbg;
 756       next;
 757     }
 758     return undef, @error if @error;
 759   }
 760   return 1, (sort keys %p);
 761 }
 762
 763 sub order {
 764   my ($config, @p) = @_;
 765
 766   my $requires = $config->{'requiresh'};
 767   my $whatprovides = $config->{'whatprovidesh'};
 768   my %deps;
 769   my %rdeps;
 770   my %needed;
 771   my %p = map {$_ => 1} @p;
 772   for my $p (@p) {
 773     my @r;
 774     for my $r (@{$requires->{$p} || []}) {
 775       my @q = @{$whatprovides->{$r} || addproviders($config, $r)};
 776       push @r, grep {$_ ne $p && $p{$_}} @q;
 777     }
 778     if (%{$config->{'order'} || {}}) {
 779       push @r, grep {$_ ne $p && $config->{'order'}->{"$_:$p"}} @p;
 780     }
 781     @r = unify(@r);
 782     $deps{$p} = \@r;
 783     $needed{$p} = @r;
 784     push @{$rdeps{$_}}, $p for @r;
 785   }
 786   @p = sort {$needed{$a} <=> $needed{$b} || $a cmp $b} @p;
 787   my @good;
 788   my @res;
 789   # the big sort loop
 790   while (@p) {
 791     @good = grep {$needed{$_} == 0} @p;
 792     if (@good) {
 793       @p = grep {$needed{$_}} @p;
 794       push @res, @good;
 795       for my $p (@good) {
 796         $needed{$_}-- for @{$rdeps{$p}};
 797       }
 798       next;
 799     }
 800     # uh oh, cycle alert. find and remove all cycles.
 801     my %notdone = map {$_ => 1} @p;
 802     $notdone{$_} = 0 for @res;  # already did those
 803     my @todo = @p;
 804     while (@todo) {
 805       my $v = shift @todo;
 806       if (ref($v)) {
 807         $notdone{$$v} = 0;      # finished this one
 808         next;
 809       }
 810       my $s = $notdone{$v};
 811       next unless $s;
 812       my @e = grep {$notdone{$_}} @{$deps{$v}};
 813       if (!@e) {
 814         $notdone{$v} = 0;       # all deps done, mark as finished
 815         next;
 816       }
 817       if ($s == 1) {
 818         $notdone{$v} = 2;       # now under investigation
 819         unshift @todo, @e, \$v;
 820         next;
 821       }
 822       # reached visited package, found a cycle!
 823       my @cyc = ();
 824       my $cycv = $v;
 825       # go back till $v is reached again
 826       while(1) {
 827         die unless @todo;
 828         $v = shift @todo;
 829         next unless ref($v);
 830         $v = $$v;
 831         $notdone{$v} = 1 if $notdone{$v} == 2;
 832         unshift @cyc, $v;
 833         last if $v eq $cycv;
 834       }
 835       unshift @todo, $cycv;
 836       print STDERR "cycle: ".join(' -> ', @cyc)."\n";
 837       my $breakv;
 838       my @breakv = (@cyc, $cyc[0]);
 839       while (@breakv > 1) {
 840         last if $config->{'order'}->{"$breakv[0]:$breakv[1]"};
 841         shift @breakv;
 842       }
 843       if (@breakv > 1) {
 844         $breakv = $breakv[0];
 845       } else {
 846         $breakv = (sort {$needed{$a} <=> $needed{$b} || $a cmp $b} @cyc)[-1];
 847       }
 848       push @cyc, $cyc[0];       # make it loop
 849       shift @cyc while $cyc[0] ne $breakv;
 850       $v = $cyc[1];
 851       print STDERR "  breaking dependency $breakv -> $v\n";
 852       $deps{$breakv} = [ grep {$_ ne $v} @{$deps{$breakv}} ];
 853       $rdeps{$v} = [ grep {$_ ne $breakv} @{$rdeps{$v}} ];
 854       $needed{$breakv}--;
 855     }
 856   }
 857   return @res;
 858 }
 859
 860 sub add_all_providers {
 861   my ($config, @p) = @_;
 862   my $whatprovides = $config->{'whatprovidesh'};
 863   my $requires = $config->{'requiresh'};
 864   my %a;
 865   for my $p (@p) {
 866     for my $r (@{$requires->{$p} || [$p]}) {
 867       my $rn = (split(' ', $r, 2))[0];
 868       $a{$_} = 1 for @{$whatprovides->{$rn} || []};
 869     }
 870   }
 871   push @p, keys %a;
 872   return unify(@p);
 873 }
 874
 875 ###########################################################################
 876
 877 sub show {
 878   my ($conffile, $fn, $field, $arch) = @ARGV;
 879   my $cf = read_config($arch, $conffile);
 880   die unless $cf;
 881   my $d = Build::parse($cf, $fn);
 882   die("$d->{'error'}\n") if $d->{'error'};
 883   $d->{'sources'} = [ map {ref($d->{$_}) ? @{$d->{$_}} : $d->{$_}} grep {/^source/} sort keys %$d ];
 884   my $x = $d->{$field};
 885   $x = [ $x ] unless ref $x;
 886   print "$_\n" for @$x;
 887 }
 888
 889 sub parse_preinstallimage {
 890   return undef unless $do_rpm;
 891   my $d = Build::Rpm::parse(@_);
 892   $d->{'name'} ||= 'preinstallimage';
 893   return $d;
 894 }
 895
 896 sub parse {
 897   my ($cf, $fn, @args) = @_;
 898   return Build::Rpm::parse($cf, $fn, @args) if $do_rpm && $fn =~ /\.spec$/;
 899   return Build::Deb::parse($cf, $fn, @args) if $do_deb && $fn =~ /\.dsc$/;
 900   return Build::Kiwi::parse($cf, $fn, @args) if $do_kiwi && $fn =~ /config\.xml$/;
 901   return Build::Kiwi::parse($cf, $fn, @args) if $do_kiwi && $fn =~ /\.kiwi$/;
 902   return Build::Arch::parse($cf, $fn, @args) if $do_arch && $fn =~ /(^|\/|-)PKGBUILD$/;
 903   return parse_preinstallimage($cf, $fn, @args) if $fn =~ /(^|\/|-)_preinstallimage$/;
 904   return undef;
 905 }
 906
 907 sub query {
 908   my ($binname, %opts) = @_;
 909   my $handle = $binname;
 910   if (ref($binname) eq 'ARRAY') {
 911     $handle = $binname->[1];
 912     $binname = $binname->[0];
 913   }
 914   return Build::Rpm::query($handle, %opts) if $do_rpm && $binname =~ /\.rpm$/;
 915   return Build::Deb::query($handle, %opts) if $do_deb && $binname =~ /\.deb$/;
 916   return Build::Kiwi::queryiso($handle, %opts) if $do_kiwi && $binname =~ /\.iso$/;
 917   return Build::Arch::query($handle, %opts) if $do_arch && $binname =~ /\.pkg\.tar(?:\.gz|\.xz)?$/;
 918   return Build::Arch::query($handle, %opts) if $do_arch && $binname =~ /\.arch$/;
 919   return undef;
 920 }
 921
 922 sub queryhdrmd5 {
 923   my ($binname) = @_;
 924   return Build::Rpm::queryhdrmd5(@_) if $do_rpm && $binname =~ /\.rpm$/;
 925   return Build::Deb::queryhdrmd5(@_) if $do_deb && $binname =~ /\.deb$/;
 926   return Build::Kiwi::queryhdrmd5(@_) if $do_kiwi && $binname =~ /\.iso$/;
 927   return Build::Kiwi::queryhdrmd5(@_) if $do_kiwi && $binname =~ /\.raw$/;
 928   return Build::Kiwi::queryhdrmd5(@_) if $do_kiwi && $binname =~ /\.raw.install$/;
 929   return Build::Arch::queryhdrmd5(@_) if $do_arch && $binname =~ /\.pkg\.tar(?:\.gz|\.xz)?$/;
 930   return Build::Arch::queryhdrmd5(@_) if $do_arch && $binname =~ /\.arch$/;
 931   return undef;
 932 }
 933
 934 1;