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