1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/openpkg/build.pl Tue Jul 31 12:23:42 2012 +0200
1.3 @@ -0,0 +1,2603 @@
1.4 +##
1.5 +## build.pl -- OpenPKG Package Building and Installing
1.6 +## Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
1.7 +##
1.8 +## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
1.9 +## All rights reserved. Licenses which grant limited permission to use,
1.10 +## copy, modify and distribute this software are available from the
1.11 +## OpenPKG GmbH.
1.12 +##
1.13 +## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
1.14 +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
1.15 +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
1.16 +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
1.17 +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1.18 +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1.19 +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
1.20 +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1.21 +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1.22 +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
1.23 +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1.24 +## SUCH DAMAGE.
1.25 +##
1.26 +
1.27 +#############################################################################
1.28 +##
1.29 +## MAIN PROCEDURE
1.30 +##
1.31 +#############################################################################
1.32 +
1.33 +require 5;
1.34 +#use strict;
1.35 +my (
1.36 + $opt_h,
1.37 + $opt_R, $opt_r, $opt_f, $opt_u, $opt_U, $opt_a, $opt_A,
1.38 + $opt_z, $opt_Z, $opt_P, $opt_N, $opt_E, $opt_H, $opt_i,
1.39 + $opt_D, $opt_p, $opt_q, $opt_s, $opt_S, $opt_X, $opt_M,
1.40 + $opt_L, $opt_W, $opt_K, $opt_e, $opt_b, $opt_B, $opt_g,
1.41 + $opt_k
1.42 +);
1.43 +
1.44 +# global context variables
1.45 +my $prg = "openpkg build";
1.46 +my %env = ('' => {});
1.47 +
1.48 +##
1.49 +## OPTION PARSING
1.50 +##
1.51 +
1.52 +# parse command line options
1.53 +my $getopts = 'hR:r:f:uUaAzZP:N:E:H:iD:p:qsSXMLWKebBgk';
1.54 +getopts($getopts);
1.55 +
1.56 +# parse configuration script options
1.57 +if (open(FH, "<$ENV{'HOME'}/.openpkg/build")) {
1.58 + my ($env) = $env{''};
1.59 + my ($go) = $getopts;
1.60 + $go =~ s/[^a-zA-Z]//g;
1.61 + while (my $line = <FH>) {
1.62 + if ($line =~ m/^\s*\[([^\]]*)\]/) {
1.63 + $env{$1} = {} unless ($env{$1});
1.64 + $env = $env{$1};
1.65 + } elsif (my ($opt, $val) = ($line =~ m/^\-([$go])\s*(.*?)\s*$/)) {
1.66 + $val = 1 unless (defined($val));
1.67 + if (exists($env->{$opt})) {
1.68 + $env->{$opt} .= " " . $val;
1.69 + } else {
1.70 + $env->{$opt} = $val;
1.71 + }
1.72 + }
1.73 + }
1.74 + close(FH);
1.75 +}
1.76 +
1.77 +# usage sanity check and usage help
1.78 +sub usage {
1.79 + my ($rc) = @_;
1.80 + my $usage =
1.81 + "openpkg:build:USAGE: $prg [options] [pattern ...]\n" .
1.82 + " -a operate on all installed packages\n" .
1.83 + " -A operate on all repository packages\n" .
1.84 + " -R <rpm> path to \"openpkg rpm\" command\n" .
1.85 + " -r <repository> URL to package repository directory\n" .
1.86 + " -f <index.rdf> URL to package repository index file\n" .
1.87 + " -u ignore local binary RPMs\n" .
1.88 + " -U upgrade all selected packages including dependencies\n" .
1.89 + " -z rebuild from zero all selected installed packages\n" .
1.90 + " -Z rebuild from zero all selected available packages\n" .
1.91 + " -i ignore errors in the generated script\n" .
1.92 + " -q ignore all reverse dependencies\n" .
1.93 + " -s generate status map instead of shell script\n" .
1.94 + " -S generate status map instead of shell script (including new)\n" .
1.95 + " -X use external XML/RDF parser instead of internal one\n" .
1.96 + " -M generate short dependency map instead of shell script\n" .
1.97 + " -L generate list of packages in repository depending on target\n" .
1.98 + " -W include dependencies as if all build options are enabled\n" .
1.99 + " -K keep temporarily installed packages\n" .
1.100 + " -k keep temporarily downloaded packages\n" .
1.101 + " -e rebuild exact version of a package from repository\n" .
1.102 + " -b build-time check existing binaries for dependencies only\n" .
1.103 + " -B build-time check existing binaries for dependencies and target\n" .
1.104 + " -g rebuild packages even when most recent version is installed\n" .
1.105 + " -P <priv-cmd> command prefix for privileged commands\n" .
1.106 + " -N <non-priv-cmd> command prefix for non-privileged commands\n" .
1.107 + " -p <platform> match platform against repository index for binary packages\n" .
1.108 + " -E <name> exclude package\n" .
1.109 + " -H <name> hint about packages to resolve ambiquity\n" .
1.110 + " -D <name>[=<val>] set build option for packages\n";
1.111 + if ($rc == 0) {
1.112 + print STDOUT $usage;
1.113 + }
1.114 + else {
1.115 + print STDERR $usage;
1.116 + }
1.117 + exit($rc);
1.118 +}
1.119 +if ($opt_h) {
1.120 + usage(0);
1.121 +}
1.122 +if (not ( ($#ARGV >= 0 && !($opt_a || $opt_A))
1.123 + || ($#ARGV == -1 && ($opt_a || $opt_A)))) {
1.124 + usage(1);
1.125 +};
1.126 +
1.127 +# determine RPM run-time information
1.128 +my $config = rpm_runtime_info();
1.129 +
1.130 +# override command line options with configuration script options
1.131 +# now that the effectively used OpenPKG RPM command is known
1.132 +foreach my $env (sort { $a cmp $b } grep {
1.133 + $config->{"rpm"} =~ m/^\Q$_\E/ # compatibility
1.134 + or $config->{"prefix"} =~ m/^\Q$_\E/ # regular
1.135 +} keys %env) {
1.136 + while (my ($opt, $val) = each(%{$env{$env}})) {
1.137 + eval "\$opt_$opt = '$val' unless defined \$opt_$opt;";
1.138 + }
1.139 +}
1.140 +
1.141 +##
1.142 +## OPTION POST-PROCESSING
1.143 +##
1.144 +
1.145 +my ($url, $repository, $installed, $env, $list, $bonly, $clist);
1.146 +my ($pattern, %with, %exclude, %hint);
1.147 +
1.148 +# determine package goal pattern
1.149 +if ($opt_a) {
1.150 + $pattern = undef;
1.151 +} else {
1.152 + $pattern = join(' ', @ARGV);
1.153 +}
1.154 +if ($opt_A) {
1.155 + $pattern = '*';
1.156 +}
1.157 +
1.158 +# parse build options
1.159 +%with = map {
1.160 + m/([^\s=]+)(?:\=(\S+))?/
1.161 + ? ($1 => (defined($2) ? $2 : 'yes'))
1.162 + : ()
1.163 +} split(/\s+/, $opt_D);
1.164 +
1.165 +# split accumulated option values
1.166 +%exclude = map { $_ => 1 } split(/\s+/, $opt_E);
1.167 +%hint = map { $_ => 1 } split(/\s+/, $opt_H);
1.168 +
1.169 +if (defined($opt_p)) {
1.170 + $config->{platform} = $opt_p;
1.171 +}
1.172 +
1.173 +# determine RPM package repository information
1.174 +if (defined $opt_r) {
1.175 + $url = $opt_r;
1.176 + $url .= '/' unless $url =~ m/\/$/;
1.177 +} else {
1.178 + $url = rpm_release_url();
1.179 +}
1.180 +# if we read the index from a file we can no longer deduce
1.181 +# repository paths from index paths. For now lets assume
1.182 +# that everything is below SRC/ to be compatible with
1.183 +# existing file indexes.
1.184 +if (defined($opt_f) and not defined($opt_r)) {
1.185 + $url .= 'SRC/';
1.186 +}
1.187 +
1.188 +# determine information about INSTALLED packages (virtual and regular),
1.189 +# including their options, provides and requirements
1.190 +my $installed = get_installed();
1.191 +
1.192 +# SPECIAL CASE post-processing for
1.193 +# -Z (ignore installed packages)
1.194 +# -a (operate for all installed packages)
1.195 +if ($opt_a and $opt_Z) {
1.196 + # This allows one to correctly upgrade an existing OpenPKG
1.197 + # instance to a newer major version by querying all installed
1.198 + # packages and their options (-a) but then ignore them (-Z) during
1.199 + # the later processing and instead perform more or less a fresh
1.200 + # rebuild from scratch. This ensures that during the process the
1.201 + # installed packages are effectively picked up as dependencies
1.202 + # only after they in turn were already updated.
1.203 + foreach my $package (keys(%{$installed})) {
1.204 + next if ($package =~ m/::/);
1.205 + if (exists($installed->{$package}->{""})) {
1.206 + # virtual package
1.207 + $hint{$installed->{$package}->{""}->[0]->{"name"}} = 1
1.208 + if (exists($installed->{$package}->{""}->[0]->{"name"}));
1.209 + }
1.210 + else {
1.211 + # regular package
1.212 + $pattern .= " $package";
1.213 + foreach my $version (keys(%{$installed->{$package}})) {
1.214 + foreach my $rec (@{$installed->{$package}->{$version}}) {
1.215 + if (defined($rec->{"OPTIONS"})) {
1.216 + my $options = $rec->{"OPTIONS"};
1.217 + foreach my $option (keys(%{$options})) {
1.218 + $with{$package."::".$option} = $options->{$option};
1.219 + }
1.220 + }
1.221 + }
1.222 + }
1.223 + }
1.224 + }
1.225 +}
1.226 +if ($opt_Z) {
1.227 + $installed = {};
1.228 +}
1.229 +
1.230 +# determine information about AVAILABLE packages
1.231 +# by fetching and parsing a package repository XML/RDF index
1.232 +$repository = get_index(
1.233 + $url . '00INDEX.rdf',
1.234 + $opt_f,
1.235 + $opt_X,
1.236 + $config->{platform},
1.237 + $installed
1.238 +);
1.239 +
1.240 +# assemble together all determined environment information
1.241 +$env = {
1.242 + config => $config,
1.243 + installed => $installed,
1.244 + repository => $repository,
1.245 + built => {},
1.246 + revdep => undef,
1.247 + with => \%with,
1.248 + exclude => \%exclude,
1.249 + hint => \%hint,
1.250 + upgrade => ($opt_a || $opt_U),
1.251 + zero => ($opt_z || $opt_Z),
1.252 + exact => $opt_e,
1.253 + quick => ($opt_q || $opt_z || $opt_Z),
1.254 + status => ($opt_s || $opt_S),
1.255 + fatal => [],
1.256 + goals => $opt_g,
1.257 + sourceonly => ($opt_u || $opt_U || $opt_z || $opt_Z)
1.258 +};
1.259 +
1.260 +##
1.261 +## PERFORM REQUESTED OPERATION
1.262 +##
1.263 +
1.264 +if ($opt_L) {
1.265 + # case 1: calculate dependencies only and
1.266 + # print packages depending on target
1.267 + ($list) = build_deps($pattern, $env);
1.268 + print_deps($list);
1.269 +} else {
1.270 + # case 2: calculate build commands and
1.271 + # print results in different formats
1.272 + ($list, $bonly, $clist) = build_list($pattern, $env);
1.273 + die "openpkg:build:FATAL: cannot find package\n" if (not defined($list));
1.274 + if ($opt_M) {
1.275 + print_map($installed, $repository, $list, $bonly, $clist);
1.276 + } elsif ($opt_S) {
1.277 + print_status($installed, $repository, $list, $bonly, $clist);
1.278 + } elsif ($opt_s) {
1.279 + print_status($installed, {}, $list, $bonly, $clist);
1.280 + } else {
1.281 + if (@{$env->{fatal}}) {
1.282 + die "openpkg:build:FATAL: errors occured while building:\n", @{$env->{fatal}}, "\n";
1.283 + }
1.284 + print_list1($list, $config, $opt_a || $opt_u || $opt_U, $env->{with}, $opt_i, $opt_b, $opt_B);
1.285 + print_list2($bonly, $config) if (not $opt_K);
1.286 + }
1.287 +}
1.288 +
1.289 +# die gracefully
1.290 +exit(0);
1.291 +
1.292 +#############################################################################
1.293 +##
1.294 +## FUNCTIONS: PARSING & RUN-TIME INFORMATION
1.295 +##
1.296 +#############################################################################
1.297 +
1.298 +# home-brewn getopt(3) style option parser
1.299 +sub getopts ($) {
1.300 + my ($opts) = @_;
1.301 + my (%optf) = map { m/(\w)/; $1 => $_ } $opts =~ m/(\w:|\w)/g;
1.302 + my (%opts, @argv, $optarg);
1.303 +
1.304 + foreach (@ARGV) {
1.305 + if (@argv) {
1.306 + push @argv, $_;
1.307 + } elsif (defined $optarg) {
1.308 + if (exists $opts{$optarg}) {
1.309 + $opts{$optarg} .= " $_";
1.310 + } else {
1.311 + $opts{$optarg} = $_;
1.312 + }
1.313 + $optarg = undef;
1.314 + } elsif (!/^[-]/) {
1.315 + push @argv, $_;
1.316 + } else {
1.317 + while (/^\-(\w)(.*)/) {
1.318 + if (exists $optf{$1}) {
1.319 + if (length($optf{$1}) > 1) {
1.320 + if ($2 ne '') {
1.321 + if (exists $opts{$1}) {
1.322 + $opts{$1} .= " $2";
1.323 + } else {
1.324 + $opts{$1} = $2;
1.325 + }
1.326 + } else {
1.327 + $optarg = $1;
1.328 + }
1.329 + last;
1.330 + } else {
1.331 + $opts{$1} = 1;
1.332 + }
1.333 + } else {
1.334 + warn "openpkg:build:WARNING: unknown option $_\n";
1.335 + }
1.336 + $_ = "-$2";
1.337 + }
1.338 + }
1.339 + }
1.340 + if (defined $optarg) {
1.341 + warn "openpkg:build:WARNING: option $optarg requires an argument\n";
1.342 + }
1.343 + foreach (keys %opts) {
1.344 + eval '$opt_'.$_.' = "'.quotemeta($opts{$_}).'";';
1.345 + }
1.346 + @ARGV = @argv;
1.347 +}
1.348 +
1.349 +# determine RPM run-time information
1.350 +sub rpm_runtime_info () {
1.351 + # determine OpenPKG instance prefix via
1.352 + # 1. the environment of the "openpkg build" framework
1.353 + # 2. the installation path of the script
1.354 + # 3. the installation path of the Perl interpreter
1.355 + # 4. the path of the "openpkg" command in $PATH
1.356 + my $l_prefix = $ENV{'OPENPKG_PREFIX'};
1.357 + if (not $l_prefix) {
1.358 + ($l_prefix) = ($0 =~ m/^(.+)\/lib(exec)?\/openpkg(-tools)?\/build(\.pl)?$/);
1.359 + }
1.360 + if (not $l_prefix) {
1.361 + ($l_prefix) = ($^X =~ m/^(.+)\/bin\/perl.*$/);
1.362 + }
1.363 + if (not $l_prefix) {
1.364 + $l_prefix = (`(which openpkg) 2>/dev/null` =~ m/^(.+)\/bin\/openpkg$/);
1.365 + }
1.366 + if (not -x "$l_prefix/bin/openpkg") {
1.367 + die "openpkg:build:FATAL: cannot determine OpenPKG instance prefix";
1.368 + }
1.369 + print "# operating with OpenPKG instance $l_prefix\n";
1.370 +
1.371 + # determine OpenPKG RPM command
1.372 + my $rpm = $opt_R || $env{''}->{'R'} ||
1.373 + ((-f "$l_prefix/bin/openpkg" && -f "$l_prefix/libexec/openpkg/rpm") ?
1.374 + "$l_prefix/bin/openpkg rpm" : "$l_prefix/bin/rpm");
1.375 + $rpm = (`(which $rpm) 2>/dev/null` =~ m{^(/.*)})[0] if ($rpm !~ m|^/|);
1.376 + die "openpkg:build:FATAL: cannot locate OpenPKG RPM in path" unless ($rpm =~ m{^/});
1.377 + print "# operating with OpenPKG RPM $rpm\n";
1.378 +
1.379 + # determine additional tools
1.380 + my $mkp = "$l_prefix/bin/openpkg makeproxy";
1.381 + my $rel = "$l_prefix/bin/openpkg release";
1.382 + my $bzip2 = $rpm;
1.383 + $bzip2 =~ s/\/bin\/openpkg rpm$/\/lib\/openpkg\/bzip2/;
1.384 + my $curl = $rpm;
1.385 + $curl =~ s/\/bin\/openpkg rpm$/\/lib\/openpkg\/curl/;
1.386 + $curl = "$l_prefix/bin/openpkg curl" if (system("$l_prefix/bin/openpkg curl file://$l_prefix/etc/openpkg/platform >/dev/null 2>&1") == 0);
1.387 +
1.388 + # expand RPM macros holding information
1.389 + my $c = run("$rpm --eval '%{_rpmdir} %{_rpmfilename} %{_target_os} %{_target_cpu} %{_srcrpmdir}'");
1.390 +
1.391 + # parse and post-process information
1.392 + chomp($c);
1.393 + my (@q) = split(/\s+/, $c);
1.394 + $q[1] =~ s/%{OS}/$q[2]/;
1.395 + $q[1] =~ s/%{ARCH}/$q[3]/;
1.396 +
1.397 + # expand RPM rc information about tools
1.398 + $c = run("$rpm --showrc");
1.399 + my @g = ($c =~ m/\%\{l_tool_locate\s+([^\s\}]+)/g);
1.400 +
1.401 + # return accumulated information
1.402 + return {
1.403 + rpm => $rpm,
1.404 + mkp => $mkp,
1.405 + rel => $rel,
1.406 + bzip2 => $bzip2,
1.407 + curl => $curl,
1.408 + rpmdir => $q[0],
1.409 + srcrpmdir=> $q[4],
1.410 + template => $q[1],
1.411 + platform => '',
1.412 + prefix => $l_prefix,
1.413 + optreg => '(?:'. join('|', map { "\Quse_$_\E" } @g) .')'
1.414 + };
1.415 +}
1.416 +
1.417 +# determine RPM release URL
1.418 +sub rpm_release_url ($$) {
1.419 + my ($rel, $url);
1.420 +
1.421 + # determine the release URL the newer way
1.422 + $url = run("(".$config->{"rel"}." --fmt='%u') 2>/dev/null || true") || "";
1.423 + $url =~ s/^\s+//s;
1.424 + $url =~ s/\s+$//s;
1.425 +
1.426 + # use a local jumpstart RDF
1.427 + if (-f $config->{"prefix"}."/etc/openpkg/build.rdf") {
1.428 + $url = "file://".$config->{"prefix"}."/etc/openpkg/build.rdf"
1.429 + }
1.430 +
1.431 + return $url;
1.432 +}
1.433 +
1.434 +#############################################################################
1.435 +##
1.436 +## FUNCTIONS: VERSION STRING HANDLING
1.437 +##
1.438 +#############################################################################
1.439 +
1.440 +# compare two package versions
1.441 +# - "openpkg rpm":
1.442 +# splits according to !isalnum(3) ([a-zA-Z0-9])
1.443 +# and between isdigit(3) ([0-9]) and isalpha(3) ([a-zA-Z])
1.444 +# - "openpkg build" (this):
1.445 +# splits on "." characters
1.446 +sub vcmp_version ($$) {
1.447 + my ($a, $b) = @_;
1.448 + my (@a, @b, $c);
1.449 + my ($ax, $bx);
1.450 +
1.451 + # split according to dots
1.452 + @a = split(/\./, $a);
1.453 + @b = split(/\./, $b);
1.454 +
1.455 + # compare as long as components exist
1.456 + while (@a && @b) {
1.457 + if ($a[0] =~ m/^\d+$/ && $b[0] =~ m/^\d+$/) {
1.458 + # numerical comparison
1.459 + $c = $a[0] <=> $b[0];
1.460 + } elsif ((($a, $ax) = $a[0] =~ m/^(\d+)(.*)$/) &&
1.461 + (($b, $bx) = $b[0] =~ m/^(\d+)(.*)$/)) {
1.462 + # numerical comparison for prefix,
1.463 + # string comparison for remainder
1.464 + $c = $a <=> $b;
1.465 + $c = $ax cmp $bx unless ($c);
1.466 + } else {
1.467 + # string comparison
1.468 + $c = $a[0] cmp $b[0];
1.469 + }
1.470 +
1.471 + # stop comparison if components already mismatched
1.472 + return $c if ($c != 0);
1.473 +
1.474 + # else reduce by one component level
1.475 + shift(@a);
1.476 + shift(@b);
1.477 + }
1.478 +
1.479 + # finally compare number of remaining components
1.480 + # (in case one is more specific)
1.481 + $c = (scalar(@a) <=> scalar(@b));
1.482 + return $c;
1.483 +}
1.484 +
1.485 +# compare two package releases
1.486 +# - "openpkg rpm":
1.487 +# uses "vcmp_version" semantics 1:1 again
1.488 +# - "openpkg build" (this):
1.489 +# uses "vcmp_version" semantics 1:1 again (>= 20060719)
1.490 +# trivial string comparison (<= 20060719)
1.491 +sub vcmp_release ($$) {
1.492 + my ($a, $b) = @_;
1.493 +
1.494 + return vcmp_version($a, $b);
1.495 +}
1.496 +
1.497 +# compare two package "version" or "version-release" strings
1.498 +# - "openpkg rpm":
1.499 +# compares "epoch", "version", "release" (in this order)
1.500 +# - "openpkg build" (this):
1.501 +# compares "release", "version", (in this order)
1.502 +sub vcmp ($$) {
1.503 + my ($a, $b) = @_;
1.504 + my ($c);
1.505 +
1.506 + # short-circuit comparison for simple case
1.507 + return 0 if ($a eq $b);
1.508 +
1.509 + # split into "version" and "release"
1.510 + my ($av, $ar) = ($a =~ m/^(.*?)(?:\-([\d\.]+))?$/);
1.511 + my ($bv, $br) = ($b =~ m/^(.*?)(?:\-([\d\.]+))?$/);
1.512 +
1.513 + # compare "release"
1.514 + if (defined($ar) and defined($br)) {
1.515 + $c = vcmp_release($ar, $br);
1.516 + return $c if ($c); # short-circuit
1.517 + }
1.518 +
1.519 + # compare "version"
1.520 + if (defined($av) && defined($bv)) {
1.521 + $c = vcmp_version($av, $bv);
1.522 + return $c if ($c); # short-circuit
1.523 + }
1.524 +
1.525 + # equality
1.526 + return 0;
1.527 +}
1.528 +
1.529 +# create "version" or "version-release" string
1.530 +# from a provide object (see parse_provides)
1.531 +sub vs ($) {
1.532 + my ($t) = @_;
1.533 + return (
1.534 + defined($t->{release})
1.535 + ? "$t->{version}-$t->{release}"
1.536 + : $t->{version}
1.537 + );
1.538 +}
1.539 +
1.540 +# create "name-version" or "name-version-release" string
1.541 +# from a provide object (see parse_provides)
1.542 +sub vsn ($) {
1.543 + my ($t) = @_;
1.544 + return "$t->{name}-".vs($t);
1.545 +}
1.546 +
1.547 +#############################################################################
1.548 +##
1.549 +## FUNCTIONS: INSTALLATION INFORMATION
1.550 +##
1.551 +#############################################################################
1.552 +
1.553 +# parse OpenPKG RPM 'provide' string
1.554 +# "<virtual-name>" (virtual package)
1.555 +# "<name> = <version>-<release>" (regular package)
1.556 +# "<name>::<option> = <value>" (regular package build option)
1.557 +sub parse_provides ($) {
1.558 + my ($s) = @_;
1.559 + my ($nam, $val, $pre, $with, $pxy, $ver, $rel);
1.560 +
1.561 + ($nam, $val) = ($s =~ m/^([^\s\(]+(?:\([^\)]*\))?)\s*(?:=\s*(\S*?))?$/);
1.562 + if (($pre, $with) = ($nam =~ m/^(\S+?)::(\S*)$/)) {
1.563 + # build option
1.564 + $val =~ s/(?:\%([0-9a-fA-F][0-9a-fA-F]))/chr(hex($1))/eg; # hex decode
1.565 + ($ver, $rel, $pxy) = ($val, undef, undef);
1.566 + } else {
1.567 + # virtual or real package
1.568 + ($ver, $rel, $pxy) = ($val =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/);
1.569 + }
1.570 +
1.571 + # return accumulated information
1.572 + return {
1.573 + name => $nam, # the full name of the resource
1.574 + version => $ver, # the version (or value)
1.575 + release => $rel, # and release number (or undef)
1.576 + proxy => $pxy, # whether the resource is a PROXY resource (or undef)
1.577 + prefix => $pre, # the packagename (if resource is an option)
1.578 + with => $with # the buildoption (if resource is an option)
1.579 + };
1.580 +}
1.581 +
1.582 +# parse option from RPM 'provides' list
1.583 +sub parse_provideslist ($) {
1.584 + my ($l) = @_;
1.585 + my ($p);
1.586 + my ($nam, $val, %opts);
1.587 +
1.588 + foreach (@$l) {
1.589 + $p = parse_provides($_);
1.590 + next if (not (defined $p->{with} && defined $p->{prefix}));
1.591 + $opts{$p->{with}} = $p->{version};
1.592 + }
1.593 + return \%opts;
1.594 +}
1.595 +
1.596 +# translate dependency object into provides object
1.597 +sub depends2provides ($) {
1.598 + my ($dep) = @_;
1.599 + my ($ver, $rel, $pxy, $pre, $with);
1.600 +
1.601 + ($ver, $rel, $pxy) = ($dep->{val} =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/);
1.602 + ($pre, $with) = ($dep->{name} =~ m/^(\S+?)::(\S*)$/);
1.603 +
1.604 + return {
1.605 + name => $dep->{name},
1.606 + version => (defined $ver ? $ver : $dep->{val}),
1.607 + release => $rel,
1.608 + proxy => $pxy,
1.609 + prefix => $pre,
1.610 + with => $with
1.611 + }
1.612 +}
1.613 +
1.614 +# parse OpenPKG RPM 'require' string
1.615 +# "<virtual-name>" (virtual package)
1.616 +# "<name> =|<|<=|>|>= <version>[-<release>]" (regular package)
1.617 +# "<name>::<option> =|<|<=|>|>= <value>" (regular package build option)
1.618 +sub parse_depends ($) {
1.619 + my ($dep) = @_;
1.620 + my ($name, $op, $val);
1.621 +
1.622 + if (ref($dep)) {
1.623 + # dependency from new index stored as a node
1.624 + # - content of the node is the name
1.625 + # - certain attributes denote the comparison operator
1.626 + # - the value of such an attribute is the comparison operand
1.627 + # - the operator (and operand) are optional and there can only be one
1.628 + $name = $dep->{content};
1.629 + $op = undef;
1.630 + $op = 'equ' if (exists($dep->{equ}));
1.631 + $op = 'geq' if (exists($dep->{geq}));
1.632 + $op = 'leq' if (exists($dep->{leq}));
1.633 + $op = 'gt' if (exists($dep->{gt}));
1.634 + $op = 'lt' if (exists($dep->{lt}));
1.635 + if (defined($op)) {
1.636 + $val = $dep->{$op};
1.637 + }
1.638 + } elsif ($dep =~ m/\S/) {
1.639 + # dependency from old index stored as text string
1.640 + # "name operator operand" or "name"
1.641 + ($name, $op, $val) = ($dep =~ m/(\S+)\s*(?:(\S+)\s*(\S+))?\s*$/);
1.642 + if (defined($op)) {
1.643 + $op = {
1.644 + '==' => 'equ', '=' => 'equ',
1.645 + '>=' => 'geq', '=>' => 'geq',
1.646 + '<=' => 'leq', '=<' => 'leq',
1.647 + '>' => 'gt', '<' => 'lt'
1.648 + }->{$op};
1.649 + if (not defined($op)) {
1.650 + print "# don't know how to handle dependency: $dep (invalid operator)\n";
1.651 + return;
1.652 + }
1.653 + }
1.654 + }
1.655 + return {
1.656 + name => $name,
1.657 + op => $op,
1.658 + val => $val
1.659 + };
1.660 +}
1.661 +
1.662 +# retrieve the local installed package base.
1.663 +# for packages that provide option resources (packagename::buildoption)
1.664 +# the options are parsed into the OPTIONS hash.
1.665 +# other packages will query options on demand.
1.666 +sub get_installed () {
1.667 + my (%map);
1.668 + my (@l, $p);
1.669 + my ($nam, $val, %options);
1.670 + my ($vs, $rec, @list);
1.671 + my ($name, $version, $release);
1.672 + my ($req);
1.673 +
1.674 + # generated total result:
1.675 + # $map = {
1.676 + # # regular package
1.677 + # "<package-name>" <foo> => {
1.678 + # "<version>-<release>" <1.2.3-20060622> => [
1.679 + # <<1>{
1.680 + # "name" => $name,
1.681 + # "version" => $version,
1.682 + # "release" => $release,
1.683 + # "PROXY" => $proxy,
1.684 + # "depends" => [
1.685 + # <<3>>{
1.686 + # "cond" => '',
1.687 + # "value" => {
1.688 + # name => $name,
1.689 + # op => $op,
1.690 + # val => $val
1.691 + # },
1.692 + # },
1.693 + # ...
1.694 + # ],
1.695 + # "keeps" => [
1.696 + # \<<3>
1.697 + # ...
1.698 + # ],
1.699 + # "OPTIONS" => {
1.700 + # "<option>" => "<value>",
1.701 + # "<option>" => "<value>",
1.702 + # ...
1.703 + # },
1.704 + # },
1.705 + # ...
1.706 + # ],
1.707 + # },
1.708 + # # build option
1.709 + # "<package-name>::<option>" <foo::with_baz> => {
1.710 + # "<value>" <yes> => [
1.711 + # \<<1>>
1.712 + # ...
1.713 + # ],
1.714 + # },
1.715 + # # virtual package
1.716 + # "<package-name>" <BAR> => {
1.717 + # "" => [
1.718 + # \<<1>>,
1.719 + # ...
1.720 + # ],
1.721 + # },
1.722 + # ...
1.723 + # };
1.724 +
1.725 + # query and parse all provides of all packages
1.726 + # HINT: We assume(!) that OpenPKG RPM outputs "provides" in order:
1.727 + # 1. virtual package & build option
1.728 + # 2. regular package
1.729 + # FIXME: The better long-term solution for all this fiddling would be something like:
1.730 + # "openpkg rpm -qa -qf '%{NAME} %{VERSION} %{RELEASE}[ .%{PROVIDENAME} .%{PROVIDEFLAGS:depflags} .%{PROVIDEVERSION}]\\n'"
1.731 + @l = run($config->{"rpm"}. " --provides -qa");
1.732 + @list = ();
1.733 + foreach (@l) {
1.734 + # parse into provide object
1.735 + $p = parse_provides($_) or next;
1.736 +
1.737 + # short-circuit processing for RPM special case
1.738 + next if ($p->{name} =~ m/^gpg\(/);
1.739 +
1.740 + # is this an option?
1.741 + if (defined($p->{with})) {
1.742 + $options{$p->{prefix}}->{$p->{with}} = $p->{version};
1.743 + push(@list, $p);
1.744 + next;
1.745 + }
1.746 +
1.747 + # is this a virtual target?
1.748 + $vs = vs($p);
1.749 + if ($vs eq '') {
1.750 + push(@list, $p);
1.751 + next;
1.752 + }
1.753 +
1.754 + # assemble package details
1.755 + $name = $p->{name};
1.756 + $version = defined($p->{version}) ? $p->{version} : '*';
1.757 + $release = defined($p->{release}) ? $p->{release} : '*';
1.758 + push(@list, {
1.759 + name => $name,
1.760 + version => $version,
1.761 + release => $release
1.762 + });
1.763 +
1.764 + # create target record
1.765 + $rec = {
1.766 + name => $name,
1.767 + version => $version,
1.768 + release => $release,
1.769 + PROXY => $p->{proxy},
1.770 + depends => [],
1.771 + keeps => []
1.772 + };
1.773 + foreach (@list) {
1.774 + push(@{$map{$_->{name}}->{vs($_)}}, $rec);
1.775 + }
1.776 +
1.777 + # remove assembled details
1.778 + @list = ();
1.779 + }
1.780 + if (@list) {
1.781 + print "# ATTENTION: ", scalar(@list), " froods (unassignable RPM 'provides') left\n";
1.782 + }
1.783 +
1.784 + # options are provided for a package,
1.785 + # apply them to all instances of the package
1.786 + # FIXME: duplicate copying because record exists multiple times (but harmless)
1.787 + # FIXME: merges all "provides" of all package instances together -- which might be wrong
1.788 + foreach $nam (keys(%options)) {
1.789 + foreach $val (keys(%{$map{$nam}})) {
1.790 + foreach (@{$map{$nam}->{$val}}) {
1.791 + $_->{OPTIONS} = $options{$nam};
1.792 + }
1.793 + }
1.794 + }
1.795 +
1.796 + # query all 'requires' of all installed packages
1.797 + # to determine the package dependencies
1.798 + @l = run($config->{"rpm"} . " --qf '%{NAME}:::%{VERSION}:::%{RELEASE}[ :::%{REQUIRENAME}:::%{REQUIREFLAGS:depflags}:::%{REQUIREVERSION}:::]\\n' -qa");
1.799 + @list = ();
1.800 + foreach (@l) {
1.801 + ($name, $version, $release, $req) = m/^([^:]+):::([^:]+):::([^:]+)(.*?)$/;
1.802 + next if ($name eq 'gpg-pubkey');
1.803 + $release =~ s/\+PROXY$//;
1.804 + # for each requirement triple...
1.805 + while ($req =~ m/\s+:::(.+?):::\s*(.*?)\s*:::(.*?):::/g) {
1.806 + $p = parse_depends("$1 $2 $3");
1.807 + next if ($p->{name} =~ m/^(rpmlib|gpg)\(/);
1.808 + $vs = vs({ version => $version, release => $release });
1.809 + $p = { cond => '', value => $p };
1.810 + foreach $rec (@{$map{$name}->{$vs}}) {
1.811 + push(@{$rec->{depends}}, $p);
1.812 + push(@{$rec->{keeps}}, $p);
1.813 + }
1.814 + }
1.815 + }
1.816 + if (@list) {
1.817 + print "# ATTENTION: ",scalar(@list)," fnords (unassignable RPM 'requires') left\n";
1.818 + }
1.819 +
1.820 + # return final result
1.821 + return \%map;
1.822 +}
1.823 +
1.824 +#############################################################################
1.825 +##
1.826 +## FUNCTIONS: REPOSITORY INDEX INFORMATION
1.827 +##
1.828 +#############################################################################
1.829 +
1.830 +# fetch XML/RDF index from file or URL
1.831 +# (recursively fetches sub-indexes, too)
1.832 +sub get_index ($$$$$) {
1.833 + my ($url, $fn, $xml, $pfmatch, $installed) = @_;
1.834 + my (%map, $include);
1.835 + my ($fetch, $bzip2, $path);
1.836 + my ($parser);
1.837 +
1.838 + # determine command/path to fetch/open index
1.839 + $bzip2 = $config->{"bzip2"};
1.840 + $fetch = defined($fn) ? $fn : $url;
1.841 + $fetch !~ m/\.bz2$/ || -x $bzip2
1.842 + or die "openpkg:build:FATAL: $bzip2 not found\n";
1.843 + if ($fetch =~ m/^\w+:/) {
1.844 + # looks like URL scheme
1.845 + print "# fetching XML/RDF index from URL $fetch\n";
1.846 + $path = $config->{"curl"} . " -s -o - \"$fetch\" |";
1.847 + $path .= "$bzip2 -dc |" if ($fetch =~ m/\.bz2$/);
1.848 + } else {
1.849 + print "# reading XML/RDF index from file $fetch\n";
1.850 + if ($fetch =~ m/\.bz2$/) {
1.851 + $path = "$bzip2 -dc $fetch |";
1.852 + } else {
1.853 + $path = "<$fetch";
1.854 + }
1.855 + }
1.856 +
1.857 + # open index
1.858 + open(RFH, $path) or
1.859 + die "openpkg:build:FATAL: cannot open '$fetch' ($!)\n";
1.860 +
1.861 + # if XML parser can be used, try to lazy-load it
1.862 + if ($xml) {
1.863 + eval { require XML::Simple; };
1.864 + $xml = 0 if ($@);
1.865 + }
1.866 +
1.867 + # determine and run XML parser
1.868 + # (returns contained index includes)
1.869 + $parser = ($xml ? \&xml_parser : \&simple_text_parser);
1.870 + $include = $parser->(\*RFH, $url, \%map, $pfmatch, $installed);
1.871 +
1.872 + # close index
1.873 + close(RFH)
1.874 + or die "openpkg:build:FATAL: an I/O error occured\n";
1.875 +
1.876 + # cannot do real recursions on file handles, so we simply append
1.877 + # (instead of inserting at the correct position) all sub-RDFs, as
1.878 + # the result is flattend into a big hash anyway
1.879 + foreach (@$include) {
1.880 + my ($submap);
1.881 + my ($suburl, $subfn) = relurl($url, $fn, $_);
1.882 + $submap = get_index($suburl, $subfn, $xml, $pfmatch, $installed); # RECURSION
1.883 + while (my ($name, $vmap) = each(%$submap)) {
1.884 + while (my ($vs, $recs) = each(%$vmap)) {
1.885 + push(@{$map{$name}->{$vs}}, @$recs);
1.886 + }
1.887 + }
1.888 + }
1.889 +
1.890 + # return final result
1.891 + # $map = {
1.892 + # <package-name> => {
1.893 + # "<version>-<release>" => {
1.894 + # href => ...,
1.895 + # name => ...,
1.896 + # version => ...,
1.897 + # release => ...,
1.898 + # platform => ...,
1.899 + # prefix => ...,
1.900 + # depends => [ ... ],
1.901 + # keeps => [ ... ],
1.902 + # conflicts => [ ... ],
1.903 + # source => ...,
1.904 + # nosource => ...,
1.905 + # desc => $desc,
1.906 + # OPTIONS => $options,
1.907 + # DEFOPTS => { %$options },
1.908 + # };
1.909 + # };
1.910 + # };
1.911 + return \%map;
1.912 +}
1.913 +
1.914 +# compute absolute paths
1.915 +# - (url, fn) point to a base document
1.916 +# the location is the file path fn if fn is
1.917 +# defined, otherwise it is url.
1.918 +# - augment the pointer with suburl
1.919 +# - suburl can be an absolute url
1.920 +# then the new pointer is (suburl, undef)
1.921 +# - suburl can be a absolute file path
1.922 +# then the new pointer is (suburl, suburl)
1.923 +# - suburl can be a relative path
1.924 +# then it augments url or fn accordingly
1.925 +sub relurl ($$$) {
1.926 + my ($url, $fn, $suburl) = @_;
1.927 + my ($subfn);
1.928 +
1.929 + if ($suburl =~ m/^\w+:\/\//) {
1.930 + # NOP
1.931 + } elsif ($suburl =~ m/^\//) {
1.932 + $subfn = $suburl;
1.933 + } else {
1.934 + if (defined($fn)) {
1.935 + $subfn = $fn;
1.936 + $subfn =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
1.937 + $suburl = $subfn;
1.938 + } else {
1.939 + $subfn = $url;
1.940 + $subfn =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
1.941 + $suburl = $subfn;
1.942 + $subfn = undef;
1.943 + }
1.944 + }
1.945 + 1 while ($suburl =~ s/\/\.\//\//s);
1.946 + 1 while ($suburl =~ s/\/[^\/]+\/\.\.\//\//s);
1.947 + return ($suburl, $subfn);
1.948 +}
1.949 +
1.950 +# XML/RDF parser (simple way)
1.951 +sub simple_text_parser ($$$$$) {
1.952 + my ($fh, $url, $map, $pfmatch, $installed) = @_;
1.953 + my (@include);
1.954 + my ($section);
1.955 + my ($name, $version);
1.956 + my ($href, $release, $desc, $bags);
1.957 + my (%options, @provides);
1.958 + my ($platform, $prefix);
1.959 + my ($rec);
1.960 + my ($tag, $cond, $attrname, $attrval, $body);
1.961 + my ($usecond);
1.962 + my ($options);
1.963 +
1.964 + print "# using internal XML/RDF parser\n";
1.965 +
1.966 + # read XML/RDF line-wise as we know that our
1.967 + # OpenPKG XML/RDF indices follow a strict formatting
1.968 + while (<$fh>) {
1.969 + # unescape some XML entities
1.970 + s/>/>/g;
1.971 + s/</</g;
1.972 +
1.973 + if (!(defined($href)) && m/<rdf:Description.*?href="([^"]*)"/) {
1.974 + # start of new package description
1.975 + $href = $1;
1.976 + $section = undef;
1.977 + $name = undef;
1.978 + $release = undef;
1.979 + $desc = '';
1.980 + $platform = undef;
1.981 + $prefix = undef;
1.982 + $bags = {};
1.983 + @provides = ();
1.984 + }
1.985 +
1.986 + if (!(defined($href)) && m/<Repository.*?href="([^"]*)"(?:\s*platform="([^"]*)")?/) {
1.987 + # external XML/RDF index reference for particular binary platform
1.988 + if (goodpf($2, $pfmatch)) {
1.989 + push(@include, $1);
1.990 + }
1.991 + next;
1.992 + }
1.993 +
1.994 + # skip content unless referenced piece was found
1.995 + next if (not defined($href));
1.996 +
1.997 + # parse XML/RDF element into components
1.998 + ($tag, $cond, $attrname, $attrval, $body) = m{
1.999 + < # start delimiter
1.1000 + (\/?[\w:]+) # begin element name
1.1001 + \s* # optional space before attributes
1.1002 + (?:cond="([^"]+)")? # known attribute
1.1003 + (?:(\w+)="([^"]+)")? # unknown attribute
1.1004 + > # end delimiter
1.1005 + (.*?) # optional element body
1.1006 + (?:<\/\1>)? # optional end tag
1.1007 + $ # end of string
1.1008 + }mx;
1.1009 +
1.1010 + # recognize the various XML/RDF elements
1.1011 + if ($tag eq 'Description') {
1.1012 + $usecond = $cond;
1.1013 + $section = 'description';
1.1014 + } elsif ($tag eq '/Description') {
1.1015 + $usecond = $cond;
1.1016 + $section = undef;
1.1017 + } elsif ($section eq 'description') {
1.1018 + $desc .= $_;
1.1019 + } elsif ($tag eq 'PreReq') {
1.1020 + $usecond = $cond;
1.1021 + $section = 'prereq';
1.1022 + } elsif ($tag eq '/PreReq') {
1.1023 + $usecond = undef;
1.1024 + $section = undef;
1.1025 + } elsif ($tag eq 'BuildPreReq') {
1.1026 + $usecond = $cond;
1.1027 + $section = 'bprereq';
1.1028 + } elsif ($tag eq '/BuildPreReq') {
1.1029 + $usecond = undef;
1.1030 + $section = undef;
1.1031 + } elsif ($tag eq 'Provides') {
1.1032 + $usecond = $cond;
1.1033 + $section = 'provides';
1.1034 + } elsif ($tag eq '/Provides') {
1.1035 + $usecond = undef;
1.1036 + $section = undef;
1.1037 + } elsif ($tag eq 'Conflicts') {
1.1038 + $usecond = $cond;
1.1039 + $section = 'conflicts';
1.1040 + } elsif ($tag eq '/Conflicts') {
1.1041 + $usecond = undef;
1.1042 + $section = undef;
1.1043 + } elsif ($tag eq 'NoSource') {
1.1044 + $usecond = $cond;
1.1045 + $section = 'nosource';
1.1046 + } elsif ($tag eq '/NoSource') {
1.1047 + $usecond = undef;
1.1048 + $section = undef;
1.1049 + } elsif ($tag eq 'Source') {
1.1050 + $usecond = $cond;
1.1051 + $section = 'source';
1.1052 + } elsif ($tag eq '/Source') {
1.1053 + $usecond = undef;
1.1054 + $section = undef;
1.1055 + } elsif ($tag eq 'Name') {
1.1056 + $name = $body;
1.1057 + } elsif ($tag eq 'Version') {
1.1058 + $version = $body;
1.1059 + } elsif ($tag eq 'Release') {
1.1060 + $release = $body;
1.1061 + } elsif ($tag eq 'Platform') {
1.1062 + $platform = $body;
1.1063 + } elsif ($tag eq 'Prefixes') {
1.1064 + $prefix = $body;
1.1065 + } elsif ($tag eq 'rdf:li' || $tag eq 'resource') {
1.1066 + if (defined($attrname)) {
1.1067 + $body = {
1.1068 + $attrname => $attrval,
1.1069 + content => $body
1.1070 + };
1.1071 + }
1.1072 + if ($section eq 'provides') {
1.1073 + push(@provides, $body) if (!defined($usecond));
1.1074 + } elsif ($section ne '') {
1.1075 + push(@{$bags->{"$usecond"}->{$section}}, $body);
1.1076 + }
1.1077 + } elsif ($tag eq '/rdf:Description') {
1.1078 + if ( defined($href)
1.1079 + && defined($name)
1.1080 + && defined($version)
1.1081 + && defined($release)) {
1.1082 + # process the accumulated package information
1.1083 + @provides = map {
1.1084 + depends2provides(parse_depends($_))
1.1085 + } @provides;
1.1086 + %options = map {
1.1087 + ($_->{with} => $_->{version})
1.1088 + } grep {
1.1089 + defined($_->{with})
1.1090 + } @provides;
1.1091 + push(@provides, {
1.1092 + name => $name,
1.1093 + version => $version,
1.1094 + release => $release
1.1095 + });
1.1096 + $options =
1.1097 + %options
1.1098 + ? { %options }
1.1099 + : parse_options($desc);
1.1100 + if ($options) {
1.1101 + my (@t) = get_targets($installed->{$name}, sub { 1; });
1.1102 + }
1.1103 + # store accumulated package information
1.1104 + eval {
1.1105 + $rec = {
1.1106 + href => (relurl($url, undef, $href))[0],
1.1107 + name => $name,
1.1108 + version => $version,
1.1109 + release => $release,
1.1110 + depends => depend_list(swith($bags, 'bprereq')),
1.1111 + keeps => depend_list(swith($bags, 'prereq')),
1.1112 + conflicts => swith($bags, 'conflicts'),
1.1113 + source => swith($bags, 'source'),
1.1114 + nosource => swith($bags, 'nosource'),
1.1115 + desc => $desc,
1.1116 + platform => $platform,
1.1117 + prefix => $prefix,
1.1118 + OPTIONS => $options,
1.1119 + DEFOPTS => { %$options }
1.1120 + };
1.1121 + };
1.1122 + if ($@) {
1.1123 + die "openpkg:build:FATAL: when reading entry '$name':\n" . $@;
1.1124 + }
1.1125 + foreach (@provides) {
1.1126 + push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
1.1127 + }
1.1128 + }
1.1129 + # prepare to recognize next package
1.1130 + $href = undef;
1.1131 + }
1.1132 + }
1.1133 +
1.1134 + # return contained XML/RDF indices
1.1135 + return \@include;
1.1136 +}
1.1137 +
1.1138 +# XML/RDF parser (usual way)
1.1139 +sub xml_parser ($$$$$) {
1.1140 + my ($fh, $url, $map, $pfmatch, $installed) = @_;
1.1141 + my (@include);
1.1142 + my ($xml, $rep, $sub);
1.1143 + my (@provides, %options, $rec);
1.1144 + my ($href, $name, $version, $release, $desc);
1.1145 + my ($options);
1.1146 +
1.1147 + print "# using external XML/RDF parser\n";
1.1148 +
1.1149 + # parse XML/RDF with XML::Simple parser
1.1150 + $xml = XML::Simple::XMLin($fh, forcearray => 1);
1.1151 + $rep = $xml->{'Repository'}->[0]->{'rdf:Description'};
1.1152 + $sub = $xml->{'Repository'}->[0]->{'Repository'};
1.1153 +
1.1154 + # iterate over all package descriptions
1.1155 + foreach (@$rep) {
1.1156 + # fetch package information
1.1157 + $href = $_->{'href'};
1.1158 + $name = xel($_->{'Name'});
1.1159 + $version = xel($_->{'Version'});
1.1160 + $release = xel($_->{'Release'});
1.1161 + next if (not (
1.1162 + defined($href)
1.1163 + && defined($name)
1.1164 + && defined($version)
1.1165 + && defined($release)
1.1166 + ));
1.1167 +
1.1168 + # determine package "provides"
1.1169 + @provides = ();
1.1170 + if ($_->{'Provides'}) {
1.1171 + @provides = map {
1.1172 + $_ = $_->{'rdf:bag'}->[0];
1.1173 + $_ = $_->{'rdf:li'} ? $_->{'rdf:li'} : $_->{'resource'};
1.1174 + @$_;
1.1175 + } grep {
1.1176 + !exists $_->{'cond'}
1.1177 + } @{$_->{'Provides'}};
1.1178 + }
1.1179 + @provides = map {
1.1180 + depends2provides(parse_depends($_))
1.1181 + } @provides;
1.1182 + %options = map {
1.1183 + ($_->{with} => $_->{version})
1.1184 + } grep {
1.1185 + defined $_->{with}
1.1186 + } @provides;
1.1187 + push(@provides, {
1.1188 + name => $name,
1.1189 + version => $version,
1.1190 + release => $release
1.1191 + });
1.1192 +
1.1193 + # determine targets
1.1194 + $desc = xel($_->{'Description'});
1.1195 + $options =
1.1196 + %options
1.1197 + ? { %options }
1.1198 + : parse_options($desc);
1.1199 + if ($options) {
1.1200 + my (@t) = get_targets($installed->{$name}, sub { 1; });
1.1201 + }
1.1202 +
1.1203 + # store accumulated package information
1.1204 + eval {
1.1205 + $rec = {
1.1206 + href => (relurl($url, undef, $href))[0],
1.1207 + name => $name,
1.1208 + version => $version,
1.1209 + release => $release,
1.1210 + platform => xel($_->{'Platform'}),
1.1211 + prefix => xel($_->{'Prefixes'}),
1.1212 + depends => depend_list(xwith($_->{'BuildPreReq'})),
1.1213 + keeps => depend_list(xwith($_->{'PreReq'})),
1.1214 + conflicts => xwith($_->{'Conflicts'}),
1.1215 + source => xwith($_->{'Source'}),
1.1216 + nosource => xwith($_->{'NoSource'}),
1.1217 + desc => $desc,
1.1218 + OPTIONS => $options,
1.1219 + DEFOPTS => { %$options }
1.1220 + };
1.1221 + };
1.1222 + if ($@) {
1.1223 + die "openpkg:build:FATAL: when reading entry '$name'\n".$@;
1.1224 + }
1.1225 + foreach (@provides) {
1.1226 + push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
1.1227 + }
1.1228 + }
1.1229 +
1.1230 + # determine contained XML/RDF indices
1.1231 + if ($sub) {
1.1232 + @include = map {
1.1233 + goodpf($_->{platform}, $pfmatch)
1.1234 + ? ( $_->{href} )
1.1235 + : ( )
1.1236 + } @$sub;
1.1237 + }
1.1238 +
1.1239 + # return contained XML/RDF indices
1.1240 + return \@include;
1.1241 +}
1.1242 +
1.1243 +# convert XML parser output to dependency records
1.1244 +sub depend_list ($) {
1.1245 + my ($dl) = @_;
1.1246 + foreach (@$dl) {
1.1247 + $_->{value} = parse_depends($_->{value});
1.1248 + }
1.1249 + return $dl;
1.1250 +}
1.1251 +
1.1252 +# convert simple XML parser Bag into flat list
1.1253 +sub swith ($$) {
1.1254 + my ($bags,$name) = @_;
1.1255 + my ($cond);
1.1256 + my (@out);
1.1257 +
1.1258 + foreach $cond (keys %$bags) {
1.1259 + foreach (@{$bags->{$cond}->{$name}}) {
1.1260 + push @out, {
1.1261 + cond => $cond,
1.1262 + value => $_
1.1263 + };
1.1264 + }
1.1265 + }
1.1266 + return \@out;
1.1267 +}
1.1268 +
1.1269 +# convert (conditional) XML/RDF Bag into flat list
1.1270 +sub xwith ($) {
1.1271 + my ($bags) = @_;
1.1272 + my ($bag, $li, $el);
1.1273 + my (@out);
1.1274 +
1.1275 + foreach $bag (@$bags) {
1.1276 + foreach $li (@{$bag->{'rdf:bag'}}) {
1.1277 + $el = $li->{'resource'} || $li->{'rdf:li'};
1.1278 + foreach (@$el) {
1.1279 + push @out, {
1.1280 + cond => $bag->{'cond'},
1.1281 + value => $_
1.1282 + };
1.1283 + }
1.1284 + }
1.1285 + }
1.1286 + return \@out;
1.1287 +}
1.1288 +
1.1289 +# return node value from XML parser
1.1290 +sub xel($) {
1.1291 + my ($a) = @_;
1.1292 + my ($l) = $a->[0];
1.1293 + return '' if ref($l);
1.1294 + return $l;
1.1295 +}
1.1296 +
1.1297 +# is the platform a good one?
1.1298 +sub goodpf ($$) {
1.1299 + my ($l, $p) = @_;
1.1300 + return 1 if $l eq '';
1.1301 + return ($l =~ m/(?:^|\s)\Q$p\E(?:\s|$)/);
1.1302 +}
1.1303 +
1.1304 +
1.1305 +#############################################################################
1.1306 +##
1.1307 +## FUNCTIONS: HELPER FUNCTIONS FOR XML PARSING & DEPENDENCY PROCESSING
1.1308 +##
1.1309 +#############################################################################
1.1310 +
1.1311 +# parse option from RPM output
1.1312 +# < "%option with_foo bar"
1.1313 +# > $with{"with_foo"} = "bar"
1.1314 +sub parse_options ($) {
1.1315 + my ($l) = @_;
1.1316 + $l = join("\n", @$l) if (ref($l));
1.1317 + return {} if ($l !~ m/(--define|\%option\s+)/s);
1.1318 + my $with = {};
1.1319 + $l =~ s/--define\s*'(\S+)\s+(\S+?)'/$with->{$1} = $2, ''/sge; # before openpkg-20021230
1.1320 + $l =~ s/\%option\s+(\S+)\s+(\S+)/$with->{$1} = $2, ''/sge; # after openpkg-20021230
1.1321 + return $with;
1.1322 +}
1.1323 +
1.1324 +# fetch targets of a name that satisfy a condition and sort by target
1.1325 +# version. Input is a hash of versions(?) on which the condition has
1.1326 +# to be true and which points to an array of records with package
1.1327 +# version information. Output is the list of version sorted package
1.1328 +# version information records.
1.1329 +sub get_targets ($$) {
1.1330 + my ($relmap, $cond) = @_;
1.1331 + return (
1.1332 + sort {
1.1333 + vcmp(vs($a), vs($b));
1.1334 + } map {
1.1335 + @{$relmap->{$_}}
1.1336 + } grep {
1.1337 + $cond->($_);
1.1338 + } keys %$relmap
1.1339 + );
1.1340 +}
1.1341 +
1.1342 +#############################################################################
1.1343 +##
1.1344 +## FUNCTIONS: DEPENDENCY PROCESSING
1.1345 +##
1.1346 +#############################################################################
1.1347 +
1.1348 +# search environment for packages that match a pattern
1.1349 +sub search_pattern ($$) {
1.1350 + my ($pattern, $env) = @_;
1.1351 + my (@todo);
1.1352 +
1.1353 + if (defined($pattern)) {
1.1354 + # explicitly given package pattern
1.1355 + @todo = map {
1.1356 + my ($p) = $_;
1.1357 + my ($s, $iswildcard);
1.1358 + $s = $1 if ($p =~ s/(,[^\s,]+)$//);
1.1359 + if ($p =~ s/\*+$//) {
1.1360 + $p = '^'.quotemeta($p).'';
1.1361 + $iswildcard = 1;
1.1362 + } else {
1.1363 + $p = '^'.quotemeta($p).'$';
1.1364 + }
1.1365 + map { "$_$s" }
1.1366 + grep { m/$p/ && !($iswildcard && exists($env->{exclude}->{$_})) }
1.1367 + keys %{$env->{repository}}
1.1368 + } split(/\s+/, $pattern);
1.1369 + } else {
1.1370 + # undefined pattern means "-a" option that selects
1.1371 + # all packages from repository that are installed
1.1372 + # and not explicitly excluded on command line
1.1373 + @todo = grep {
1.1374 + my ($n) = $_;
1.1375 + (ref($env->{installed}->{$n}))
1.1376 + && !exists($env->{exclude}->{$n})
1.1377 + && grep { $_ ne '-' } keys %{$env->{installed}->{$n}}
1.1378 + } keys(%{$env->{repository}});
1.1379 + }
1.1380 + return \@todo;
1.1381 +}
1.1382 +
1.1383 +# pull in OPTIONS for a package or an RPM file
1.1384 +my $get_with_cache = {};
1.1385 +sub get_with ($;$) {
1.1386 + my ($t, $fn) = @_;
1.1387 + my (@l, %with);
1.1388 + my ($optmap, $opt);
1.1389 +
1.1390 + if ($t->{OPTIONS}) {
1.1391 + $opt = $t->{OPTIONS};
1.1392 + } else {
1.1393 + if (defined($fn)) {
1.1394 + @l = run($config->{"rpm"} . " -q --provides -p $fn");
1.1395 + } else {
1.1396 + if (not exists($get_with_cache->{-provides})) {
1.1397 + # pre-cache the "provides" query for all(!) packages at once for speedup
1.1398 + my @c = run($config->{"rpm"} . " -qa --qf " .
1.1399 + '\'%{NAME}[ :::%{PROVIDENAME}:::%{PROVIDEFLAGS:depflags}:::%{PROVIDEVERSION}:::]\n\'');
1.1400 + $get_with_cache->{-provides} = {};
1.1401 + foreach my $c (@c) {
1.1402 + if ($c =~ m/^(\S+)(.*)$/s) {
1.1403 + my ($name, $provides) = ($1, $2);
1.1404 + while ($provides =~ m/\s+:::(.+?):::\s*(.*?)\s*:::(.*?):::/g) {
1.1405 + $get_with_cache->{-provides}->{$name} = [] if (not exists($get_with_cache->{-provides}->{$name}));
1.1406 + push(@{$get_with_cache->{-provides}->{$name}}, "$1 $2 $3");
1.1407 + }
1.1408 + }
1.1409 + }
1.1410 + }
1.1411 + @l = $get_with_cache->{-provides}->{$t->{name}};
1.1412 + if (not @l) {
1.1413 + # (should not happen in practice, but anyway)
1.1414 + @l = run($config->{"rpm"} . " -q --provides $t->{name}");
1.1415 + $get_with_cache->{-provides}->{$t->{name}} = [ @l ];
1.1416 + }
1.1417 + }
1.1418 + $opt = parse_provideslist(\@l);
1.1419 + if (scalar(keys(%$opt)) == 0) {
1.1420 + if (defined($fn)) {
1.1421 + @l = run($config->{"rpm"} . " -qi -p $fn");
1.1422 + } else {
1.1423 + if (not exists($get_with_cache->{-infos})) {
1.1424 + # pre-cache the "infos" query for all(!) packages at once for speedup
1.1425 + my @c = run($config->{"rpm"} . " -qi -a");
1.1426 + my $p = "";
1.1427 + $get_with_cache->{-infos} = {};
1.1428 + foreach my $c (@c) {
1.1429 + $p = $1 if ($c =~ m/^Name:\s+(\S+)/s);
1.1430 + $get_with_cache->{-infos}->{$p} = [] if (not exists($get_with_cache->{-infos}->{$p}));
1.1431 + push(@{$get_with_cache->{-infos}->{$p}}, $c);
1.1432 + }
1.1433 + }
1.1434 + @l = $get_with_cache->{-infos}->{$t->{name}};
1.1435 + if (not @l) {
1.1436 + # (should not happen in practice, but anyway)
1.1437 + @l = run($config->{"rpm"} . " -qi $t->{name}");
1.1438 + $get_with_cache->{-infos}->{$t->{name}} = [ @l ];
1.1439 + }
1.1440 + }
1.1441 + $opt = parse_options(\@l);
1.1442 + }
1.1443 + $t->{OPTIONS} = $opt;
1.1444 + }
1.1445 + return $opt;
1.1446 +}
1.1447 +
1.1448 +# copy options from new to old
1.1449 +# where option already exists in old or option key
1.1450 +# matches regular expression
1.1451 +sub override_options ($$$) {
1.1452 + my ($old, $new, $reg) = @_;
1.1453 + my ($k);
1.1454 +
1.1455 + foreach $k (keys(%$new)) {
1.1456 + if ((exists($old->{$k}) && $old->{$k} ne $new->{$k}) || $k =~ m/^$reg$/) {
1.1457 + $old->{$k} = $new->{$k};
1.1458 + }
1.1459 + }
1.1460 +}
1.1461 +
1.1462 +# filter package options
1.1463 +sub filter_name_with ($$$) {
1.1464 + my ($name, $with, $global) = @_;
1.1465 + my (@keys);
1.1466 +
1.1467 + if ($global) {
1.1468 + push(@keys, grep { !/::/ } keys %$with);
1.1469 + }
1.1470 + push(@keys, grep { m/::/ } keys %$with);
1.1471 + return {
1.1472 + map {
1.1473 + my ($k) = $_;
1.1474 + $k !~ m/::/ || $k =~ s/^\Q$name\E:://
1.1475 + ? ( $k => $with->{$_} )
1.1476 + : ( )
1.1477 + } @keys
1.1478 + };
1.1479 +}
1.1480 +
1.1481 +# filter out package relevant options
1.1482 +sub name_with ($$) {
1.1483 + filter_name_with($_[0], $_[1], 1);
1.1484 +}
1.1485 +
1.1486 +# filter out package specific options
1.1487 +sub name_only_with ($$) {
1.1488 + filter_name_with($_[0], $_[1], 0);
1.1489 +}
1.1490 +
1.1491 +# evaluate a condition attribute from an option set
1.1492 +sub conditional ($$) {
1.1493 + my ($cond, $with) = @_;
1.1494 + my (@s, $res);
1.1495 +
1.1496 + return 1 if ($cond eq '' || !defined($with));
1.1497 + foreach (split(/\s+/,$cond)) {
1.1498 + if ($_ eq '+') {
1.1499 + die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 2;
1.1500 + my ($a) = pop(@s);
1.1501 + my ($b) = pop(@s);
1.1502 + push(@s, $a && $b);
1.1503 + } elsif ($_ eq '|') {
1.1504 + die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 2;
1.1505 + my ($a) = pop(@s);
1.1506 + my ($b) = pop(@s);
1.1507 + push(@s, $a || $b);
1.1508 + } elsif ($_ eq '!') {
1.1509 + die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 1;
1.1510 + my ($a) = pop(@s);
1.1511 + push(@s, !$a);
1.1512 + } else {
1.1513 + push(@s, ($with->{$_} eq 'yes') ? 1 : 0);
1.1514 + }
1.1515 + }
1.1516 + die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 1;
1.1517 + $res = pop(@s);
1.1518 +
1.1519 + die "openpkg:build:FATAL: stack not empty in: $cond\n" if scalar(@s) > 0;
1.1520 + return $res;
1.1521 +}
1.1522 +
1.1523 +# retrieve conditional target attributes in map
1.1524 +sub target_attribute ($$$;$) {
1.1525 + my ($target, $env, $attr, $with) = @_;
1.1526 + my ($optreg) = $env->{config}->{optreg};
1.1527 + my ($name, @out);
1.1528 +
1.1529 + return if (not $target);
1.1530 + $name = $target->{name};
1.1531 +
1.1532 + my ($mywith) = ($with ? $with : get_with($target));
1.1533 + override_options($mywith, name_with($name, $env->{with}), $optreg);
1.1534 +
1.1535 + foreach (@{$target->{$attr}}) {
1.1536 + next if (not conditional($_->{'cond'}, $mywith));
1.1537 + push(@out, $_->{'value'});
1.1538 + }
1.1539 + return \@out;
1.1540 +}
1.1541 +
1.1542 +# see whether target is in map
1.1543 +sub target_exists ($$) {
1.1544 + my ($target, $map) = @_;
1.1545 + my ($vmap) = $map->{$target->{name}};
1.1546 + return if (not $vmap);
1.1547 + return (
1.1548 + !defined $target->{version}
1.1549 + || defined $vmap->{vs($target)}
1.1550 + );
1.1551 +}
1.1552 +
1.1553 +# see whether target has conflicts
1.1554 +sub target_conflicts ($$) {
1.1555 + my ($target, $env) = @_;
1.1556 + return target_attribute($target, $env, 'conflicts');
1.1557 +}
1.1558 +
1.1559 +# retrieve build dependencies for target
1.1560 +sub target_depends ($$) {
1.1561 + my ($target, $env) = @_;
1.1562 + return target_attribute($target, $env, 'depends');
1.1563 +}
1.1564 +
1.1565 +# retrieve runtime dependencies for target
1.1566 +sub target_keeps ($$) {
1.1567 + my ($target, $env) = @_;
1.1568 + return target_attribute($target, $env, 'keeps');
1.1569 +}
1.1570 +
1.1571 +# retrieve source list for target
1.1572 +sub target_source ($$) {
1.1573 + my ($target, $env) = @_;
1.1574 + return target_attribute($target, $env, 'source');
1.1575 +}
1.1576 +
1.1577 +# retrieve nosource list for target
1.1578 +sub target_nosource ($$) {
1.1579 + my ($target, $env) = @_;
1.1580 + return target_attribute($target, $env, 'nosource');
1.1581 +}
1.1582 +
1.1583 +# check whether target conflicts against map
1.1584 +sub target_has_conflicts ($$$) {
1.1585 + my ($target, $map, $env) = @_;
1.1586 + my ($conflicts, $t);
1.1587 +
1.1588 + $conflicts = target_conflicts($target, $env);
1.1589 + foreach (@$conflicts) {
1.1590 + my ($t) = find_target($_, $map, 0);
1.1591 + return $t if $t;
1.1592 + }
1.1593 + return;
1.1594 +}
1.1595 +
1.1596 +# record target status
1.1597 +sub target_setstatus ($$$) {
1.1598 + my ($target, $status, $pri) = @_;
1.1599 +
1.1600 + if ($pri > $target->{STATUSPRI}) {
1.1601 + $target->{STATUSPRI} = $pri;
1.1602 + $target->{STATUS} = $status;
1.1603 + }
1.1604 +}
1.1605 +
1.1606 +# strip doubles from depend/keep lists
1.1607 +# and return a map name => depend/keep
1.1608 +sub unique_map {
1.1609 + my (%out);
1.1610 + foreach (@_) {
1.1611 + foreach (@$_) {
1.1612 + $out{$_->{name}} = $_;
1.1613 + }
1.1614 + }
1.1615 + return %out;
1.1616 +}
1.1617 +
1.1618 +# check whether installed package matches build options. If default
1.1619 +# = 1 then options which are not required must be identical to the
1.1620 +# DEFOPTS.
1.1621 +sub target_suitable ($$$) {
1.1622 + my ($target, $with, $default) = @_;
1.1623 + my ($iwith, $dwith);
1.1624 + my ($k, $v);
1.1625 +
1.1626 + if ($target->{GOAL}) {
1.1627 + $with = name_with($target->{name}, $with);
1.1628 + } else {
1.1629 + $with = name_only_with($target->{name}, $with);
1.1630 + }
1.1631 + $iwith = $target->{OPTIONS};
1.1632 + $dwith = $target->{DEFOPTS};
1.1633 + while (($k,$v) = each(%$iwith)) {
1.1634 + if (exists($with->{$k})) {
1.1635 + return 0 if ($iwith->{$k} ne $with->{$k});
1.1636 + } elsif ($default) {
1.1637 + return 0 if ($iwith->{$k} ne $dwith->{$k});
1.1638 + }
1.1639 + }
1.1640 + return 1;
1.1641 +}
1.1642 +
1.1643 +# determine whether target should be rebuild
1.1644 +sub target_better ($$$) {
1.1645 + my ($env, $target, $map) = @_;
1.1646 + my ($vs) = vs($target);
1.1647 + my ($vmap) = $map->{$target->{name}};
1.1648 +
1.1649 + # rebuild if target isn't installed
1.1650 + return 'new' unless $vmap;
1.1651 +
1.1652 + # if "-e" then
1.1653 + # always update if installed version is different from repository
1.1654 + if ($env->{exact} && !grep { vcmp($vs, $_) == 0; } keys(%$vmap)) {
1.1655 + return 'exact';
1.1656 + }
1.1657 +
1.1658 + # if target is goal
1.1659 + # always update if installed version is older than repository
1.1660 + if ($target->{GOAL} && !grep { vcmp($vs, $_) <= 0; } keys(%$vmap)) {
1.1661 + return 'goal';
1.1662 + }
1.1663 +
1.1664 + # if -U then
1.1665 + # always update if installed version is older than repository
1.1666 + if ($env->{upgrade} && !grep { vcmp($vs, $_) <= 0; } keys(%$vmap)) {
1.1667 + return 'upgrade';
1.1668 + }
1.1669 +
1.1670 + # if -z/-Z then
1.1671 + # always update if installed version is equal or older than repository
1.1672 + if ($env->{zero} && grep { vcmp($vs, $_) >= 0; } keys(%$vmap)) {
1.1673 + return 'zero';
1.1674 + }
1.1675 +
1.1676 + # keep installed target
1.1677 + return;
1.1678 +}
1.1679 +
1.1680 +# check if target record describes a source package
1.1681 +sub is_source ($) {
1.1682 + my ($t) = @_;
1.1683 + return !(defined $t->{'prefix'});
1.1684 +}
1.1685 +
1.1686 +# there can be multiple sources for a target release
1.1687 +sub chose_source ($$$$$) {
1.1688 + my ($env, $name, $select, $vmap, $cond) = @_;
1.1689 + my (@targ, @recs, @nrecs, $rec, %nam);
1.1690 +
1.1691 + # resolve name into a list of versions
1.1692 + # for virtual targets this resolves to a list
1.1693 + # of real targets that provide the virtual target
1.1694 + @targ = get_targets($vmap, sub { 1; });
1.1695 + return unless @targ;
1.1696 +
1.1697 + # find usable binary targets add all source targets
1.1698 + @recs = (
1.1699 + ( grep {
1.1700 + !$env->{sourceonly}
1.1701 + && !is_source($_)
1.1702 + && $_->{'platform'} eq $env->{config}->{platform}
1.1703 + && $_->{'prefix'} eq $env->{config}->{prefix}
1.1704 + } get_targets($vmap, $cond) ),
1.1705 + ( grep {
1.1706 + is_source($_)
1.1707 + } @targ )
1.1708 + );
1.1709 + return if (not @recs);
1.1710 +
1.1711 + # limit list to exact matches if provided by "-e"
1.1712 + if (defined($select)) {
1.1713 + @recs = grep {
1.1714 + vsn($_) =~ m/^\Q$select\E/
1.1715 + } @recs;
1.1716 + }
1.1717 +
1.1718 + # try to resolve ambiguity against installed targets
1.1719 + # and targets previously selected
1.1720 + if (scalar(@recs) > 1) {
1.1721 + @nrecs = grep {
1.1722 + $env->{built}->{$_->{name}}
1.1723 + || $env->{installed}->{$_->{name}}
1.1724 + } @recs;
1.1725 + @recs = @nrecs if (@nrecs);
1.1726 + }
1.1727 +
1.1728 + # try to resolve ambiguity against hints
1.1729 + if ($env->{hint}) {
1.1730 + @nrecs = grep {
1.1731 + exists($env->{hint}->{$_->{name}})
1.1732 + } @recs;
1.1733 + @recs = @nrecs if (@nrecs);
1.1734 + }
1.1735 +
1.1736 + # try to resolve ambiguity against targets that match
1.1737 + # the exact name
1.1738 + if (scalar(@recs) > 1) {
1.1739 + @nrecs = grep {
1.1740 + $name eq $_->{name}
1.1741 + } @recs;
1.1742 + @recs = @nrecs if (@nrecs);
1.1743 + }
1.1744 +
1.1745 + # try to resolve ambiguity by preferring binaries
1.1746 + if (scalar(@recs) > 1 && !$env->{sourceonly}) {
1.1747 + @nrecs = grep {
1.1748 + defined($_->{'platform'})
1.1749 + } @recs;
1.1750 + @recs = @nrecs if (@nrecs);
1.1751 + }
1.1752 +
1.1753 + # if we still have non-unique targets, complain
1.1754 + if (scalar(@recs) > 1) {
1.1755 + %nam = map { $_->{name} => 1 } @recs;
1.1756 + if (scalar(keys(%nam)) > 1) {
1.1757 + print "# ambigous sources for $name\n";
1.1758 + my ($i) = 0;
1.1759 + foreach (@recs) {
1.1760 + print "# $i: ".vsn($_)." = $_->{href}\n";
1.1761 + $i++;
1.1762 + }
1.1763 + return;
1.1764 + }
1.1765 + }
1.1766 +
1.1767 + # prefer full-source packages
1.1768 + if (scalar(@recs) > 1) {
1.1769 + @nrecs = grep {
1.1770 + ! $_->{nosource}
1.1771 + || ! @{$_->{nosource}}
1.1772 + } @recs;
1.1773 + unless (@nrecs) {
1.1774 + @nrecs = grep {
1.1775 + $_->{href} !~ m/\.nosrc.rpm$/
1.1776 + } @recs;
1.1777 + }
1.1778 + @recs = @nrecs if (@nrecs);
1.1779 + }
1.1780 +
1.1781 + # nothing left -> exit
1.1782 + return if (scalar(@recs) == 0);
1.1783 +
1.1784 + # chose last (= max version) in list of targets
1.1785 + $rec = $recs[-1];
1.1786 + print "# source for $name is ".vsn($rec)."\n";
1.1787 + return $rec;
1.1788 +}
1.1789 +
1.1790 +# locate target for a dependency
1.1791 +sub dep2target ($$$) {
1.1792 + my ($dep, $env, $source) = @_;
1.1793 + my ($name, $op, @targ);
1.1794 + my ($i, $r, $b, $cond, $version);
1.1795 + my ($t, $tdef, $why);
1.1796 +
1.1797 + ($name, $op, $version) = ($dep->{name}, $dep->{op}, $dep->{val});
1.1798 +
1.1799 + $i = $env->{installed}->{$name};
1.1800 + $r = $env->{repository}->{$name};
1.1801 + $b = $env->{built}->{$name};
1.1802 +
1.1803 + return if (not ($i || $r || $b));
1.1804 +
1.1805 + if (!defined($op)) {
1.1806 + $cond = sub { 1; };
1.1807 + } elsif ($op eq 'geq') {
1.1808 + $cond = sub { vcmp($_[0],$version) >= 0; };
1.1809 + } elsif ($op eq 'leq') {
1.1810 + $cond = sub { vcmp($_[0],$version) <= 0; };
1.1811 + } elsif ($op eq 'gt') {
1.1812 + $cond = sub { vcmp($_[0],$version) > 0; };
1.1813 + } elsif ($op eq 'lt') {
1.1814 + $cond = sub { vcmp($_[0],$version) < 0; };
1.1815 + } elsif ($op eq 'equ') {
1.1816 + $cond = sub { vcmp($_[0],$version) == 0; };
1.1817 + } else {
1.1818 + die "openpkg:build:FATAL: internal error in dep2target\n";
1.1819 + }
1.1820 +
1.1821 + $tdef = undef;
1.1822 +
1.1823 + # search installed target that matches requirement
1.1824 + # use it if we are not upgrading (no -U and no -z/-Z)
1.1825 + if ($i && (@targ = get_targets($i, $cond))) {
1.1826 + foreach $t (@targ) {
1.1827 + get_with($t);
1.1828 + if (target_suitable($t, $env->{with}, 0)) {
1.1829 + $tdef = $t;
1.1830 + if (not ($env->{upgrade} || $env->{zero} || $source)) {
1.1831 + return ($t, 1);
1.1832 + }
1.1833 + }
1.1834 + }
1.1835 + }
1.1836 +
1.1837 + # search target in current build list that matches requirement
1.1838 + # use it if it exists
1.1839 + if ($b && (@targ = get_targets($b, $cond))) {
1.1840 + $t = $targ[0];
1.1841 + return ($t, 1);
1.1842 + }
1.1843 +
1.1844 + # search target in repository and install it, if it is newer than
1.1845 + # corresponding installed versions avoid repository packages that
1.1846 + # would install 'new' (i.e. are not an upgrade of an existing
1.1847 + # package)
1.1848 + $t = chose_source($env, $name, undef, $r, $cond);
1.1849 + if ($t) {
1.1850 + if (!$tdef || (
1.1851 + ($why = target_better($env, $t, $env->{installed})) &&
1.1852 + $why ne 'new'
1.1853 + ) || $source) {
1.1854 + return ($t, 0);
1.1855 + }
1.1856 + }
1.1857 +
1.1858 + # if nothing is suitable in repository then fall back to
1.1859 + # anything we already have installed but that we skipped
1.1860 + # above to look for upgrades.
1.1861 + if ($tdef) {
1.1862 + return ($tdef, 1);
1.1863 + }
1.1864 +
1.1865 + return;
1.1866 +}
1.1867 +
1.1868 +# compute reverse dependency map
1.1869 +sub get_revdep ($) {
1.1870 + my ($env) = @_;
1.1871 + my ($i) = $env->{'installed'};
1.1872 + my ($r) = $env->{'repository'};
1.1873 + my ($pkg, %dep, %dlist, %rev);
1.1874 + my (@targ, $t, $t1, $t2, $with, $name, $vmap);
1.1875 + my ($d, $k, %d, $old, %name, %pkg);
1.1876 +
1.1877 + print "# computing reverse dependencies\n";
1.1878 +
1.1879 + # iterate over all installed packages
1.1880 + foreach $pkg (keys(%$i)) {
1.1881 + $vmap = $r->{$pkg};
1.1882 + if (not $vmap) {
1.1883 + print "# ATTENTION: $pkg has no upgrade path (installed package not found in repository)\n";
1.1884 + next;
1.1885 + }
1.1886 +
1.1887 + # get forward dependencies from installed packages
1.1888 + # dep{a}{b} is true if b depends directly on a
1.1889 + # dlist{a} is list of packages that depend on a
1.1890 + @targ = get_targets($i->{$pkg}, sub { 1; });
1.1891 + foreach $t (@targ) {
1.1892 + $with = get_with($t);
1.1893 + $d = target_attribute($t, $env, 'depends', $with);
1.1894 + $k = target_attribute($t, $env, 'keeps', $with);
1.1895 + next if (not (@$d || @$k));
1.1896 + %d = unique_map($d,$k);
1.1897 +
1.1898 + # resolve package
1.1899 + if (not exists($pkg{$pkg})) {
1.1900 + ($t2, $old) = dep2target({ name => $pkg }, $env, 1);
1.1901 + $t2 = undef if ($old);
1.1902 + $pkg{$pkg} = $t2;
1.1903 + }
1.1904 + $t2 = $pkg{$pkg};
1.1905 + next if (not $t2);
1.1906 + foreach (keys(%d)) {
1.1907 + next if ($_ eq 'OpenPKG');
1.1908 + # resolve target
1.1909 + unless (exists($name{$_})) {
1.1910 + ($t1, $old) = dep2target($d{$_}, $env, 0);
1.1911 + $name{$_} = ($t1 ? $t1->{name} : $_);
1.1912 + }
1.1913 + $name = $name{$_};
1.1914 + if (not $dep{$name}{$t->{name}}) {
1.1915 + $dep{$name}{$t->{name}} = 1;
1.1916 + push(@{$dlist{$name}}, $t2);
1.1917 + }
1.1918 + }
1.1919 + }
1.1920 + }
1.1921 +
1.1922 + # sort reverse dependencies
1.1923 + foreach $pkg (keys(%dep)) {
1.1924 + $rev{$pkg} = [
1.1925 + sort {
1.1926 + $dep{$b->{name}}{$a->{name}}
1.1927 + || -$dep{$a->{name}}{$b->{name}}
1.1928 + || $a->{name} cmp $b->{name}
1.1929 + } @{$dlist{$pkg}}
1.1930 + ];
1.1931 + }
1.1932 +
1.1933 + # return hash of package reverse dependencies
1.1934 + return \%rev;
1.1935 +}
1.1936 +
1.1937 +# build package dependencies
1.1938 +# (all input and output is passed in 'env' hash)
1.1939 +sub build_deps ($$) {
1.1940 + my ($pattern, $env) = @_;
1.1941 + my ($todo, @list, $list, @out);
1.1942 +
1.1943 + # determine all packages which match the pattern
1.1944 + $todo = search_pattern($pattern, $env);
1.1945 +
1.1946 + # unfold target names into all(!) real targets names
1.1947 + @list =
1.1948 + map {
1.1949 + map {
1.1950 + map {
1.1951 + $_->{name}
1.1952 + } @$_
1.1953 + } values(%{$env->{repository}->{$_}})
1.1954 + } @$todo;
1.1955 +
1.1956 + # also add target name
1.1957 + push @list, @$todo;
1.1958 +
1.1959 + # strip duplicate names
1.1960 + @list = keys %{ { map { $_ => 1 } @list } };
1.1961 +
1.1962 + # cache reverse dependencies
1.1963 + if (not $env->{revdep}) {
1.1964 + $env->{revdep} = get_revdep($env);
1.1965 + }
1.1966 +
1.1967 + # map targets into list of dependency names
1.1968 + @list = map {
1.1969 + $env->{revdep}->{$_}
1.1970 + ? (@{$env->{revdep}->{$_}})
1.1971 + : ()
1.1972 + } @list;
1.1973 +
1.1974 + # iterate over dependencies
1.1975 + foreach (@list) {
1.1976 + # avoiding cycles
1.1977 + next if ($env->{builddeps}->{$_->{name}});
1.1978 + $env->{builddeps}->{$_->{name}} = 1;
1.1979 +
1.1980 + # generate result
1.1981 + push(@out, $_);
1.1982 +
1.1983 + # generate result recursively
1.1984 + $list = build_deps($_->{name}, $env); # RECURSION
1.1985 + push(@out, @$list);
1.1986 + }
1.1987 +
1.1988 + # return final results
1.1989 + return \@out;
1.1990 +}
1.1991 +
1.1992 +# report options that are not used for
1.1993 +sub warn_about_options ($$$) {
1.1994 + my ($target, $with, $c) = @_;
1.1995 + my ($iwith) = $target->{OPTIONS};
1.1996 + my ($k, $v);
1.1997 +
1.1998 + return if (not defined($iwith));
1.1999 + $with = name_with($target->{name}, $with);
1.2000 + while (($k,$v) = each %$with) {
1.2001 + if (not ($k =~ m/^$c->{optreg}$/ || exists $iwith->{$k})) {
1.2002 + print "# ATTENTION: $target->{name} ignores option '$k'\n";
1.2003 + }
1.2004 + }
1.2005 +}
1.2006 +
1.2007 +# find target in map
1.2008 +sub find_target ($$$) {
1.2009 + my ($name, $map, $pos) = @_;
1.2010 + my ($vmap) = $map->{$name};
1.2011 + my (@vs);
1.2012 +
1.2013 + return if (not $vmap);
1.2014 + @vs = sort { vcmp($b,$a) } keys(%$vmap);
1.2015 + return $vmap->{$vs[$pos]}->[-1];
1.2016 +}
1.2017 +
1.2018 +# add dependency as build option
1.2019 +sub depend_option ($$$) {
1.2020 + my ($target, $dep, $env) = @_;
1.2021 + my ($with, $opt, $relmap, @t, $t);
1.2022 + my ($pro) = depends2provides($dep);
1.2023 + my ($conflict) = 0;
1.2024 +
1.2025 + return 1 if (not defined($pro->{with}));
1.2026 +
1.2027 + my ($val) = defined($pro->{version}) ? $pro->{version} : 'yes';
1.2028 +
1.2029 + $with = $env->{with};
1.2030 + $opt = $pro->{prefix}.'::'.$pro->{with};
1.2031 + if (defined($with->{$opt}) && $with->{$opt} ne $val) {
1.2032 + print "# ", vsn($target), " has conflicting requirement $opt = $with->{$opt} != $val\n";
1.2033 + $conflict = 1;
1.2034 + }
1.2035 +
1.2036 + $relmap = $env->{built}->{$pro->{prefix}};
1.2037 + @t = get_targets($relmap, sub { 1; });
1.2038 + foreach $t (@t) {
1.2039 + $with = $t->{OPTIONS};
1.2040 + $opt = $pro->{with};
1.2041 + if (defined($with->{$opt}) && $with->{$opt} ne $val) {
1.2042 + print "# ", vsn($t), " has conflicting requirement $opt = $with->{$opt} != $val\n";
1.2043 + $conflict = 1;
1.2044 + }
1.2045 + }
1.2046 +
1.2047 + return 0 if ($conflict);
1.2048 +
1.2049 + print "# ", vsn($target), " adds option $opt = $val\n";
1.2050 + $with->{$opt} = $val;
1.2051 + return 1;
1.2052 +}
1.2053 +
1.2054 +# remember fatal error
1.2055 +sub pusherr ($$$) {
1.2056 + my ($env, $target, $mess) = @_;
1.2057 + print "# $mess\n";
1.2058 + push(@{$env->{fatal}}, vsn($target).": $mess\n");
1.2059 +}
1.2060 +
1.2061 +# generate dependencies
1.2062 +sub make_dep ($$$$$$$) {
1.2063 + my ($who, $target, $depth, $env, $list, $blist, $clist) = @_;
1.2064 + my ($d, $k, %d, %k, $t, $old);
1.2065 + my (@deps, $conflict, $why);
1.2066 +
1.2067 + # check whether target is already in list of to be build packages
1.2068 + if (target_exists($target, $env->{built})) {
1.2069 + print "# $target->{name} is already in list\n";
1.2070 + return;
1.2071 + }
1.2072 +
1.2073 + # check whether target is in conflict with already installed package
1.2074 + if ($t = target_has_conflicts($target, $env->{installed}, $env)) {
1.2075 + target_setstatus($target, 'CONFLICT', 4);
1.2076 + push(@$clist, $target);
1.2077 + pusherr($env, $target, "$target->{name} conflicts with ".vsn($t));
1.2078 + return;
1.2079 + }
1.2080 +
1.2081 + # check whether target is in conflict with to be build package
1.2082 + if ($t = target_has_conflicts($target, $env->{built}, $env)) {
1.2083 + target_setstatus($target, 'CONFLICT', 4);
1.2084 + push(@$clist, $target);
1.2085 + pusherr($env, $target, "$target->{name} conflicts with ".vsn($t));
1.2086 + return;
1.2087 + }
1.2088 +
1.2089 + # see if a target is already installed and requires a rebuild
1.2090 + if ($t = find_target($target->{name}, $env->{installed}, -1)) {
1.2091 + if (exists($env->{exclude}->{$target->{name}})) {
1.2092 + print "# excluding $target->{name} (no upgrade allowed)\n";
1.2093 + return;
1.2094 + }
1.2095 +
1.2096 + # pull in options (for status report)
1.2097 + if ($target->{REBUILD}) {
1.2098 + target_setstatus($target, 'DEPEND', 1);
1.2099 + print "# rebuilding $target->{name} (dependency)\n";
1.2100 + } elsif ($env->{zero}) {
1.2101 + target_setstatus($target, 'ZERO', 1);
1.2102 + print "# rebuilding $target->{name} (zero)\n";
1.2103 + } elsif (vs($target) ne vs($t)) {
1.2104 + target_setstatus($target, 'UPDATE', 3);
1.2105 + print "# rebuilding $target->{name} (update)\n";
1.2106 + } elsif (!target_suitable($t, $env->{with}, 0)) {
1.2107 + target_setstatus($target, 'MISMATCH', 2);
1.2108 + print "# rebuilding $target->{name} (parameter mismatch)\n";
1.2109 + } elsif ($env->{goals} && $target->{GOAL}) {
1.2110 + target_setstatus($target, 'GOAL', 3);
1.2111 + print "# rebuilding $target->{name} (goal)\n";
1.2112 + } else {
1.2113 + print "# $target->{name} is already installed\n";
1.2114 + return;
1.2115 + }
1.2116 +
1.2117 + # use options from installed base
1.2118 + override_options(get_with($target), get_with($t), $env->{config}->{optreg});
1.2119 +
1.2120 + # remember this is a rebuild for a proxy package
1.2121 + $target->{PROXY} = $t->{PROXY};
1.2122 + $target->{REBUILD} = 1;
1.2123 + } else {
1.2124 + print "# creating $target->{name}\n";
1.2125 + target_setstatus($target, 'ADD', 3);
1.2126 + }
1.2127 +
1.2128 + if (exists($env->{exclude}->{$target->{name}})) {
1.2129 + die "openpkg:build:FATAL: target ".vsn($target)." is forbidden\n";
1.2130 + }
1.2131 +
1.2132 + # mark this as a target before reverse dependencies trigger it again
1.2133 + push(@{$env->{built}->{$target->{name}}->{vs($target)}}, $target);
1.2134 + $target->{LIMBO} = 1;
1.2135 +
1.2136 + # recurse over dependencies
1.2137 + $d = target_depends($target, $env);
1.2138 + $k = target_keeps($target, $env);
1.2139 + if (@$d || @$k) {
1.2140 + %d = unique_map($d, $k);
1.2141 + %k = unique_map($k);
1.2142 + @deps = ();
1.2143 + $conflict = 0;
1.2144 + foreach (keys %d) {
1.2145 + # old index misses a OpenPKG provider in the index... skip it
1.2146 + next if ($_ eq 'OpenPKG');
1.2147 + ($t, $old) = dep2target($d{$_}, $env, 0);
1.2148 + if ($t) {
1.2149 + if ($old) {
1.2150 + print "# $target->{name} uses ".vsn($t)." for $_\n";
1.2151 + if ($t->{LIMBO}) {
1.2152 + print "# ATTENTION: ".vsn($t)." is in LIMBO\n";
1.2153 + }
1.2154 + next;
1.2155 + }
1.2156 + if (not depend_option($t, $d{$_}, $env)) {
1.2157 + push(@$clist, $target);
1.2158 + pusherr($env, $target, "$target->{name} has conflicting requirement");
1.2159 + target_setstatus($target, 'UNDEF', 4);
1.2160 + $conflict = 1;
1.2161 + next;
1.2162 + }
1.2163 + if ($k{$_}) {
1.2164 + push(@$blist, $t);
1.2165 + print "# $target->{name} installs ".vsn($t)." for $_\n";
1.2166 + } else {
1.2167 + print "# $target->{name} requires ".vsn($t)." for $_\n";
1.2168 + }
1.2169 + push(@deps, $t);
1.2170 + } else {
1.2171 + push(@$clist, $target);
1.2172 + pusherr($env, $target, "$target->{name} searches a frood called '$_'");
1.2173 + target_setstatus($target, 'UNDEF', 4);
1.2174 + $conflict = 1;
1.2175 + }
1.2176 + }
1.2177 + if (not $conflict) {
1.2178 + foreach $t (@deps) {
1.2179 + make_dep($target, $t, $depth+1, $env, $list, $blist, $clist); # RECURSION
1.2180 + }
1.2181 + }
1.2182 + }
1.2183 +
1.2184 + print "# adding ".vsn($target)." to list\n";
1.2185 + $target->{WHO} = $who;
1.2186 + $target->{WHY} = $target->{STATUS};
1.2187 + push(@$list, $target);
1.2188 +
1.2189 + # remember new options
1.2190 + override_options(get_with($target), name_with($target->{name}, $env->{with}), '');
1.2191 +
1.2192 + # moan about non-source packages
1.2193 + foreach (@{target_nosource($target, $env)}) {
1.2194 + my ($p) = target_source($target, $env)->[$_];
1.2195 + $p =~ s/.*\///;
1.2196 + print "# ATTENTION: unpackaged source $_: $p\n";
1.2197 + }
1.2198 +
1.2199 + # cleanup limbo
1.2200 + $target->{LIMBO} = 0;
1.2201 +
1.2202 + # a dependency could not be resolved, don't bother with reverse
1.2203 + # dependencies for this target
1.2204 + return if ($conflict);
1.2205 +
1.2206 + if (!$env->{quick} && $target->{name} ne 'openpkg' ) {
1.2207 + if (not $env->{revdep}) {
1.2208 + $env->{revdep} = get_revdep($env);
1.2209 + }
1.2210 + foreach $t (@{$env->{revdep}->{$target->{name}}}) {
1.2211 + # this is a rebuild, triggering further revdeps
1.2212 + $t->{REBUILD} = 1;
1.2213 +
1.2214 + # this is a rebuild, keep this installed
1.2215 + push(@$blist, $t);
1.2216 +
1.2217 + print "# rebuilding reverse dependency ".vsn($t)."\n";
1.2218 + make_dep($target, $t, $depth+1, $env, $list, $blist, $clist); # RECURSION
1.2219 + }
1.2220 + }
1.2221 +}
1.2222 +
1.2223 +# generate build lists for targets matched by pattern
1.2224 +# (all input and output is passed in 'env' hash)
1.2225 +sub build_list ($$) {
1.2226 + my ($pattern, $env) = @_;
1.2227 + my (@goals, @targets, @keeps, @conflicts, @bonly, $t);
1.2228 + my ($name, $select, $r, $i);
1.2229 + my ($todo, %keep);
1.2230 +
1.2231 + # determine all packages which match the pattern
1.2232 + $todo = search_pattern($pattern, $env);
1.2233 +
1.2234 + # chose sources for goals from repository
1.2235 + foreach $name (@$todo) {
1.2236 + $select = undef;
1.2237 + $select = $1 if ($name =~ s/,([^\s,]+)$//);
1.2238 + $t = undef;
1.2239 +
1.2240 + # keeping installed packages for goals is ugly
1.2241 + # - we currently do not support installed source RPMs
1.2242 + # - source RPMs might already have expired from repository
1.2243 + # consequence:
1.2244 + # - goals are always upgraded to repository versions
1.2245 + #if (not $env->{upgrade}) {
1.2246 + # $i = $env->{installed}->{$name};
1.2247 + # $t = chose_source($env, $name, $select, $i, sub { 1; });
1.2248 + #}
1.2249 + if (not $t) {
1.2250 + $r = $env->{repository}->{$name};
1.2251 + $t = chose_source($env, $name, $select, $r, sub { 1; });
1.2252 + }
1.2253 +
1.2254 + if ($t) {
1.2255 + warn_about_options($t, $env->{with}, $env->{config});
1.2256 + $t->{GOAL} = 1;
1.2257 + push @goals, $t;
1.2258 + } else {
1.2259 + # error
1.2260 + if ($env->{status}) {
1.2261 + print "# dropping goal '$name'\n";
1.2262 + } else {
1.2263 + die "openpkg:build:FATAL: cannot find source for '$name'\n";
1.2264 + }
1.2265 + }
1.2266 + }
1.2267 + return if (not @goals);
1.2268 +
1.2269 + # recurse over dependencies
1.2270 + @targets = ();
1.2271 + @keeps = @goals;
1.2272 + foreach $t (@goals) {
1.2273 + print "# recursing over dependencies for ".vsn($t)."\n";
1.2274 + make_dep(undef, $t, 0, $env, \@targets, \@keeps, \@conflicts);
1.2275 + }
1.2276 +
1.2277 + # determine "binary only" packages which should be not kept
1.2278 + # as they were not installed and are used temporarily only.
1.2279 + %keep = map { $_ => 1 } @keeps;
1.2280 + @bonly = reverse grep {
1.2281 + !$keep{$_} && !$env->{installed}->{$_->{name}}
1.2282 + } @targets;
1.2283 +
1.2284 + # return results
1.2285 + return (\@targets, \@bonly, \@conflicts);
1.2286 +}
1.2287 +
1.2288 +
1.2289 +#############################################################################
1.2290 +##
1.2291 +## FUNCTIONS: RESULT PRINTING
1.2292 +##
1.2293 +#############################################################################
1.2294 +
1.2295 +# determine execution command
1.2296 +sub cmd ($$) {
1.2297 + my ($w,$s) = @_;
1.2298 + if (!defined($w)) {
1.2299 + return $s;
1.2300 + } elsif ($w =~ m/^-(.*)/) {
1.2301 + return "$1 \"$s\"";
1.2302 + } else {
1.2303 + return "$w $s";
1.2304 + }
1.2305 +}
1.2306 +sub priv ($) { cmd($opt_P, $_[0]); }
1.2307 +sub npriv ($) { cmd($opt_N, $_[0]); }
1.2308 +
1.2309 +# execute a command
1.2310 +my $run_cache = {};
1.2311 +sub run ($) {
1.2312 + my $cmd = cmd($opt_N, $_[0]);
1.2313 + my $out = $run_cache->{$cmd};
1.2314 + if (not defined($out)) {
1.2315 + my @out = `$cmd`;
1.2316 + $out = [ @out ];
1.2317 + $run_cache->{$cmd} = $out;
1.2318 + }
1.2319 + return (wantarray ? @{$out} : join(//, @{$out}));
1.2320 +}
1.2321 +
1.2322 +# print dependency list
1.2323 +sub print_deps ($) {
1.2324 + my ($list) = @_;
1.2325 +
1.2326 + print join("\n", sort map { vsn($_) } @$list), "\n";
1.2327 +}
1.2328 +
1.2329 +# print dependency map
1.2330 +sub print_map ($$$$$) {
1.2331 + my ($installed, $repository, $list, $bonly, $clist) = @_;
1.2332 + my (%dep);
1.2333 +
1.2334 + foreach (@$bonly) {
1.2335 + $_->{status} = 'TEMP';
1.2336 + }
1.2337 + foreach (reverse(@$list)) {
1.2338 + printf("%-35s %-8s %s\n",
1.2339 + $_->{WHO} ? vsn($_->{WHO}) : "GOAL",
1.2340 + $_->{WHY} ? $_->{WHY} : '???',
1.2341 + vsn($_)
1.2342 + );
1.2343 + }
1.2344 +}
1.2345 +
1.2346 +# instead of printing a command list, print a status map
1.2347 +# that shows all packages and how the build process would
1.2348 +# change their status
1.2349 +sub print_status ($$$$$) {
1.2350 + my ($installed, $repository, $list, $bonly, $clist) = @_;
1.2351 + my (%bonly) = map { $_ => 1 } @$bonly;
1.2352 + my (%map, $n, @names, $t);
1.2353 + my ($old, $tag, $new);
1.2354 +
1.2355 + # augment map with additional information
1.2356 + # about conflicting and binary only (temporary) packages
1.2357 + foreach (@$list, @$clist) {
1.2358 + next if (not $_->{release} =~ m/\S/);
1.2359 + $map{$_->{name}} = {
1.2360 + rel => "$_->{version}-$_->{release}",
1.2361 + status => $_->{STATUS}
1.2362 + };
1.2363 + }
1.2364 + foreach (@$bonly) {
1.2365 + next if (not $_->{release} =~ m/\S/);
1.2366 + $map{$_->{name}} = {
1.2367 + rel => "$_->{version}-$_->{release}",
1.2368 + status => 'TEMP'
1.2369 + };
1.2370 + }
1.2371 +
1.2372 + # augment map with additional information
1.2373 + # about up-to-date and new packages
1.2374 + @names = keys(%map);
1.2375 + foreach $n (keys(%$installed)) {
1.2376 + next if ($n =~ m/::/);
1.2377 + next if (exists($map{$n}));
1.2378 + next if (not (grep { $_ ne '' } keys(%{$installed->{$n}})));
1.2379 + $map{$n}->{'status'} = 'OK';
1.2380 + push(@names, $n);
1.2381 + }
1.2382 + foreach $n (keys(%$repository)) {
1.2383 + next if ($n =~ m/::/);
1.2384 + next if (exists($map{$n}));
1.2385 + next if (not (grep { $_ ne '' } keys(%{$repository->{$n}})));
1.2386 + $t = find_target($n, $repository, 0);
1.2387 + $map{$n}->{'status'} = 'NEW';
1.2388 + $map{$n}->{'rel'} = vs($t);
1.2389 + push(@names, $n);
1.2390 + }
1.2391 +
1.2392 + # generate status output
1.2393 + foreach $n (sort(@names)) {
1.2394 + $old = join(',',
1.2395 + map { "$n-$_" }
1.2396 + sort
1.2397 + grep { $_ ne '-' }
1.2398 + keys(%{$installed->{$n}})
1.2399 + );
1.2400 + $old = $n if ($old eq '');
1.2401 + $tag = $map{$n}->{status};
1.2402 + $new = defined($map{$n}->{rel}) ? " $n-$map{$n}->{rel}" : '';
1.2403 + printf("%-35s %-8s%s\n", $old, $tag, $new);
1.2404 + }
1.2405 +}
1.2406 +
1.2407 +# compute path to source RPM from rpm config and target data
1.2408 +sub target2srcrpm ($$) {
1.2409 + my ($target, $c) = @_;
1.2410 + return $c->{srcrpmdir}.'/'.$target->{name}.'-'.$target->{version}.'-'.$target->{release}.'.src.rpm';
1.2411 +}
1.2412 +
1.2413 +# compute path to binary RPM from rpm config and target data
1.2414 +sub target2rpm ($$) {
1.2415 + my ($target, $c) = @_;
1.2416 + my ($tmpl) = $c->{template};
1.2417 + my ($popt) = $target->{PROXY} ? '+PROXY' : '';
1.2418 +
1.2419 + $tmpl =~ s/%{NAME}/$target->{name}/;
1.2420 + $tmpl =~ s/%{VERSION}/$target->{version}/;
1.2421 + $tmpl =~ s/%{RELEASE}/$target->{release}$popt/;
1.2422 +
1.2423 + return $c->{rpmdir}.'/'.$tmpl;
1.2424 +}
1.2425 +
1.2426 +# merge parameters from installed package
1.2427 +# with new parameter set and global parameters
1.2428 +# from configuration
1.2429 +# then map the result to --define command line arguments
1.2430 +# suitable for rpm
1.2431 +sub make_defines ($$$$) {
1.2432 + my ($old, $new, $def, $c) = @_;
1.2433 + my ($with);
1.2434 +
1.2435 + $old = {} unless $old;
1.2436 + $def = {} unless $def;
1.2437 +
1.2438 + # override old parameters with new parameters
1.2439 + # drop new parameters that do not exist in old set
1.2440 + $old = { %$old };
1.2441 + override_options($old, $new, $c->{optreg});
1.2442 +
1.2443 + # convert parameters to --define command line options
1.2444 + # skip parameter templates from index
1.2445 + # skip parameters that are identical to defaults
1.2446 + $with = join(' ',
1.2447 + map { "--define '$_ $old->{$_}'" }
1.2448 + sort grep {
1.2449 + $old->{$_} =~ m/\S/ &&
1.2450 + $old->{$_} !~ m/^%/ &&
1.2451 + $old->{$_} ne $def->{$_}
1.2452 + } keys %$old
1.2453 + );
1.2454 +
1.2455 + $with = ' '.$with if ($with ne '');
1.2456 +
1.2457 + return $with;
1.2458 +}
1.2459 +
1.2460 +# compute new target based on old target augmented with options from
1.2461 +# a binary RPM file
1.2462 +sub binary_target ($$) {
1.2463 + my ($t, $fn) = @_;
1.2464 + my (%target) = %$t;
1.2465 +
1.2466 + # pull in options from binary RPM file
1.2467 + delete $target{'OPTIONS'};
1.2468 + get_with(\%target, $fn);
1.2469 + return \%target;
1.2470 +}
1.2471 +
1.2472 +# return path to master package for a proxy package
1.2473 +sub find_proxy ($$) {
1.2474 + my ($t, $bpkg) = @_;
1.2475 + my (@l) = run($config->{"rpm"} . " -ql $t->{name}");
1.2476 + my ($link) = (grep { $_ =~ m/\/\.prefix-$t->{name}$/ } @l)[0];
1.2477 + return if (not defined($link));
1.2478 + chomp $link;
1.2479 + my ($prefix) = readlink($link);
1.2480 + return if (not defined($prefix));
1.2481 + $bpkg =~ s/.*\///;
1.2482 + $bpkg =~ s/\+PROXY(\.[^-]+-[^-]+)-[^-]+\.rpm$/$1-*.rpm/;
1.2483 + return (glob("$prefix/RPM/PKG/$bpkg"))[0];
1.2484 +}
1.2485 +
1.2486 +# indent text to form a block
1.2487 +sub indent ($) {
1.2488 + my ($txt) = @_;
1.2489 + $txt =~ s/^/ /gm;
1.2490 + return $txt;
1.2491 +}
1.2492 +
1.2493 +# print commands from package build list
1.2494 +# c -> configuration to derive paths from
1.2495 +# uncond -> always do the --rebuild
1.2496 +# with -> parameter set passed to build tool
1.2497 +# ignore -> generate script that does not stop on error
1.2498 +# usebin -> build-time check to skip rebuild when binary exists
1.2499 +# allbin -> usebin also for goals
1.2500 +sub print_list1 ($$$$$$$) {
1.2501 + my ($list, $c, $uncond, $with, $ignore, $usebin, $allbin) = @_;
1.2502 + my ($pkg, $spkg, $bpkg, $uvhpkg, $ppkg);
1.2503 + my ($opt);
1.2504 + my ($cmd1, $cmd2, $mark);
1.2505 + my ($cmd3, $srcpkg);
1.2506 +
1.2507 + $mark = '::::';
1.2508 +
1.2509 + my $err;
1.2510 + if ($ignore) { $err = "|| true" } else { $err = "|| exit \$?" };
1.2511 + foreach (@$list) {
1.2512 + $pkg = $_->{name};
1.2513 + $spkg = $_->{href};
1.2514 + unless ($spkg =~ m/\S/) {
1.2515 + die "openpkg:build:FATAL: internal error, ",vsn($_)," without source URL\n";
1.2516 + }
1.2517 + $bpkg = target2rpm($_, $c); $uvhpkg = $bpkg;
1.2518 + $srcpkg = target2srcrpm($_, $c);
1.2519 + $cmd3 = '';
1.2520 +
1.2521 + # rebuild binary package IF
1.2522 + # 'unconditional' option
1.2523 + # OR target is tagged as rebuilding
1.2524 + # OR there is no binary package
1.2525 + # OR dependency check found that installed package is not suitable
1.2526 + # OR existing binary package doesn't satisfy wanted options
1.2527 + $cmd1 = undef;
1.2528 + if ( $uncond
1.2529 + || !-f $bpkg
1.2530 + || !target_suitable(binary_target($_, $bpkg), $with, 1)) {
1.2531 +
1.2532 + $opt = make_defines($_->{OPTIONS}, $with,
1.2533 + $_->{DEFOPTS}, $c);
1.2534 +
1.2535 + # proxy packages are rebuilt from their maste
1.2536 + # hierachy
1.2537 + # someone preferred a binary from the repository
1.2538 + # just copy it to the local store
1.2539 + if ($_->{PROXY}) {
1.2540 + $ppkg = find_proxy($_,$bpkg) or
1.2541 + die "openpkg:build:FATAL: proxy package ",vsn($_)," does not exist\n";
1.2542 +
1.2543 + # rpm doesn't support additional parameters to the
1.2544 + # mkproxy script
1.2545 + # $cmd1 = npriv($config->{"mkp"} . " $ppkg -- -o $bpkg");
1.2546 + $cmd1 = "( cd $c->{rpmdir} && ".
1.2547 + npriv($config->{"mkp"} . " $ppkg").
1.2548 + " )";
1.2549 + } elsif (defined $_->{prefix}) {
1.2550 + $cmd1 = '';
1.2551 + if ($spkg =~ m|^\.?/|) {
1.2552 + $uvhpkg = $spkg;
1.2553 + }
1.2554 + else {
1.2555 + $cmd1 .= npriv($config->{"curl"} . " -# -o $bpkg $spkg $err\n");
1.2556 + $cmd3 = npriv("rm -f $bpkg >/dev/null 2>&1 $err\n") unless ($opt_k);
1.2557 + }
1.2558 + } else {
1.2559 + $cmd1 = '';
1.2560 + if ($spkg =~ m|^\.?/|) {
1.2561 + $cmd1 .= npriv($config->{"rpm"} . "$opt --rebuild $spkg $err\n");
1.2562 + }
1.2563 + else {
1.2564 + $cmd1 .= "if test ! -f $srcpkg; then\n";
1.2565 + $cmd1 .= indent(npriv($config->{"curl"} . " -# -o $srcpkg $spkg $err\n"));
1.2566 + $cmd1 .= "fi\n";
1.2567 + $cmd1 .= npriv($config->{"rpm"} . "$opt --rebuild $srcpkg $err\n");
1.2568 + $cmd1 .= npriv("rm -f $srcpkg >/dev/null 2>&1 $err\n") unless ($opt_k);
1.2569 + }
1.2570 + }
1.2571 + }
1.2572 +
1.2573 + # wrap build command with build-time check for existing
1.2574 + # binary target
1.2575 + if (defined($cmd1) && ($allbin || ($usebin && !$_->{GOAL}))) {
1.2576 + $cmd1 = "if test ! -f $uvhpkg; then\n".indent($cmd1)."fi\n";
1.2577 + }
1.2578 +
1.2579 + # if package exist force rpm to copy over new files
1.2580 + # better than erasing everything and losing configuration
1.2581 + # files
1.2582 + $opt = ($_->{REBUILD} || ($allbin || ($usebin && !$_->{GOAL}))) ? ' --force' : '';
1.2583 + $cmd2 = '';
1.2584 + $cmd2 .= priv($config->{"rpm"} . "$opt -Uvh $uvhpkg $err\n");
1.2585 + if ($allbin || ($usebin && !$_->{GOAL})) {
1.2586 + $cmd2 = "if test \".`".$config->{"rpm"}." -q --qf '\%{SIGMD5}' $pkg`\" != \".`".$config->{"rpm"}." -qp --qf '\%{SIGMD5}' $uvhpkg`\"; then\n".indent($cmd2)."fi\n";
1.2587 + }
1.2588 + $cmd2 = $cmd1.$cmd2 if ($cmd1);
1.2589 + $cmd2 = $cmd2.$cmd3 if ($cmd3);
1.2590 + print "echo $mark $spkg $mark\n".$cmd2."echo $mark $spkg = \$? $mark\n";
1.2591 + }
1.2592 +}
1.2593 +
1.2594 +# print commands for the temporary package list
1.2595 +# temporary packages are only used for building other packages
1.2596 +# and are removed when everything is done
1.2597 +sub print_list2 ($$) {
1.2598 + my ($list, $c) = @_;
1.2599 + my ($pkg);
1.2600 +
1.2601 + foreach (@$list) {
1.2602 + $pkg = "$_->{name}-$_->{version}-$_->{release}";
1.2603 + print priv($config->{"rpm"} . " -e $pkg\n");
1.2604 + }
1.2605 +}
1.2606 +
