openpkg/build.pl@c10fb90893b9
openpkg/build.pl
Thu, 04 Oct 2012 20:30:05 +0200
- author
- Michael Schloh von Bennewitz <michael@schloh.com>
- date
- Thu, 04 Oct 2012 20:30:05 +0200
- changeset 715
- c10fb90893b9
- permissions
- -rw-r--r--
Correct out of date build configuration, porting to Solaris 11 network
link infrastructure and new libpcap logic. This additionally allows for
device drivers in subdirectories of /dev. Correct packaged nmap
personalities and signatures to work out of the box. Finally, hack
arpd logic to properly close sockets and quit on TERM by repeating
signaling in the run command script. Sadly, all this fails to correct
the run time behaviour of honeyd which fails to bind to the IP layer.
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 }
