openpkg/build.pl@a2c6460cfb16
openpkg/build.pl
Mon, 28 Jan 2013 17:37:18 +0100
- author
- Michael Schloh von Bennewitz <michael@schloh.com>
- date
- Mon, 28 Jan 2013 17:37:18 +0100
- changeset 758
- a2c6460cfb16
- permissions
- -rw-r--r--
Correct socket error reporting improvement with IPv6 portable code,
after helpful recommendation by Saúl Ibarra Corretgé on OSips devlist.
1 ##
2 ## build.pl -- OpenPKG Package Building and Installing
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 ##
24 #############################################################################
25 ##
26 ## MAIN PROCEDURE
27 ##
28 #############################################################################
30 require 5;
31 #use strict;
32 my (
33 $opt_h,
34 $opt_R, $opt_r, $opt_f, $opt_u, $opt_U, $opt_a, $opt_A,
35 $opt_z, $opt_Z, $opt_P, $opt_N, $opt_E, $opt_H, $opt_i,
36 $opt_D, $opt_p, $opt_q, $opt_s, $opt_S, $opt_X, $opt_M,
37 $opt_L, $opt_W, $opt_K, $opt_e, $opt_b, $opt_B, $opt_g,
38 $opt_k
39 );
41 # global context variables
42 my $prg = "openpkg build";
43 my %env = ('' => {});
45 ##
46 ## OPTION PARSING
47 ##
49 # parse command line options
50 my $getopts = 'hR:r:f:uUaAzZP:N:E:H:iD:p:qsSXMLWKebBgk';
51 getopts($getopts);
53 # parse configuration script options
54 if (open(FH, "<$ENV{'HOME'}/.openpkg/build")) {
55 my ($env) = $env{''};
56 my ($go) = $getopts;
57 $go =~ s/[^a-zA-Z]//g;
58 while (my $line = <FH>) {
59 if ($line =~ m/^\s*\[([^\]]*)\]/) {
60 $env{$1} = {} unless ($env{$1});
61 $env = $env{$1};
62 } elsif (my ($opt, $val) = ($line =~ m/^\-([$go])\s*(.*?)\s*$/)) {
63 $val = 1 unless (defined($val));
64 if (exists($env->{$opt})) {
65 $env->{$opt} .= " " . $val;
66 } else {
67 $env->{$opt} = $val;
68 }
69 }
70 }
71 close(FH);
72 }
74 # usage sanity check and usage help
75 sub usage {
76 my ($rc) = @_;
77 my $usage =
78 "openpkg:build:USAGE: $prg [options] [pattern ...]\n" .
79 " -a operate on all installed packages\n" .
80 " -A operate on all repository packages\n" .
81 " -R <rpm> path to \"openpkg rpm\" command\n" .
82 " -r <repository> URL to package repository directory\n" .
83 " -f <index.rdf> URL to package repository index file\n" .
84 " -u ignore local binary RPMs\n" .
85 " -U upgrade all selected packages including dependencies\n" .
86 " -z rebuild from zero all selected installed packages\n" .
87 " -Z rebuild from zero all selected available packages\n" .
88 " -i ignore errors in the generated script\n" .
89 " -q ignore all reverse dependencies\n" .
90 " -s generate status map instead of shell script\n" .
91 " -S generate status map instead of shell script (including new)\n" .
92 " -X use external XML/RDF parser instead of internal one\n" .
93 " -M generate short dependency map instead of shell script\n" .
94 " -L generate list of packages in repository depending on target\n" .
95 " -W include dependencies as if all build options are enabled\n" .
96 " -K keep temporarily installed packages\n" .
97 " -k keep temporarily downloaded packages\n" .
98 " -e rebuild exact version of a package from repository\n" .
99 " -b build-time check existing binaries for dependencies only\n" .
100 " -B build-time check existing binaries for dependencies and target\n" .
101 " -g rebuild packages even when most recent version is installed\n" .
102 " -P <priv-cmd> command prefix for privileged commands\n" .
103 " -N <non-priv-cmd> command prefix for non-privileged commands\n" .
104 " -p <platform> match platform against repository index for binary packages\n" .
105 " -E <name> exclude package\n" .
106 " -H <name> hint about packages to resolve ambiquity\n" .
107 " -D <name>[=<val>] set build option for packages\n";
108 if ($rc == 0) {
109 print STDOUT $usage;
110 }
111 else {
112 print STDERR $usage;
113 }
114 exit($rc);
115 }
116 if ($opt_h) {
117 usage(0);
118 }
119 if (not ( ($#ARGV >= 0 && !($opt_a || $opt_A))
120 || ($#ARGV == -1 && ($opt_a || $opt_A)))) {
121 usage(1);
122 };
124 # determine RPM run-time information
125 my $config = rpm_runtime_info();
127 # override command line options with configuration script options
128 # now that the effectively used OpenPKG RPM command is known
129 foreach my $env (sort { $a cmp $b } grep {
130 $config->{"rpm"} =~ m/^\Q$_\E/ # compatibility
131 or $config->{"prefix"} =~ m/^\Q$_\E/ # regular
132 } keys %env) {
133 while (my ($opt, $val) = each(%{$env{$env}})) {
134 eval "\$opt_$opt = '$val' unless defined \$opt_$opt;";
135 }
136 }
138 ##
139 ## OPTION POST-PROCESSING
140 ##
142 my ($url, $repository, $installed, $env, $list, $bonly, $clist);
143 my ($pattern, %with, %exclude, %hint);
145 # determine package goal pattern
146 if ($opt_a) {
147 $pattern = undef;
148 } else {
149 $pattern = join(' ', @ARGV);
150 }
151 if ($opt_A) {
152 $pattern = '*';
153 }
155 # parse build options
156 %with = map {
157 m/([^\s=]+)(?:\=(\S+))?/
158 ? ($1 => (defined($2) ? $2 : 'yes'))
159 : ()
160 } split(/\s+/, $opt_D);
162 # split accumulated option values
163 %exclude = map { $_ => 1 } split(/\s+/, $opt_E);
164 %hint = map { $_ => 1 } split(/\s+/, $opt_H);
166 if (defined($opt_p)) {
167 $config->{platform} = $opt_p;
168 }
170 # determine RPM package repository information
171 if (defined $opt_r) {
172 $url = $opt_r;
173 $url .= '/' unless $url =~ m/\/$/;
174 } else {
175 $url = rpm_release_url();
176 }
177 # if we read the index from a file we can no longer deduce
178 # repository paths from index paths. For now lets assume
179 # that everything is below SRC/ to be compatible with
180 # existing file indexes.
181 if (defined($opt_f) and not defined($opt_r)) {
182 $url .= 'SRC/';
183 }
185 # determine information about INSTALLED packages (virtual and regular),
186 # including their options, provides and requirements
187 my $installed = get_installed();
189 # SPECIAL CASE post-processing for
190 # -Z (ignore installed packages)
191 # -a (operate for all installed packages)
192 if ($opt_a and $opt_Z) {
193 # This allows one to correctly upgrade an existing OpenPKG
194 # instance to a newer major version by querying all installed
195 # packages and their options (-a) but then ignore them (-Z) during
196 # the later processing and instead perform more or less a fresh
197 # rebuild from scratch. This ensures that during the process the
198 # installed packages are effectively picked up as dependencies
199 # only after they in turn were already updated.
200 foreach my $package (keys(%{$installed})) {
201 next if ($package =~ m/::/);
202 if (exists($installed->{$package}->{""})) {
203 # virtual package
204 $hint{$installed->{$package}->{""}->[0]->{"name"}} = 1
205 if (exists($installed->{$package}->{""}->[0]->{"name"}));
206 }
207 else {
208 # regular package
209 $pattern .= " $package";
210 foreach my $version (keys(%{$installed->{$package}})) {
211 foreach my $rec (@{$installed->{$package}->{$version}}) {
212 if (defined($rec->{"OPTIONS"})) {
213 my $options = $rec->{"OPTIONS"};
214 foreach my $option (keys(%{$options})) {
215 $with{$package."::".$option} = $options->{$option};
216 }
217 }
218 }
219 }
220 }
221 }
222 }
223 if ($opt_Z) {
224 $installed = {};
225 }
227 # determine information about AVAILABLE packages
228 # by fetching and parsing a package repository XML/RDF index
229 $repository = get_index(
230 $url . '00INDEX.rdf',
231 $opt_f,
232 $opt_X,
233 $config->{platform},
234 $installed
235 );
237 # assemble together all determined environment information
238 $env = {
239 config => $config,
240 installed => $installed,
241 repository => $repository,
242 built => {},
243 revdep => undef,
244 with => \%with,
245 exclude => \%exclude,
246 hint => \%hint,
247 upgrade => ($opt_a || $opt_U),
248 zero => ($opt_z || $opt_Z),
249 exact => $opt_e,
250 quick => ($opt_q || $opt_z || $opt_Z),
251 status => ($opt_s || $opt_S),
252 fatal => [],
253 goals => $opt_g,
254 sourceonly => ($opt_u || $opt_U || $opt_z || $opt_Z)
255 };
257 ##
258 ## PERFORM REQUESTED OPERATION
259 ##
261 if ($opt_L) {
262 # case 1: calculate dependencies only and
263 # print packages depending on target
264 ($list) = build_deps($pattern, $env);
265 print_deps($list);
266 } else {
267 # case 2: calculate build commands and
268 # print results in different formats
269 ($list, $bonly, $clist) = build_list($pattern, $env);
270 die "openpkg:build:FATAL: cannot find package\n" if (not defined($list));
271 if ($opt_M) {
272 print_map($installed, $repository, $list, $bonly, $clist);
273 } elsif ($opt_S) {
274 print_status($installed, $repository, $list, $bonly, $clist);
275 } elsif ($opt_s) {
276 print_status($installed, {}, $list, $bonly, $clist);
277 } else {
278 if (@{$env->{fatal}}) {
279 die "openpkg:build:FATAL: errors occured while building:\n", @{$env->{fatal}}, "\n";
280 }
281 print_list1($list, $config, $opt_a || $opt_u || $opt_U, $env->{with}, $opt_i, $opt_b, $opt_B);
282 print_list2($bonly, $config) if (not $opt_K);
283 }
284 }
286 # die gracefully
287 exit(0);
289 #############################################################################
290 ##
291 ## FUNCTIONS: PARSING & RUN-TIME INFORMATION
292 ##
293 #############################################################################
295 # home-brewn getopt(3) style option parser
296 sub getopts ($) {
297 my ($opts) = @_;
298 my (%optf) = map { m/(\w)/; $1 => $_ } $opts =~ m/(\w:|\w)/g;
299 my (%opts, @argv, $optarg);
301 foreach (@ARGV) {
302 if (@argv) {
303 push @argv, $_;
304 } elsif (defined $optarg) {
305 if (exists $opts{$optarg}) {
306 $opts{$optarg} .= " $_";
307 } else {
308 $opts{$optarg} = $_;
309 }
310 $optarg = undef;
311 } elsif (!/^[-]/) {
312 push @argv, $_;
313 } else {
314 while (/^\-(\w)(.*)/) {
315 if (exists $optf{$1}) {
316 if (length($optf{$1}) > 1) {
317 if ($2 ne '') {
318 if (exists $opts{$1}) {
319 $opts{$1} .= " $2";
320 } else {
321 $opts{$1} = $2;
322 }
323 } else {
324 $optarg = $1;
325 }
326 last;
327 } else {
328 $opts{$1} = 1;
329 }
330 } else {
331 warn "openpkg:build:WARNING: unknown option $_\n";
332 }
333 $_ = "-$2";
334 }
335 }
336 }
337 if (defined $optarg) {
338 warn "openpkg:build:WARNING: option $optarg requires an argument\n";
339 }
340 foreach (keys %opts) {
341 eval '$opt_'.$_.' = "'.quotemeta($opts{$_}).'";';
342 }
343 @ARGV = @argv;
344 }
346 # determine RPM run-time information
347 sub rpm_runtime_info () {
348 # determine OpenPKG instance prefix via
349 # 1. the environment of the "openpkg build" framework
350 # 2. the installation path of the script
351 # 3. the installation path of the Perl interpreter
352 # 4. the path of the "openpkg" command in $PATH
353 my $l_prefix = $ENV{'OPENPKG_PREFIX'};
354 if (not $l_prefix) {
355 ($l_prefix) = ($0 =~ m/^(.+)\/lib(exec)?\/openpkg(-tools)?\/build(\.pl)?$/);
356 }
357 if (not $l_prefix) {
358 ($l_prefix) = ($^X =~ m/^(.+)\/bin\/perl.*$/);
359 }
360 if (not $l_prefix) {
361 $l_prefix = (`(which openpkg) 2>/dev/null` =~ m/^(.+)\/bin\/openpkg$/);
362 }
363 if (not -x "$l_prefix/bin/openpkg") {
364 die "openpkg:build:FATAL: cannot determine OpenPKG instance prefix";
365 }
366 print "# operating with OpenPKG instance $l_prefix\n";
368 # determine OpenPKG RPM command
369 my $rpm = $opt_R || $env{''}->{'R'} ||
370 ((-f "$l_prefix/bin/openpkg" && -f "$l_prefix/libexec/openpkg/rpm") ?
371 "$l_prefix/bin/openpkg rpm" : "$l_prefix/bin/rpm");
372 $rpm = (`(which $rpm) 2>/dev/null` =~ m{^(/.*)})[0] if ($rpm !~ m|^/|);
373 die "openpkg:build:FATAL: cannot locate OpenPKG RPM in path" unless ($rpm =~ m{^/});
374 print "# operating with OpenPKG RPM $rpm\n";
376 # determine additional tools
377 my $mkp = "$l_prefix/bin/openpkg makeproxy";
378 my $rel = "$l_prefix/bin/openpkg release";
379 my $bzip2 = $rpm;
380 $bzip2 =~ s/\/bin\/openpkg rpm$/\/lib\/openpkg\/bzip2/;
381 my $curl = $rpm;
382 $curl =~ s/\/bin\/openpkg rpm$/\/lib\/openpkg\/curl/;
383 $curl = "$l_prefix/bin/openpkg curl" if (system("$l_prefix/bin/openpkg curl file://$l_prefix/etc/openpkg/platform >/dev/null 2>&1") == 0);
385 # expand RPM macros holding information
386 my $c = run("$rpm --eval '%{_rpmdir} %{_rpmfilename} %{_target_os} %{_target_cpu} %{_srcrpmdir}'");
388 # parse and post-process information
389 chomp($c);
390 my (@q) = split(/\s+/, $c);
391 $q[1] =~ s/%{OS}/$q[2]/;
392 $q[1] =~ s/%{ARCH}/$q[3]/;
394 # expand RPM rc information about tools
395 $c = run("$rpm --showrc");
396 my @g = ($c =~ m/\%\{l_tool_locate\s+([^\s\}]+)/g);
398 # return accumulated information
399 return {
400 rpm => $rpm,
401 mkp => $mkp,
402 rel => $rel,
403 bzip2 => $bzip2,
404 curl => $curl,
405 rpmdir => $q[0],
406 srcrpmdir=> $q[4],
407 template => $q[1],
408 platform => '',
409 prefix => $l_prefix,
410 optreg => '(?:'. join('|', map { "\Quse_$_\E" } @g) .')'
411 };
412 }
414 # determine RPM release URL
415 sub rpm_release_url ($$) {
416 my ($rel, $url);
418 # determine the release URL the newer way
419 $url = run("(".$config->{"rel"}." --fmt='%u') 2>/dev/null || true") || "";
420 $url =~ s/^\s+//s;
421 $url =~ s/\s+$//s;
423 # use a local jumpstart RDF
424 if (-f $config->{"prefix"}."/etc/openpkg/build.rdf") {
425 $url = "file://".$config->{"prefix"}."/etc/openpkg/build.rdf"
426 }
428 return $url;
429 }
431 #############################################################################
432 ##
433 ## FUNCTIONS: VERSION STRING HANDLING
434 ##
435 #############################################################################
437 # compare two package versions
438 # - "openpkg rpm":
439 # splits according to !isalnum(3) ([a-zA-Z0-9])
440 # and between isdigit(3) ([0-9]) and isalpha(3) ([a-zA-Z])
441 # - "openpkg build" (this):
442 # splits on "." characters
443 sub vcmp_version ($$) {
444 my ($a, $b) = @_;
445 my (@a, @b, $c);
446 my ($ax, $bx);
448 # split according to dots
449 @a = split(/\./, $a);
450 @b = split(/\./, $b);
452 # compare as long as components exist
453 while (@a && @b) {
454 if ($a[0] =~ m/^\d+$/ && $b[0] =~ m/^\d+$/) {
455 # numerical comparison
456 $c = $a[0] <=> $b[0];
457 } elsif ((($a, $ax) = $a[0] =~ m/^(\d+)(.*)$/) &&
458 (($b, $bx) = $b[0] =~ m/^(\d+)(.*)$/)) {
459 # numerical comparison for prefix,
460 # string comparison for remainder
461 $c = $a <=> $b;
462 $c = $ax cmp $bx unless ($c);
463 } else {
464 # string comparison
465 $c = $a[0] cmp $b[0];
466 }
468 # stop comparison if components already mismatched
469 return $c if ($c != 0);
471 # else reduce by one component level
472 shift(@a);
473 shift(@b);
474 }
476 # finally compare number of remaining components
477 # (in case one is more specific)
478 $c = (scalar(@a) <=> scalar(@b));
479 return $c;
480 }
482 # compare two package releases
483 # - "openpkg rpm":
484 # uses "vcmp_version" semantics 1:1 again
485 # - "openpkg build" (this):
486 # uses "vcmp_version" semantics 1:1 again (>= 20060719)
487 # trivial string comparison (<= 20060719)
488 sub vcmp_release ($$) {
489 my ($a, $b) = @_;
491 return vcmp_version($a, $b);
492 }
494 # compare two package "version" or "version-release" strings
495 # - "openpkg rpm":
496 # compares "epoch", "version", "release" (in this order)
497 # - "openpkg build" (this):
498 # compares "release", "version", (in this order)
499 sub vcmp ($$) {
500 my ($a, $b) = @_;
501 my ($c);
503 # short-circuit comparison for simple case
504 return 0 if ($a eq $b);
506 # split into "version" and "release"
507 my ($av, $ar) = ($a =~ m/^(.*?)(?:\-([\d\.]+))?$/);
508 my ($bv, $br) = ($b =~ m/^(.*?)(?:\-([\d\.]+))?$/);
510 # compare "release"
511 if (defined($ar) and defined($br)) {
512 $c = vcmp_release($ar, $br);
513 return $c if ($c); # short-circuit
514 }
516 # compare "version"
517 if (defined($av) && defined($bv)) {
518 $c = vcmp_version($av, $bv);
519 return $c if ($c); # short-circuit
520 }
522 # equality
523 return 0;
524 }
526 # create "version" or "version-release" string
527 # from a provide object (see parse_provides)
528 sub vs ($) {
529 my ($t) = @_;
530 return (
531 defined($t->{release})
532 ? "$t->{version}-$t->{release}"
533 : $t->{version}
534 );
535 }
537 # create "name-version" or "name-version-release" string
538 # from a provide object (see parse_provides)
539 sub vsn ($) {
540 my ($t) = @_;
541 return "$t->{name}-".vs($t);
542 }
544 #############################################################################
545 ##
546 ## FUNCTIONS: INSTALLATION INFORMATION
547 ##
548 #############################################################################
550 # parse OpenPKG RPM 'provide' string
551 # "<virtual-name>" (virtual package)
552 # "<name> = <version>-<release>" (regular package)
553 # "<name>::<option> = <value>" (regular package build option)
554 sub parse_provides ($) {
555 my ($s) = @_;
556 my ($nam, $val, $pre, $with, $pxy, $ver, $rel);
558 ($nam, $val) = ($s =~ m/^([^\s\(]+(?:\([^\)]*\))?)\s*(?:=\s*(\S*?))?$/);
559 if (($pre, $with) = ($nam =~ m/^(\S+?)::(\S*)$/)) {
560 # build option
561 $val =~ s/(?:\%([0-9a-fA-F][0-9a-fA-F]))/chr(hex($1))/eg; # hex decode
562 ($ver, $rel, $pxy) = ($val, undef, undef);
563 } else {
564 # virtual or real package
565 ($ver, $rel, $pxy) = ($val =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/);
566 }
568 # return accumulated information
569 return {
570 name => $nam, # the full name of the resource
571 version => $ver, # the version (or value)
572 release => $rel, # and release number (or undef)
573 proxy => $pxy, # whether the resource is a PROXY resource (or undef)
574 prefix => $pre, # the packagename (if resource is an option)
575 with => $with # the buildoption (if resource is an option)
576 };
577 }
579 # parse option from RPM 'provides' list
580 sub parse_provideslist ($) {
581 my ($l) = @_;
582 my ($p);
583 my ($nam, $val, %opts);
585 foreach (@$l) {
586 $p = parse_provides($_);
587 next if (not (defined $p->{with} && defined $p->{prefix}));
588 $opts{$p->{with}} = $p->{version};
589 }
590 return \%opts;
591 }
593 # translate dependency object into provides object
594 sub depends2provides ($) {
595 my ($dep) = @_;
596 my ($ver, $rel, $pxy, $pre, $with);
598 ($ver, $rel, $pxy) = ($dep->{val} =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/);
599 ($pre, $with) = ($dep->{name} =~ m/^(\S+?)::(\S*)$/);
601 return {
602 name => $dep->{name},
603 version => (defined $ver ? $ver : $dep->{val}),
604 release => $rel,
605 proxy => $pxy,
606 prefix => $pre,
607 with => $with
608 }
609 }
611 # parse OpenPKG RPM 'require' string
612 # "<virtual-name>" (virtual package)
613 # "<name> =|<|<=|>|>= <version>[-<release>]" (regular package)
614 # "<name>::<option> =|<|<=|>|>= <value>" (regular package build option)
615 sub parse_depends ($) {
616 my ($dep) = @_;
617 my ($name, $op, $val);
619 if (ref($dep)) {
620 # dependency from new index stored as a node
621 # - content of the node is the name
622 # - certain attributes denote the comparison operator
623 # - the value of such an attribute is the comparison operand
624 # - the operator (and operand) are optional and there can only be one
625 $name = $dep->{content};
626 $op = undef;
627 $op = 'equ' if (exists($dep->{equ}));
628 $op = 'geq' if (exists($dep->{geq}));
629 $op = 'leq' if (exists($dep->{leq}));
630 $op = 'gt' if (exists($dep->{gt}));
631 $op = 'lt' if (exists($dep->{lt}));
632 if (defined($op)) {
633 $val = $dep->{$op};
634 }
635 } elsif ($dep =~ m/\S/) {
636 # dependency from old index stored as text string
637 # "name operator operand" or "name"
638 ($name, $op, $val) = ($dep =~ m/(\S+)\s*(?:(\S+)\s*(\S+))?\s*$/);
639 if (defined($op)) {
640 $op = {
641 '==' => 'equ', '=' => 'equ',
642 '>=' => 'geq', '=>' => 'geq',
643 '<=' => 'leq', '=<' => 'leq',
644 '>' => 'gt', '<' => 'lt'
645 }->{$op};
646 if (not defined($op)) {
647 print "# don't know how to handle dependency: $dep (invalid operator)\n";
648 return;
649 }
650 }
651 }
652 return {
653 name => $name,
654 op => $op,
655 val => $val
656 };
657 }
659 # retrieve the local installed package base.
660 # for packages that provide option resources (packagename::buildoption)
661 # the options are parsed into the OPTIONS hash.
662 # other packages will query options on demand.
663 sub get_installed () {
664 my (%map);
665 my (@l, $p);
666 my ($nam, $val, %options);
667 my ($vs, $rec, @list);
668 my ($name, $version, $release);
669 my ($req);
671 # generated total result:
672 # $map = {
673 # # regular package
674 # "<package-name>" <foo> => {
675 # "<version>-<release>" <1.2.3-20060622> => [
676 # <<1>{
677 # "name" => $name,
678 # "version" => $version,
679 # "release" => $release,
680 # "PROXY" => $proxy,
681 # "depends" => [
682 # <<3>>{
683 # "cond" => '',
684 # "value" => {
685 # name => $name,
686 # op => $op,
687 # val => $val
688 # },
689 # },
690 # ...
691 # ],
692 # "keeps" => [
693 # \<<3>
694 # ...
695 # ],
696 # "OPTIONS" => {
697 # "<option>" => "<value>",
698 # "<option>" => "<value>",
699 # ...
700 # },
701 # },
702 # ...
703 # ],
704 # },
705 # # build option
706 # "<package-name>::<option>" <foo::with_baz> => {
707 # "<value>" <yes> => [
708 # \<<1>>
709 # ...
710 # ],
711 # },
712 # # virtual package
713 # "<package-name>" <BAR> => {
714 # "" => [
715 # \<<1>>,
716 # ...
717 # ],
718 # },
719 # ...
720 # };
722 # query and parse all provides of all packages
723 # HINT: We assume(!) that OpenPKG RPM outputs "provides" in order:
724 # 1. virtual package & build option
725 # 2. regular package
726 # FIXME: The better long-term solution for all this fiddling would be something like:
727 # "openpkg rpm -qa -qf '%{NAME} %{VERSION} %{RELEASE}[ .%{PROVIDENAME} .%{PROVIDEFLAGS:depflags} .%{PROVIDEVERSION}]\\n'"
728 @l = run($config->{"rpm"}. " --provides -qa");
729 @list = ();
730 foreach (@l) {
731 # parse into provide object
732 $p = parse_provides($_) or next;
734 # short-circuit processing for RPM special case
735 next if ($p->{name} =~ m/^gpg\(/);
737 # is this an option?
738 if (defined($p->{with})) {
739 $options{$p->{prefix}}->{$p->{with}} = $p->{version};
740 push(@list, $p);
741 next;
742 }
744 # is this a virtual target?
745 $vs = vs($p);
746 if ($vs eq '') {
747 push(@list, $p);
748 next;
749 }
751 # assemble package details
752 $name = $p->{name};
753 $version = defined($p->{version}) ? $p->{version} : '*';
754 $release = defined($p->{release}) ? $p->{release} : '*';
755 push(@list, {
756 name => $name,
757 version => $version,
758 release => $release
759 });
761 # create target record
762 $rec = {
763 name => $name,
764 version => $version,
765 release => $release,
766 PROXY => $p->{proxy},
767 depends => [],
768 keeps => []
769 };
770 foreach (@list) {
771 push(@{$map{$_->{name}}->{vs($_)}}, $rec);
772 }
774 # remove assembled details
775 @list = ();
776 }
777 if (@list) {
778 print "# ATTENTION: ", scalar(@list), " froods (unassignable RPM 'provides') left\n";
779 }
781 # options are provided for a package,
782 # apply them to all instances of the package
783 # FIXME: duplicate copying because record exists multiple times (but harmless)
784 # FIXME: merges all "provides" of all package instances together -- which might be wrong
785 foreach $nam (keys(%options)) {
786 foreach $val (keys(%{$map{$nam}})) {
787 foreach (@{$map{$nam}->{$val}}) {
788 $_->{OPTIONS} = $options{$nam};
789 }
790 }
791 }
793 # query all 'requires' of all installed packages
794 # to determine the package dependencies
795 @l = run($config->{"rpm"} . " --qf '%{NAME}:::%{VERSION}:::%{RELEASE}[ :::%{REQUIRENAME}:::%{REQUIREFLAGS:depflags}:::%{REQUIREVERSION}:::]\\n' -qa");
796 @list = ();
797 foreach (@l) {
798 ($name, $version, $release, $req) = m/^([^:]+):::([^:]+):::([^:]+)(.*?)$/;
799 next if ($name eq 'gpg-pubkey');
800 $release =~ s/\+PROXY$//;
801 # for each requirement triple...
802 while ($req =~ m/\s+:::(.+?):::\s*(.*?)\s*:::(.*?):::/g) {
803 $p = parse_depends("$1 $2 $3");
804 next if ($p->{name} =~ m/^(rpmlib|gpg)\(/);
805 $vs = vs({ version => $version, release => $release });
806 $p = { cond => '', value => $p };
807 foreach $rec (@{$map{$name}->{$vs}}) {
808 push(@{$rec->{depends}}, $p);
809 push(@{$rec->{keeps}}, $p);
810 }
811 }
812 }
813 if (@list) {
814 print "# ATTENTION: ",scalar(@list)," fnords (unassignable RPM 'requires') left\n";
815 }
817 # return final result
818 return \%map;
819 }
821 #############################################################################
822 ##
823 ## FUNCTIONS: REPOSITORY INDEX INFORMATION
824 ##
825 #############################################################################
827 # fetch XML/RDF index from file or URL
828 # (recursively fetches sub-indexes, too)
829 sub get_index ($$$$$) {
830 my ($url, $fn, $xml, $pfmatch, $installed) = @_;
831 my (%map, $include);
832 my ($fetch, $bzip2, $path);
833 my ($parser);
835 # determine command/path to fetch/open index
836 $bzip2 = $config->{"bzip2"};
837 $fetch = defined($fn) ? $fn : $url;
838 $fetch !~ m/\.bz2$/ || -x $bzip2
839 or die "openpkg:build:FATAL: $bzip2 not found\n";
840 if ($fetch =~ m/^\w+:/) {
841 # looks like URL scheme
842 print "# fetching XML/RDF index from URL $fetch\n";
843 $path = $config->{"curl"} . " -s -o - \"$fetch\" |";
844 $path .= "$bzip2 -dc |" if ($fetch =~ m/\.bz2$/);
845 } else {
846 print "# reading XML/RDF index from file $fetch\n";
847 if ($fetch =~ m/\.bz2$/) {
848 $path = "$bzip2 -dc $fetch |";
849 } else {
850 $path = "<$fetch";
851 }
852 }
854 # open index
855 open(RFH, $path) or
856 die "openpkg:build:FATAL: cannot open '$fetch' ($!)\n";
858 # if XML parser can be used, try to lazy-load it
859 if ($xml) {
860 eval { require XML::Simple; };
861 $xml = 0 if ($@);
862 }
864 # determine and run XML parser
865 # (returns contained index includes)
866 $parser = ($xml ? \&xml_parser : \&simple_text_parser);
867 $include = $parser->(\*RFH, $url, \%map, $pfmatch, $installed);
869 # close index
870 close(RFH)
871 or die "openpkg:build:FATAL: an I/O error occured\n";
873 # cannot do real recursions on file handles, so we simply append
874 # (instead of inserting at the correct position) all sub-RDFs, as
875 # the result is flattend into a big hash anyway
876 foreach (@$include) {
877 my ($submap);
878 my ($suburl, $subfn) = relurl($url, $fn, $_);
879 $submap = get_index($suburl, $subfn, $xml, $pfmatch, $installed); # RECURSION
880 while (my ($name, $vmap) = each(%$submap)) {
881 while (my ($vs, $recs) = each(%$vmap)) {
882 push(@{$map{$name}->{$vs}}, @$recs);
883 }
884 }
885 }
887 # return final result
888 # $map = {
889 # <package-name> => {
890 # "<version>-<release>" => {
891 # href => ...,
892 # name => ...,
893 # version => ...,
894 # release => ...,
895 # platform => ...,
896 # prefix => ...,
897 # depends => [ ... ],
898 # keeps => [ ... ],
899 # conflicts => [ ... ],
900 # source => ...,
901 # nosource => ...,
902 # desc => $desc,
903 # OPTIONS => $options,
904 # DEFOPTS => { %$options },
905 # };
906 # };
907 # };
908 return \%map;
909 }
911 # compute absolute paths
912 # - (url, fn) point to a base document
913 # the location is the file path fn if fn is
914 # defined, otherwise it is url.
915 # - augment the pointer with suburl
916 # - suburl can be an absolute url
917 # then the new pointer is (suburl, undef)
918 # - suburl can be a absolute file path
919 # then the new pointer is (suburl, suburl)
920 # - suburl can be a relative path
921 # then it augments url or fn accordingly
922 sub relurl ($$$) {
923 my ($url, $fn, $suburl) = @_;
924 my ($subfn);
926 if ($suburl =~ m/^\w+:\/\//) {
927 # NOP
928 } elsif ($suburl =~ m/^\//) {
929 $subfn = $suburl;
930 } else {
931 if (defined($fn)) {
932 $subfn = $fn;
933 $subfn =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
934 $suburl = $subfn;
935 } else {
936 $subfn = $url;
937 $subfn =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
938 $suburl = $subfn;
939 $subfn = undef;
940 }
941 }
942 1 while ($suburl =~ s/\/\.\//\//s);
943 1 while ($suburl =~ s/\/[^\/]+\/\.\.\//\//s);
944 return ($suburl, $subfn);
945 }
947 # XML/RDF parser (simple way)
948 sub simple_text_parser ($$$$$) {
949 my ($fh, $url, $map, $pfmatch, $installed) = @_;
950 my (@include);
951 my ($section);
952 my ($name, $version);
953 my ($href, $release, $desc, $bags);
954 my (%options, @provides);
955 my ($platform, $prefix);
956 my ($rec);
957 my ($tag, $cond, $attrname, $attrval, $body);
958 my ($usecond);
959 my ($options);
961 print "# using internal XML/RDF parser\n";
963 # read XML/RDF line-wise as we know that our
964 # OpenPKG XML/RDF indices follow a strict formatting
965 while (<$fh>) {
966 # unescape some XML entities
967 s/>/>/g;
968 s/</</g;
970 if (!(defined($href)) && m/<rdf:Description.*?href="([^"]*)"/) {
971 # start of new package description
972 $href = $1;
973 $section = undef;
974 $name = undef;
975 $release = undef;
976 $desc = '';
977 $platform = undef;
978 $prefix = undef;
979 $bags = {};
980 @provides = ();
981 }
983 if (!(defined($href)) && m/<Repository.*?href="([^"]*)"(?:\s*platform="([^"]*)")?/) {
984 # external XML/RDF index reference for particular binary platform
985 if (goodpf($2, $pfmatch)) {
986 push(@include, $1);
987 }
988 next;
989 }
991 # skip content unless referenced piece was found
992 next if (not defined($href));
994 # parse XML/RDF element into components
995 ($tag, $cond, $attrname, $attrval, $body) = m{
996 < # start delimiter
997 (\/?[\w:]+) # begin element name
998 \s* # optional space before attributes
999 (?:cond="([^"]+)")? # known attribute
1000 (?:(\w+)="([^"]+)")? # unknown attribute
1001 > # end delimiter
1002 (.*?) # optional element body
1003 (?:<\/\1>)? # optional end tag
1004 $ # end of string
1005 }mx;
1007 # recognize the various XML/RDF elements
1008 if ($tag eq 'Description') {
1009 $usecond = $cond;
1010 $section = 'description';
1011 } elsif ($tag eq '/Description') {
1012 $usecond = $cond;
1013 $section = undef;
1014 } elsif ($section eq 'description') {
1015 $desc .= $_;
1016 } elsif ($tag eq 'PreReq') {
1017 $usecond = $cond;
1018 $section = 'prereq';
1019 } elsif ($tag eq '/PreReq') {
1020 $usecond = undef;
1021 $section = undef;
1022 } elsif ($tag eq 'BuildPreReq') {
1023 $usecond = $cond;
1024 $section = 'bprereq';
1025 } elsif ($tag eq '/BuildPreReq') {
1026 $usecond = undef;
1027 $section = undef;
1028 } elsif ($tag eq 'Provides') {
1029 $usecond = $cond;
1030 $section = 'provides';
1031 } elsif ($tag eq '/Provides') {
1032 $usecond = undef;
1033 $section = undef;
1034 } elsif ($tag eq 'Conflicts') {
1035 $usecond = $cond;
1036 $section = 'conflicts';
1037 } elsif ($tag eq '/Conflicts') {
1038 $usecond = undef;
1039 $section = undef;
1040 } elsif ($tag eq 'NoSource') {
1041 $usecond = $cond;
1042 $section = 'nosource';
1043 } elsif ($tag eq '/NoSource') {
1044 $usecond = undef;
1045 $section = undef;
1046 } elsif ($tag eq 'Source') {
1047 $usecond = $cond;
1048 $section = 'source';
1049 } elsif ($tag eq '/Source') {
1050 $usecond = undef;
1051 $section = undef;
1052 } elsif ($tag eq 'Name') {
1053 $name = $body;
1054 } elsif ($tag eq 'Version') {
1055 $version = $body;
1056 } elsif ($tag eq 'Release') {
1057 $release = $body;
1058 } elsif ($tag eq 'Platform') {
1059 $platform = $body;
1060 } elsif ($tag eq 'Prefixes') {
1061 $prefix = $body;
1062 } elsif ($tag eq 'rdf:li' || $tag eq 'resource') {
1063 if (defined($attrname)) {
1064 $body = {
1065 $attrname => $attrval,
1066 content => $body
1067 };
1068 }
1069 if ($section eq 'provides') {
1070 push(@provides, $body) if (!defined($usecond));
1071 } elsif ($section ne '') {
1072 push(@{$bags->{"$usecond"}->{$section}}, $body);
1073 }
1074 } elsif ($tag eq '/rdf:Description') {
1075 if ( defined($href)
1076 && defined($name)
1077 && defined($version)
1078 && defined($release)) {
1079 # process the accumulated package information
1080 @provides = map {
1081 depends2provides(parse_depends($_))
1082 } @provides;
1083 %options = map {
1084 ($_->{with} => $_->{version})
1085 } grep {
1086 defined($_->{with})
1087 } @provides;
1088 push(@provides, {
1089 name => $name,
1090 version => $version,
1091 release => $release
1092 });
1093 $options =
1094 %options
1095 ? { %options }
1096 : parse_options($desc);
1097 if ($options) {
1098 my (@t) = get_targets($installed->{$name}, sub { 1; });
1099 }
1100 # store accumulated package information
1101 eval {
1102 $rec = {
1103 href => (relurl($url, undef, $href))[0],
1104 name => $name,
1105 version => $version,
1106 release => $release,
1107 depends => depend_list(swith($bags, 'bprereq')),
1108 keeps => depend_list(swith($bags, 'prereq')),
1109 conflicts => swith($bags, 'conflicts'),
1110 source => swith($bags, 'source'),
1111 nosource => swith($bags, 'nosource'),
1112 desc => $desc,
1113 platform => $platform,
1114 prefix => $prefix,
1115 OPTIONS => $options,
1116 DEFOPTS => { %$options }
1117 };
1118 };
1119 if ($@) {
1120 die "openpkg:build:FATAL: when reading entry '$name':\n" . $@;
1121 }
1122 foreach (@provides) {
1123 push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
1124 }
1125 }
1126 # prepare to recognize next package
1127 $href = undef;
1128 }
1129 }
1131 # return contained XML/RDF indices
1132 return \@include;
1133 }
1135 # XML/RDF parser (usual way)
1136 sub xml_parser ($$$$$) {
1137 my ($fh, $url, $map, $pfmatch, $installed) = @_;
1138 my (@include);
1139 my ($xml, $rep, $sub);
1140 my (@provides, %options, $rec);
1141 my ($href, $name, $version, $release, $desc);
1142 my ($options);
1144 print "# using external XML/RDF parser\n";
1146 # parse XML/RDF with XML::Simple parser
1147 $xml = XML::Simple::XMLin($fh, forcearray => 1);
1148 $rep = $xml->{'Repository'}->[0]->{'rdf:Description'};
1149 $sub = $xml->{'Repository'}->[0]->{'Repository'};
1151 # iterate over all package descriptions
1152 foreach (@$rep) {
1153 # fetch package information
1154 $href = $_->{'href'};
1155 $name = xel($_->{'Name'});
1156 $version = xel($_->{'Version'});
1157 $release = xel($_->{'Release'});
1158 next if (not (
1159 defined($href)
1160 && defined($name)
1161 && defined($version)
1162 && defined($release)
1163 ));
1165 # determine package "provides"
1166 @provides = ();
1167 if ($_->{'Provides'}) {
1168 @provides = map {
1169 $_ = $_->{'rdf:bag'}->[0];
1170 $_ = $_->{'rdf:li'} ? $_->{'rdf:li'} : $_->{'resource'};
1171 @$_;
1172 } grep {
1173 !exists $_->{'cond'}
1174 } @{$_->{'Provides'}};
1175 }
1176 @provides = map {
1177 depends2provides(parse_depends($_))
1178 } @provides;
1179 %options = map {
1180 ($_->{with} => $_->{version})
1181 } grep {
1182 defined $_->{with}
1183 } @provides;
1184 push(@provides, {
1185 name => $name,
1186 version => $version,
1187 release => $release
1188 });
1190 # determine targets
1191 $desc = xel($_->{'Description'});
1192 $options =
1193 %options
1194 ? { %options }
1195 : parse_options($desc);
1196 if ($options) {
1197 my (@t) = get_targets($installed->{$name}, sub { 1; });
1198 }
1200 # store accumulated package information
1201 eval {
1202 $rec = {
1203 href => (relurl($url, undef, $href))[0],
1204 name => $name,
1205 version => $version,
1206 release => $release,
1207 platform => xel($_->{'Platform'}),
1208 prefix => xel($_->{'Prefixes'}),
1209 depends => depend_list(xwith($_->{'BuildPreReq'})),
1210 keeps => depend_list(xwith($_->{'PreReq'})),
1211 conflicts => xwith($_->{'Conflicts'}),
1212 source => xwith($_->{'Source'}),
1213 nosource => xwith($_->{'NoSource'}),
1214 desc => $desc,
1215 OPTIONS => $options,
1216 DEFOPTS => { %$options }
1217 };
1218 };
1219 if ($@) {
1220 die "openpkg:build:FATAL: when reading entry '$name'\n".$@;
1221 }
1222 foreach (@provides) {
1223 push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
1224 }
1225 }
1227 # determine contained XML/RDF indices
1228 if ($sub) {
1229 @include = map {
1230 goodpf($_->{platform}, $pfmatch)
1231 ? ( $_->{href} )
1232 : ( )
1233 } @$sub;
1234 }
1236 # return contained XML/RDF indices
1237 return \@include;
1238 }
1240 # convert XML parser output to dependency records
1241 sub depend_list ($) {
1242 my ($dl) = @_;
1243 foreach (@$dl) {
1244 $_->{value} = parse_depends($_->{value});
1245 }
1246 return $dl;
1247 }
1249 # convert simple XML parser Bag into flat list
1250 sub swith ($$) {
1251 my ($bags,$name) = @_;
1252 my ($cond);
1253 my (@out);
1255 foreach $cond (keys %$bags) {
1256 foreach (@{$bags->{$cond}->{$name}}) {
1257 push @out, {
1258 cond => $cond,
1259 value => $_
1260 };
1261 }
1262 }
1263 return \@out;
1264 }
1266 # convert (conditional) XML/RDF Bag into flat list
1267 sub xwith ($) {
1268 my ($bags) = @_;
1269 my ($bag, $li, $el);
1270 my (@out);
1272 foreach $bag (@$bags) {
1273 foreach $li (@{$bag->{'rdf:bag'}}) {
1274 $el = $li->{'resource'} || $li->{'rdf:li'};
1275 foreach (@$el) {
1276 push @out, {
1277 cond => $bag->{'cond'},
1278 value => $_
1279 };
1280 }
1281 }
1282 }
1283 return \@out;
1284 }
1286 # return node value from XML parser
1287 sub xel($) {
1288 my ($a) = @_;
1289 my ($l) = $a->[0];
1290 return '' if ref($l);
1291 return $l;
1292 }
1294 # is the platform a good one?
1295 sub goodpf ($$) {
1296 my ($l, $p) = @_;
1297 return 1 if $l eq '';
1298 return ($l =~ m/(?:^|\s)\Q$p\E(?:\s|$)/);
1299 }
1302 #############################################################################
1303 ##
1304 ## FUNCTIONS: HELPER FUNCTIONS FOR XML PARSING & DEPENDENCY PROCESSING
1305 ##
1306 #############################################################################
1308 # parse option from RPM output
1309 # < "%option with_foo bar"
1310 # > $with{"with_foo"} = "bar"
1311 sub parse_options ($) {
1312 my ($l) = @_;
1313 $l = join("\n", @$l) if (ref($l));
1314 return {} if ($l !~ m/(--define|\%option\s+)/s);
1315 my $with = {};
1316 $l =~ s/--define\s*'(\S+)\s+(\S+?)'/$with->{$1} = $2, ''/sge; # before openpkg-20021230
1317 $l =~ s/\%option\s+(\S+)\s+(\S+)/$with->{$1} = $2, ''/sge; # after openpkg-20021230
1318 return $with;
1319 }
1321 # fetch targets of a name that satisfy a condition and sort by target
1322 # version. Input is a hash of versions(?) on which the condition has
1323 # to be true and which points to an array of records with package
1324 # version information. Output is the list of version sorted package
1325 # version information records.
1326 sub get_targets ($$) {
1327 my ($relmap, $cond) = @_;
1328 return (
1329 sort {
1330 vcmp(vs($a), vs($b));
1331 } map {
1332 @{$relmap->{$_}}
1333 } grep {
1334 $cond->($_);
1335 } keys %$relmap
1336 );
1337 }
1339 #############################################################################
1340 ##
1341 ## FUNCTIONS: DEPENDENCY PROCESSING
1342 ##
1343 #############################################################################
1345 # search environment for packages that match a pattern
1346 sub search_pattern ($$) {
1347 my ($pattern, $env) = @_;
1348 my (@todo);
1350 if (defined($pattern)) {
1351 # explicitly given package pattern
1352 @todo = map {
1353 my ($p) = $_;
1354 my ($s, $iswildcard);
1355 $s = $1 if ($p =~ s/(,[^\s,]+)$//);
1356 if ($p =~ s/\*+$//) {
1357 $p = '^'.quotemeta($p).'';
1358 $iswildcard = 1;
1359 } else {
1360 $p = '^'.quotemeta($p).'$';
1361 }
1362 map { "$_$s" }
1363 grep { m/$p/ && !($iswildcard && exists($env->{exclude}->{$_})) }
1364 keys %{$env->{repository}}
1365 } split(/\s+/, $pattern);
1366 } else {
1367 # undefined pattern means "-a" option that selects
1368 # all packages from repository that are installed
1369 # and not explicitly excluded on command line
1370 @todo = grep {
1371 my ($n) = $_;
1372 (ref($env->{installed}->{$n}))
1373 && !exists($env->{exclude}->{$n})
1374 && grep { $_ ne '-' } keys %{$env->{installed}->{$n}}
1375 } keys(%{$env->{repository}});
1376 }
1377 return \@todo;
1378 }
1380 # pull in OPTIONS for a package or an RPM file
1381 my $get_with_cache = {};
1382 sub get_with ($;$) {
1383 my ($t, $fn) = @_;
1384 my (@l, %with);
1385 my ($optmap, $opt);
1387 if ($t->{OPTIONS}) {
1388 $opt = $t->{OPTIONS};
1389 } else {
1390 if (defined($fn)) {
1391 @l = run($config->{"rpm"} . " -q --provides -p $fn");
1392 } else {
1393 if (not exists($get_with_cache->{-provides})) {
1394 # pre-cache the "provides" query for all(!) packages at once for speedup
1395 my @c = run($config->{"rpm"} . " -qa --qf " .
1396 '\'%{NAME}[ :::%{PROVIDENAME}:::%{PROVIDEFLAGS:depflags}:::%{PROVIDEVERSION}:::]\n\'');
1397 $get_with_cache->{-provides} = {};
1398 foreach my $c (@c) {
1399 if ($c =~ m/^(\S+)(.*)$/s) {
1400 my ($name, $provides) = ($1, $2);
1401 while ($provides =~ m/\s+:::(.+?):::\s*(.*?)\s*:::(.*?):::/g) {
1402 $get_with_cache->{-provides}->{$name} = [] if (not exists($get_with_cache->{-provides}->{$name}));
1403 push(@{$get_with_cache->{-provides}->{$name}}, "$1 $2 $3");
1404 }
1405 }
1406 }
1407 }
1408 @l = $get_with_cache->{-provides}->{$t->{name}};
1409 if (not @l) {
1410 # (should not happen in practice, but anyway)
1411 @l = run($config->{"rpm"} . " -q --provides $t->{name}");
1412 $get_with_cache->{-provides}->{$t->{name}} = [ @l ];
1413 }
1414 }
1415 $opt = parse_provideslist(\@l);
1416 if (scalar(keys(%$opt)) == 0) {
1417 if (defined($fn)) {
1418 @l = run($config->{"rpm"} . " -qi -p $fn");
1419 } else {
1420 if (not exists($get_with_cache->{-infos})) {
1421 # pre-cache the "infos" query for all(!) packages at once for speedup
1422 my @c = run($config->{"rpm"} . " -qi -a");
1423 my $p = "";
1424 $get_with_cache->{-infos} = {};
1425 foreach my $c (@c) {
1426 $p = $1 if ($c =~ m/^Name:\s+(\S+)/s);
1427 $get_with_cache->{-infos}->{$p} = [] if (not exists($get_with_cache->{-infos}->{$p}));
1428 push(@{$get_with_cache->{-infos}->{$p}}, $c);
1429 }
1430 }
1431 @l = $get_with_cache->{-infos}->{$t->{name}};
1432 if (not @l) {
1433 # (should not happen in practice, but anyway)
1434 @l = run($config->{"rpm"} . " -qi $t->{name}");
1435 $get_with_cache->{-infos}->{$t->{name}} = [ @l ];
1436 }
1437 }
1438 $opt = parse_options(\@l);
1439 }
1440 $t->{OPTIONS} = $opt;
1441 }
1442 return $opt;
1443 }
1445 # copy options from new to old
1446 # where option already exists in old or option key
1447 # matches regular expression
1448 sub override_options ($$$) {
1449 my ($old, $new, $reg) = @_;
1450 my ($k);
1452 foreach $k (keys(%$new)) {
1453 if ((exists($old->{$k}) && $old->{$k} ne $new->{$k}) || $k =~ m/^$reg$/) {
1454 $old->{$k} = $new->{$k};
1455 }
1456 }
1457 }
1459 # filter package options
1460 sub filter_name_with ($$$) {
1461 my ($name, $with, $global) = @_;
1462 my (@keys);
1464 if ($global) {
1465 push(@keys, grep { !/::/ } keys %$with);
1466 }
1467 push(@keys, grep { m/::/ } keys %$with);
1468 return {
1469 map {
1470 my ($k) = $_;
1471 $k !~ m/::/ || $k =~ s/^\Q$name\E:://
1472 ? ( $k => $with->{$_} )
1473 : ( )
1474 } @keys
1475 };
1476 }
1478 # filter out package relevant options
1479 sub name_with ($$) {
1480 filter_name_with($_[0], $_[1], 1);
1481 }
1483 # filter out package specific options
1484 sub name_only_with ($$) {
1485 filter_name_with($_[0], $_[1], 0);
1486 }
1488 # evaluate a condition attribute from an option set
1489 sub conditional ($$) {
1490 my ($cond, $with) = @_;
1491 my (@s, $res);
1493 return 1 if ($cond eq '' || !defined($with));
1494 foreach (split(/\s+/,$cond)) {
1495 if ($_ eq '+') {
1496 die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 2;
1497 my ($a) = pop(@s);
1498 my ($b) = pop(@s);
1499 push(@s, $a && $b);
1500 } elsif ($_ eq '|') {
1501 die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 2;
1502 my ($a) = pop(@s);
1503 my ($b) = pop(@s);
1504 push(@s, $a || $b);
1505 } elsif ($_ eq '!') {
1506 die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 1;
1507 my ($a) = pop(@s);
1508 push(@s, !$a);
1509 } else {
1510 push(@s, ($with->{$_} eq 'yes') ? 1 : 0);
1511 }
1512 }
1513 die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 1;
1514 $res = pop(@s);
1516 die "openpkg:build:FATAL: stack not empty in: $cond\n" if scalar(@s) > 0;
1517 return $res;
1518 }
1520 # retrieve conditional target attributes in map
1521 sub target_attribute ($$$;$) {
1522 my ($target, $env, $attr, $with) = @_;
1523 my ($optreg) = $env->{config}->{optreg};
1524 my ($name, @out);
1526 return if (not $target);
1527 $name = $target->{name};
1529 my ($mywith) = ($with ? $with : get_with($target));
1530 override_options($mywith, name_with($name, $env->{with}), $optreg);
1532 foreach (@{$target->{$attr}}) {
1533 next if (not conditional($_->{'cond'}, $mywith));
1534 push(@out, $_->{'value'});
1535 }
1536 return \@out;
1537 }
1539 # see whether target is in map
1540 sub target_exists ($$) {
1541 my ($target, $map) = @_;
1542 my ($vmap) = $map->{$target->{name}};
1543 return if (not $vmap);
1544 return (
1545 !defined $target->{version}
1546 || defined $vmap->{vs($target)}
1547 );
1548 }
1550 # see whether target has conflicts
1551 sub target_conflicts ($$) {
1552 my ($target, $env) = @_;
1553 return target_attribute($target, $env, 'conflicts');
1554 }
1556 # retrieve build dependencies for target
1557 sub target_depends ($$) {
1558 my ($target, $env) = @_;
1559 return target_attribute($target, $env, 'depends');
1560 }
1562 # retrieve runtime dependencies for target
1563 sub target_keeps ($$) {
1564 my ($target, $env) = @_;
1565 return target_attribute($target, $env, 'keeps');
1566 }
1568 # retrieve source list for target
1569 sub target_source ($$) {
1570 my ($target, $env) = @_;
1571 return target_attribute($target, $env, 'source');
1572 }
1574 # retrieve nosource list for target
1575 sub target_nosource ($$) {
1576 my ($target, $env) = @_;
1577 return target_attribute($target, $env, 'nosource');
1578 }
1580 # check whether target conflicts against map
1581 sub target_has_conflicts ($$$) {
1582 my ($target, $map, $env) = @_;
1583 my ($conflicts, $t);
1585 $conflicts = target_conflicts($target, $env);
1586 foreach (@$conflicts) {
1587 my ($t) = find_target($_, $map, 0);
1588 return $t if $t;
1589 }
1590 return;
1591 }
1593 # record target status
1594 sub target_setstatus ($$$) {
1595 my ($target, $status, $pri) = @_;
1597 if ($pri > $target->{STATUSPRI}) {
1598 $target->{STATUSPRI} = $pri;
1599 $target->{STATUS} = $status;
1600 }
1601 }
1603 # strip doubles from depend/keep lists
1604 # and return a map name => depend/keep
1605 sub unique_map {
1606 my (%out);
1607 foreach (@_) {
1608 foreach (@$_) {
1609 $out{$_->{name}} = $_;
1610 }
1611 }
1612 return %out;
1613 }
1615 # check whether installed package matches build options. If default
1616 # = 1 then options which are not required must be identical to the
1617 # DEFOPTS.
1618 sub target_suitable ($$$) {
1619 my ($target, $with, $default) = @_;
1620 my ($iwith, $dwith);
1621 my ($k, $v);
1623 if ($target->{GOAL}) {
1624 $with = name_with($target->{name}, $with);
1625 } else {
1626 $with = name_only_with($target->{name}, $with);
1627 }
1628 $iwith = $target->{OPTIONS};
1629 $dwith = $target->{DEFOPTS};
1630 while (($k,$v) = each(%$iwith)) {
1631 if (exists($with->{$k})) {
1632 return 0 if ($iwith->{$k} ne $with->{$k});
1633 } elsif ($default) {
1634 return 0 if ($iwith->{$k} ne $dwith->{$k});
1635 }
1636 }
1637 return 1;
1638 }
1640 # determine whether target should be rebuild
1641 sub target_better ($$$) {
1642 my ($env, $target, $map) = @_;
1643 my ($vs) = vs($target);
1644 my ($vmap) = $map->{$target->{name}};
1646 # rebuild if target isn't installed
1647 return 'new' unless $vmap;
1649 # if "-e" then
1650 # always update if installed version is different from repository
1651 if ($env->{exact} && !grep { vcmp($vs, $_) == 0; } keys(%$vmap)) {
1652 return 'exact';
1653 }
1655 # if target is goal
1656 # always update if installed version is older than repository
1657 if ($target->{GOAL} && !grep { vcmp($vs, $_) <= 0; } keys(%$vmap)) {
1658 return 'goal';
1659 }
1661 # if -U then
1662 # always update if installed version is older than repository
1663 if ($env->{upgrade} && !grep { vcmp($vs, $_) <= 0; } keys(%$vmap)) {
1664 return 'upgrade';
1665 }
1667 # if -z/-Z then
1668 # always update if installed version is equal or older than repository
1669 if ($env->{zero} && grep { vcmp($vs, $_) >= 0; } keys(%$vmap)) {
1670 return 'zero';
1671 }
1673 # keep installed target
1674 return;
1675 }
1677 # check if target record describes a source package
1678 sub is_source ($) {
1679 my ($t) = @_;
1680 return !(defined $t->{'prefix'});
1681 }
1683 # there can be multiple sources for a target release
1684 sub chose_source ($$$$$) {
1685 my ($env, $name, $select, $vmap, $cond) = @_;
1686 my (@targ, @recs, @nrecs, $rec, %nam);
1688 # resolve name into a list of versions
1689 # for virtual targets this resolves to a list
1690 # of real targets that provide the virtual target
1691 @targ = get_targets($vmap, sub { 1; });
1692 return unless @targ;
1694 # find usable binary targets add all source targets
1695 @recs = (
1696 ( grep {
1697 !$env->{sourceonly}
1698 && !is_source($_)
1699 && $_->{'platform'} eq $env->{config}->{platform}
1700 && $_->{'prefix'} eq $env->{config}->{prefix}
1701 } get_targets($vmap, $cond) ),
1702 ( grep {
1703 is_source($_)
1704 } @targ )
1705 );
1706 return if (not @recs);
1708 # limit list to exact matches if provided by "-e"
1709 if (defined($select)) {
1710 @recs = grep {
1711 vsn($_) =~ m/^\Q$select\E/
1712 } @recs;
1713 }
1715 # try to resolve ambiguity against installed targets
1716 # and targets previously selected
1717 if (scalar(@recs) > 1) {
1718 @nrecs = grep {
1719 $env->{built}->{$_->{name}}
1720 || $env->{installed}->{$_->{name}}
1721 } @recs;
1722 @recs = @nrecs if (@nrecs);
1723 }
1725 # try to resolve ambiguity against hints
1726 if ($env->{hint}) {
1727 @nrecs = grep {
1728 exists($env->{hint}->{$_->{name}})
1729 } @recs;
1730 @recs = @nrecs if (@nrecs);
1731 }
1733 # try to resolve ambiguity against targets that match
1734 # the exact name
1735 if (scalar(@recs) > 1) {
1736 @nrecs = grep {
1737 $name eq $_->{name}
1738 } @recs;
1739 @recs = @nrecs if (@nrecs);
1740 }
1742 # try to resolve ambiguity by preferring binaries
1743 if (scalar(@recs) > 1 && !$env->{sourceonly}) {
1744 @nrecs = grep {
1745 defined($_->{'platform'})
1746 } @recs;
1747 @recs = @nrecs if (@nrecs);
1748 }
1750 # if we still have non-unique targets, complain
1751 if (scalar(@recs) > 1) {
1752 %nam = map { $_->{name} => 1 } @recs;
1753 if (scalar(keys(%nam)) > 1) {
1754 print "# ambigous sources for $name\n";
1755 my ($i) = 0;
1756 foreach (@recs) {
1757 print "# $i: ".vsn($_)." = $_->{href}\n";
1758 $i++;
1759 }
1760 return;
1761 }
1762 }
1764 # prefer full-source packages
1765 if (scalar(@recs) > 1) {
1766 @nrecs = grep {
1767 ! $_->{nosource}
1768 || ! @{$_->{nosource}}
1769 } @recs;
1770 unless (@nrecs) {
1771 @nrecs = grep {
1772 $_->{href} !~ m/\.nosrc.rpm$/
1773 } @recs;
1774 }
1775 @recs = @nrecs if (@nrecs);
1776 }
1778 # nothing left -> exit
1779 return if (scalar(@recs) == 0);
1781 # chose last (= max version) in list of targets
1782 $rec = $recs[-1];
1783 print "# source for $name is ".vsn($rec)."\n";
1784 return $rec;
1785 }
1787 # locate target for a dependency
1788 sub dep2target ($$$) {
1789 my ($dep, $env, $source) = @_;
1790 my ($name, $op, @targ);
1791 my ($i, $r, $b, $cond, $version);
1792 my ($t, $tdef, $why);
1794 ($name, $op, $version) = ($dep->{name}, $dep->{op}, $dep->{val});
1796 $i = $env->{installed}->{$name};
1797 $r = $env->{repository}->{$name};
1798 $b = $env->{built}->{$name};
1800 return if (not ($i || $r || $b));
1802 if (!defined($op)) {
1803 $cond = sub { 1; };
1804 } elsif ($op eq 'geq') {
1805 $cond = sub { vcmp($_[0],$version) >= 0; };
1806 } elsif ($op eq 'leq') {
1807 $cond = sub { vcmp($_[0],$version) <= 0; };
1808 } elsif ($op eq 'gt') {
1809 $cond = sub { vcmp($_[0],$version) > 0; };
1810 } elsif ($op eq 'lt') {
1811 $cond = sub { vcmp($_[0],$version) < 0; };
1812 } elsif ($op eq 'equ') {
1813 $cond = sub { vcmp($_[0],$version) == 0; };
1814 } else {
1815 die "openpkg:build:FATAL: internal error in dep2target\n";
1816 }
1818 $tdef = undef;
1820 # search installed target that matches requirement
1821 # use it if we are not upgrading (no -U and no -z/-Z)
1822 if ($i && (@targ = get_targets($i, $cond))) {
1823 foreach $t (@targ) {
1824 get_with($t);
1825 if (target_suitable($t, $env->{with}, 0)) {
1826 $tdef = $t;
1827 if (not ($env->{upgrade} || $env->{zero} || $source)) {
1828 return ($t, 1);
1829 }
1830 }
1831 }
1832 }
1834 # search target in current build list that matches requirement
1835 # use it if it exists
1836 if ($b && (@targ = get_targets($b, $cond))) {
1837 $t = $targ[0];
1838 return ($t, 1);
1839 }
1841 # search target in repository and install it, if it is newer than
1842 # corresponding installed versions avoid repository packages that
1843 # would install 'new' (i.e. are not an upgrade of an existing
1844 # package)
1845 $t = chose_source($env, $name, undef, $r, $cond);
1846 if ($t) {
1847 if (!$tdef || (
1848 ($why = target_better($env, $t, $env->{installed})) &&
1849 $why ne 'new'
1850 ) || $source) {
1851 return ($t, 0);
1852 }
1853 }
1855 # if nothing is suitable in repository then fall back to
1856 # anything we already have installed but that we skipped
1857 # above to look for upgrades.
1858 if ($tdef) {
1859 return ($tdef, 1);
1860 }
1862 return;
1863 }
1865 # compute reverse dependency map
1866 sub get_revdep ($) {
1867 my ($env) = @_;
1868 my ($i) = $env->{'installed'};
1869 my ($r) = $env->{'repository'};
1870 my ($pkg, %dep, %dlist, %rev);
1871 my (@targ, $t, $t1, $t2, $with, $name, $vmap);
1872 my ($d, $k, %d, $old, %name, %pkg);
1874 print "# computing reverse dependencies\n";
1876 # iterate over all installed packages
1877 foreach $pkg (keys(%$i)) {
1878 $vmap = $r->{$pkg};
1879 if (not $vmap) {
1880 print "# ATTENTION: $pkg has no upgrade path (installed package not found in repository)\n";
1881 next;
1882 }
1884 # get forward dependencies from installed packages
1885 # dep{a}{b} is true if b depends directly on a
1886 # dlist{a} is list of packages that depend on a
1887 @targ = get_targets($i->{$pkg}, sub { 1; });
1888 foreach $t (@targ) {
1889 $with = get_with($t);
1890 $d = target_attribute($t, $env, 'depends', $with);
1891 $k = target_attribute($t, $env, 'keeps', $with);
1892 next if (not (@$d || @$k));
1893 %d = unique_map($d,$k);
1895 # resolve package
1896 if (not exists($pkg{$pkg})) {
1897 ($t2, $old) = dep2target({ name => $pkg }, $env, 1);
1898 $t2 = undef if ($old);
1899 $pkg{$pkg} = $t2;
1900 }
1901 $t2 = $pkg{$pkg};
1902 next if (not $t2);
1903 foreach (keys(%d)) {
1904 next if ($_ eq 'OpenPKG');
1905 # resolve target
1906 unless (exists($name{$_})) {
1907 ($t1, $old) = dep2target($d{$_}, $env, 0);
1908 $name{$_} = ($t1 ? $t1->{name} : $_);
1909 }
1910 $name = $name{$_};
1911 if (not $dep{$name}{$t->{name}}) {
1912 $dep{$name}{$t->{name}} = 1;
1913 push(@{$dlist{$name}}, $t2);
1914 }
1915 }
1916 }
1917 }
1919 # sort reverse dependencies
1920 foreach $pkg (keys(%dep)) {
1921 $rev{$pkg} = [
1922 sort {
1923 $dep{$b->{name}}{$a->{name}}
1924 || -$dep{$a->{name}}{$b->{name}}
1925 || $a->{name} cmp $b->{name}
1926 } @{$dlist{$pkg}}
1927 ];
1928 }
1930 # return hash of package reverse dependencies
1931 return \%rev;
1932 }
1934 # build package dependencies
1935 # (all input and output is passed in 'env' hash)
1936 sub build_deps ($$) {
1937 my ($pattern, $env) = @_;
1938 my ($todo, @list, $list, @out);
1940 # determine all packages which match the pattern
1941 $todo = search_pattern($pattern, $env);
1943 # unfold target names into all(!) real targets names
1944 @list =
1945 map {
1946 map {
1947 map {
1948 $_->{name}
1949 } @$_
1950 } values(%{$env->{repository}->{$_}})
1951 } @$todo;
1953 # also add target name
1954 push @list, @$todo;
1956 # strip duplicate names
1957 @list = keys %{ { map { $_ => 1 } @list } };
1959 # cache reverse dependencies
1960 if (not $env->{revdep}) {
1961 $env->{revdep} = get_revdep($env);
1962 }
1964 # map targets into list of dependency names
1965 @list = map {
1966 $env->{revdep}->{$_}
1967 ? (@{$env->{revdep}->{$_}})
1968 : ()
1969 } @list;
1971 # iterate over dependencies
1972 foreach (@list) {
1973 # avoiding cycles
1974 next if ($env->{builddeps}->{$_->{name}});
1975 $env->{builddeps}->{$_->{name}} = 1;
1977 # generate result
1978 push(@out, $_);
1980 # generate result recursively
1981 $list = build_deps($_->{name}, $env); # RECURSION
1982 push(@out, @$list);
1983 }
1985 # return final results
1986 return \@out;
1987 }
1989 # report options that are not used for
1990 sub warn_about_options ($$$) {
1991 my ($target, $with, $c) = @_;
1992 my ($iwith) = $target->{OPTIONS};
1993 my ($k, $v);
1995 return if (not defined($iwith));
1996 $with = name_with($target->{name}, $with);
1997 while (($k,$v) = each %$with) {
1998 if (not ($k =~ m/^$c->{optreg}$/ || exists $iwith->{$k})) {
1999 print "# ATTENTION: $target->{name} ignores option '$k'\n";
2000 }
2001 }
2002 }
2004 # find target in map
2005 sub find_target ($$$) {
2006 my ($name, $map, $pos) = @_;
2007 my ($vmap) = $map->{$name};
2008 my (@vs);
2010 return if (not $vmap);
2011 @vs = sort { vcmp($b,$a) } keys(%$vmap);
2012 return $vmap->{$vs[$pos]}->[-1];
2013 }
2015 # add dependency as build option
2016 sub depend_option ($$$) {
2017 my ($target, $dep, $env) = @_;
2018 my ($with, $opt, $relmap, @t, $t);
2019 my ($pro) = depends2provides($dep);
2020 my ($conflict) = 0;
2022 return 1 if (not defined($pro->{with}));
2024 my ($val) = defined($pro->{version}) ? $pro->{version} : 'yes';
2026 $with = $env->{with};
2027 $opt = $pro->{prefix}.'::'.$pro->{with};
2028 if (defined($with->{$opt}) && $with->{$opt} ne $val) {
2029 print "# ", vsn($target), " has conflicting requirement $opt = $with->{$opt} != $val\n";
2030 $conflict = 1;
2031 }
2033 $relmap = $env->{built}->{$pro->{prefix}};
2034 @t = get_targets($relmap, sub { 1; });
2035 foreach $t (@t) {
2036 $with = $t->{OPTIONS};
2037 $opt = $pro->{with};
2038 if (defined($with->{$opt}) && $with->{$opt} ne $val) {
2039 print "# ", vsn($t), " has conflicting requirement $opt = $with->{$opt} != $val\n";
2040 $conflict = 1;
2041 }
2042 }
2044 return 0 if ($conflict);
2046 print "# ", vsn($target), " adds option $opt = $val\n";
2047 $with->{$opt} = $val;
2048 return 1;
2049 }
2051 # remember fatal error
2052 sub pusherr ($$$) {
2053 my ($env, $target, $mess) = @_;
2054 print "# $mess\n";
2055 push(@{$env->{fatal}}, vsn($target).": $mess\n");
2056 }
2058 # generate dependencies
2059 sub make_dep ($$$$$$$) {
2060 my ($who, $target, $depth, $env, $list, $blist, $clist) = @_;
2061 my ($d, $k, %d, %k, $t, $old);
2062 my (@deps, $conflict, $why);
2064 # check whether target is already in list of to be build packages
2065 if (target_exists($target, $env->{built})) {
2066 print "# $target->{name} is already in list\n";
2067 return;
2068 }
2070 # check whether target is in conflict with already installed package
2071 if ($t = target_has_conflicts($target, $env->{installed}, $env)) {
2072 target_setstatus($target, 'CONFLICT', 4);
2073 push(@$clist, $target);
2074 pusherr($env, $target, "$target->{name} conflicts with ".vsn($t));
2075 return;
2076 }
2078 # check whether target is in conflict with to be build package
2079 if ($t = target_has_conflicts($target, $env->{built}, $env)) {
2080 target_setstatus($target, 'CONFLICT', 4);
2081 push(@$clist, $target);
2082 pusherr($env, $target, "$target->{name} conflicts with ".vsn($t));
2083 return;
2084 }
2086 # see if a target is already installed and requires a rebuild
2087 if ($t = find_target($target->{name}, $env->{installed}, -1)) {
2088 if (exists($env->{exclude}->{$target->{name}})) {
2089 print "# excluding $target->{name} (no upgrade allowed)\n";
2090 return;
2091 }
2093 # pull in options (for status report)
2094 if ($target->{REBUILD}) {
2095 target_setstatus($target, 'DEPEND', 1);
2096 print "# rebuilding $target->{name} (dependency)\n";
2097 } elsif ($env->{zero}) {
2098 target_setstatus($target, 'ZERO', 1);
2099 print "# rebuilding $target->{name} (zero)\n";
2100 } elsif (vs($target) ne vs($t)) {
2101 target_setstatus($target, 'UPDATE', 3);
2102 print "# rebuilding $target->{name} (update)\n";
2103 } elsif (!target_suitable($t, $env->{with}, 0)) {
2104 target_setstatus($target, 'MISMATCH', 2);
2105 print "# rebuilding $target->{name} (parameter mismatch)\n";
2106 } elsif ($env->{goals} && $target->{GOAL}) {
2107 target_setstatus($target, 'GOAL', 3);
2108 print "# rebuilding $target->{name} (goal)\n";
2109 } else {
2110 print "# $target->{name} is already installed\n";
2111 return;
2112 }
2114 # use options from installed base
2115 override_options(get_with($target), get_with($t), $env->{config}->{optreg});
2117 # remember this is a rebuild for a proxy package
2118 $target->{PROXY} = $t->{PROXY};
2119 $target->{REBUILD} = 1;
2120 } else {
2121 print "# creating $target->{name}\n";
2122 target_setstatus($target, 'ADD', 3);
2123 }
2125 if (exists($env->{exclude}->{$target->{name}})) {
2126 die "openpkg:build:FATAL: target ".vsn($target)." is forbidden\n";
2127 }
2129 # mark this as a target before reverse dependencies trigger it again
2130 push(@{$env->{built}->{$target->{name}}->{vs($target)}}, $target);
2131 $target->{LIMBO} = 1;
2133 # recurse over dependencies
2134 $d = target_depends($target, $env);
2135 $k = target_keeps($target, $env);
2136 if (@$d || @$k) {
2137 %d = unique_map($d, $k);
2138 %k = unique_map($k);
2139 @deps = ();
2140 $conflict = 0;
2141 foreach (keys %d) {
2142 # old index misses a OpenPKG provider in the index... skip it
2143 next if ($_ eq 'OpenPKG');
2144 ($t, $old) = dep2target($d{$_}, $env, 0);
2145 if ($t) {
2146 if ($old) {
2147 print "# $target->{name} uses ".vsn($t)." for $_\n";
2148 if ($t->{LIMBO}) {
2149 print "# ATTENTION: ".vsn($t)." is in LIMBO\n";
2150 }
2151 next;
2152 }
2153 if (not depend_option($t, $d{$_}, $env)) {
2154 push(@$clist, $target);
2155 pusherr($env, $target, "$target->{name} has conflicting requirement");
2156 target_setstatus($target, 'UNDEF', 4);
2157 $conflict = 1;
2158 next;
2159 }
2160 if ($k{$_}) {
2161 push(@$blist, $t);
2162 print "# $target->{name} installs ".vsn($t)." for $_\n";
2163 } else {
2164 print "# $target->{name} requires ".vsn($t)." for $_\n";
2165 }
2166 push(@deps, $t);
2167 } else {
2168 push(@$clist, $target);
2169 pusherr($env, $target, "$target->{name} searches a frood called '$_'");
2170 target_setstatus($target, 'UNDEF', 4);
2171 $conflict = 1;
2172 }
2173 }
2174 if (not $conflict) {
2175 foreach $t (@deps) {
2176 make_dep($target, $t, $depth+1, $env, $list, $blist, $clist); # RECURSION
2177 }
2178 }
2179 }
2181 print "# adding ".vsn($target)." to list\n";
2182 $target->{WHO} = $who;
2183 $target->{WHY} = $target->{STATUS};
2184 push(@$list, $target);
2186 # remember new options
2187 override_options(get_with($target), name_with($target->{name}, $env->{with}), '');
2189 # moan about non-source packages
2190 foreach (@{target_nosource($target, $env)}) {
2191 my ($p) = target_source($target, $env)->[$_];
2192 $p =~ s/.*\///;
2193 print "# ATTENTION: unpackaged source $_: $p\n";
2194 }
2196 # cleanup limbo
2197 $target->{LIMBO} = 0;
2199 # a dependency could not be resolved, don't bother with reverse
2200 # dependencies for this target
2201 return if ($conflict);
2203 if (!$env->{quick} && $target->{name} ne 'openpkg' ) {
2204 if (not $env->{revdep}) {
2205 $env->{revdep} = get_revdep($env);
2206 }
2207 foreach $t (@{$env->{revdep}->{$target->{name}}}) {
2208 # this is a rebuild, triggering further revdeps
2209 $t->{REBUILD} = 1;
2211 # this is a rebuild, keep this installed
2212 push(@$blist, $t);
2214 print "# rebuilding reverse dependency ".vsn($t)."\n";
2215 make_dep($target, $t, $depth+1, $env, $list, $blist, $clist); # RECURSION
2216 }
2217 }
2218 }
2220 # generate build lists for targets matched by pattern
2221 # (all input and output is passed in 'env' hash)
2222 sub build_list ($$) {
2223 my ($pattern, $env) = @_;
2224 my (@goals, @targets, @keeps, @conflicts, @bonly, $t);
2225 my ($name, $select, $r, $i);
2226 my ($todo, %keep);
2228 # determine all packages which match the pattern
2229 $todo = search_pattern($pattern, $env);
2231 # chose sources for goals from repository
2232 foreach $name (@$todo) {
2233 $select = undef;
2234 $select = $1 if ($name =~ s/,([^\s,]+)$//);
2235 $t = undef;
2237 # keeping installed packages for goals is ugly
2238 # - we currently do not support installed source RPMs
2239 # - source RPMs might already have expired from repository
2240 # consequence:
2241 # - goals are always upgraded to repository versions
2242 #if (not $env->{upgrade}) {
2243 # $i = $env->{installed}->{$name};
2244 # $t = chose_source($env, $name, $select, $i, sub { 1; });
2245 #}
2246 if (not $t) {
2247 $r = $env->{repository}->{$name};
2248 $t = chose_source($env, $name, $select, $r, sub { 1; });
2249 }
2251 if ($t) {
2252 warn_about_options($t, $env->{with}, $env->{config});
2253 $t->{GOAL} = 1;
2254 push @goals, $t;
2255 } else {
2256 # error
2257 if ($env->{status}) {
2258 print "# dropping goal '$name'\n";
2259 } else {
2260 die "openpkg:build:FATAL: cannot find source for '$name'\n";
2261 }
2262 }
2263 }
2264 return if (not @goals);
2266 # recurse over dependencies
2267 @targets = ();
2268 @keeps = @goals;
2269 foreach $t (@goals) {
2270 print "# recursing over dependencies for ".vsn($t)."\n";
2271 make_dep(undef, $t, 0, $env, \@targets, \@keeps, \@conflicts);
2272 }
2274 # determine "binary only" packages which should be not kept
2275 # as they were not installed and are used temporarily only.
2276 %keep = map { $_ => 1 } @keeps;
2277 @bonly = reverse grep {
2278 !$keep{$_} && !$env->{installed}->{$_->{name}}
2279 } @targets;
2281 # return results
2282 return (\@targets, \@bonly, \@conflicts);
2283 }
2286 #############################################################################
2287 ##
2288 ## FUNCTIONS: RESULT PRINTING
2289 ##
2290 #############################################################################
2292 # determine execution command
2293 sub cmd ($$) {
2294 my ($w,$s) = @_;
2295 if (!defined($w)) {
2296 return $s;
2297 } elsif ($w =~ m/^-(.*)/) {
2298 return "$1 \"$s\"";
2299 } else {
2300 return "$w $s";
2301 }
2302 }
2303 sub priv ($) { cmd($opt_P, $_[0]); }
2304 sub npriv ($) { cmd($opt_N, $_[0]); }
2306 # execute a command
2307 my $run_cache = {};
2308 sub run ($) {
2309 my $cmd = cmd($opt_N, $_[0]);
2310 my $out = $run_cache->{$cmd};
2311 if (not defined($out)) {
2312 my @out = `$cmd`;
2313 $out = [ @out ];
2314 $run_cache->{$cmd} = $out;
2315 }
2316 return (wantarray ? @{$out} : join(//, @{$out}));
2317 }
2319 # print dependency list
2320 sub print_deps ($) {
2321 my ($list) = @_;
2323 print join("\n", sort map { vsn($_) } @$list), "\n";
2324 }
2326 # print dependency map
2327 sub print_map ($$$$$) {
2328 my ($installed, $repository, $list, $bonly, $clist) = @_;
2329 my (%dep);
2331 foreach (@$bonly) {
2332 $_->{status} = 'TEMP';
2333 }
2334 foreach (reverse(@$list)) {
2335 printf("%-35s %-8s %s\n",
2336 $_->{WHO} ? vsn($_->{WHO}) : "GOAL",
2337 $_->{WHY} ? $_->{WHY} : '???',
2338 vsn($_)
2339 );
2340 }
2341 }
2343 # instead of printing a command list, print a status map
2344 # that shows all packages and how the build process would
2345 # change their status
2346 sub print_status ($$$$$) {
2347 my ($installed, $repository, $list, $bonly, $clist) = @_;
2348 my (%bonly) = map { $_ => 1 } @$bonly;
2349 my (%map, $n, @names, $t);
2350 my ($old, $tag, $new);
2352 # augment map with additional information
2353 # about conflicting and binary only (temporary) packages
2354 foreach (@$list, @$clist) {
2355 next if (not $_->{release} =~ m/\S/);
2356 $map{$_->{name}} = {
2357 rel => "$_->{version}-$_->{release}",
2358 status => $_->{STATUS}
2359 };
2360 }
2361 foreach (@$bonly) {
2362 next if (not $_->{release} =~ m/\S/);
2363 $map{$_->{name}} = {
2364 rel => "$_->{version}-$_->{release}",
2365 status => 'TEMP'
2366 };
2367 }
2369 # augment map with additional information
2370 # about up-to-date and new packages
2371 @names = keys(%map);
2372 foreach $n (keys(%$installed)) {
2373 next if ($n =~ m/::/);
2374 next if (exists($map{$n}));
2375 next if (not (grep { $_ ne '' } keys(%{$installed->{$n}})));
2376 $map{$n}->{'status'} = 'OK';
2377 push(@names, $n);
2378 }
2379 foreach $n (keys(%$repository)) {
2380 next if ($n =~ m/::/);
2381 next if (exists($map{$n}));
2382 next if (not (grep { $_ ne '' } keys(%{$repository->{$n}})));
2383 $t = find_target($n, $repository, 0);
2384 $map{$n}->{'status'} = 'NEW';
2385 $map{$n}->{'rel'} = vs($t);
2386 push(@names, $n);
2387 }
2389 # generate status output
2390 foreach $n (sort(@names)) {
2391 $old = join(',',
2392 map { "$n-$_" }
2393 sort
2394 grep { $_ ne '-' }
2395 keys(%{$installed->{$n}})
2396 );
2397 $old = $n if ($old eq '');
2398 $tag = $map{$n}->{status};
2399 $new = defined($map{$n}->{rel}) ? " $n-$map{$n}->{rel}" : '';
2400 printf("%-35s %-8s%s\n", $old, $tag, $new);
2401 }
2402 }
2404 # compute path to source RPM from rpm config and target data
2405 sub target2srcrpm ($$) {
2406 my ($target, $c) = @_;
2407 return $c->{srcrpmdir}.'/'.$target->{name}.'-'.$target->{version}.'-'.$target->{release}.'.src.rpm';
2408 }
2410 # compute path to binary RPM from rpm config and target data
2411 sub target2rpm ($$) {
2412 my ($target, $c) = @_;
2413 my ($tmpl) = $c->{template};
2414 my ($popt) = $target->{PROXY} ? '+PROXY' : '';
2416 $tmpl =~ s/%{NAME}/$target->{name}/;
2417 $tmpl =~ s/%{VERSION}/$target->{version}/;
2418 $tmpl =~ s/%{RELEASE}/$target->{release}$popt/;
2420 return $c->{rpmdir}.'/'.$tmpl;
2421 }
2423 # merge parameters from installed package
2424 # with new parameter set and global parameters
2425 # from configuration
2426 # then map the result to --define command line arguments
2427 # suitable for rpm
2428 sub make_defines ($$$$) {
2429 my ($old, $new, $def, $c) = @_;
2430 my ($with);
2432 $old = {} unless $old;
2433 $def = {} unless $def;
2435 # override old parameters with new parameters
2436 # drop new parameters that do not exist in old set
2437 $old = { %$old };
2438 override_options($old, $new, $c->{optreg});
2440 # convert parameters to --define command line options
2441 # skip parameter templates from index
2442 # skip parameters that are identical to defaults
2443 $with = join(' ',
2444 map { "--define '$_ $old->{$_}'" }
2445 sort grep {
2446 $old->{$_} =~ m/\S/ &&
2447 $old->{$_} !~ m/^%/ &&
2448 $old->{$_} ne $def->{$_}
2449 } keys %$old
2450 );
2452 $with = ' '.$with if ($with ne '');
2454 return $with;
2455 }
2457 # compute new target based on old target augmented with options from
2458 # a binary RPM file
2459 sub binary_target ($$) {
2460 my ($t, $fn) = @_;
2461 my (%target) = %$t;
2463 # pull in options from binary RPM file
2464 delete $target{'OPTIONS'};
2465 get_with(\%target, $fn);
2466 return \%target;
2467 }
2469 # return path to master package for a proxy package
2470 sub find_proxy ($$) {
2471 my ($t, $bpkg) = @_;
2472 my (@l) = run($config->{"rpm"} . " -ql $t->{name}");
2473 my ($link) = (grep { $_ =~ m/\/\.prefix-$t->{name}$/ } @l)[0];
2474 return if (not defined($link));
2475 chomp $link;
2476 my ($prefix) = readlink($link);
2477 return if (not defined($prefix));
2478 $bpkg =~ s/.*\///;
2479 $bpkg =~ s/\+PROXY(\.[^-]+-[^-]+)-[^-]+\.rpm$/$1-*.rpm/;
2480 return (glob("$prefix/RPM/PKG/$bpkg"))[0];
2481 }
2483 # indent text to form a block
2484 sub indent ($) {
2485 my ($txt) = @_;
2486 $txt =~ s/^/ /gm;
2487 return $txt;
2488 }
2490 # print commands from package build list
2491 # c -> configuration to derive paths from
2492 # uncond -> always do the --rebuild
2493 # with -> parameter set passed to build tool
2494 # ignore -> generate script that does not stop on error
2495 # usebin -> build-time check to skip rebuild when binary exists
2496 # allbin -> usebin also for goals
2497 sub print_list1 ($$$$$$$) {
2498 my ($list, $c, $uncond, $with, $ignore, $usebin, $allbin) = @_;
2499 my ($pkg, $spkg, $bpkg, $uvhpkg, $ppkg);
2500 my ($opt);
2501 my ($cmd1, $cmd2, $mark);
2502 my ($cmd3, $srcpkg);
2504 $mark = '::::';
2506 my $err;
2507 if ($ignore) { $err = "|| true" } else { $err = "|| exit \$?" };
2508 foreach (@$list) {
2509 $pkg = $_->{name};
2510 $spkg = $_->{href};
2511 unless ($spkg =~ m/\S/) {
2512 die "openpkg:build:FATAL: internal error, ",vsn($_)," without source URL\n";
2513 }
2514 $bpkg = target2rpm($_, $c); $uvhpkg = $bpkg;
2515 $srcpkg = target2srcrpm($_, $c);
2516 $cmd3 = '';
2518 # rebuild binary package IF
2519 # 'unconditional' option
2520 # OR target is tagged as rebuilding
2521 # OR there is no binary package
2522 # OR dependency check found that installed package is not suitable
2523 # OR existing binary package doesn't satisfy wanted options
2524 $cmd1 = undef;
2525 if ( $uncond
2526 || !-f $bpkg
2527 || !target_suitable(binary_target($_, $bpkg), $with, 1)) {
2529 $opt = make_defines($_->{OPTIONS}, $with,
2530 $_->{DEFOPTS}, $c);
2532 # proxy packages are rebuilt from their maste
2533 # hierachy
2534 # someone preferred a binary from the repository
2535 # just copy it to the local store
2536 if ($_->{PROXY}) {
2537 $ppkg = find_proxy($_,$bpkg) or
2538 die "openpkg:build:FATAL: proxy package ",vsn($_)," does not exist\n";
2540 # rpm doesn't support additional parameters to the
2541 # mkproxy script
2542 # $cmd1 = npriv($config->{"mkp"} . " $ppkg -- -o $bpkg");
2543 $cmd1 = "( cd $c->{rpmdir} && ".
2544 npriv($config->{"mkp"} . " $ppkg").
2545 " )";
2546 } elsif (defined $_->{prefix}) {
2547 $cmd1 = '';
2548 if ($spkg =~ m|^\.?/|) {
2549 $uvhpkg = $spkg;
2550 }
2551 else {
2552 $cmd1 .= npriv($config->{"curl"} . " -# -o $bpkg $spkg $err\n");
2553 $cmd3 = npriv("rm -f $bpkg >/dev/null 2>&1 $err\n") unless ($opt_k);
2554 }
2555 } else {
2556 $cmd1 = '';
2557 if ($spkg =~ m|^\.?/|) {
2558 $cmd1 .= npriv($config->{"rpm"} . "$opt --rebuild $spkg $err\n");
2559 }
2560 else {
2561 $cmd1 .= "if test ! -f $srcpkg; then\n";
2562 $cmd1 .= indent(npriv($config->{"curl"} . " -# -o $srcpkg $spkg $err\n"));
2563 $cmd1 .= "fi\n";
2564 $cmd1 .= npriv($config->{"rpm"} . "$opt --rebuild $srcpkg $err\n");
2565 $cmd1 .= npriv("rm -f $srcpkg >/dev/null 2>&1 $err\n") unless ($opt_k);
2566 }
2567 }
2568 }
2570 # wrap build command with build-time check for existing
2571 # binary target
2572 if (defined($cmd1) && ($allbin || ($usebin && !$_->{GOAL}))) {
2573 $cmd1 = "if test ! -f $uvhpkg; then\n".indent($cmd1)."fi\n";
2574 }
2576 # if package exist force rpm to copy over new files
2577 # better than erasing everything and losing configuration
2578 # files
2579 $opt = ($_->{REBUILD} || ($allbin || ($usebin && !$_->{GOAL}))) ? ' --force' : '';
2580 $cmd2 = '';
2581 $cmd2 .= priv($config->{"rpm"} . "$opt -Uvh $uvhpkg $err\n");
2582 if ($allbin || ($usebin && !$_->{GOAL})) {
2583 $cmd2 = "if test \".`".$config->{"rpm"}." -q --qf '\%{SIGMD5}' $pkg`\" != \".`".$config->{"rpm"}." -qp --qf '\%{SIGMD5}' $uvhpkg`\"; then\n".indent($cmd2)."fi\n";
2584 }
2585 $cmd2 = $cmd1.$cmd2 if ($cmd1);
2586 $cmd2 = $cmd2.$cmd3 if ($cmd3);
2587 print "echo $mark $spkg $mark\n".$cmd2."echo $mark $spkg = \$? $mark\n";
2588 }
2589 }
2591 # print commands for the temporary package list
2592 # temporary packages are only used for building other packages
2593 # and are removed when everything is done
2594 sub print_list2 ($$) {
2595 my ($list, $c) = @_;
2596 my ($pkg);
2598 foreach (@$list) {
2599 $pkg = "$_->{name}-$_->{version}-$_->{release}";
2600 print priv($config->{"rpm"} . " -e $pkg\n");
2601 }
2602 }
